Compare commits
15 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 58519f9a4d | |||
| 6b1a5e31b5 | |||
|
d332322200 | ||
|
|
1d4e66b863 | ||
|
|
8c3cce2fd8 | ||
|
|
0de3eac7be | ||
| 1a07c673c7 | |||
| 665d80261d | |||
| b0d3bd4e35 | |||
| e3583f9152 | |||
| 7fd15a5cff | |||
|
cb8c2558e0 | ||
| ffc008e07a | |||
|
|
81445d48f3 | ||
|
|
1c33c1368f |
2
.gitignore
vendored
2
.gitignore
vendored
@@ -332,3 +332,5 @@ ASALocalRun/
|
||||
### --- ###
|
||||
src/PrayerTracker/appsettings.json
|
||||
docs/_site
|
||||
|
||||
.ionide
|
||||
@@ -1,6 +1,6 @@
|
||||
# PrayerTracker
|
||||
|
||||
[](https://ci.appveyor.com/project/danieljsummers/prayertracker/branch/master)
|
||||
[](https://ci.appveyor.com/project/danieljsummers/prayertracker/branch/main)
|
||||
|
||||
### Visit the Site
|
||||
|
||||
|
||||
@@ -1,12 +1,10 @@
|
||||
GEM
|
||||
remote: https://rubygems.org/
|
||||
specs:
|
||||
activesupport (4.2.11.1)
|
||||
i18n (~> 0.7)
|
||||
minitest (~> 5.1)
|
||||
thread_safe (~> 0.3, >= 0.3.4)
|
||||
tzinfo (~> 1.1)
|
||||
addressable (2.7.0)
|
||||
activesupport (3.2.22.5)
|
||||
i18n (~> 0.6, >= 0.6.4)
|
||||
multi_json (~> 1.0)
|
||||
addressable (2.8.0)
|
||||
public_suffix (>= 2.0.2, < 5.0)
|
||||
coffee-script (2.4.1)
|
||||
coffee-script-source
|
||||
@@ -15,10 +13,10 @@ GEM
|
||||
colorator (1.1.0)
|
||||
commonmarker (0.17.13)
|
||||
ruby-enum (~> 0.5)
|
||||
concurrent-ruby (1.1.5)
|
||||
dnsruby (1.61.3)
|
||||
addressable (~> 2.5)
|
||||
em-websocket (0.5.1)
|
||||
concurrent-ruby (1.1.7)
|
||||
dnsruby (1.61.5)
|
||||
simpleidn (~> 0.1)
|
||||
em-websocket (0.5.2)
|
||||
eventmachine (>= 0.12.9)
|
||||
http_parser.rb (~> 0.6.0)
|
||||
ethon (0.12.0)
|
||||
@@ -26,56 +24,56 @@ GEM
|
||||
eventmachine (1.2.7)
|
||||
eventmachine (1.2.7-x64-mingw32)
|
||||
execjs (2.7.0)
|
||||
faraday (0.17.0)
|
||||
faraday (1.1.0)
|
||||
multipart-post (>= 1.2, < 3)
|
||||
ffi (1.11.1)
|
||||
ffi (1.11.1-x64-mingw32)
|
||||
ruby2_keywords
|
||||
ffi (1.13.1)
|
||||
ffi (1.13.1-x64-mingw32)
|
||||
forwardable-extended (2.6.0)
|
||||
gemoji (3.0.1)
|
||||
github-pages (201)
|
||||
activesupport (= 4.2.11.1)
|
||||
github-pages (209)
|
||||
github-pages-health-check (= 1.16.1)
|
||||
jekyll (= 3.8.5)
|
||||
jekyll-avatar (= 0.6.0)
|
||||
jekyll (= 3.9.0)
|
||||
jekyll-avatar (= 0.7.0)
|
||||
jekyll-coffeescript (= 1.1.1)
|
||||
jekyll-commonmark-ghpages (= 0.1.6)
|
||||
jekyll-default-layout (= 0.1.4)
|
||||
jekyll-feed (= 0.11.0)
|
||||
jekyll-feed (= 0.15.1)
|
||||
jekyll-gist (= 1.5.0)
|
||||
jekyll-github-metadata (= 2.12.1)
|
||||
jekyll-mentions (= 1.4.1)
|
||||
jekyll-optional-front-matter (= 0.3.0)
|
||||
jekyll-github-metadata (= 2.13.0)
|
||||
jekyll-mentions (= 1.6.0)
|
||||
jekyll-optional-front-matter (= 0.3.2)
|
||||
jekyll-paginate (= 1.1.0)
|
||||
jekyll-readme-index (= 0.2.0)
|
||||
jekyll-redirect-from (= 0.14.0)
|
||||
jekyll-relative-links (= 0.6.0)
|
||||
jekyll-remote-theme (= 0.4.0)
|
||||
jekyll-readme-index (= 0.3.0)
|
||||
jekyll-redirect-from (= 0.16.0)
|
||||
jekyll-relative-links (= 0.6.1)
|
||||
jekyll-remote-theme (= 0.4.2)
|
||||
jekyll-sass-converter (= 1.5.2)
|
||||
jekyll-seo-tag (= 2.5.0)
|
||||
jekyll-sitemap (= 1.2.0)
|
||||
jekyll-swiss (= 0.4.0)
|
||||
jekyll-seo-tag (= 2.6.1)
|
||||
jekyll-sitemap (= 1.4.0)
|
||||
jekyll-swiss (= 1.0.0)
|
||||
jekyll-theme-architect (= 0.1.1)
|
||||
jekyll-theme-cayman (= 0.1.1)
|
||||
jekyll-theme-dinky (= 0.1.1)
|
||||
jekyll-theme-hacker (= 0.1.1)
|
||||
jekyll-theme-hacker (= 0.1.2)
|
||||
jekyll-theme-leap-day (= 0.1.1)
|
||||
jekyll-theme-merlot (= 0.1.1)
|
||||
jekyll-theme-midnight (= 0.1.1)
|
||||
jekyll-theme-minimal (= 0.1.1)
|
||||
jekyll-theme-modernist (= 0.1.1)
|
||||
jekyll-theme-primer (= 0.5.3)
|
||||
jekyll-theme-primer (= 0.5.4)
|
||||
jekyll-theme-slate (= 0.1.1)
|
||||
jekyll-theme-tactile (= 0.1.1)
|
||||
jekyll-theme-time-machine (= 0.1.1)
|
||||
jekyll-titles-from-headings (= 0.5.1)
|
||||
jemoji (= 0.10.2)
|
||||
kramdown (= 1.17.0)
|
||||
liquid (= 4.0.0)
|
||||
listen (= 3.1.5)
|
||||
jekyll-titles-from-headings (= 0.5.3)
|
||||
jemoji (= 0.12.0)
|
||||
kramdown (= 2.3.0)
|
||||
kramdown-parser-gfm (= 1.1.0)
|
||||
liquid (= 4.0.3)
|
||||
mercenary (~> 0.3)
|
||||
minima (= 2.5.0)
|
||||
minima (= 2.5.1)
|
||||
nokogiri (>= 1.10.4, < 2.0)
|
||||
rouge (= 3.11.0)
|
||||
rouge (= 3.23.0)
|
||||
terminal-table (~> 1.4)
|
||||
github-pages-health-check (1.16.1)
|
||||
addressable (~> 2.3)
|
||||
@@ -83,27 +81,27 @@ GEM
|
||||
octokit (~> 4.0)
|
||||
public_suffix (~> 3.0)
|
||||
typhoeus (~> 1.3)
|
||||
html-pipeline (2.12.0)
|
||||
html-pipeline (2.14.0)
|
||||
activesupport (>= 2)
|
||||
nokogiri (>= 1.4)
|
||||
http_parser.rb (0.6.0)
|
||||
i18n (0.9.5)
|
||||
concurrent-ruby (~> 1.0)
|
||||
jekyll (3.8.5)
|
||||
jekyll (3.9.0)
|
||||
addressable (~> 2.4)
|
||||
colorator (~> 1.0)
|
||||
em-websocket (~> 0.5)
|
||||
i18n (~> 0.7)
|
||||
jekyll-sass-converter (~> 1.0)
|
||||
jekyll-watch (~> 2.0)
|
||||
kramdown (~> 1.14)
|
||||
kramdown (>= 1.17, < 3)
|
||||
liquid (~> 4.0)
|
||||
mercenary (~> 0.3.3)
|
||||
pathutil (~> 0.9)
|
||||
rouge (>= 1.7, < 4)
|
||||
safe_yaml (~> 1.0)
|
||||
jekyll-avatar (0.6.0)
|
||||
jekyll (~> 3.0)
|
||||
jekyll-avatar (0.7.0)
|
||||
jekyll (>= 3.0, < 5.0)
|
||||
jekyll-coffeescript (1.1.1)
|
||||
coffee-script (~> 2.2)
|
||||
coffee-script-source (~> 1.11.1)
|
||||
@@ -116,36 +114,37 @@ GEM
|
||||
rouge (>= 2.0, < 4.0)
|
||||
jekyll-default-layout (0.1.4)
|
||||
jekyll (~> 3.0)
|
||||
jekyll-feed (0.11.0)
|
||||
jekyll (~> 3.3)
|
||||
jekyll-feed (0.15.1)
|
||||
jekyll (>= 3.7, < 5.0)
|
||||
jekyll-gist (1.5.0)
|
||||
octokit (~> 4.2)
|
||||
jekyll-github-metadata (2.12.1)
|
||||
jekyll (~> 3.4)
|
||||
jekyll-github-metadata (2.13.0)
|
||||
jekyll (>= 3.4, < 5.0)
|
||||
octokit (~> 4.0, != 4.4.0)
|
||||
jekyll-mentions (1.4.1)
|
||||
jekyll-mentions (1.6.0)
|
||||
html-pipeline (~> 2.3)
|
||||
jekyll (~> 3.0)
|
||||
jekyll-optional-front-matter (0.3.0)
|
||||
jekyll (~> 3.0)
|
||||
jekyll (>= 3.7, < 5.0)
|
||||
jekyll-optional-front-matter (0.3.2)
|
||||
jekyll (>= 3.0, < 5.0)
|
||||
jekyll-paginate (1.1.0)
|
||||
jekyll-readme-index (0.2.0)
|
||||
jekyll (~> 3.0)
|
||||
jekyll-redirect-from (0.14.0)
|
||||
jekyll (~> 3.3)
|
||||
jekyll-relative-links (0.6.0)
|
||||
jekyll (~> 3.3)
|
||||
jekyll-remote-theme (0.4.0)
|
||||
jekyll-readme-index (0.3.0)
|
||||
jekyll (>= 3.0, < 5.0)
|
||||
jekyll-redirect-from (0.16.0)
|
||||
jekyll (>= 3.3, < 5.0)
|
||||
jekyll-relative-links (0.6.1)
|
||||
jekyll (>= 3.3, < 5.0)
|
||||
jekyll-remote-theme (0.4.2)
|
||||
addressable (~> 2.0)
|
||||
jekyll (~> 3.5)
|
||||
rubyzip (>= 1.2.1, < 3.0)
|
||||
jekyll (>= 3.5, < 5.0)
|
||||
jekyll-sass-converter (>= 1.0, <= 3.0.0, != 2.0.0)
|
||||
rubyzip (>= 1.3.0, < 3.0)
|
||||
jekyll-sass-converter (1.5.2)
|
||||
sass (~> 3.4)
|
||||
jekyll-seo-tag (2.5.0)
|
||||
jekyll (~> 3.3)
|
||||
jekyll-sitemap (1.2.0)
|
||||
jekyll (~> 3.3)
|
||||
jekyll-swiss (0.4.0)
|
||||
jekyll-seo-tag (2.6.1)
|
||||
jekyll (>= 3.3, < 5.0)
|
||||
jekyll-sitemap (1.4.0)
|
||||
jekyll (>= 3.7, < 5.0)
|
||||
jekyll-swiss (1.0.0)
|
||||
jekyll-theme-architect (0.1.1)
|
||||
jekyll (~> 3.5)
|
||||
jekyll-seo-tag (~> 2.0)
|
||||
@@ -155,8 +154,8 @@ GEM
|
||||
jekyll-theme-dinky (0.1.1)
|
||||
jekyll (~> 3.5)
|
||||
jekyll-seo-tag (~> 2.0)
|
||||
jekyll-theme-hacker (0.1.1)
|
||||
jekyll (~> 3.5)
|
||||
jekyll-theme-hacker (0.1.2)
|
||||
jekyll (> 3.5, < 5.0)
|
||||
jekyll-seo-tag (~> 2.0)
|
||||
jekyll-theme-leap-day (0.1.1)
|
||||
jekyll (~> 3.5)
|
||||
@@ -173,8 +172,8 @@ GEM
|
||||
jekyll-theme-modernist (0.1.1)
|
||||
jekyll (~> 3.5)
|
||||
jekyll-seo-tag (~> 2.0)
|
||||
jekyll-theme-primer (0.5.3)
|
||||
jekyll (~> 3.5)
|
||||
jekyll-theme-primer (0.5.4)
|
||||
jekyll (> 3.5, < 5.0)
|
||||
jekyll-github-metadata (~> 2.9)
|
||||
jekyll-seo-tag (~> 2.0)
|
||||
jekyll-theme-slate (0.1.1)
|
||||
@@ -186,45 +185,51 @@ GEM
|
||||
jekyll-theme-time-machine (0.1.1)
|
||||
jekyll (~> 3.5)
|
||||
jekyll-seo-tag (~> 2.0)
|
||||
jekyll-titles-from-headings (0.5.1)
|
||||
jekyll (~> 3.3)
|
||||
jekyll-titles-from-headings (0.5.3)
|
||||
jekyll (>= 3.3, < 5.0)
|
||||
jekyll-watch (2.2.1)
|
||||
listen (~> 3.0)
|
||||
jemoji (0.10.2)
|
||||
jemoji (0.12.0)
|
||||
gemoji (~> 3.0)
|
||||
html-pipeline (~> 2.2)
|
||||
jekyll (~> 3.0)
|
||||
kramdown (1.17.0)
|
||||
liquid (4.0.0)
|
||||
listen (3.1.5)
|
||||
rb-fsevent (~> 0.9, >= 0.9.4)
|
||||
rb-inotify (~> 0.9, >= 0.9.7)
|
||||
ruby_dep (~> 1.2)
|
||||
jekyll (>= 3.0, < 5.0)
|
||||
kramdown (2.3.0)
|
||||
rexml
|
||||
kramdown-parser-gfm (1.1.0)
|
||||
kramdown (~> 2.0)
|
||||
liquid (4.0.3)
|
||||
listen (3.3.1)
|
||||
rb-fsevent (~> 0.10, >= 0.10.3)
|
||||
rb-inotify (~> 0.9, >= 0.9.10)
|
||||
mercenary (0.3.6)
|
||||
mini_portile2 (2.4.0)
|
||||
minima (2.5.0)
|
||||
jekyll (~> 3.5)
|
||||
mini_portile2 (2.8.0)
|
||||
minima (2.5.1)
|
||||
jekyll (>= 3.5, < 5.0)
|
||||
jekyll-feed (~> 0.9)
|
||||
jekyll-seo-tag (~> 2.1)
|
||||
minitest (5.12.2)
|
||||
multi_json (1.15.0)
|
||||
multipart-post (2.1.1)
|
||||
nokogiri (1.10.4)
|
||||
mini_portile2 (~> 2.4.0)
|
||||
nokogiri (1.10.4-x64-mingw32)
|
||||
mini_portile2 (~> 2.4.0)
|
||||
octokit (4.14.0)
|
||||
nokogiri (1.13.6)
|
||||
mini_portile2 (~> 2.8.0)
|
||||
racc (~> 1.4)
|
||||
nokogiri (1.13.6-x64-mingw32)
|
||||
racc (~> 1.4)
|
||||
octokit (4.19.0)
|
||||
faraday (>= 0.9)
|
||||
sawyer (~> 0.8.0, >= 0.5.3)
|
||||
pathutil (0.16.2)
|
||||
forwardable-extended (~> 2.6)
|
||||
public_suffix (3.1.1)
|
||||
rb-fsevent (0.10.3)
|
||||
rb-inotify (0.10.0)
|
||||
racc (1.6.0)
|
||||
rb-fsevent (0.10.4)
|
||||
rb-inotify (0.10.1)
|
||||
ffi (~> 1.0)
|
||||
rouge (3.11.0)
|
||||
ruby-enum (0.7.2)
|
||||
rexml (3.2.5)
|
||||
rouge (3.23.0)
|
||||
ruby-enum (0.8.0)
|
||||
i18n
|
||||
ruby_dep (1.5.0)
|
||||
rubyzip (2.0.0)
|
||||
ruby2_keywords (0.0.2)
|
||||
rubyzip (2.3.0)
|
||||
safe_yaml (1.0.5)
|
||||
sass (3.7.4)
|
||||
sass-listen (~> 4.0.0)
|
||||
@@ -234,17 +239,21 @@ GEM
|
||||
sawyer (0.8.2)
|
||||
addressable (>= 2.3.5)
|
||||
faraday (> 0.8, < 2.0)
|
||||
simpleidn (0.1.1)
|
||||
unf (~> 0.1.4)
|
||||
terminal-table (1.8.0)
|
||||
unicode-display_width (~> 1.1, >= 1.1.1)
|
||||
thread_safe (0.3.6)
|
||||
typhoeus (1.3.1)
|
||||
typhoeus (1.4.0)
|
||||
ethon (>= 0.9.0)
|
||||
tzinfo (1.2.5)
|
||||
thread_safe (~> 0.1)
|
||||
tzinfo-data (1.2019.3)
|
||||
tzinfo (2.0.3)
|
||||
concurrent-ruby (~> 1.0)
|
||||
tzinfo-data (1.2020.4)
|
||||
tzinfo (>= 1.0.0)
|
||||
unicode-display_width (1.6.0)
|
||||
wdm (0.1.1)
|
||||
unf (0.1.4)
|
||||
unf_ext
|
||||
unf_ext (0.0.7.7)
|
||||
unf_ext (0.0.7.7-x64-mingw32)
|
||||
unicode-display_width (1.7.0)
|
||||
|
||||
PLATFORMS
|
||||
ruby
|
||||
@@ -253,7 +262,6 @@ PLATFORMS
|
||||
DEPENDENCIES
|
||||
github-pages
|
||||
tzinfo-data
|
||||
wdm (~> 0.1.0)
|
||||
|
||||
BUNDLED WITH
|
||||
2.0.2
|
||||
2.1.4
|
||||
|
||||
@@ -1,9 +1,9 @@
|
||||
<Project>
|
||||
<PropertyGroup>
|
||||
<AssemblyVersion>7.4.0.0</AssemblyVersion>
|
||||
<FileVersion>7.4.0.0</FileVersion>
|
||||
<AssemblyVersion>7.6.1.0</AssemblyVersion>
|
||||
<FileVersion>7.6.1.0</FileVersion>
|
||||
<Authors>danieljsummers</Authors>
|
||||
<Company>Bit Badger Solutions</Company>
|
||||
<Version>7.4.0</Version>
|
||||
<Version>7.6.1</Version>
|
||||
</PropertyGroup>
|
||||
</Project>
|
||||
|
||||
@@ -1,7 +1,6 @@
|
||||
[<AutoOpen>]
|
||||
module PrayerTracker.DataAccess
|
||||
|
||||
open FSharp.Control.Tasks.ContextInsensitive
|
||||
open Microsoft.EntityFrameworkCore
|
||||
open PrayerTracker.Entities
|
||||
open System.Collections.Generic
|
||||
@@ -239,7 +238,7 @@ type AppDbContext with
|
||||
}
|
||||
let! grps = q.ToListAsync ()
|
||||
return grps
|
||||
|> Seq.map (fun grp -> grp.smallGroupId.ToString "N", sprintf "%s | %s" grp.church.name grp.name)
|
||||
|> Seq.map (fun grp -> grp.smallGroupId.ToString "N", $"{grp.church.name} | {grp.name}")
|
||||
|> List.ofSeq
|
||||
}
|
||||
|
||||
@@ -337,15 +336,8 @@ type AppDbContext with
|
||||
/// Get all PrayerTracker users as members (used to send e-mails)
|
||||
member this.AllUsersAsMembers () =
|
||||
task {
|
||||
let q =
|
||||
query {
|
||||
for usr in this.Users.AsNoTracking () do
|
||||
sortBy usr.lastName
|
||||
thenBy usr.firstName
|
||||
select { Member.empty with email = usr.emailAddress; memberName = usr.fullName }
|
||||
}
|
||||
let! usrs = q.ToListAsync ()
|
||||
return List.ofSeq usrs
|
||||
let! users = this.AllUsers ()
|
||||
return users |> List.map (fun u -> { Member.empty with email = u.emailAddress; memberName = u.fullName })
|
||||
}
|
||||
|
||||
/// Find a user based on their credentials
|
||||
|
||||
@@ -6,6 +6,8 @@ open NodaTime
|
||||
open System
|
||||
open System.Collections.Generic
|
||||
|
||||
// fsharplint:disable RecordFieldNames MemberNames
|
||||
|
||||
(*-- SUPPORT TYPES --*)
|
||||
|
||||
/// How as-of dates should (or should not) be displayed with requests
|
||||
|
||||
@@ -10,6 +10,7 @@ open PrayerTracker
|
||||
open PrayerTracker.Entities
|
||||
open System
|
||||
|
||||
// fsharplint:disable RecordFieldNames
|
||||
|
||||
type ChurchTable =
|
||||
{ churchId : OperationBuilder<AddColumnOperation>
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
<Project Sdk="Microsoft.NET.Sdk">
|
||||
|
||||
<PropertyGroup>
|
||||
<TargetFramework>netstandard2.1</TargetFramework>
|
||||
<TargetFramework>net6.0</TargetFramework>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
@@ -14,14 +14,9 @@
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="FSharp.EFCore.OptionConverter" Version="1.0.0" />
|
||||
<PackageReference Include="Microsoft.FSharpLu" Version="0.11.5" />
|
||||
<PackageReference Include="NodaTime" Version="2.4.7" />
|
||||
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="3.0.1" />
|
||||
<PackageReference Include="TaskBuilder.fs" Version="2.1.0" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Update="FSharp.Core" Version="4.7.0" />
|
||||
<PackageReference Include="Microsoft.FSharpLu" Version="0.11.7" />
|
||||
<PackageReference Include="NodaTime" Version="3.0.5" />
|
||||
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="5.0.10" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
|
||||
<PropertyGroup>
|
||||
<OutputType>Exe</OutputType>
|
||||
<TargetFramework>netcoreapp3.0</TargetFramework>
|
||||
<TargetFramework>net6.0</TargetFramework>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
@@ -15,9 +15,9 @@
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="Expecto" Version="8.12.0" />
|
||||
<PackageReference Include="Expecto" Version="9.0.4" />
|
||||
<PackageReference Include="Expecto.VisualStudio.TestAdapter" Version="10.0.2" />
|
||||
<PackageReference Include="NodaTime.Testing" Version="2.4.7" />
|
||||
<PackageReference Include="NodaTime.Testing" Version="3.0.5" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
@@ -26,8 +26,4 @@
|
||||
<ProjectReference Include="..\PrayerTracker\PrayerTracker.fsproj" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Update="FSharp.Core" Version="4.7.0" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
module PrayerTracker.UI.CommonFunctionsTests
|
||||
|
||||
open Expecto
|
||||
open Giraffe.GiraffeViewEngine
|
||||
open Giraffe.ViewEngine
|
||||
open Microsoft.AspNetCore.Mvc.Localization
|
||||
open Microsoft.Extensions.Localization
|
||||
open PrayerTracker.Tests.TestLocalization
|
||||
|
||||
@@ -660,19 +660,19 @@ let userLogOnTests =
|
||||
let userMessageTests =
|
||||
testList "UserMessage" [
|
||||
test "Error is constructed properly" {
|
||||
let msg = UserMessage.Error
|
||||
let msg = UserMessage.error
|
||||
Expect.equal msg.level "ERROR" "Incorrect message level"
|
||||
Expect.equal msg.text HtmlString.Empty "Text should have been blank"
|
||||
Expect.isNone msg.description "Description should have been None"
|
||||
}
|
||||
test "Warning is constructed properly" {
|
||||
let msg = UserMessage.Warning
|
||||
let msg = UserMessage.warning
|
||||
Expect.equal msg.level "WARNING" "Incorrect message level"
|
||||
Expect.equal msg.text HtmlString.Empty "Text should have been blank"
|
||||
Expect.isNone msg.description "Description should have been None"
|
||||
}
|
||||
test "Info is constructed properly" {
|
||||
let msg = UserMessage.Info
|
||||
let msg = UserMessage.info
|
||||
Expect.equal msg.level "Info" "Incorrect message level"
|
||||
Expect.equal msg.text HtmlString.Empty "Text should have been blank"
|
||||
Expect.isNone msg.description "Description should have been None"
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
module PrayerTracker.Views.Church
|
||||
|
||||
open Giraffe.GiraffeViewEngine
|
||||
open Giraffe.ViewEngine
|
||||
open PrayerTracker.Entities
|
||||
open PrayerTracker.ViewModels
|
||||
|
||||
@@ -74,15 +74,15 @@ let maintain (churches : Church list) (stats : Map<string, ChurchStats>) ctx vi
|
||||
churches
|
||||
|> List.map (fun ch ->
|
||||
let chId = flatGuid ch.churchId
|
||||
let delAction = sprintf "/web/church/%s/delete" chId
|
||||
let delAction = $"/web/church/{chId}/delete"
|
||||
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.",
|
||||
sprintf "%s (%s)" (s.["Church"].Value.ToLower ()) ch.name]
|
||||
$"""{s.["Church"].Value.ToLower ()} ({ch.name})"""]
|
||||
tr [] [
|
||||
td [] [
|
||||
a [ _href (sprintf "/web/church/%s/edit" chId); _title s.["Edit This Church"].Value ] [ icon "edit" ]
|
||||
a [ _href $"/web/church/{chId}/edit"; _title s.["Edit This Church"].Value ] [ icon "edit" ]
|
||||
a [ _href delAction
|
||||
_title s.["Delete This Church"].Value
|
||||
_onclick (sprintf "return PT.confirmDelete('%s','%A')" delAction delPrompt) ]
|
||||
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
|
||||
[ icon "delete_forever" ]
|
||||
]
|
||||
td [] [ str ch.name ]
|
||||
@@ -96,7 +96,7 @@ let maintain (churches : Church list) (stats : Map<string, ChurchStats>) ctx vi
|
||||
]
|
||||
[ div [ _class "pt-center-text" ] [
|
||||
br []
|
||||
a [ _href (sprintf "/web/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 " "; locStr s.["Add a New Church"] ]
|
||||
br []
|
||||
br []
|
||||
|
||||
@@ -2,8 +2,9 @@
|
||||
module PrayerTracker.Views.CommonFunctions
|
||||
|
||||
open Giraffe
|
||||
open Giraffe.GiraffeViewEngine
|
||||
open Giraffe.ViewEngine
|
||||
open Microsoft.AspNetCore.Antiforgery
|
||||
open Microsoft.AspNetCore.Html
|
||||
open Microsoft.AspNetCore.Http
|
||||
open Microsoft.AspNetCore.Mvc.Localization
|
||||
open Microsoft.Extensions.Localization
|
||||
@@ -28,7 +29,7 @@ let space = rawText " "
|
||||
let icon name = i [ _class "material-icons" ] [ rawText name ]
|
||||
|
||||
/// Generate a Material Design icon, specifying the point size (must be defined in CSS)
|
||||
let iconSized size name = i [ _class (sprintf "material-icons md-%i" size) ] [ rawText name ]
|
||||
let iconSized size name = i [ _class $"material-icons md-{size}" ] [ rawText name ]
|
||||
|
||||
/// Generate a CSRF prevention token
|
||||
let csrfToken (ctx : HttpContext) =
|
||||
@@ -72,7 +73,7 @@ let namedColorList name selected attrs (s : IStringLocalizer) =
|
||||
|> Seq.map (fun color ->
|
||||
let (colorName, dispText, txtColor) = color
|
||||
option [ yield _value colorName
|
||||
yield _style (sprintf "background-color:%s;color:%s;" colorName txtColor)
|
||||
yield _style $"background-color:{colorName};color:{txtColor};"
|
||||
match colorName = selected with true -> yield _selected | false -> () ] [
|
||||
encodedText (dispText.Value.ToLower ())
|
||||
])
|
||||
@@ -97,7 +98,7 @@ let selectList name selected attrs items =
|
||||
|> select (List.concat [ [ _name name; _id name ]; attrs ])
|
||||
|
||||
/// Generate the text for a default entry at the top of a select list
|
||||
let selectDefault text = sprintf "— %s —" text
|
||||
let selectDefault text = $"— {text} —"
|
||||
|
||||
/// Generate a standard submit button with icon and text
|
||||
let submit attrs ico text = button (_type "submit" :: attrs) [ icon ico; rawText " "; locStr text ]
|
||||
@@ -115,7 +116,7 @@ let blockquote = tag "blockquote"
|
||||
/// role attribute
|
||||
let _role = attr "role"
|
||||
/// aria-* attribute
|
||||
let _aria typ = attr (sprintf "aria-%s" typ)
|
||||
let _aria typ = attr $"aria-{typ}"
|
||||
/// onclick attribute
|
||||
let _onclick = attr "onclick"
|
||||
/// onsubmit attribute
|
||||
@@ -125,6 +126,13 @@ let _onsubmit = attr "onsubmit"
|
||||
let _scoped = flag "scoped"
|
||||
|
||||
|
||||
/// The name this function used to have when the view engine was part of Giraffe
|
||||
let renderHtmlNode = RenderView.AsString.htmlNode
|
||||
|
||||
/// Render an HTML node, then return the value as an HTML string
|
||||
let renderHtmlString = renderHtmlNode >> HtmlString
|
||||
|
||||
|
||||
/// Utility methods to help with time zones (and localization of their names)
|
||||
module TimeZones =
|
||||
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
/// Views associated with the home page, or those that don't fit anywhere else
|
||||
module PrayerTracker.Views.Home
|
||||
|
||||
open Giraffe.GiraffeViewEngine
|
||||
open Giraffe.ViewEngine
|
||||
open Microsoft.AspNetCore.Html
|
||||
open PrayerTracker.ViewModels
|
||||
open System.IO
|
||||
@@ -35,9 +35,9 @@ let error code vi =
|
||||
br []
|
||||
hr []
|
||||
div [ _style "font-size:70%;font-family:-apple-system,BlinkMacSystemFont,'Segoe UI',Roboto,Oxygen-Sans,Ubuntu,Cantarell,'Helvetica Neue',sans-serif" ] [
|
||||
img [ _src (sprintf "/img/%A.png" s.["footer_en"])
|
||||
_alt (sprintf "%A %A" s.["PrayerTracker"] s.["from Bit Badger Solutions"])
|
||||
_title (sprintf "%A %A" s.["PrayerTracker"] s.["from Bit Badger Solutions"])
|
||||
img [ _src $"""/img/%A{s.["footer_en"]}.png"""
|
||||
_alt $"""%A{s.["PrayerTracker"]} %A{s.["from Bit Badger Solutions"]}"""
|
||||
_title $"""%A{s.["PrayerTracker"]} %A{s.["from Bit Badger Solutions"]}"""
|
||||
_style "vertical-align:text-bottom;" ]
|
||||
str vi.version
|
||||
]
|
||||
@@ -204,7 +204,7 @@ let termsOfService vi =
|
||||
let raw = rawLocText sw
|
||||
let ppLink =
|
||||
a [ _href "/web/legal/privacy-policy" ] [ str (s.["Privacy Policy"].Value.ToLower ()) ]
|
||||
|> (renderHtmlNode >> HtmlString)
|
||||
|> renderHtmlString
|
||||
|
||||
[ p [ _class "pt-right-text" ] [ small [] [ em [] [ raw l.["(as of May 24, 2018)"] ] ] ]
|
||||
h3 [] [ str "1. "; raw l.["Acceptance of Terms"] ]
|
||||
|
||||
@@ -19,4 +19,4 @@ let localizer = lazy (stringLocFactory.Create ("Common", resAsmName))
|
||||
|
||||
/// Get a view localizer
|
||||
let forView (view : string) =
|
||||
htmlLocFactory.Create (sprintf "Views.%s" (view.Replace ('/', '.')), resAsmName)
|
||||
htmlLocFactory.Create ($"""Views.{view.Replace ('/', '.')}""", resAsmName)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
/// Layout items for PrayerTracker
|
||||
module PrayerTracker.Views.Layout
|
||||
|
||||
open Giraffe.GiraffeViewEngine
|
||||
open Giraffe.ViewEngine
|
||||
open PrayerTracker
|
||||
open PrayerTracker.ViewModels
|
||||
open System
|
||||
@@ -76,7 +76,7 @@ module Navigation =
|
||||
[ icon "list"; space; locStr s.["View Request List"] ]
|
||||
]
|
||||
li [] [
|
||||
a [ _href (sprintf "https://docs.prayer.bitbadger.solutions/%s" <| langCode ())
|
||||
a [ _href $"https://docs.prayer.bitbadger.solutions/{langCode ()}"
|
||||
_aria "label" s.["Help"].Value;
|
||||
_title s.["View Help"].Value
|
||||
_target "_blank"
|
||||
@@ -183,9 +183,9 @@ let private htmlHead m pageTitle =
|
||||
title [] [ locStr pageTitle; titleSep; locStr s.["PrayerTracker"] ]
|
||||
yield! commonHead
|
||||
for cssFile in m.style do
|
||||
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
|
||||
script [ _src (sprintf "/js/%s.js" jsFile) ] []
|
||||
script [ _src $"/js/{jsFile}.js" ] []
|
||||
]
|
||||
|
||||
/// Render a link to the help page for the current page
|
||||
@@ -194,7 +194,7 @@ let private helpLink link =
|
||||
sup [] [
|
||||
a [ _href link
|
||||
_title s.["Click for Help on This Page"].Value
|
||||
_onclick (sprintf "return PT.showHelp('%s')" link) ] [
|
||||
_onclick $"return PT.showHelp('{link}')" ] [
|
||||
icon "help_outline"
|
||||
]
|
||||
]
|
||||
@@ -211,7 +211,7 @@ let private messages m =
|
||||
let s = I18N.localizer.Force ()
|
||||
m.messages
|
||||
|> List.map (fun msg ->
|
||||
table [ _class (sprintf "pt-msg %s" (msg.level.ToLower ())) ] [
|
||||
table [ _class $"pt-msg {msg.level.ToLower ()}" ] [
|
||||
tr [] [
|
||||
td [] [
|
||||
match msg.level with
|
||||
@@ -249,7 +249,7 @@ let private htmlFooter m =
|
||||
]
|
||||
div [ _id "pt-footer" ] [
|
||||
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
|
||||
space
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
module PrayerTracker.Views.PrayerRequest
|
||||
|
||||
open Giraffe
|
||||
open Giraffe.GiraffeViewEngine
|
||||
open Giraffe.ViewEngine
|
||||
open Microsoft.AspNetCore.Http
|
||||
open NodaTime
|
||||
open PrayerTracker
|
||||
@@ -55,7 +55,7 @@ let edit (m : EditRequest) today ctx vi =
|
||||
label [] [ locStr s.["Expiration"] ]
|
||||
ReferenceList.expirationList s ((m.isNew >> not) ())
|
||||
|> List.map (fun exp ->
|
||||
let radioId = sprintf "expiration_%s" (fst exp)
|
||||
let radioId = $"expiration_{fst exp}"
|
||||
span [ _class "text-nowrap" ] [
|
||||
radio "expiration" radioId (fst exp) m.expiration
|
||||
label [ _for radioId ] [ locStr (snd exp) ]
|
||||
@@ -80,13 +80,13 @@ let edit (m : EditRequest) today ctx vi =
|
||||
/// View for the request e-mail results page
|
||||
let email m vi =
|
||||
let s = I18N.localizer.Force ()
|
||||
let pageTitle = sprintf "%s • %s" s.["Prayer Requests"].Value m.listGroup.name
|
||||
let pageTitle = $"""{s.["Prayer Requests"].Value} • {m.listGroup.name}"""
|
||||
let prefs = m.listGroup.preferences
|
||||
let addresses =
|
||||
m.recipients
|
||||
|> List.fold (fun (acc : StringBuilder) mbr -> acc.AppendFormat(", {0} <{1}>", mbr.memberName, mbr.email))
|
||||
(StringBuilder ())
|
||||
[ p [ _style (sprintf "font-family:%s;font-size:%ipt;" prefs.listFonts prefs.textFontSize) ] [
|
||||
[ p [ _style $"font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;" ] [
|
||||
locStr s.["The request list was sent to the following people, via individual e-mails"]
|
||||
rawText ":"
|
||||
br []
|
||||
@@ -143,9 +143,9 @@ let lists (grps : SmallGroup list) vi =
|
||||
tr [] [
|
||||
match grp.preferences.isPublic with
|
||||
| true ->
|
||||
a [ _href (sprintf "/web/prayer-requests/%s/list" grpId); _title s.["View"].Value ] [ icon "list" ]
|
||||
a [ _href $"/web/prayer-requests/{grpId}/list"; _title s.["View"].Value ] [ icon "list" ]
|
||||
| false ->
|
||||
a [ _href (sprintf "/web/small-group/log-on/%s" grpId); _title s.["Log On"].Value ]
|
||||
a [ _href $"/web/small-group/log-on/{grpId}"; _title s.["Log On"].Value ]
|
||||
[ icon "verified_user" ]
|
||||
|> List.singleton
|
||||
|> td []
|
||||
@@ -179,8 +179,8 @@ let maintain m (ctx : HttpContext) vi =
|
||||
m.requests
|
||||
|> Seq.map (fun req ->
|
||||
let reqId = flatGuid req.prayerRequestId
|
||||
let reqText = Utils.htmlToPlainText req.text
|
||||
let delAction = sprintf "/web/prayer-request/%s/delete" reqId
|
||||
let reqText = htmlToPlainText req.text
|
||||
let delAction = $"/web/prayer-request/{reqId}/delete"
|
||||
let delPrompt =
|
||||
[ s.["Are you sure you want to delete this {0}? This action cannot be undone.",
|
||||
s.["Prayer Request"].Value.ToLower() ]
|
||||
@@ -192,36 +192,36 @@ let maintain m (ctx : HttpContext) vi =
|
||||
|> String.concat ""
|
||||
tr [] [
|
||||
td [] [
|
||||
a [ _href (sprintf "/web/prayer-request/%s/edit" reqId); _title l.["Edit This Prayer Request"].Value ]
|
||||
a [ _href $"/web/prayer-request/{reqId}/edit"; _title l.["Edit This Prayer Request"].Value ]
|
||||
[ icon "edit" ]
|
||||
match req.isExpired now m.smallGroup.preferences.daysToExpire with
|
||||
| true ->
|
||||
a [ _href (sprintf "/web/prayer-request/%s/restore" reqId)
|
||||
a [ _href $"/web/prayer-request/{reqId}/restore"
|
||||
_title l.["Restore This Inactive Request"].Value ]
|
||||
[ icon "visibility" ]
|
||||
| false ->
|
||||
a [ _href (sprintf "/web/prayer-request/%s/expire" reqId)
|
||||
a [ _href $"/web/prayer-request/{reqId}/expire"
|
||||
_title l.["Expire This Request Immediately"].Value ]
|
||||
[ icon "visibility_off" ]
|
||||
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" ]
|
||||
]
|
||||
td [ updReq req ] [
|
||||
str (req.updatedDate.ToString(s.["MMMM d, yyyy"].Value, System.Globalization.CultureInfo.CurrentUICulture))
|
||||
str (req.updatedDate.ToString(s.["MMMM d, yyyy"].Value, Globalization.CultureInfo.CurrentUICulture))
|
||||
]
|
||||
td [] [ locStr typs.[req.requestType] ]
|
||||
td [ reqExp req ] [ str (match req.requestor with Some r -> r | None -> " ") ]
|
||||
td [] [
|
||||
match reqText.Length with
|
||||
| len when len < 60 -> rawText reqText
|
||||
| _ -> rawText (sprintf "%s…" reqText.[0..59])
|
||||
| _ -> rawText $"{reqText.[0..59]}…"
|
||||
]
|
||||
])
|
||||
|> List.ofSeq
|
||||
[ div [ _class "pt-center-text" ] [
|
||||
br []
|
||||
a [ _href (sprintf "/web/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 " "; locStr s.["Add a New Request"] ]
|
||||
rawText " "
|
||||
a [ _href "/web/prayer-requests/view"; _title s.["View Prayer Request List"].Value ]
|
||||
@@ -302,14 +302,14 @@ let maintain m (ctx : HttpContext) vi =
|
||||
/// View for the printable prayer request list
|
||||
let print m version =
|
||||
let s = I18N.localizer.Force ()
|
||||
let pageTitle = sprintf "%s • %s" s.["Prayer Requests"].Value m.listGroup.name
|
||||
let imgAlt = sprintf "%s %s" s.["PrayerTracker"].Value s.["from Bit Badger Solutions"].Value
|
||||
let pageTitle = $"""{s.["Prayer Requests"].Value} • {m.listGroup.name}"""
|
||||
let imgAlt = $"""{s.["PrayerTracker"].Value} {s.["from Bit Badger Solutions"].Value}"""
|
||||
article [] [
|
||||
rawText (m.asHtml s)
|
||||
br []
|
||||
hr []
|
||||
div [ _style "font-size:70%;font-family:@Model.ListGroup.preferences.listFonts;" ] [
|
||||
img [ _src (sprintf "/img/%s.png" s.["footer_en"].Value)
|
||||
div [ _style $"font-size:70%%;font-family:{m.listGroup.preferences.listFonts};" ] [
|
||||
img [ _src $"""/img/{s.["footer_en"].Value}.png"""
|
||||
_style "vertical-align:text-bottom;"
|
||||
_alt imgAlt
|
||||
_title imgAlt ]
|
||||
@@ -323,13 +323,13 @@ let print m version =
|
||||
/// View for the prayer request list
|
||||
let view m vi =
|
||||
let s = I18N.localizer.Force ()
|
||||
let pageTitle = sprintf "%s • %s" s.["Prayer Requests"].Value m.listGroup.name
|
||||
let pageTitle = $"""{s.["Prayer Requests"].Value} • {m.listGroup.name}"""
|
||||
let spacer = rawText " "
|
||||
let dtString = m.date.ToString "yyyy-MM-dd"
|
||||
[ div [ _class "pt-center-text" ] [
|
||||
br []
|
||||
a [ _class "pt-icon-link"
|
||||
_href (sprintf "/web/prayer-requests/print/%s" dtString)
|
||||
_href $"/web/prayer-requests/print/{dtString}"
|
||||
_title s.["View Printable"].Value ] [
|
||||
icon "print"; rawText " "; locStr s.["View Printable"]
|
||||
]
|
||||
@@ -345,16 +345,16 @@ let view m vi =
|
||||
| false -> findSunday (date.AddDays 1.)
|
||||
let sunday = findSunday m.date
|
||||
a [ _class "pt-icon-link"
|
||||
_href (sprintf "/web/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 ] [
|
||||
icon "update"; rawText " "; locStr s.["List for Next Sunday"]
|
||||
]
|
||||
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
|
||||
a [ _class "pt-icon-link"
|
||||
_href (sprintf "/web/prayer-requests/email/%s" dtString)
|
||||
_href $"/web/prayer-requests/email/{dtString}"
|
||||
_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 " "; locStr s.["Send via E-mail"]
|
||||
]
|
||||
spacer
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
<Project Sdk="Microsoft.NET.Sdk">
|
||||
|
||||
<PropertyGroup>
|
||||
<TargetFramework>netstandard2.1</TargetFramework>
|
||||
<TargetFramework>net6.0</TargetFramework>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
@@ -18,13 +18,14 @@
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="Giraffe" Version="4.0.1" />
|
||||
<PackageReference Include="MailKit" Version="2.3.2" />
|
||||
<PackageReference Include="Giraffe" Version="5.0.0" />
|
||||
<PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" />
|
||||
<PackageReference Include="MailKit" Version="2.15.0" />
|
||||
<PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.2.0" />
|
||||
<PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" />
|
||||
<PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" />
|
||||
<PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" />
|
||||
<PackageReference Include="Newtonsoft.Json" Version="12.0.2" />
|
||||
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
@@ -61,8 +62,4 @@
|
||||
</EmbeddedResource>
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Update="FSharp.Core" Version="4.7.0" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
module PrayerTracker.Views.SmallGroup
|
||||
|
||||
open Giraffe.GiraffeViewEngine
|
||||
open Giraffe.ViewEngine
|
||||
open Microsoft.Extensions.Localization
|
||||
open PrayerTracker
|
||||
open PrayerTracker.Entities
|
||||
@@ -147,7 +147,7 @@ let logOn (grps : SmallGroup list) grpId ctx vi =
|
||||
| _ ->
|
||||
"", selectDefault s.["Select Group"].Value
|
||||
yield! grps
|
||||
|> List.map (fun grp -> flatGuid grp.smallGroupId, sprintf "%s | %s" grp.church.name grp.name)
|
||||
|> List.map (fun grp -> flatGuid grp.smallGroupId, $"{grp.church.name} | {grp.name}")
|
||||
}
|
||||
|> selectList "smallGroupId" grpId [ _required ]
|
||||
]
|
||||
@@ -190,15 +190,15 @@ let maintain (grps : SmallGroup list) ctx vi =
|
||||
grps
|
||||
|> List.map (fun g ->
|
||||
let grpId = flatGuid g.smallGroupId
|
||||
let delAction = sprintf "/web/small-group/%s/delete" grpId
|
||||
let delAction = $"/web/small-group/{grpId}/delete"
|
||||
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.",
|
||||
sprintf "%s (%s)" (s.["Small Group"].Value.ToLower ()) g.name].Value
|
||||
$"""{s.["Small Group"].Value.ToLower ()} ({g.name})""" ].Value
|
||||
tr [] [
|
||||
td [] [
|
||||
a [ _href (sprintf "/web/small-group/%s/edit" grpId); _title s.["Edit This Group"].Value ] [ icon "edit" ]
|
||||
a [ _href $"/web/small-group/{grpId}/edit"; _title s.["Edit This Group"].Value ] [ icon "edit" ]
|
||||
a [ _href delAction
|
||||
_title s.["Delete This Group"].Value
|
||||
_onclick (sprintf "return PT.confirmDelete('%s','%s')" delAction delPrompt) ]
|
||||
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
|
||||
[ icon "delete_forever" ]
|
||||
]
|
||||
td [] [ str g.name ]
|
||||
@@ -209,7 +209,7 @@ let maintain (grps : SmallGroup list) ctx vi =
|
||||
]
|
||||
[ div [ _class "pt-center-text" ] [
|
||||
br []
|
||||
a [ _href (sprintf "/web/small-group/%s/edit" emptyGuid); _title s.["Add a New Group"].Value ] [
|
||||
a [ _href $"/web/small-group/{emptyGuid}/edit"; _title s.["Add a New Group"].Value ] [
|
||||
icon "add_circle"
|
||||
rawText " "
|
||||
locStr s.["Add a New Group"]
|
||||
@@ -244,18 +244,18 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
|
||||
mbrs
|
||||
|> List.map (fun mbr ->
|
||||
let mbrId = flatGuid mbr.memberId
|
||||
let delAction = sprintf "/web/small-group/member/%s/delete" mbrId
|
||||
let delAction = $"/web/small-group/member/{mbrId}/delete"
|
||||
let delPrompt =
|
||||
s.["Are you sure you want to delete this {0}? This action cannot be undone.", s.["group member"]]
|
||||
.Value
|
||||
.Replace("?", sprintf " (%s)?" mbr.memberName)
|
||||
.Replace("?", $" ({mbr.memberName})?")
|
||||
tr [] [
|
||||
td [] [
|
||||
a [ _href (sprintf "/web/small-group/member/%s/edit" mbrId); _title s.["Edit This Group Member"].Value ]
|
||||
a [ _href $"/web/small-group/member/{mbrId}/edit"; _title s.["Edit This Group Member"].Value ]
|
||||
[ icon "edit" ]
|
||||
a [ _href delAction
|
||||
_title s.["Delete This Group Member"].Value
|
||||
_onclick (sprintf "return PT.confirmDelete('%s','%s')" delAction delPrompt) ]
|
||||
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
|
||||
[ icon "delete_forever" ]
|
||||
]
|
||||
td [] [ str mbr.memberName ]
|
||||
@@ -266,7 +266,7 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
|
||||
]
|
||||
[ div [ _class"pt-center-text" ] [
|
||||
br []
|
||||
a [ _href (sprintf "/web/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 " "; locStr s.["Add a New Group Member"] ]
|
||||
br []
|
||||
br []
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
module PrayerTracker.Views.User
|
||||
|
||||
open Giraffe.GiraffeViewEngine
|
||||
open Giraffe.ViewEngine
|
||||
open PrayerTracker.Entities
|
||||
open PrayerTracker.ViewModels
|
||||
|
||||
@@ -21,7 +21,7 @@ let assignGroups m groups curGroups ctx vi =
|
||||
]
|
||||
groups
|
||||
|> List.map (fun (grpId, grpName) ->
|
||||
let inputId = sprintf "id-%s" grpId
|
||||
let inputId = $"id-{grpId}"
|
||||
tr [] [
|
||||
td [] [
|
||||
input [ _type "checkbox"
|
||||
@@ -49,7 +49,7 @@ let changePassword ctx vi =
|
||||
]
|
||||
form [ _action "/web/user/password/change"
|
||||
_method "post"
|
||||
_onsubmit (sprintf "return PT.compareValidation('newPassword','newPasswordConfirm','%A')" s.["The passwords do not match"]) ] [
|
||||
_onsubmit $"""return PT.compareValidation('newPassword','newPasswordConfirm','%A{s.["The passwords do not match"]}')""" ] [
|
||||
style [ _scoped ] [ rawText "#oldPassword, #newPassword, #newPasswordConfirm { width: 10rem; } "]
|
||||
csrfToken ctx
|
||||
div [ _class "pt-field-row" ] [
|
||||
@@ -84,7 +84,7 @@ let edit (m : EditUser) ctx vi =
|
||||
let pageTitle = match m.isNew () with true -> "Add a New User" | false -> "Edit User"
|
||||
let pwPlaceholder = s.[match m.isNew () with true -> "" | false -> "No change"].Value
|
||||
[ form [ _action "/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 ]
|
||||
[ rawText "#firstName, #lastName, #password, #passwordConfirm { width: 10rem; } #emailAddress { width: 20rem; } " ]
|
||||
csrfToken ctx
|
||||
@@ -123,7 +123,7 @@ let edit (m : EditUser) ctx vi =
|
||||
]
|
||||
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save User"] ]
|
||||
]
|
||||
script [] [ rawText (sprintf "PT.onLoad(PT.user.edit.onPageLoad(%s))" ((string (m.isNew ())).ToLower ())) ]
|
||||
script [] [ rawText $"PT.onLoad(PT.user.edit.onPageLoad({(string (m.isNew ())).ToLower ()}))" ]
|
||||
]
|
||||
|> Layout.Content.standard
|
||||
|> Layout.standard vi pageTitle
|
||||
@@ -189,17 +189,17 @@ let maintain (users : User list) ctx vi =
|
||||
users
|
||||
|> List.map (fun user ->
|
||||
let userId = flatGuid user.userId
|
||||
let delAction = sprintf "/web/user/%s/delete" userId
|
||||
let delAction = $"/web/user/{userId}/delete"
|
||||
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.",
|
||||
(sprintf "%s (%s)" (s.["User"].Value.ToLower()) user.fullName)].Value
|
||||
$"""{s.["User"].Value.ToLower ()} ({user.fullName})"""].Value
|
||||
tr [] [
|
||||
td [] [
|
||||
a [ _href (sprintf "/web/user/%s/edit" userId); _title s.["Edit This User"].Value ] [ icon "edit" ]
|
||||
a [ _href (sprintf "/web/user/%s/small-groups" userId); _title s.["Assign Groups to This User"].Value ]
|
||||
a [ _href $"/web/user/{userId}/edit"; _title s.["Edit This User"].Value ] [ icon "edit" ]
|
||||
a [ _href $"/web/user/{userId}/small-groups"; _title s.["Assign Groups to This User"].Value ]
|
||||
[ icon "group" ]
|
||||
a [ _href delAction
|
||||
_title s.["Delete This User"].Value
|
||||
_onclick (sprintf "return PT.confirmDelete('%s','%s')" delAction delPrompt) ]
|
||||
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
|
||||
[ icon "delete_forever" ]
|
||||
]
|
||||
td [] [ str user.fullName ]
|
||||
@@ -213,7 +213,7 @@ let maintain (users : User list) ctx vi =
|
||||
]
|
||||
[ div [ _class "pt-center-text" ] [
|
||||
br []
|
||||
a [ _href (sprintf "/web/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 " "; locStr s.["Add a New User"] ]
|
||||
br []
|
||||
br []
|
||||
|
||||
@@ -54,9 +54,9 @@ let stripTags allowedTags input =
|
||||
|> List.fold
|
||||
(fun acc t ->
|
||||
acc
|
||||
|| htmlTag.IndexOf (sprintf "<%s>" t) = 0
|
||||
|| htmlTag.IndexOf (sprintf "<%s " t) = 0
|
||||
|| htmlTag.IndexOf (sprintf "</%s" t) = 0) false
|
||||
|| htmlTag.IndexOf $"<{t}>" = 0
|
||||
|| htmlTag.IndexOf $"<{t} " = 0
|
||||
|| htmlTag.IndexOf $"</{t}" = 0) false
|
||||
match isAllowed with
|
||||
| true -> ()
|
||||
| false -> output <- String.replaceFirst tag.Value "" output
|
||||
@@ -200,7 +200,7 @@ module Help =
|
||||
/// Help link for user password change page
|
||||
let changePassword = "user/password"
|
||||
/// Create a full link for a help page
|
||||
let fullLink lang url = sprintf "https://docs.prayer.bitbadger.solutions/%s/%s.html" lang url
|
||||
let fullLink lang url = $"https://docs.prayer.bitbadger.solutions/%s{lang}/%s{url}.html"
|
||||
|
||||
/// This class serves as a common anchor for resources
|
||||
type Common () =
|
||||
|
||||
@@ -25,7 +25,7 @@ module ReferenceList =
|
||||
| HtmlFormat -> s.["HTML Format"].Value
|
||||
| PlainTextFormat -> s.["Plain-Text Format"].Value
|
||||
seq {
|
||||
"", LocalizedString ("", sprintf "%s (%s)" s.["Group Default"].Value defaultType)
|
||||
"", LocalizedString ("", $"""{s.["Group Default"].Value} ({defaultType})""")
|
||||
HtmlFormat.code, s.["HTML Format"]
|
||||
PlainTextFormat.code, s.["Plain-Text Format"]
|
||||
}
|
||||
@@ -46,6 +46,7 @@ module ReferenceList =
|
||||
Announcement, s.["Announcements"]
|
||||
]
|
||||
|
||||
// fsharplint:disable RecordFieldNames MemberNames
|
||||
|
||||
/// This is used to create a message that is displayed to the user
|
||||
[<NoComparison; NoEquality>]
|
||||
@@ -57,21 +58,21 @@ type UserMessage =
|
||||
/// The description (further information)
|
||||
description : HtmlString option
|
||||
}
|
||||
with
|
||||
module UserMessage =
|
||||
/// Error message template
|
||||
static member Error =
|
||||
let error =
|
||||
{ level = "ERROR"
|
||||
text = HtmlString.Empty
|
||||
description = None
|
||||
}
|
||||
/// Warning message template
|
||||
static member Warning =
|
||||
let warning =
|
||||
{ level = "WARNING"
|
||||
text = HtmlString.Empty
|
||||
description = None
|
||||
}
|
||||
/// Info message template
|
||||
static member Info =
|
||||
let info =
|
||||
{ level = "Info"
|
||||
text = HtmlString.Empty
|
||||
description = None
|
||||
@@ -98,9 +99,9 @@ type AppViewInfo =
|
||||
/// The currently logged on small group, if there is one
|
||||
group : SmallGroup option
|
||||
}
|
||||
with
|
||||
module AppViewInfo =
|
||||
/// A fresh version that can be populated to process the current request
|
||||
static member fresh =
|
||||
let fresh =
|
||||
{ style = []
|
||||
script = []
|
||||
helpLink = None
|
||||
@@ -139,9 +140,9 @@ type AssignGroups =
|
||||
/// The Ids of the small groups to which the user is authorized
|
||||
smallGroups : string
|
||||
}
|
||||
with
|
||||
module AssignGroups =
|
||||
/// Create an instance of this form from an existing user
|
||||
static member fromUser (u : User) =
|
||||
let fromUser (u : User) =
|
||||
{ userId = u.userId
|
||||
userName = u.fullName
|
||||
smallGroups = ""
|
||||
@@ -177,24 +178,6 @@ type EditChurch =
|
||||
interfaceAddress : string option
|
||||
}
|
||||
with
|
||||
/// Create an instance from an existing church
|
||||
static member fromChurch (ch : Church) =
|
||||
{ churchId = ch.churchId
|
||||
name = ch.name
|
||||
city = ch.city
|
||||
st = ch.st
|
||||
hasInterface = match ch.hasInterface with true -> Some true | false -> None
|
||||
interfaceAddress = ch.interfaceAddress
|
||||
}
|
||||
/// An instance to use for adding churches
|
||||
static member empty =
|
||||
{ churchId = Guid.Empty
|
||||
name = ""
|
||||
city = ""
|
||||
st = ""
|
||||
hasInterface = None
|
||||
interfaceAddress = None
|
||||
}
|
||||
/// Is this a new church?
|
||||
member this.isNew () = Guid.Empty = this.churchId
|
||||
/// Populate a church from this form
|
||||
@@ -206,6 +189,25 @@ with
|
||||
hasInterface = match this.hasInterface with Some x -> x | None -> false
|
||||
interfaceAddress = match this.hasInterface with Some x when x -> this.interfaceAddress | _ -> None
|
||||
}
|
||||
module EditChurch =
|
||||
/// Create an instance from an existing church
|
||||
let fromChurch (ch : Church) =
|
||||
{ churchId = ch.churchId
|
||||
name = ch.name
|
||||
city = ch.city
|
||||
st = ch.st
|
||||
hasInterface = match ch.hasInterface with true -> Some true | false -> None
|
||||
interfaceAddress = ch.interfaceAddress
|
||||
}
|
||||
/// An instance to use for adding churches
|
||||
let empty =
|
||||
{ churchId = Guid.Empty
|
||||
name = ""
|
||||
city = ""
|
||||
st = ""
|
||||
hasInterface = None
|
||||
interfaceAddress = None
|
||||
}
|
||||
|
||||
|
||||
/// Form for adding/editing small group members
|
||||
@@ -221,22 +223,23 @@ type EditMember =
|
||||
emailType : string
|
||||
}
|
||||
with
|
||||
/// Is this a new member?
|
||||
member this.isNew () = Guid.Empty = this.memberId
|
||||
module EditMember =
|
||||
/// Create an instance from an existing member
|
||||
static member fromMember (m : Member) =
|
||||
let fromMember (m : Member) =
|
||||
{ memberId = m.memberId
|
||||
memberName = m.memberName
|
||||
emailAddress = m.email
|
||||
emailType = match m.format with Some f -> f | None -> ""
|
||||
}
|
||||
/// An empty instance
|
||||
static member empty =
|
||||
let empty =
|
||||
{ memberId = Guid.Empty
|
||||
memberName = ""
|
||||
emailAddress = ""
|
||||
emailType = ""
|
||||
}
|
||||
/// Is this a new member?
|
||||
member this.isNew () = Guid.Empty = this.memberId
|
||||
|
||||
|
||||
/// This form allows the user to set class preferences
|
||||
@@ -282,32 +285,6 @@ type EditPreferences =
|
||||
asOfDate : string
|
||||
}
|
||||
with
|
||||
static member fromPreferences (prefs : ListPreferences) =
|
||||
let setType (x : string) = match x.StartsWith "#" with true -> "RGB" | false -> "Name"
|
||||
{ expireDays = prefs.daysToExpire
|
||||
daysToKeepNew = prefs.daysToKeepNew
|
||||
longTermUpdateWeeks = prefs.longTermUpdateWeeks
|
||||
requestSort = prefs.requestSort.code
|
||||
emailFromName = prefs.emailFromName
|
||||
emailFromAddress = prefs.emailFromAddress
|
||||
defaultEmailType = prefs.defaultEmailType.code
|
||||
headingLineType = setType prefs.lineColor
|
||||
headingLineColor = prefs.lineColor
|
||||
headingTextType = setType prefs.headingColor
|
||||
headingTextColor = prefs.headingColor
|
||||
listFonts = prefs.listFonts
|
||||
headingFontSize = prefs.headingFontSize
|
||||
listFontSize = prefs.textFontSize
|
||||
timeZone = prefs.timeZoneId
|
||||
groupPassword = Some prefs.groupPassword
|
||||
pageSize = prefs.pageSize
|
||||
asOfDate = prefs.asOfDateDisplay.code
|
||||
listVisibility =
|
||||
match true with
|
||||
| _ when prefs.isPublic -> RequestVisibility.``public``
|
||||
| _ when prefs.groupPassword = "" -> RequestVisibility.``private``
|
||||
| _ -> RequestVisibility.passwordProtected
|
||||
}
|
||||
/// Set the properties of a small group based on the form's properties
|
||||
member this.populatePreferences (prefs : ListPreferences) =
|
||||
let isPublic, grpPw =
|
||||
@@ -335,6 +312,34 @@ with
|
||||
pageSize = this.pageSize
|
||||
asOfDateDisplay = AsOfDateDisplay.fromCode this.asOfDate
|
||||
}
|
||||
module EditPreferences =
|
||||
/// Populate an edit form from existing preferences
|
||||
let fromPreferences (prefs : ListPreferences) =
|
||||
let setType (x : string) = match x.StartsWith "#" with true -> "RGB" | false -> "Name"
|
||||
{ expireDays = prefs.daysToExpire
|
||||
daysToKeepNew = prefs.daysToKeepNew
|
||||
longTermUpdateWeeks = prefs.longTermUpdateWeeks
|
||||
requestSort = prefs.requestSort.code
|
||||
emailFromName = prefs.emailFromName
|
||||
emailFromAddress = prefs.emailFromAddress
|
||||
defaultEmailType = prefs.defaultEmailType.code
|
||||
headingLineType = setType prefs.lineColor
|
||||
headingLineColor = prefs.lineColor
|
||||
headingTextType = setType prefs.headingColor
|
||||
headingTextColor = prefs.headingColor
|
||||
listFonts = prefs.listFonts
|
||||
headingFontSize = prefs.headingFontSize
|
||||
listFontSize = prefs.textFontSize
|
||||
timeZone = prefs.timeZoneId
|
||||
groupPassword = Some prefs.groupPassword
|
||||
pageSize = prefs.pageSize
|
||||
asOfDate = prefs.asOfDateDisplay.code
|
||||
listVisibility =
|
||||
match true with
|
||||
| _ when prefs.isPublic -> RequestVisibility.``public``
|
||||
| _ when prefs.groupPassword = "" -> RequestVisibility.``private``
|
||||
| _ -> RequestVisibility.passwordProtected
|
||||
}
|
||||
|
||||
|
||||
/// Form for adding or editing prayer requests
|
||||
@@ -357,8 +362,11 @@ type EditRequest =
|
||||
text : string
|
||||
}
|
||||
with
|
||||
/// Is this a new request?
|
||||
member this.isNew () = Guid.Empty = this.requestId
|
||||
module EditRequest =
|
||||
/// An empty instance to use for new requests
|
||||
static member empty =
|
||||
let empty =
|
||||
{ requestId = Guid.Empty
|
||||
requestType = CurrentRequest.code
|
||||
enteredDate = None
|
||||
@@ -368,16 +376,14 @@ with
|
||||
text = ""
|
||||
}
|
||||
/// Create an instance from an existing request
|
||||
static member fromRequest req =
|
||||
{ EditRequest.empty with
|
||||
let fromRequest req =
|
||||
{ empty with
|
||||
requestId = req.prayerRequestId
|
||||
requestType = req.requestType.code
|
||||
requestor = req.requestor
|
||||
expiration = req.expiration.code
|
||||
text = req.text
|
||||
}
|
||||
/// Is this a new request?
|
||||
member this.isNew () = Guid.Empty = this.requestId
|
||||
|
||||
|
||||
/// Form for the admin-level editing of small groups
|
||||
@@ -391,18 +397,6 @@ type EditSmallGroup =
|
||||
churchId : ChurchId
|
||||
}
|
||||
with
|
||||
/// Create an instance from an existing small group
|
||||
static member fromGroup (g : SmallGroup) =
|
||||
{ smallGroupId = g.smallGroupId
|
||||
name = g.name
|
||||
churchId = g.churchId
|
||||
}
|
||||
/// An empty instance (used when adding a new group)
|
||||
static member empty =
|
||||
{ smallGroupId = Guid.Empty
|
||||
name = ""
|
||||
churchId = Guid.Empty
|
||||
}
|
||||
/// Is this a new small group?
|
||||
member this.isNew () = Guid.Empty = this.smallGroupId
|
||||
/// Populate a small group from this form
|
||||
@@ -411,6 +405,19 @@ with
|
||||
name = this.name
|
||||
churchId = this.churchId
|
||||
}
|
||||
module EditSmallGroup =
|
||||
/// Create an instance from an existing small group
|
||||
let fromGroup (g : SmallGroup) =
|
||||
{ smallGroupId = g.smallGroupId
|
||||
name = g.name
|
||||
churchId = g.churchId
|
||||
}
|
||||
/// An empty instance (used when adding a new group)
|
||||
let empty =
|
||||
{ smallGroupId = Guid.Empty
|
||||
name = ""
|
||||
churchId = Guid.Empty
|
||||
}
|
||||
|
||||
|
||||
/// Form for the user edit page
|
||||
@@ -432,25 +439,6 @@ type EditUser =
|
||||
isAdmin : bool option
|
||||
}
|
||||
with
|
||||
/// An empty instance
|
||||
static member empty =
|
||||
{ userId = Guid.Empty
|
||||
firstName = ""
|
||||
lastName = ""
|
||||
emailAddress = ""
|
||||
password = ""
|
||||
passwordConfirm = ""
|
||||
isAdmin = None
|
||||
}
|
||||
/// Create an instance from an existing user
|
||||
static member fromUser (user : User) =
|
||||
{ EditUser.empty with
|
||||
userId = user.userId
|
||||
firstName = user.firstName
|
||||
lastName = user.lastName
|
||||
emailAddress = user.emailAddress
|
||||
isAdmin = match user.isAdmin with true -> Some true | false -> None
|
||||
}
|
||||
/// Is this a new user?
|
||||
member this.isNew () = Guid.Empty = this.userId
|
||||
/// Populate a user from the form
|
||||
@@ -462,8 +450,28 @@ with
|
||||
isAdmin = match this.isAdmin with Some x -> x | None -> false
|
||||
}
|
||||
|> function
|
||||
| u when this.password = null || this.password = "" -> u
|
||||
| u when isNull this.password || this.password = "" -> u
|
||||
| u -> { u with passwordHash = hasher this.password }
|
||||
module EditUser =
|
||||
/// An empty instance
|
||||
let empty =
|
||||
{ userId = Guid.Empty
|
||||
firstName = ""
|
||||
lastName = ""
|
||||
emailAddress = ""
|
||||
password = ""
|
||||
passwordConfirm = ""
|
||||
isAdmin = None
|
||||
}
|
||||
/// Create an instance from an existing user
|
||||
let fromUser (user : User) =
|
||||
{ empty with
|
||||
userId = user.userId
|
||||
firstName = user.firstName
|
||||
lastName = user.lastName
|
||||
emailAddress = user.emailAddress
|
||||
isAdmin = match user.isAdmin with true -> Some true | false -> None
|
||||
}
|
||||
|
||||
|
||||
/// Form for the small group log on page
|
||||
@@ -476,8 +484,9 @@ type GroupLogOn =
|
||||
/// Whether to remember the login
|
||||
rememberMe : bool option
|
||||
}
|
||||
with
|
||||
static member empty =
|
||||
module GroupLogOn =
|
||||
/// An empty instance
|
||||
let empty =
|
||||
{ smallGroupId = Guid.Empty
|
||||
password = ""
|
||||
rememberMe = None
|
||||
@@ -498,8 +507,9 @@ type MaintainRequests =
|
||||
/// The page number of the results
|
||||
pageNbr : int option
|
||||
}
|
||||
with
|
||||
static member empty =
|
||||
module MaintainRequests =
|
||||
/// An empty instance
|
||||
let empty =
|
||||
{ requests = Seq.empty
|
||||
smallGroup = SmallGroup.empty
|
||||
onlyActive = None
|
||||
@@ -536,8 +546,9 @@ type UserLogOn =
|
||||
/// The URL to which the user should be redirected once login is successful
|
||||
redirectUrl : string option
|
||||
}
|
||||
with
|
||||
static member empty =
|
||||
module UserLogOn =
|
||||
/// An empty instance
|
||||
let empty =
|
||||
{ emailAddress = ""
|
||||
password = ""
|
||||
smallGroupId = Guid.Empty
|
||||
@@ -546,7 +557,7 @@ with
|
||||
}
|
||||
|
||||
|
||||
open Giraffe.GiraffeViewEngine
|
||||
open Giraffe.ViewEngine
|
||||
|
||||
/// This represents a list of requests
|
||||
type RequestList =
|
||||
@@ -583,12 +594,12 @@ with
|
||||
let asOfSize = Math.Round (float prefs.textFontSize * 0.8, 2)
|
||||
[ match this.showHeader with
|
||||
| true ->
|
||||
div [ _style (sprintf "text-align:center;font-family:%s" prefs.listFonts) ] [
|
||||
span [ _style (sprintf "font-size:%ipt;" prefs.headingFontSize) ] [
|
||||
div [ _style $"text-align:center;font-family:{prefs.listFonts}" ] [
|
||||
span [ _style $"font-size:%i{prefs.headingFontSize}pt;" ] [
|
||||
strong [] [ str s.["Prayer Requests"].Value ]
|
||||
]
|
||||
br []
|
||||
span [ _style (sprintf "font-size:%ipt;" prefs.textFontSize) ] [
|
||||
span [ _style $"font-size:%i{prefs.textFontSize}pt;" ] [
|
||||
strong [] [ str this.listGroup.name ]
|
||||
br []
|
||||
str (this.date.ToString s.["MMMM d, yyyy"].Value)
|
||||
@@ -605,10 +616,9 @@ with
|
||||
let reqs = this.requestsInCategory cat
|
||||
let catName = typs |> List.filter (fun t -> fst t = cat) |> List.head |> snd
|
||||
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 [] [
|
||||
td [ _style (sprintf "font-size:%ipt;color:%s;padding:3px 0;border-top:solid 3px %s;border-bottom:solid 3px %s;font-weight:bold;"
|
||||
prefs.headingFontSize prefs.headingColor prefs.lineColor prefs.lineColor) ] [
|
||||
td [ _style $"font-size:%i{prefs.headingFontSize}pt;color:{prefs.headingColor};padding:3px 0;border-top:solid 3px {prefs.lineColor};border-bottom:solid 3px {prefs.lineColor};font-weight:bold;" ] [
|
||||
rawText " "; str catName.Value; rawText " "
|
||||
]
|
||||
]
|
||||
@@ -617,8 +627,7 @@ with
|
||||
reqs
|
||||
|> List.map (fun req ->
|
||||
let bullet = match this.isNew req with true -> "circle" | false -> "disc"
|
||||
li [ _style (sprintf "list-style-type:%s;font-family:%s;font-size:%ipt;padding-bottom:.25em;"
|
||||
bullet prefs.listFonts prefs.textFontSize) ] [
|
||||
li [ _style $"list-style-type:{bullet};font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;padding-bottom:.25em;" ] [
|
||||
match req.requestor with
|
||||
| Some rqstr when rqstr <> "" ->
|
||||
strong [] [ str rqstr ]
|
||||
@@ -635,14 +644,14 @@ with
|
||||
| ShortDate -> req.updatedDate.ToShortDateString ()
|
||||
| LongDate -> req.updatedDate.ToLongDateString ()
|
||||
| _ -> ""
|
||||
i [ _style (sprintf "font-size:%.2fpt" asOfSize) ] [
|
||||
i [ _style $"font-size:%.2f{asOfSize}pt" ] [
|
||||
rawText " ("; str s.["as of"].Value; str " "; str dt; rawText ")"
|
||||
]
|
||||
])
|
||||
|> ul []
|
||||
br []
|
||||
]
|
||||
|> renderHtmlNodes
|
||||
|> RenderView.AsString.htmlNodes
|
||||
|
||||
/// Generate this list as plain text
|
||||
member this.asText (s : IStringLocalizer) =
|
||||
@@ -661,7 +670,7 @@ with
|
||||
let typ = (typs |> List.filter (fun t -> fst t = cat) |> List.head |> snd).Value
|
||||
let dashes = String.replicate (typ.Length + 4) "-"
|
||||
dashes
|
||||
sprintf @" %s" (typ.ToUpper ())
|
||||
$" {typ.ToUpper ()}"
|
||||
dashes
|
||||
for req in reqs do
|
||||
let bullet = match this.isNew req with true -> "+" | false -> "-"
|
||||
@@ -674,7 +683,7 @@ with
|
||||
| ShortDate -> req.updatedDate.ToShortDateString ()
|
||||
| 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)
|
||||
" "
|
||||
}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
|
||||
Microsoft Visual Studio Solution File, Format Version 12.00
|
||||
# Visual Studio Version 16
|
||||
VisualStudioVersion = 16.0.29411.108
|
||||
# Visual Studio Version 17
|
||||
VisualStudioVersion = 17.2.32630.192
|
||||
MinimumVisualStudioVersion = 10.0.40219.1
|
||||
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker", "PrayerTracker\PrayerTracker.fsproj", "{63780D3F-D811-4BFB-9FB0-C28A83CCE28F}"
|
||||
EndProject
|
||||
@@ -14,6 +14,7 @@ EndProject
|
||||
Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{B290BA27-C8B8-44F3-BF01-D103302D815F}"
|
||||
ProjectSection(SolutionItems) = preProject
|
||||
Directory.Build.props = Directory.Build.props
|
||||
Publish-App.ps1 = Publish-App.ps1
|
||||
EndProjectSection
|
||||
EndProject
|
||||
Global
|
||||
|
||||
12
src/PrayerTracker/.config/dotnet-tools.json
Normal file
12
src/PrayerTracker/.config/dotnet-tools.json
Normal file
@@ -0,0 +1,12 @@
|
||||
{
|
||||
"version": 1,
|
||||
"isRoot": true,
|
||||
"tools": {
|
||||
"dotnet-ef": {
|
||||
"version": "3.1.2",
|
||||
"commands": [
|
||||
"dotnet-ef"
|
||||
]
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -9,7 +9,7 @@ module Configure =
|
||||
|
||||
open Cookies
|
||||
open Giraffe
|
||||
open Giraffe.TokenRouter
|
||||
open Giraffe.EndpointRouting
|
||||
open Microsoft.AspNetCore.Localization
|
||||
open Microsoft.AspNetCore.Server.Kestrel.Core
|
||||
open Microsoft.EntityFrameworkCore
|
||||
@@ -26,7 +26,7 @@ module Configure =
|
||||
let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) =
|
||||
cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath)
|
||||
.AddJsonFile("appsettings.json", optional = true, reloadOnChange = true)
|
||||
.AddJsonFile(sprintf "appsettings.%s.json" ctx.HostingEnvironment.EnvironmentName, optional = true)
|
||||
.AddJsonFile($"appsettings.{ctx.HostingEnvironment.EnvironmentName}.json", optional = true)
|
||||
.AddEnvironmentVariables()
|
||||
|> ignore
|
||||
|
||||
@@ -49,22 +49,22 @@ module Configure =
|
||||
.AddDistributedMemoryCache()
|
||||
.AddSession()
|
||||
.AddAntiforgery()
|
||||
.AddRouting()
|
||||
.AddSingleton<IClock>(SystemClock.Instance)
|
||||
|> ignore
|
||||
let config = svc.BuildServiceProvider().GetRequiredService<IConfiguration>()
|
||||
let crypto = config.GetSection "CookieCrypto"
|
||||
CookieCrypto (crypto.["Key"], crypto.["IV"]) |> setCrypto
|
||||
svc.AddDbContext<AppDbContext>(
|
||||
fun options ->
|
||||
options.UseNpgsql (config.GetConnectionString "PrayerTracker") |> ignore)
|
||||
(fun options ->
|
||||
options.UseNpgsql (config.GetConnectionString "PrayerTracker") |> ignore),
|
||||
ServiceLifetime.Scoped, ServiceLifetime.Singleton)
|
||||
|> ignore
|
||||
|
||||
/// Routes for PrayerTracker
|
||||
let webApp =
|
||||
router Handlers.CommonFunctions.fourOhFour [
|
||||
// Traditional web app routes
|
||||
subRoute"/web" [
|
||||
GET [
|
||||
let routes =
|
||||
[ subRoute "/web" [
|
||||
GET_HEAD [
|
||||
subRoute "/church" [
|
||||
route "es" Handlers.Church.maintain
|
||||
routef "/%O/edit" Handlers.Church.edit
|
||||
@@ -145,6 +145,7 @@ module Configure =
|
||||
route "/" (redirectTo false "/web/")
|
||||
]
|
||||
|
||||
/// Giraffe error handler
|
||||
let errorHandler (ex : exn) (logger : ILogger) =
|
||||
logger.LogError(EventId(), ex, "An unhandled exception has occurred while executing the request.")
|
||||
clearResponse >=> setStatusCode 500 >=> text ex.Message
|
||||
@@ -171,9 +172,10 @@ module Configure =
|
||||
app.UseGiraffeErrorHandler errorHandler)
|
||||
.UseStatusCodePagesWithReExecute("/error/{0}")
|
||||
.UseStaticFiles()
|
||||
.UseRouting()
|
||||
.UseSession()
|
||||
.UseRequestLocalization(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value)
|
||||
.UseGiraffe(webApp)
|
||||
.UseEndpoints (fun e -> e.MapGiraffeEndpoints routes)
|
||||
|> ignore
|
||||
Views.I18N.setUpFactories <| app.ApplicationServices.GetRequiredService<IStringLocalizerFactory> ()
|
||||
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
module PrayerTracker.Handlers.Church
|
||||
|
||||
open FSharp.Control.Tasks.V2.ContextInsensitive
|
||||
open Giraffe
|
||||
open PrayerTracker
|
||||
open PrayerTracker.Entities
|
||||
@@ -10,8 +9,7 @@ open System
|
||||
open System.Threading.Tasks
|
||||
|
||||
/// Find statistics for the given church
|
||||
let private findStats (db : AppDbContext) churchId =
|
||||
task {
|
||||
let private findStats (db : AppDbContext) churchId = task {
|
||||
let! grps = db.CountGroupsByChurch churchId
|
||||
let! reqs = db.CountRequestsByChurch churchId
|
||||
let! usrs = db.CountUsersByChurch churchId
|
||||
@@ -23,19 +21,16 @@ let private findStats (db : AppDbContext) churchId =
|
||||
let delete churchId : HttpHandler =
|
||||
requireAccess [ Admin ]
|
||||
>=> validateCSRF
|
||||
>=> fun next ctx ->
|
||||
let db = ctx.dbContext ()
|
||||
task {
|
||||
let! church = db.TryChurchById churchId
|
||||
match church with
|
||||
| Some ch ->
|
||||
let! _, stats = findStats db churchId
|
||||
db.RemoveEntry ch
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
>=> fun next ctx -> task {
|
||||
match! ctx.db.TryChurchById churchId with
|
||||
| Some church ->
|
||||
let! _, stats = findStats ctx.db churchId
|
||||
ctx.db.RemoveEntry church
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
addInfo ctx
|
||||
s.["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)",
|
||||
ch.name, stats.smallGroups, stats.prayerRequests, stats.users]
|
||||
church.name, stats.smallGroups, stats.prayerRequests, stats.users]
|
||||
return! redirectTo false "/web/churches" next ctx
|
||||
| None -> return! fourOhFour next ctx
|
||||
}
|
||||
@@ -44,9 +39,8 @@ let delete churchId : HttpHandler =
|
||||
/// GET /church/[church-id]/edit
|
||||
let edit churchId : HttpHandler =
|
||||
requireAccess [ Admin ]
|
||||
>=> fun next ctx ->
|
||||
>=> fun next ctx -> task {
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
task {
|
||||
match churchId with
|
||||
| x when x = Guid.Empty ->
|
||||
return!
|
||||
@@ -54,13 +48,11 @@ let edit churchId : HttpHandler =
|
||||
|> Views.Church.edit EditChurch.empty ctx
|
||||
|> renderHtml next ctx
|
||||
| _ ->
|
||||
let db = ctx.dbContext ()
|
||||
let! church = db.TryChurchById churchId
|
||||
match church with
|
||||
| Some ch ->
|
||||
match! ctx.db.TryChurchById churchId with
|
||||
| Some church ->
|
||||
return!
|
||||
viewInfo ctx startTicks
|
||||
|> Views.Church.edit (EditChurch.fromChurch ch) ctx
|
||||
|> Views.Church.edit (EditChurch.fromChurch church) ctx
|
||||
|> renderHtml next ctx
|
||||
| None -> return! fourOhFour next ctx
|
||||
}
|
||||
@@ -69,13 +61,11 @@ let edit churchId : HttpHandler =
|
||||
/// GET /churches
|
||||
let maintain : HttpHandler =
|
||||
requireAccess [ Admin ]
|
||||
>=> fun next ctx ->
|
||||
>=> fun next ctx -> task {
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
let await = Async.AwaitTask >> Async.RunSynchronously
|
||||
let db = ctx.dbContext ()
|
||||
task {
|
||||
let! churches = db.AllChurches ()
|
||||
let stats = churches |> List.map (fun c -> await (findStats db c.churchId))
|
||||
let! churches = ctx.db.AllChurches ()
|
||||
let stats = churches |> List.map (fun c -> await (findStats ctx.db c.churchId))
|
||||
return!
|
||||
viewInfo ctx startTicks
|
||||
|> Views.Church.maintain churches (stats |> Map.ofList) ctx
|
||||
@@ -87,21 +77,18 @@ let maintain : HttpHandler =
|
||||
let save : HttpHandler =
|
||||
requireAccess [ Admin ]
|
||||
>=> validateCSRF
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
let! result = ctx.TryBindFormAsync<EditChurch> ()
|
||||
match result with
|
||||
>=> fun next ctx -> task {
|
||||
match! ctx.TryBindFormAsync<EditChurch> () with
|
||||
| Ok m ->
|
||||
let db = ctx.dbContext ()
|
||||
let! church =
|
||||
match m.isNew () with
|
||||
| true -> Task.FromResult<Church option>(Some { Church.empty with churchId = Guid.NewGuid () })
|
||||
| false -> db.TryChurchById m.churchId
|
||||
| false -> ctx.db.TryChurchById m.churchId
|
||||
match church with
|
||||
| Some ch ->
|
||||
m.populateChurch ch
|
||||
|> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry)
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
|> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry)
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
let act = s.[match m.isNew () with true -> "Added" | _ -> "Updated"].Value.ToLower ()
|
||||
addInfo ctx s.["Successfully {0} church “{1}”", act, m.name]
|
||||
|
||||
@@ -2,7 +2,6 @@
|
||||
[<AutoOpen>]
|
||||
module PrayerTracker.Handlers.CommonFunctions
|
||||
|
||||
open FSharp.Control.Tasks.V2.ContextInsensitive
|
||||
open Giraffe
|
||||
open Microsoft.AspNetCore.Antiforgery
|
||||
open Microsoft.AspNetCore.Html
|
||||
@@ -24,7 +23,7 @@ let toSelectList<'T> valFunc textFunc withDefault emptyText (items : 'T seq) =
|
||||
[ match withDefault with
|
||||
| true ->
|
||||
let s = PrayerTracker.Views.I18N.localizer.Force ()
|
||||
yield SelectListItem (sprintf "— %A —" s.[emptyText], "")
|
||||
yield SelectListItem ($"""— %A{s.[emptyText]} —""", "")
|
||||
| _ -> ()
|
||||
yield! items |> Seq.map (fun x -> SelectListItem (textFunc x, valFunc x))
|
||||
]
|
||||
@@ -41,44 +40,36 @@ let toSelectListWithDefault<'T> valFunc textFunc (items : 'T seq) =
|
||||
let appVersion =
|
||||
let v = Assembly.GetExecutingAssembly().GetName().Version
|
||||
#if (DEBUG)
|
||||
sprintf "v%A" v
|
||||
$"v{v}"
|
||||
#else
|
||||
seq {
|
||||
sprintf "v%d" v.Major
|
||||
$"v%d{v.Major}"
|
||||
match v.Minor with
|
||||
| 0 -> match v.Build with 0 -> () | _ -> sprintf ".0.%d" v.Build
|
||||
| 0 -> match v.Build with 0 -> () | _ -> $".0.%d{v.Build}"
|
||||
| _ ->
|
||||
sprintf ".%d" v.Minor
|
||||
match v.Build with 0 -> () | _ -> sprintf ".%d" v.Build
|
||||
$".%d{v.Minor}"
|
||||
match v.Build with 0 -> () | _ -> $".%d{v.Build}"
|
||||
}
|
||||
|> String.concat ""
|
||||
#endif
|
||||
|
||||
/// An option of the currently signed-in user
|
||||
let tryCurrentUser (ctx : HttpContext) =
|
||||
ctx.Session.GetUser ()
|
||||
|
||||
/// The currently signed-in user (will raise if none exists)
|
||||
let currentUser ctx =
|
||||
match tryCurrentUser ctx with Some u -> u | None -> nullArg "User"
|
||||
|
||||
/// An option of the currently signed-in small group
|
||||
let tryCurrentGroup (ctx : HttpContext) =
|
||||
ctx.Session.GetSmallGroup ()
|
||||
let currentUser (ctx : HttpContext) =
|
||||
match ctx.Session.user with Some u -> u | None -> nullArg "User"
|
||||
|
||||
/// The currently signed-in small group (will raise if none exists)
|
||||
let currentGroup ctx =
|
||||
match tryCurrentGroup ctx with Some g -> g | None -> nullArg "SmallGroup"
|
||||
let currentGroup (ctx : HttpContext) =
|
||||
match ctx.Session.smallGroup with Some g -> g | None -> nullArg "SmallGroup"
|
||||
|
||||
/// Create the common view information heading
|
||||
let viewInfo (ctx : HttpContext) startTicks =
|
||||
let msg =
|
||||
match ctx.Session.GetMessages () with
|
||||
match ctx.Session.messages with
|
||||
| [] -> []
|
||||
| x ->
|
||||
ctx.Session.SetMessages []
|
||||
ctx.Session.messages <- []
|
||||
x
|
||||
match tryCurrentUser ctx with
|
||||
match ctx.Session.user with
|
||||
| Some u ->
|
||||
// The idle timeout is 2 hours; if the app pool is recycled or the actual session goes away, we will log the
|
||||
// user back in transparently using this cookie. Every request resets the timer.
|
||||
@@ -96,8 +87,8 @@ let viewInfo (ctx : HttpContext) startTicks =
|
||||
version = appVersion
|
||||
messages = msg
|
||||
requestStart = startTicks
|
||||
user = ctx.Session.GetUser ()
|
||||
group = ctx.Session.GetSmallGroup ()
|
||||
user = ctx.Session.user
|
||||
group = ctx.Session.smallGroup
|
||||
}
|
||||
|
||||
/// The view is the last parameter, so it can be composed
|
||||
@@ -118,11 +109,8 @@ let fourOhFour next (ctx : HttpContext) =
|
||||
|
||||
/// Handler to validate CSRF prevention token
|
||||
let validateCSRF : HttpHandler =
|
||||
fun next ctx ->
|
||||
let antiForgery = ctx.GetService<IAntiforgery> ()
|
||||
task {
|
||||
let! isValid = antiForgery.IsRequestValidAsync ctx
|
||||
match isValid with
|
||||
fun next ctx -> task {
|
||||
match! (ctx.GetService<IAntiforgery> ()).IsRequestValidAsync ctx with
|
||||
| true -> return! next ctx
|
||||
| false ->
|
||||
return! (clearResponse >=> setStatusCode 400 >=> text "Quit hacking...") (fun _ -> Task.FromResult None) ctx
|
||||
@@ -131,7 +119,7 @@ let validateCSRF : HttpHandler =
|
||||
|
||||
/// Add a message to the session
|
||||
let addUserMessage (ctx : HttpContext) msg =
|
||||
msg :: ctx.Session.GetMessages () |> ctx.Session.SetMessages
|
||||
ctx.Session.messages <- msg :: ctx.Session.messages
|
||||
|
||||
/// Convert a localized string to an HTML string
|
||||
let htmlLocString (x : LocalizedString) =
|
||||
@@ -142,19 +130,19 @@ let htmlString (x : LocalizedString) =
|
||||
|
||||
/// Add an error message to the session
|
||||
let addError ctx msg =
|
||||
addUserMessage ctx { UserMessage.Error with text = htmlLocString msg }
|
||||
addUserMessage ctx { UserMessage.error with text = htmlLocString msg }
|
||||
|
||||
/// Add an informational message to the session
|
||||
let addInfo ctx msg =
|
||||
addUserMessage ctx { UserMessage.Info with text = htmlLocString msg }
|
||||
addUserMessage ctx { UserMessage.info with text = htmlLocString msg }
|
||||
|
||||
/// Add an informational HTML message to the session
|
||||
let addHtmlInfo ctx msg =
|
||||
addUserMessage ctx { UserMessage.Info with text = htmlString msg }
|
||||
addUserMessage ctx { UserMessage.info with text = htmlString msg }
|
||||
|
||||
/// Add a warning message to the session
|
||||
let addWarning ctx msg =
|
||||
addUserMessage ctx { UserMessage.Warning with text = htmlLocString msg }
|
||||
addUserMessage ctx { UserMessage.warning with text = htmlLocString msg }
|
||||
|
||||
|
||||
/// A level of required access
|
||||
@@ -174,22 +162,20 @@ let requireAccess level : HttpHandler =
|
||||
|
||||
/// Is there currently a user logged on?
|
||||
let isUserLoggedOn (ctx : HttpContext) =
|
||||
ctx.Session.GetUser () |> Option.isSome
|
||||
ctx.Session.user |> Option.isSome
|
||||
|
||||
/// Log a user on from the timeout cookie
|
||||
let logOnUserFromTimeoutCookie (ctx : HttpContext) =
|
||||
task {
|
||||
let logOnUserFromTimeoutCookie (ctx : HttpContext) = task {
|
||||
// Make sure the cookie hasn't been tampered with
|
||||
try
|
||||
match TimeoutCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.timeout] with
|
||||
| Some c when c.Password = saltedTimeoutHash c ->
|
||||
let db = ctx.dbContext ()
|
||||
let! user = db.TryUserById c.Id
|
||||
let! user = ctx.db.TryUserById c.Id
|
||||
match user with
|
||||
| Some _ ->
|
||||
ctx.Session.SetUser user
|
||||
let! grp = db.TryGroupById c.GroupId
|
||||
ctx.Session.SetSmallGroup grp
|
||||
ctx.Session.user <- user
|
||||
let! grp = ctx.db.TryGroupById c.GroupId
|
||||
ctx.Session.smallGroup <- grp
|
||||
| _ -> ()
|
||||
| _ -> ()
|
||||
// If something above doesn't work, the user doesn't get logged in
|
||||
@@ -197,17 +183,15 @@ let requireAccess level : HttpHandler =
|
||||
}
|
||||
|
||||
/// Attempt to log the user on from their stored cookie
|
||||
let logOnUserFromCookie (ctx : HttpContext) =
|
||||
task {
|
||||
let logOnUserFromCookie (ctx : HttpContext) = task {
|
||||
match UserCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.user] with
|
||||
| Some c ->
|
||||
let db = ctx.dbContext ()
|
||||
let! user = db.TryUserLogOnByCookie c.Id c.GroupId c.PasswordHash
|
||||
let! user = ctx.db.TryUserLogOnByCookie c.Id c.GroupId c.PasswordHash
|
||||
match user with
|
||||
| Some _ ->
|
||||
ctx.Session.SetUser user
|
||||
let! grp = db.TryGroupById c.GroupId
|
||||
ctx.Session.SetSmallGroup grp
|
||||
ctx.Session.user <- user
|
||||
let! grp = ctx.db.TryGroupById c.GroupId
|
||||
ctx.Session.smallGroup <- grp
|
||||
// Rewrite the cookie to extend the expiration
|
||||
ctx.Response.Cookies.Append (Key.Cookie.user, c.toPayload (), autoRefresh)
|
||||
| _ -> ()
|
||||
@@ -216,25 +200,24 @@ let requireAccess level : HttpHandler =
|
||||
|
||||
/// Is there currently a small group (or member thereof) logged on?
|
||||
let isGroupLoggedOn (ctx : HttpContext) =
|
||||
ctx.Session.GetSmallGroup () |> Option.isSome
|
||||
ctx.Session.smallGroup |> Option.isSome
|
||||
|
||||
/// Attempt to log the small group on from their stored cookie
|
||||
let logOnGroupFromCookie (ctx : HttpContext) =
|
||||
task {
|
||||
match GroupCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.group] with
|
||||
| Some c ->
|
||||
let! grp = (ctx.dbContext ()).TryGroupLogOnByCookie c.GroupId c.PasswordHash sha1Hash
|
||||
let! grp = ctx.db.TryGroupLogOnByCookie c.GroupId c.PasswordHash sha1Hash
|
||||
match grp with
|
||||
| Some _ ->
|
||||
ctx.Session.SetSmallGroup grp
|
||||
ctx.Session.smallGroup <- grp
|
||||
// Rewrite the cookie to extend the expiration
|
||||
ctx.Response.Cookies.Append (Key.Cookie.group, c.toPayload (), autoRefresh)
|
||||
| None -> ()
|
||||
| None -> ()
|
||||
}
|
||||
|
||||
fun next ctx ->
|
||||
task {
|
||||
fun next ctx -> FSharp.Control.Tasks.Affine.task {
|
||||
// Auto-logon user or class, if required
|
||||
match isUserLoggedOn ctx with
|
||||
| true -> ()
|
||||
|
||||
@@ -6,6 +6,7 @@ open System
|
||||
open System.Security.Cryptography
|
||||
open System.IO
|
||||
|
||||
// fsharplint:disable MemberNames
|
||||
|
||||
/// Cryptography settings to use for encrypting cookies
|
||||
type CookieCrypto (key : string, iv : string) =
|
||||
@@ -24,7 +25,7 @@ module private Crypto =
|
||||
|
||||
/// Encrypt a cookie payload
|
||||
let encrypt (payload : string) =
|
||||
use aes = new AesManaged ()
|
||||
use aes = Aes.Create ()
|
||||
use enc = aes.CreateEncryptor (crypto.Key, crypto.IV)
|
||||
use ms = new MemoryStream ()
|
||||
use cs = new CryptoStream (ms, enc, CryptoStreamMode.Write)
|
||||
@@ -35,7 +36,7 @@ module private Crypto =
|
||||
|
||||
/// Decrypt a cookie payload
|
||||
let decrypt payload =
|
||||
use aes = new AesManaged ()
|
||||
use aes = Aes.Create ()
|
||||
use dec = aes.CreateDecryptor (crypto.Key, crypto.IV)
|
||||
use ms = new MemoryStream (Convert.FromBase64String payload)
|
||||
use cs = new CryptoStream (ms, dec, CryptoStreamMode.Read)
|
||||
@@ -121,7 +122,7 @@ type UserCookie =
|
||||
|
||||
/// Create a salted hash to use to validate the idle timeout key
|
||||
let saltedTimeoutHash (c : TimeoutCookie) =
|
||||
sha1Hash (sprintf "Prayer%ATracker%AIdle%dTimeout" c.Id c.GroupId c.Until)
|
||||
sha1Hash $"Prayer%A{c.Id}Tracker%A{c.GroupId}Idle%d{c.Until}Timeout"
|
||||
|
||||
/// Cookie options to push an expiration out by 100 days
|
||||
let autoRefresh =
|
||||
|
||||
@@ -1,22 +1,19 @@
|
||||
/// Methods for sending e-mails
|
||||
module PrayerTracker.Email
|
||||
|
||||
open FSharp.Control.Tasks.ContextInsensitive
|
||||
open MailKit.Net.Smtp
|
||||
open MailKit.Security
|
||||
open Microsoft.Extensions.Localization
|
||||
open MimeKit
|
||||
open MimeKit.Text
|
||||
open PrayerTracker.Entities
|
||||
open System
|
||||
|
||||
/// The e-mail address from which e-mail is sent (must match Google account)
|
||||
let private fromAddress = "prayer@djs-consulting.com"
|
||||
/// The e-mail address from which e-mail is sent
|
||||
let private fromAddress = "prayer@bitbadger.solutions"
|
||||
|
||||
/// Get an SMTP client connection
|
||||
// FIXME: make host configurable
|
||||
let getConnection () =
|
||||
task {
|
||||
let getConnection () = task {
|
||||
let client = new SmtpClient ()
|
||||
do! client.ConnectAsync ("127.0.0.1", 25, SecureSocketOptions.None)
|
||||
return client
|
||||
@@ -33,9 +30,9 @@ let createMessage (grp : SmallGroup) subj =
|
||||
/// Create an HTML-format e-mail message
|
||||
let createHtmlMessage grp subj body (s : IStringLocalizer) =
|
||||
let bodyText =
|
||||
[ @"<!DOCTYPE html><html xmlns=""http://www.w3.org/1999/xhtml""><head><title></title></head><body>"
|
||||
[ """<!DOCTYPE html><html xmlns="http://www.w3.org/1999/xhtml"><head><title></title></head><body>"""
|
||||
body
|
||||
@"<hr><div style=""text-align:right;font-family:Arial,Helvetica,sans-serif;font-size:8pt;padding-right:10px;"">"
|
||||
"""<hr><div style="text-align:right;font-family:Arial,Helvetica,sans-serif;font-size:8pt;padding-right:10px;">"""
|
||||
s.["Generated by P R A Y E R T R A C K E R"].Value
|
||||
"<br><small>"
|
||||
s.["from Bit Badger Solutions"].Value
|
||||
@@ -61,8 +58,7 @@ let createTextMessage grp subj body (s : IStringLocalizer) =
|
||||
msg
|
||||
|
||||
/// Send e-mails to a class
|
||||
let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html text s =
|
||||
task {
|
||||
let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html text s = task {
|
||||
let htmlMsg = createHtmlMessage grp subj html s
|
||||
let plainTextMsg = createTextMessage grp subj text s
|
||||
|
||||
|
||||
@@ -2,11 +2,13 @@
|
||||
module PrayerTracker.Extensions
|
||||
|
||||
open Microsoft.AspNetCore.Http
|
||||
open Microsoft.Extensions.DependencyInjection
|
||||
open Microsoft.FSharpLu
|
||||
open Newtonsoft.Json
|
||||
open PrayerTracker.Entities
|
||||
open PrayerTracker.ViewModels
|
||||
|
||||
// fsharplint:disable MemberNames
|
||||
|
||||
type ISession with
|
||||
/// Set an object in the session
|
||||
@@ -19,28 +21,32 @@ type ISession with
|
||||
| null -> Unchecked.defaultof<'T>
|
||||
| v -> JsonConvert.DeserializeObject<'T> v
|
||||
|
||||
member this.GetSmallGroup () =
|
||||
this.GetObject<SmallGroup> Key.Session.currentGroup |> Option.fromObject
|
||||
member this.SetSmallGroup (group : SmallGroup option) =
|
||||
match group with
|
||||
| Some g -> this.SetObject Key.Session.currentGroup g
|
||||
/// The current small group for the session
|
||||
member this.smallGroup
|
||||
with get () = this.GetObject<SmallGroup> Key.Session.currentGroup |> Option.fromObject
|
||||
and set (v : SmallGroup option) =
|
||||
match v with
|
||||
| Some group -> this.SetObject Key.Session.currentGroup group
|
||||
| None -> this.Remove Key.Session.currentGroup
|
||||
|
||||
member this.GetUser () =
|
||||
this.GetObject<User> Key.Session.currentUser |> Option.fromObject
|
||||
member this.SetUser (user: User option) =
|
||||
match user with
|
||||
| Some u -> this.SetObject Key.Session.currentUser u
|
||||
/// The current user for the session
|
||||
member this.user
|
||||
with get () = this.GetObject<User> Key.Session.currentUser |> Option.fromObject
|
||||
and set (v : User option) =
|
||||
match v with
|
||||
| Some user -> this.SetObject Key.Session.currentUser user
|
||||
| None -> this.Remove Key.Session.currentUser
|
||||
|
||||
member this.GetMessages () =
|
||||
/// Current messages for the session
|
||||
member this.messages
|
||||
with get () =
|
||||
match box (this.GetObject<UserMessage list> Key.Session.userMessages) with
|
||||
| null -> List.empty<UserMessage>
|
||||
| msgs -> unbox msgs
|
||||
member this.SetMessages (messages : UserMessage list) =
|
||||
this.SetObject Key.Session.userMessages messages
|
||||
and set (v : UserMessage list) = this.SetObject Key.Session.userMessages v
|
||||
|
||||
|
||||
type HttpContext with
|
||||
/// Get the EF database context from DI
|
||||
member this.dbContext () : AppDbContext = downcast this.RequestServices.GetService typeof<AppDbContext>
|
||||
/// The EF Core database context (via DI)
|
||||
member this.db
|
||||
with get () = this.RequestServices.GetRequiredService<AppDbContext> ()
|
||||
|
||||
@@ -35,7 +35,7 @@ let language culture : HttpHandler =
|
||||
| ""
|
||||
| "en" -> "en-US"
|
||||
| "es" -> "es-MX"
|
||||
| _ -> sprintf "%s-%s" culture (culture.ToUpper ())
|
||||
| _ -> $"{culture}-{culture.ToUpper ()}"
|
||||
|> (CultureInfo >> Option.ofObj)
|
||||
with
|
||||
| :? CultureNotFoundException
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
module PrayerTracker.Handlers.PrayerRequest
|
||||
|
||||
open FSharp.Control.Tasks.V2.ContextInsensitive
|
||||
open Giraffe
|
||||
open Microsoft.AspNetCore.Http
|
||||
open NodaTime
|
||||
@@ -11,11 +10,9 @@ open System
|
||||
open System.Threading.Tasks
|
||||
|
||||
/// Retrieve a prayer request, and ensure that it belongs to the current class
|
||||
let private findRequest (ctx : HttpContext) reqId =
|
||||
task {
|
||||
let! req = ctx.dbContext().TryRequestById reqId
|
||||
match req with
|
||||
| Some pr when pr.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok pr
|
||||
let private findRequest (ctx : HttpContext) reqId = task {
|
||||
match! ctx.db.TryRequestById reqId with
|
||||
| Some req when req.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok req
|
||||
| Some _ ->
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
addError ctx s.["The prayer request you tried to access is not assigned to your group"]
|
||||
@@ -31,12 +28,12 @@ let private generateRequestList ctx date =
|
||||
match date with
|
||||
| Some d -> d
|
||||
| None -> grp.localDateNow clock
|
||||
let reqs = ctx.dbContext().AllRequestsForSmallGroup grp clock (Some listDate) true 0
|
||||
let reqs = ctx.db.AllRequestsForSmallGroup grp clock (Some listDate) true 0
|
||||
{ requests = reqs |> List.ofSeq
|
||||
date = listDate
|
||||
listGroup = grp
|
||||
showHeader = true
|
||||
canEmail = tryCurrentUser ctx |> Option.isSome
|
||||
canEmail = ctx.Session.user |> Option.isSome
|
||||
recipients = []
|
||||
}
|
||||
|
||||
@@ -50,11 +47,10 @@ let private parseListDate (date : string option) =
|
||||
/// GET /prayer-request/[request-id]/edit
|
||||
let edit (reqId : PrayerRequestId) : HttpHandler =
|
||||
requireAccess [ User ]
|
||||
>=> fun next ctx ->
|
||||
>=> fun next ctx -> task {
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
let grp = currentGroup ctx
|
||||
let now = grp.localDateNow (ctx.GetService<IClock> ())
|
||||
task {
|
||||
match reqId = Guid.Empty with
|
||||
| true ->
|
||||
return!
|
||||
@@ -62,13 +58,12 @@ let edit (reqId : PrayerRequestId) : HttpHandler =
|
||||
|> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx
|
||||
|> renderHtml next ctx
|
||||
| false ->
|
||||
let! result = findRequest ctx reqId
|
||||
match result with
|
||||
match! findRequest ctx reqId with
|
||||
| Ok req ->
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
match req.isExpired now grp.preferences.daysToExpire with
|
||||
| true ->
|
||||
{ UserMessage.Warning with
|
||||
{ UserMessage.warning with
|
||||
text = htmlLocString s.["This request is expired."]
|
||||
description =
|
||||
s.["To make it active again, update it as necessary, leave “{0}” and “{1}” unchecked, and it will return as an active request.",
|
||||
@@ -88,14 +83,13 @@ let edit (reqId : PrayerRequestId) : HttpHandler =
|
||||
/// GET /prayer-requests/email/[date]
|
||||
let email date : HttpHandler =
|
||||
requireAccess [ User ]
|
||||
>=> fun next ctx ->
|
||||
>=> fun next ctx -> task {
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
let listDate = parseListDate (Some date)
|
||||
let grp = currentGroup ctx
|
||||
task {
|
||||
let list = generateRequestList ctx listDate
|
||||
let! recipients = ctx.dbContext().AllMembersForSmallGroup grp.smallGroupId
|
||||
let! recipients = ctx.db.AllMembersForSmallGroup grp.smallGroupId
|
||||
use! client = Email.getConnection ()
|
||||
do! Email.sendEmails client recipients
|
||||
grp s.["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.name, list.date].Value
|
||||
@@ -111,15 +105,12 @@ let email date : HttpHandler =
|
||||
let delete reqId : HttpHandler =
|
||||
requireAccess [ User ]
|
||||
>=> validateCSRF
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
let! result = findRequest ctx reqId
|
||||
match result with
|
||||
| Ok r ->
|
||||
let db = ctx.dbContext ()
|
||||
>=> fun next ctx -> task {
|
||||
match! findRequest ctx reqId with
|
||||
| Ok req ->
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
db.PrayerRequests.Remove r |> ignore
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
ctx.db.PrayerRequests.Remove req |> ignore
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
addInfo ctx s.["The prayer request was deleted successfully"]
|
||||
return! redirectTo false "/web/prayer-requests" next ctx
|
||||
| Error e -> return! e next ctx
|
||||
@@ -129,15 +120,12 @@ let delete reqId : HttpHandler =
|
||||
/// GET /prayer-request/[request-id]/expire
|
||||
let expire reqId : HttpHandler =
|
||||
requireAccess [ User ]
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
let! result = findRequest ctx reqId
|
||||
match result with
|
||||
| Ok r ->
|
||||
let db = ctx.dbContext ()
|
||||
>=> fun next ctx -> task {
|
||||
match! findRequest ctx reqId with
|
||||
| Ok req ->
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
db.UpdateEntry { r with expiration = Forced }
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
ctx.db.UpdateEntry { req with expiration = Forced }
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
addInfo ctx s.["Successfully {0} prayer request", s.["Expired"].Value.ToLower ()]
|
||||
return! redirectTo false "/web/prayer-requests" next ctx
|
||||
| Error e -> return! e next ctx
|
||||
@@ -147,23 +135,20 @@ let expire reqId : HttpHandler =
|
||||
/// GET /prayer-requests/[group-id]/list
|
||||
let list groupId : HttpHandler =
|
||||
requireAccess [ AccessLevel.Public ]
|
||||
>=> fun next ctx ->
|
||||
>=> fun next ctx -> task {
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
let db = ctx.dbContext ()
|
||||
task {
|
||||
let! grp = db.TryGroupById groupId
|
||||
match grp with
|
||||
| Some g when g.preferences.isPublic ->
|
||||
match! ctx.db.TryGroupById groupId with
|
||||
| Some grp when grp.preferences.isPublic ->
|
||||
let clock = ctx.GetService<IClock> ()
|
||||
let reqs = db.AllRequestsForSmallGroup g clock None true 0
|
||||
let reqs = ctx.db.AllRequestsForSmallGroup grp clock None true 0
|
||||
return!
|
||||
viewInfo ctx startTicks
|
||||
|> Views.PrayerRequest.list
|
||||
{ requests = List.ofSeq reqs
|
||||
date = g.localDateNow clock
|
||||
listGroup = g
|
||||
date = grp.localDateNow clock
|
||||
listGroup = grp
|
||||
showHeader = true
|
||||
canEmail = (tryCurrentUser >> Option.isSome) ctx
|
||||
canEmail = ctx.Session.user |> Option.isSome
|
||||
recipients = []
|
||||
}
|
||||
|> renderHtml next ctx
|
||||
@@ -178,10 +163,9 @@ let list groupId : HttpHandler =
|
||||
/// GET /prayer-requests/lists
|
||||
let lists : HttpHandler =
|
||||
requireAccess [ AccessLevel.Public ]
|
||||
>=> fun next ctx ->
|
||||
>=> fun next ctx -> task {
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
task {
|
||||
let! grps = ctx.dbContext().PublicAndProtectedGroups ()
|
||||
let! grps = ctx.db.PublicAndProtectedGroups ()
|
||||
return!
|
||||
viewInfo ctx startTicks
|
||||
|> Views.PrayerRequest.lists grps
|
||||
@@ -196,9 +180,7 @@ let maintain onlyActive : HttpHandler =
|
||||
requireAccess [ User ]
|
||||
>=> fun next ctx ->
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
let db = ctx.dbContext ()
|
||||
let grp = currentGroup ctx
|
||||
task {
|
||||
let pageNbr =
|
||||
match ctx.GetQueryStringValue "page" with
|
||||
| Ok pg -> match Int32.TryParse pg with true, p -> p | false, _ -> 1
|
||||
@@ -207,48 +189,40 @@ let maintain onlyActive : HttpHandler =
|
||||
match ctx.GetQueryStringValue "search" with
|
||||
| Ok srch ->
|
||||
{ MaintainRequests.empty with
|
||||
requests = db.SearchRequestsForSmallGroup grp srch pageNbr
|
||||
requests = ctx.db.SearchRequestsForSmallGroup grp srch pageNbr
|
||||
searchTerm = Some srch
|
||||
pageNbr = Some pageNbr
|
||||
}
|
||||
| Error _ ->
|
||||
{ MaintainRequests.empty with
|
||||
requests = db.AllRequestsForSmallGroup grp (ctx.GetService<IClock> ()) None onlyActive pageNbr
|
||||
requests = ctx.db.AllRequestsForSmallGroup grp (ctx.GetService<IClock> ()) None onlyActive pageNbr
|
||||
onlyActive = Some onlyActive
|
||||
pageNbr = match onlyActive with true -> None | false -> Some pageNbr
|
||||
}
|
||||
return!
|
||||
{ viewInfo ctx startTicks with helpLink = Some Help.maintainRequests }
|
||||
|> Views.PrayerRequest.maintain { m with smallGroup = grp } ctx
|
||||
|> renderHtml next ctx
|
||||
}
|
||||
|
||||
|
||||
/// GET /prayer-request/print/[date]
|
||||
let print date : HttpHandler =
|
||||
requireAccess [ User; Group ]
|
||||
>=> fun next ctx ->
|
||||
let listDate = parseListDate (Some date)
|
||||
task {
|
||||
let list = generateRequestList ctx listDate
|
||||
return!
|
||||
let list = parseListDate (Some date) |> generateRequestList ctx
|
||||
Views.PrayerRequest.print list appVersion
|
||||
|> renderHtml next ctx
|
||||
}
|
||||
|
||||
|
||||
|
||||
/// GET /prayer-request/[request-id]/restore
|
||||
let restore reqId : HttpHandler =
|
||||
requireAccess [ User ]
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
let! result = findRequest ctx reqId
|
||||
match result with
|
||||
| Ok r ->
|
||||
let db = ctx.dbContext ()
|
||||
>=> fun next ctx -> task {
|
||||
match! findRequest ctx reqId with
|
||||
| Ok req ->
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
db.UpdateEntry { r with expiration = Automatic; updatedDate = DateTime.Now }
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
ctx.db.UpdateEntry { req with expiration = Automatic; updatedDate = DateTime.Now }
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
addInfo ctx s.["Successfully {0} prayer request", s.["Restored"].Value.ToLower ()]
|
||||
return! redirectTo false "/web/prayer-requests" next ctx
|
||||
| Error e -> return! e next ctx
|
||||
@@ -259,15 +233,13 @@ let restore reqId : HttpHandler =
|
||||
let save : HttpHandler =
|
||||
requireAccess [ User ]
|
||||
>=> validateCSRF
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
>=> fun next ctx -> task {
|
||||
match! ctx.TryBindFormAsync<EditRequest> () with
|
||||
| Ok m ->
|
||||
let db = ctx.dbContext ()
|
||||
let! req =
|
||||
match m.isNew () with
|
||||
| true -> Task.FromResult (Some { PrayerRequest.empty with prayerRequestId = Guid.NewGuid () })
|
||||
| false -> db.TryRequestById m.requestId
|
||||
| false -> ctx.db.TryRequestById m.requestId
|
||||
match req with
|
||||
| Some pr ->
|
||||
let upd8 =
|
||||
@@ -290,8 +262,8 @@ let save : HttpHandler =
|
||||
}
|
||||
| false when Option.isSome m.skipDateUpdate && Option.get m.skipDateUpdate -> upd8
|
||||
| false -> { upd8 with updatedDate = now }
|
||||
|> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry)
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
|> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry)
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
let act = match m.isNew () with true -> "Added" | false -> "Updated"
|
||||
addInfo ctx s.["Successfully {0} prayer request", s.[act].Value.ToLower ()]
|
||||
@@ -306,11 +278,7 @@ let view date : HttpHandler =
|
||||
requireAccess [ User; Group ]
|
||||
>=> fun next ctx ->
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
let listDate = parseListDate date
|
||||
task {
|
||||
let list = generateRequestList ctx listDate
|
||||
return!
|
||||
let list = parseListDate date |> generateRequestList ctx
|
||||
viewInfo ctx startTicks
|
||||
|> Views.PrayerRequest.view { list with showHeader = false }
|
||||
|> renderHtml next ctx
|
||||
}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
<Project Sdk="Microsoft.NET.Sdk.Web">
|
||||
|
||||
<PropertyGroup>
|
||||
<TargetFramework>netcoreapp3.0</TargetFramework>
|
||||
<TargetFramework>net6.0</TargetFramework>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
@@ -23,10 +23,9 @@
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="Giraffe" Version="4.0.1" />
|
||||
<PackageReference Include="Giraffe.TokenRouter" Version="1.0.0" />
|
||||
<PackageReference Include="Microsoft.VisualStudio.Web.CodeGeneration.Design" Version="3.0.0" />
|
||||
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="3.0.1" />
|
||||
<PackageReference Include="Giraffe" Version="5.0.0" />
|
||||
<PackageReference Include="Microsoft.VisualStudio.Web.CodeGeneration.Design" Version="3.1.1" />
|
||||
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="5.0.10" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
@@ -34,8 +33,4 @@
|
||||
<ProjectReference Include="..\PrayerTracker.UI\PrayerTracker.UI.fsproj" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Update="FSharp.Core" Version="4.7.0" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
|
||||
@@ -1,8 +1,7 @@
|
||||
module PrayerTracker.Handlers.SmallGroup
|
||||
|
||||
open FSharp.Control.Tasks.V2.ContextInsensitive
|
||||
open Giraffe
|
||||
open Giraffe.GiraffeViewEngine
|
||||
open Giraffe.ViewEngine
|
||||
open Microsoft.AspNetCore.Http
|
||||
open NodaTime
|
||||
open PrayerTracker
|
||||
@@ -16,7 +15,7 @@ open System.Threading.Tasks
|
||||
/// Set a small group "Remember Me" cookie
|
||||
let private setGroupCookie (ctx : HttpContext) pwHash =
|
||||
ctx.Response.Cookies.Append
|
||||
(Key.Cookie.group, { GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload(), autoRefresh)
|
||||
(Key.Cookie.group, { GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (), autoRefresh)
|
||||
|
||||
|
||||
/// GET /small-group/announcement
|
||||
@@ -33,20 +32,17 @@ let announcement : HttpHandler =
|
||||
let delete groupId : HttpHandler =
|
||||
requireAccess [ Admin ]
|
||||
>=> validateCSRF
|
||||
>=> fun next ctx ->
|
||||
let db = ctx.dbContext ()
|
||||
>=> fun next ctx -> task {
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
task {
|
||||
let! grp = db.TryGroupById groupId
|
||||
match grp with
|
||||
| Some g ->
|
||||
let! reqs = db.CountRequestsBySmallGroup groupId
|
||||
let! usrs = db.CountUsersBySmallGroup groupId
|
||||
db.RemoveEntry g
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
match! ctx.db.TryGroupById groupId with
|
||||
| Some grp ->
|
||||
let! reqs = ctx.db.CountRequestsBySmallGroup groupId
|
||||
let! usrs = ctx.db.CountUsersBySmallGroup groupId
|
||||
ctx.db.RemoveEntry grp
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
addInfo ctx
|
||||
s.["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
|
||||
g.name, reqs, usrs]
|
||||
grp.name, reqs, usrs]
|
||||
return! redirectTo false "/web/small-groups" next ctx
|
||||
| None -> return! fourOhFour next ctx
|
||||
}
|
||||
@@ -56,16 +52,13 @@ let delete groupId : HttpHandler =
|
||||
let deleteMember memberId : HttpHandler =
|
||||
requireAccess [ User ]
|
||||
>=> validateCSRF
|
||||
>=> fun next ctx ->
|
||||
let db = ctx.dbContext ()
|
||||
>=> fun next ctx -> task {
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
task {
|
||||
let! mbr = db.TryMemberById memberId
|
||||
match mbr with
|
||||
| Some m when m.smallGroupId = (currentGroup ctx).smallGroupId ->
|
||||
db.RemoveEntry m
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
addHtmlInfo ctx s.["The group member “{0}” was deleted successfully", m.memberName]
|
||||
match! ctx.db.TryMemberById memberId with
|
||||
| Some mbr when mbr.smallGroupId = (currentGroup ctx).smallGroupId ->
|
||||
ctx.db.RemoveEntry mbr
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
addHtmlInfo ctx s.["The group member “{0}” was deleted successfully", mbr.memberName]
|
||||
return! redirectTo false "/web/small-group/members" next ctx
|
||||
| Some _
|
||||
| None -> return! fourOhFour next ctx
|
||||
@@ -75,11 +68,9 @@ let deleteMember memberId : HttpHandler =
|
||||
/// GET /small-group/[group-id]/edit
|
||||
let edit (groupId : SmallGroupId) : HttpHandler =
|
||||
requireAccess [ Admin ]
|
||||
>=> fun next ctx ->
|
||||
>=> fun next ctx -> task {
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
let db = ctx.dbContext ()
|
||||
task {
|
||||
let! churches = db.AllChurches ()
|
||||
let! churches = ctx.db.AllChurches ()
|
||||
match groupId = Guid.Empty with
|
||||
| true ->
|
||||
return!
|
||||
@@ -87,12 +78,11 @@ let edit (groupId : SmallGroupId) : HttpHandler =
|
||||
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
|
||||
|> renderHtml next ctx
|
||||
| false ->
|
||||
let! grp = db.TryGroupById groupId
|
||||
match grp with
|
||||
| Some g ->
|
||||
match! ctx.db.TryGroupById groupId with
|
||||
| Some grp ->
|
||||
return!
|
||||
viewInfo ctx startTicks
|
||||
|> Views.SmallGroup.edit (EditSmallGroup.fromGroup g) churches ctx
|
||||
|> Views.SmallGroup.edit (EditSmallGroup.fromGroup grp) churches ctx
|
||||
|> renderHtml next ctx
|
||||
| None -> return! fourOhFour next ctx
|
||||
}
|
||||
@@ -103,7 +93,6 @@ let editMember (memberId : MemberId) : HttpHandler =
|
||||
requireAccess [ User ]
|
||||
>=> fun next ctx ->
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
let db = ctx.dbContext ()
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
let grp = currentGroup ctx
|
||||
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s
|
||||
@@ -115,12 +104,11 @@ let editMember (memberId : MemberId) : HttpHandler =
|
||||
|> Views.SmallGroup.editMember EditMember.empty typs ctx
|
||||
|> renderHtml next ctx
|
||||
| false ->
|
||||
let! mbr = db.TryMemberById memberId
|
||||
match mbr with
|
||||
| Some m when m.smallGroupId = grp.smallGroupId ->
|
||||
match! ctx.db.TryMemberById memberId with
|
||||
| Some mbr when mbr.smallGroupId = grp.smallGroupId ->
|
||||
return!
|
||||
viewInfo ctx startTicks
|
||||
|> Views.SmallGroup.editMember (EditMember.fromMember m) typs ctx
|
||||
|> Views.SmallGroup.editMember (EditMember.fromMember mbr) typs ctx
|
||||
|> renderHtml next ctx
|
||||
| Some _
|
||||
| None -> return! fourOhFour next ctx
|
||||
@@ -133,7 +121,7 @@ let logOn (groupId : SmallGroupId option) : HttpHandler =
|
||||
>=> fun next ctx ->
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
task {
|
||||
let! grps = ctx.dbContext().ProtectedGroups ()
|
||||
let! grps = ctx.db.ProtectedGroups ()
|
||||
let grpId = match groupId with Some gid -> flatGuid gid | None -> ""
|
||||
return!
|
||||
{ viewInfo ctx startTicks with helpLink = Some Help.logOn }
|
||||
@@ -148,22 +136,20 @@ let logOnSubmit : HttpHandler =
|
||||
>=> validateCSRF
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
let! result = ctx.TryBindFormAsync<GroupLogOn> ()
|
||||
match result with
|
||||
match! ctx.TryBindFormAsync<GroupLogOn> () with
|
||||
| Ok m ->
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
let! grp = ctx.dbContext().TryGroupLogOnByPassword m.smallGroupId m.password
|
||||
match grp with
|
||||
| Some _ ->
|
||||
ctx.Session.SetSmallGroup grp
|
||||
match! ctx.db.TryGroupLogOnByPassword m.smallGroupId m.password with
|
||||
| Some grp ->
|
||||
ctx.Session.smallGroup <- Some grp
|
||||
match m.rememberMe with
|
||||
| Some x when x -> (setGroupCookie ctx << Utils.sha1Hash) m.password
|
||||
| Some x when x -> (setGroupCookie ctx << sha1Hash) m.password
|
||||
| _ -> ()
|
||||
addInfo ctx s.["Log On Successful • Welcome to {0}", s.["PrayerTracker"]]
|
||||
return! redirectTo false "/web/prayer-requests/view" next ctx
|
||||
| None ->
|
||||
addError ctx s.["Password incorrect - login unsuccessful"]
|
||||
return! redirectTo false (sprintf "/web/small-group/log-on/%s" (flatGuid m.smallGroupId)) next ctx
|
||||
return! redirectTo false $"/web/small-group/log-on/{flatGuid m.smallGroupId}" next ctx
|
||||
| Error e -> return! bindError e next ctx
|
||||
}
|
||||
|
||||
@@ -174,7 +160,7 @@ let maintain : HttpHandler =
|
||||
>=> fun next ctx ->
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
task {
|
||||
let! grps = ctx.dbContext().AllGroups ()
|
||||
let! grps = ctx.db.AllGroups ()
|
||||
return!
|
||||
viewInfo ctx startTicks
|
||||
|> Views.SmallGroup.maintain grps ctx
|
||||
@@ -187,11 +173,10 @@ let members : HttpHandler =
|
||||
requireAccess [ User ]
|
||||
>=> fun next ctx ->
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
let db = ctx.dbContext ()
|
||||
let grp = currentGroup ctx
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
task {
|
||||
let! mbrs = db.AllMembersForSmallGroup grp.smallGroupId
|
||||
let! mbrs = ctx.db.AllMembersForSmallGroup grp.smallGroupId
|
||||
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s |> Map.ofSeq
|
||||
return!
|
||||
{ viewInfo ctx startTicks with helpLink = Some Help.maintainGroupMembers }
|
||||
@@ -205,12 +190,11 @@ let overview : HttpHandler =
|
||||
requireAccess [ User ]
|
||||
>=> fun next ctx ->
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
let db = ctx.dbContext ()
|
||||
let clock = ctx.GetService<IClock> ()
|
||||
task {
|
||||
let reqs = db.AllRequestsForSmallGroup (currentGroup ctx) clock None true 0 |> List.ofSeq
|
||||
let! reqCount = db.CountRequestsBySmallGroup (currentGroup ctx).smallGroupId
|
||||
let! mbrCount = db.CountMembersForSmallGroup (currentGroup ctx).smallGroupId
|
||||
let reqs = ctx.db.AllRequestsForSmallGroup (currentGroup ctx) clock None true 0 |> List.ofSeq
|
||||
let! reqCount = ctx.db.CountRequestsBySmallGroup (currentGroup ctx).smallGroupId
|
||||
let! mbrCount = ctx.db.CountMembersForSmallGroup (currentGroup ctx).smallGroupId
|
||||
let m =
|
||||
{ totalActiveReqs = List.length reqs
|
||||
allReqs = reqCount
|
||||
@@ -236,7 +220,7 @@ let preferences : HttpHandler =
|
||||
>=> fun next ctx ->
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
task {
|
||||
let! tzs = ctx.dbContext().AllTimeZones ()
|
||||
let! tzs = ctx.db.AllTimeZones ()
|
||||
return!
|
||||
{ viewInfo ctx startTicks with helpLink = Some Help.groupPreferences }
|
||||
|> Views.SmallGroup.preferences (EditPreferences.fromPreferences (currentGroup ctx).preferences) tzs ctx
|
||||
@@ -251,23 +235,21 @@ let save : HttpHandler =
|
||||
>=> fun next ctx ->
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
task {
|
||||
let! result = ctx.TryBindFormAsync<EditSmallGroup> ()
|
||||
match result with
|
||||
match! ctx.TryBindFormAsync<EditSmallGroup> () with
|
||||
| Ok m ->
|
||||
let db = ctx.dbContext ()
|
||||
let! grp =
|
||||
let! group =
|
||||
match m.isNew () with
|
||||
| true -> Task.FromResult<SmallGroup option>(Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () })
|
||||
| false -> db.TryGroupById m.smallGroupId
|
||||
match grp with
|
||||
| Some g ->
|
||||
m.populateGroup g
|
||||
| false -> ctx.db.TryGroupById m.smallGroupId
|
||||
match group with
|
||||
| Some grp ->
|
||||
m.populateGroup grp
|
||||
|> function
|
||||
| g when m.isNew () ->
|
||||
db.AddEntry g
|
||||
db.AddEntry { g.preferences with smallGroupId = g.smallGroupId }
|
||||
| g -> db.UpdateEntry g
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
| grp when m.isNew () ->
|
||||
ctx.db.AddEntry grp
|
||||
ctx.db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId }
|
||||
| grp -> ctx.db.UpdateEntry grp
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
|
||||
addHtmlInfo ctx s.["Successfully {0} group “{1}”", act, m.name]
|
||||
return! redirectTo false "/web/small-groups" next ctx
|
||||
@@ -282,11 +264,9 @@ let saveMember : HttpHandler =
|
||||
>=> validateCSRF
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
let! result = ctx.TryBindFormAsync<EditMember> ()
|
||||
match result with
|
||||
match! ctx.TryBindFormAsync<EditMember> () with
|
||||
| Ok m ->
|
||||
let grp = currentGroup ctx
|
||||
let db = ctx.dbContext ()
|
||||
let! mMbr =
|
||||
match m.isNew () with
|
||||
| true ->
|
||||
@@ -296,7 +276,7 @@ let saveMember : HttpHandler =
|
||||
memberId = Guid.NewGuid ()
|
||||
smallGroupId = grp.smallGroupId
|
||||
})
|
||||
| false -> db.TryMemberById m.memberId
|
||||
| false -> ctx.db.TryMemberById m.memberId
|
||||
match mMbr with
|
||||
| Some mbr when mbr.smallGroupId = grp.smallGroupId ->
|
||||
{ mbr with
|
||||
@@ -304,8 +284,8 @@ let saveMember : HttpHandler =
|
||||
email = m.emailAddress
|
||||
format = match m.emailType with "" | null -> None | _ -> Some m.emailType
|
||||
}
|
||||
|> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry)
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
|> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry)
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
|
||||
addInfo ctx s.["Successfully {0} group member", act]
|
||||
@@ -322,21 +302,18 @@ let savePreferences : HttpHandler =
|
||||
>=> validateCSRF
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
let! result = ctx.TryBindFormAsync<EditPreferences> ()
|
||||
match result with
|
||||
match! ctx.TryBindFormAsync<EditPreferences> () with
|
||||
| Ok m ->
|
||||
let db = ctx.dbContext ()
|
||||
// Since the class is stored in the session, we'll use an intermediate instance to persist it; once that
|
||||
// works, we can repopulate the session instance. That way, if the update fails, the page should still show
|
||||
// the database values, not the then out-of-sync session ones.
|
||||
let! grp = db.TryGroupById (currentGroup ctx).smallGroupId
|
||||
match grp with
|
||||
| Some g ->
|
||||
let prefs = m.populatePreferences g.preferences
|
||||
db.UpdateEntry prefs
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
match! ctx.db.TryGroupById (currentGroup ctx).smallGroupId with
|
||||
| Some grp ->
|
||||
let prefs = m.populatePreferences grp.preferences
|
||||
ctx.db.UpdateEntry prefs
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
// Refresh session instance
|
||||
ctx.Session.SetSmallGroup <| Some { g with preferences = prefs }
|
||||
ctx.Session.smallGroup <- Some { grp with preferences = prefs }
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
addInfo ctx s.["Group preferences updated successfully"]
|
||||
return! redirectTo false "/web/small-group/preferences" next ctx
|
||||
@@ -352,26 +329,24 @@ let sendAnnouncement : HttpHandler =
|
||||
>=> fun next ctx ->
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
task {
|
||||
let! result = ctx.TryBindFormAsync<Announcement> ()
|
||||
match result with
|
||||
match! ctx.TryBindFormAsync<Announcement> () with
|
||||
| Ok m ->
|
||||
let grp = currentGroup ctx
|
||||
let usr = currentUser ctx
|
||||
let db = ctx.dbContext ()
|
||||
let now = grp.localTimeNow (ctx.GetService<IClock> ())
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
// Reformat the text to use the class's font stylings
|
||||
let requestText = ckEditorToText m.text
|
||||
let htmlText =
|
||||
p [ _style (sprintf "font-family:%s;font-size:%dpt;" grp.preferences.listFonts grp.preferences.textFontSize) ]
|
||||
p [ _style $"font-family:{grp.preferences.listFonts};font-size:%d{grp.preferences.textFontSize}pt;" ]
|
||||
[ rawText requestText ]
|
||||
|> renderHtmlNode
|
||||
let plainText = (htmlToPlainText >> wordWrap 74) htmlText
|
||||
// Send the e-mails
|
||||
let! recipients =
|
||||
match m.sendToClass with
|
||||
| "N" when usr.isAdmin -> db.AllUsersAsMembers ()
|
||||
| _ -> db.AllMembersForSmallGroup grp.smallGroupId
|
||||
| "N" when usr.isAdmin -> ctx.db.AllUsersAsMembers ()
|
||||
| _ -> ctx.db.AllMembersForSmallGroup grp.smallGroupId
|
||||
use! client = Email.getConnection ()
|
||||
do! Email.sendEmails client recipients grp
|
||||
s.["Announcement for {0} - {1:MMMM d, yyyy} {2}",
|
||||
@@ -392,8 +367,8 @@ let sendAnnouncement : HttpHandler =
|
||||
enteredDate = now
|
||||
updatedDate = now
|
||||
}
|
||||
|> db.AddEntry
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
|> ctx.db.AddEntry
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
()
|
||||
// Tell 'em what they've won, Johnny!
|
||||
let toWhom =
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
module PrayerTracker.Handlers.User
|
||||
|
||||
open FSharp.Control.Tasks.V2.ContextInsensitive
|
||||
open Giraffe
|
||||
open Microsoft.AspNetCore.Html
|
||||
open Microsoft.AspNetCore.Http
|
||||
@@ -18,26 +17,21 @@ open System.Threading.Tasks
|
||||
let private setUserCookie (ctx : HttpContext) pwHash =
|
||||
ctx.Response.Cookies.Append (
|
||||
Key.Cookie.user,
|
||||
{ Id = (currentUser ctx).userId; GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload(),
|
||||
{ Id = (currentUser ctx).userId; GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (),
|
||||
autoRefresh)
|
||||
|
||||
/// Retrieve a user from the database by password
|
||||
// If the hashes do not match, determine if it matches a previous scheme, and upgrade them if it does
|
||||
let private findUserByPassword m (db : AppDbContext) =
|
||||
task {
|
||||
let private findUserByPassword m (db : AppDbContext) = task {
|
||||
match! db.TryUserByEmailAndGroup m.emailAddress m.smallGroupId with
|
||||
| Some u ->
|
||||
match u.salt with
|
||||
| Some salt ->
|
||||
| Some u when Option.isSome u.salt ->
|
||||
// Already upgraded; match = success
|
||||
let pwHash = pbkdf2Hash salt m.password
|
||||
let pwHash = pbkdf2Hash (Option.get u.salt) m.password
|
||||
match u.passwordHash = pwHash with
|
||||
| true -> return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
|
||||
| _ -> return None, ""
|
||||
| _ ->
|
||||
// Not upgraded; check against old hash
|
||||
match u.passwordHash = sha1Hash m.password with
|
||||
| true ->
|
||||
| Some u when u.passwordHash = sha1Hash m.password ->
|
||||
// Not upgraded, but password is good; upgrade 'em!
|
||||
// Upgrade 'em!
|
||||
let salt = Guid.NewGuid ()
|
||||
let pwHash = pbkdf2Hash salt m.password
|
||||
@@ -46,7 +40,6 @@ let private findUserByPassword m (db : AppDbContext) =
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
|
||||
| _ -> return None, ""
|
||||
| _ -> return None, ""
|
||||
}
|
||||
|
||||
|
||||
@@ -54,21 +47,18 @@ let private findUserByPassword m (db : AppDbContext) =
|
||||
let changePassword : HttpHandler =
|
||||
requireAccess [ User ]
|
||||
>=> validateCSRF
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
let! result = ctx.TryBindFormAsync<ChangePassword> ()
|
||||
match result with
|
||||
>=> fun next ctx -> task {
|
||||
match! ctx.TryBindFormAsync<ChangePassword> () with
|
||||
| Ok m ->
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
let db = ctx.dbContext ()
|
||||
let curUsr = currentUser ctx
|
||||
let! dbUsr = db.TryUserById curUsr.userId
|
||||
let! dbUsr = ctx.db.TryUserById curUsr.userId
|
||||
let! user =
|
||||
match dbUsr with
|
||||
| Some usr ->
|
||||
// Check the old password against a possibly non-salted hash
|
||||
(match usr.salt with | Some salt -> pbkdf2Hash salt | _ -> sha1Hash) m.oldPassword
|
||||
|> db.TryUserLogOnByCookie curUsr.userId (currentGroup ctx).smallGroupId
|
||||
|> ctx.db.TryUserLogOnByCookie curUsr.userId (currentGroup ctx).smallGroupId
|
||||
| _ -> Task.FromResult None
|
||||
match user with
|
||||
| Some _ when m.newPassword = m.newPasswordConfirm ->
|
||||
@@ -76,8 +66,8 @@ let changePassword : HttpHandler =
|
||||
| Some usr ->
|
||||
// Generate salt if it has not been already
|
||||
let salt = match usr.salt with Some s -> s | _ -> Guid.NewGuid ()
|
||||
db.UpdateEntry { usr with passwordHash = pbkdf2Hash salt m.newPassword; salt = Some salt }
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
ctx.db.UpdateEntry { usr with passwordHash = pbkdf2Hash salt m.newPassword; salt = Some salt }
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
// If the user is remembered, update the cookie with the new hash
|
||||
match ctx.Request.Cookies.Keys.Contains Key.Cookie.user with
|
||||
| true -> setUserCookie ctx usr.passwordHash
|
||||
@@ -99,16 +89,13 @@ let changePassword : HttpHandler =
|
||||
let delete userId : HttpHandler =
|
||||
requireAccess [ Admin ]
|
||||
>=> validateCSRF
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
let db = ctx.dbContext ()
|
||||
let! user = db.TryUserById userId
|
||||
match user with
|
||||
| Some u ->
|
||||
db.RemoveEntry u
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
>=> fun next ctx -> task {
|
||||
match! ctx.db.TryUserById userId with
|
||||
| Some user ->
|
||||
ctx.db.RemoveEntry user
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
addInfo ctx s.["Successfully deleted user {0}", u.fullName]
|
||||
addInfo ctx s.["Successfully deleted user {0}", user.fullName]
|
||||
return! redirectTo false "/web/users" next ctx
|
||||
| _ -> return! fourOhFour next ctx
|
||||
}
|
||||
@@ -118,20 +105,17 @@ let delete userId : HttpHandler =
|
||||
let doLogOn : HttpHandler =
|
||||
requireAccess [ AccessLevel.Public ]
|
||||
>=> validateCSRF
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
let! result = ctx.TryBindFormAsync<UserLogOn> ()
|
||||
match result with
|
||||
>=> fun next ctx -> task {
|
||||
match! ctx.TryBindFormAsync<UserLogOn> () with
|
||||
| Ok m ->
|
||||
let db = ctx.dbContext ()
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
let! usr, pwHash = findUserByPassword m db
|
||||
let! grp = db.TryGroupById m.smallGroupId
|
||||
let! usr, pwHash = findUserByPassword m ctx.db
|
||||
let! grp = ctx.db.TryGroupById m.smallGroupId
|
||||
let nextUrl =
|
||||
match usr with
|
||||
| Some _ ->
|
||||
ctx.Session.SetUser usr
|
||||
ctx.Session.SetSmallGroup grp
|
||||
ctx.Session.user <- usr
|
||||
ctx.Session.smallGroup <- grp
|
||||
match m.rememberMe with Some x when x -> setUserCookie ctx pwHash | _ -> ()
|
||||
addHtmlInfo ctx s.["Log On Successful • Welcome to {0}", s.["PrayerTracker"]]
|
||||
match m.redirectUrl with
|
||||
@@ -140,7 +124,7 @@ let doLogOn : HttpHandler =
|
||||
| Some x -> x
|
||||
| _ ->
|
||||
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"]
|
||||
description =
|
||||
[ s.["This is likely due to one of the following reasons"].Value
|
||||
@@ -165,9 +149,8 @@ let doLogOn : HttpHandler =
|
||||
/// GET /user/[user-id]/edit
|
||||
let edit (userId : UserId) : HttpHandler =
|
||||
requireAccess [ Admin ]
|
||||
>=> fun next ctx ->
|
||||
>=> fun next ctx -> task {
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
task {
|
||||
match userId = Guid.Empty with
|
||||
| true ->
|
||||
return!
|
||||
@@ -175,12 +158,11 @@ let edit (userId : UserId) : HttpHandler =
|
||||
|> Views.User.edit EditUser.empty ctx
|
||||
|> renderHtml next ctx
|
||||
| false ->
|
||||
let! user = ctx.dbContext().TryUserById userId
|
||||
match user with
|
||||
| Some u ->
|
||||
match! ctx.db.TryUserById userId with
|
||||
| Some user ->
|
||||
return!
|
||||
viewInfo ctx startTicks
|
||||
|> Views.User.edit (EditUser.fromUser u) ctx
|
||||
|> Views.User.edit (EditUser.fromUser user) ctx
|
||||
|> renderHtml next ctx
|
||||
| _ -> return! fourOhFour next ctx
|
||||
}
|
||||
@@ -189,11 +171,10 @@ let edit (userId : UserId) : HttpHandler =
|
||||
/// GET /user/log-on
|
||||
let logOn : HttpHandler =
|
||||
requireAccess [ AccessLevel.Public ]
|
||||
>=> fun next ctx ->
|
||||
>=> fun next ctx -> task {
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
task {
|
||||
let! groups = ctx.dbContext().GroupList ()
|
||||
let! groups = ctx.db.GroupList ()
|
||||
let url = Option.ofObj <| ctx.Session.GetString Key.Session.redirectUrl
|
||||
match url with
|
||||
| Some _ ->
|
||||
@@ -210,10 +191,9 @@ let logOn : HttpHandler =
|
||||
/// GET /users
|
||||
let maintain : HttpHandler =
|
||||
requireAccess [ Admin ]
|
||||
>=> fun next ctx ->
|
||||
>=> fun next ctx -> task {
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
task {
|
||||
let! users = ctx.dbContext().AllUsers ()
|
||||
let! users = ctx.db.AllUsers ()
|
||||
return!
|
||||
viewInfo ctx startTicks
|
||||
|> Views.User.maintain users ctx
|
||||
@@ -234,16 +214,13 @@ let password : HttpHandler =
|
||||
let save : HttpHandler =
|
||||
requireAccess [ Admin ]
|
||||
>=> validateCSRF
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
let! result = ctx.TryBindFormAsync<EditUser> ()
|
||||
match result with
|
||||
>=> fun next ctx -> task {
|
||||
match! ctx.TryBindFormAsync<EditUser> () with
|
||||
| Ok m ->
|
||||
let db = ctx.dbContext ()
|
||||
let! user =
|
||||
match m.isNew () with
|
||||
| true -> Task.FromResult (Some { User.empty with userId = Guid.NewGuid () })
|
||||
| false -> db.TryUserById m.userId
|
||||
| false -> ctx.db.TryUserById m.userId
|
||||
let saltedUser =
|
||||
match user with
|
||||
| Some u ->
|
||||
@@ -257,21 +234,22 @@ let save : HttpHandler =
|
||||
| _ -> user
|
||||
match saltedUser with
|
||||
| Some u ->
|
||||
m.populateUser u (pbkdf2Hash (Option.get u.salt))
|
||||
|> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry)
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
let updatedUser = m.populateUser u (pbkdf2Hash (Option.get u.salt))
|
||||
updatedUser |> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry)
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
match m.isNew () with
|
||||
| true ->
|
||||
let h = CommonFunctions.htmlString
|
||||
{ UserMessage.Info with
|
||||
{ UserMessage.info with
|
||||
text = h s.["Successfully {0} user", s.["Added"].Value.ToLower ()]
|
||||
description =
|
||||
h s.[ "Please select at least one group for which this user ({0}) is authorized", u.fullName]
|
||||
h s.["Please select at least one group for which this user ({0}) is authorized",
|
||||
updatedUser.fullName]
|
||||
|> Some
|
||||
}
|
||||
|> addUserMessage ctx
|
||||
return! redirectTo false (sprintf "/web/user/%s/small-groups" (flatGuid u.userId)) next ctx
|
||||
return! redirectTo false $"/web/user/{flatGuid u.userId}/small-groups" next ctx
|
||||
| false ->
|
||||
addInfo ctx s.["Successfully {0} user", s.["Updated"].Value.ToLower ()]
|
||||
return! redirectTo false "/web/users" next ctx
|
||||
@@ -284,35 +262,31 @@ let save : HttpHandler =
|
||||
let saveGroups : HttpHandler =
|
||||
requireAccess [ Admin ]
|
||||
>=> validateCSRF
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
let! result = ctx.TryBindFormAsync<AssignGroups> ()
|
||||
match result with
|
||||
>=> fun next ctx -> task {
|
||||
match! ctx.TryBindFormAsync<AssignGroups> () with
|
||||
| Ok m ->
|
||||
let s = Views.I18N.localizer.Force ()
|
||||
match Seq.length m.smallGroups with
|
||||
| 0 ->
|
||||
addError ctx s.["You must select at least one group to assign"]
|
||||
return! redirectTo false (sprintf "/web/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! user = db.TryUserByIdWithGroups m.userId
|
||||
match user with
|
||||
| Some u ->
|
||||
match! ctx.db.TryUserByIdWithGroups m.userId with
|
||||
| Some user ->
|
||||
let grps =
|
||||
m.smallGroups.Split ','
|
||||
|> Array.map Guid.Parse
|
||||
|> List.ofArray
|
||||
u.smallGroups
|
||||
user.smallGroups
|
||||
|> Seq.filter (fun x -> not (grps |> List.exists (fun y -> y = x.smallGroupId)))
|
||||
|> db.UserGroupXref.RemoveRange
|
||||
|> ctx.db.UserGroupXref.RemoveRange
|
||||
grps
|
||||
|> Seq.ofList
|
||||
|> Seq.filter (fun x -> not (u.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x)))
|
||||
|> Seq.map (fun x -> { UserSmallGroup.empty with userId = u.userId; smallGroupId = x })
|
||||
|> Seq.filter (fun x -> not (user.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x)))
|
||||
|> Seq.map (fun x -> { UserSmallGroup.empty with userId = user.userId; smallGroupId = x })
|
||||
|> List.ofSeq
|
||||
|> List.iter db.AddEntry
|
||||
let! _ = db.SaveChangesAsync ()
|
||||
|> List.iter ctx.db.AddEntry
|
||||
let! _ = ctx.db.SaveChangesAsync ()
|
||||
addInfo ctx s.["Successfully updated group permissions for {0}", m.userName]
|
||||
return! redirectTo false "/web/users" next ctx
|
||||
| _ -> return! fourOhFour next ctx
|
||||
@@ -323,18 +297,15 @@ let saveGroups : HttpHandler =
|
||||
/// GET /user/[user-id]/small-groups
|
||||
let smallGroups userId : HttpHandler =
|
||||
requireAccess [ Admin ]
|
||||
>=> fun next ctx ->
|
||||
>=> fun next ctx -> task {
|
||||
let startTicks = DateTime.Now.Ticks
|
||||
let db = ctx.dbContext ()
|
||||
task {
|
||||
let! user = db.TryUserByIdWithGroups userId
|
||||
match user with
|
||||
| Some u ->
|
||||
let! grps = db.GroupList ()
|
||||
let curGroups = u.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq
|
||||
match! ctx.db.TryUserByIdWithGroups userId with
|
||||
| Some user ->
|
||||
let! grps = ctx.db.GroupList ()
|
||||
let curGroups = user.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq
|
||||
return!
|
||||
viewInfo ctx startTicks
|
||||
|> Views.User.assignGroups (AssignGroups.fromUser u) grps curGroups ctx
|
||||
|> Views.User.assignGroups (AssignGroups.fromUser user) grps curGroups ctx
|
||||
|> renderHtml next ctx
|
||||
| None -> return! fourOhFour next ctx
|
||||
}
|
||||
|
||||
3
src/Publish-App.ps1
Normal file
3
src/Publish-App.ps1
Normal file
@@ -0,0 +1,3 @@
|
||||
Set-Location PrayerTracker
|
||||
dotnet publish -c Release -r linux-x64 -p:PublishSingleFile=true --self-contained false
|
||||
Set-Location bin\Release\net6.0\linux-x64\publish
|
||||
Reference in New Issue
Block a user