8 Commits
v7.4.1 ... v7.6

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

Signed-off-by: dependabot[bot] <support@github.com>
2020-02-25 21:22:27 +00:00
37 changed files with 1100 additions and 1187 deletions

2
.gitignore vendored
View File

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

View File

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

View File

@@ -1,11 +1,9 @@
GEM GEM
remote: https://rubygems.org/ remote: https://rubygems.org/
specs: specs:
activesupport (4.2.11.1) activesupport (3.2.22.5)
i18n (~> 0.7) i18n (~> 0.6, >= 0.6.4)
minitest (~> 5.1) multi_json (~> 1.0)
thread_safe (~> 0.3, >= 0.3.4)
tzinfo (~> 1.1)
addressable (2.7.0) addressable (2.7.0)
public_suffix (>= 2.0.2, < 5.0) public_suffix (>= 2.0.2, < 5.0)
coffee-script (2.4.1) coffee-script (2.4.1)
@@ -15,10 +13,10 @@ GEM
colorator (1.1.0) colorator (1.1.0)
commonmarker (0.17.13) commonmarker (0.17.13)
ruby-enum (~> 0.5) ruby-enum (~> 0.5)
concurrent-ruby (1.1.5) concurrent-ruby (1.1.7)
dnsruby (1.61.3) dnsruby (1.61.5)
addressable (~> 2.5) simpleidn (~> 0.1)
em-websocket (0.5.1) em-websocket (0.5.2)
eventmachine (>= 0.12.9) eventmachine (>= 0.12.9)
http_parser.rb (~> 0.6.0) http_parser.rb (~> 0.6.0)
ethon (0.12.0) ethon (0.12.0)
@@ -26,56 +24,56 @@ GEM
eventmachine (1.2.7) eventmachine (1.2.7)
eventmachine (1.2.7-x64-mingw32) eventmachine (1.2.7-x64-mingw32)
execjs (2.7.0) execjs (2.7.0)
faraday (0.17.0) faraday (1.1.0)
multipart-post (>= 1.2, < 3) multipart-post (>= 1.2, < 3)
ffi (1.11.1) ruby2_keywords
ffi (1.11.1-x64-mingw32) ffi (1.13.1)
ffi (1.13.1-x64-mingw32)
forwardable-extended (2.6.0) forwardable-extended (2.6.0)
gemoji (3.0.1) gemoji (3.0.1)
github-pages (201) github-pages (209)
activesupport (= 4.2.11.1)
github-pages-health-check (= 1.16.1) github-pages-health-check (= 1.16.1)
jekyll (= 3.8.5) jekyll (= 3.9.0)
jekyll-avatar (= 0.6.0) jekyll-avatar (= 0.7.0)
jekyll-coffeescript (= 1.1.1) jekyll-coffeescript (= 1.1.1)
jekyll-commonmark-ghpages (= 0.1.6) jekyll-commonmark-ghpages (= 0.1.6)
jekyll-default-layout (= 0.1.4) jekyll-default-layout (= 0.1.4)
jekyll-feed (= 0.11.0) jekyll-feed (= 0.15.1)
jekyll-gist (= 1.5.0) jekyll-gist (= 1.5.0)
jekyll-github-metadata (= 2.12.1) jekyll-github-metadata (= 2.13.0)
jekyll-mentions (= 1.4.1) jekyll-mentions (= 1.6.0)
jekyll-optional-front-matter (= 0.3.0) jekyll-optional-front-matter (= 0.3.2)
jekyll-paginate (= 1.1.0) jekyll-paginate (= 1.1.0)
jekyll-readme-index (= 0.2.0) jekyll-readme-index (= 0.3.0)
jekyll-redirect-from (= 0.14.0) jekyll-redirect-from (= 0.16.0)
jekyll-relative-links (= 0.6.0) jekyll-relative-links (= 0.6.1)
jekyll-remote-theme (= 0.4.0) jekyll-remote-theme (= 0.4.2)
jekyll-sass-converter (= 1.5.2) jekyll-sass-converter (= 1.5.2)
jekyll-seo-tag (= 2.5.0) jekyll-seo-tag (= 2.6.1)
jekyll-sitemap (= 1.2.0) jekyll-sitemap (= 1.4.0)
jekyll-swiss (= 0.4.0) jekyll-swiss (= 1.0.0)
jekyll-theme-architect (= 0.1.1) jekyll-theme-architect (= 0.1.1)
jekyll-theme-cayman (= 0.1.1) jekyll-theme-cayman (= 0.1.1)
jekyll-theme-dinky (= 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-leap-day (= 0.1.1)
jekyll-theme-merlot (= 0.1.1) jekyll-theme-merlot (= 0.1.1)
jekyll-theme-midnight (= 0.1.1) jekyll-theme-midnight (= 0.1.1)
jekyll-theme-minimal (= 0.1.1) jekyll-theme-minimal (= 0.1.1)
jekyll-theme-modernist (= 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-slate (= 0.1.1)
jekyll-theme-tactile (= 0.1.1) jekyll-theme-tactile (= 0.1.1)
jekyll-theme-time-machine (= 0.1.1) jekyll-theme-time-machine (= 0.1.1)
jekyll-titles-from-headings (= 0.5.1) jekyll-titles-from-headings (= 0.5.3)
jemoji (= 0.10.2) jemoji (= 0.12.0)
kramdown (= 1.17.0) kramdown (= 2.3.0)
liquid (= 4.0.0) kramdown-parser-gfm (= 1.1.0)
listen (= 3.1.5) liquid (= 4.0.3)
mercenary (~> 0.3) mercenary (~> 0.3)
minima (= 2.5.0) minima (= 2.5.1)
nokogiri (>= 1.10.4, < 2.0) nokogiri (>= 1.10.4, < 2.0)
rouge (= 3.11.0) rouge (= 3.23.0)
terminal-table (~> 1.4) terminal-table (~> 1.4)
github-pages-health-check (1.16.1) github-pages-health-check (1.16.1)
addressable (~> 2.3) addressable (~> 2.3)
@@ -83,27 +81,27 @@ GEM
octokit (~> 4.0) octokit (~> 4.0)
public_suffix (~> 3.0) public_suffix (~> 3.0)
typhoeus (~> 1.3) typhoeus (~> 1.3)
html-pipeline (2.12.0) html-pipeline (2.14.0)
activesupport (>= 2) activesupport (>= 2)
nokogiri (>= 1.4) nokogiri (>= 1.4)
http_parser.rb (0.6.0) http_parser.rb (0.6.0)
i18n (0.9.5) i18n (0.9.5)
concurrent-ruby (~> 1.0) concurrent-ruby (~> 1.0)
jekyll (3.8.5) jekyll (3.9.0)
addressable (~> 2.4) addressable (~> 2.4)
colorator (~> 1.0) colorator (~> 1.0)
em-websocket (~> 0.5) em-websocket (~> 0.5)
i18n (~> 0.7) i18n (~> 0.7)
jekyll-sass-converter (~> 1.0) jekyll-sass-converter (~> 1.0)
jekyll-watch (~> 2.0) jekyll-watch (~> 2.0)
kramdown (~> 1.14) kramdown (>= 1.17, < 3)
liquid (~> 4.0) liquid (~> 4.0)
mercenary (~> 0.3.3) mercenary (~> 0.3.3)
pathutil (~> 0.9) pathutil (~> 0.9)
rouge (>= 1.7, < 4) rouge (>= 1.7, < 4)
safe_yaml (~> 1.0) safe_yaml (~> 1.0)
jekyll-avatar (0.6.0) jekyll-avatar (0.7.0)
jekyll (~> 3.0) jekyll (>= 3.0, < 5.0)
jekyll-coffeescript (1.1.1) jekyll-coffeescript (1.1.1)
coffee-script (~> 2.2) coffee-script (~> 2.2)
coffee-script-source (~> 1.11.1) coffee-script-source (~> 1.11.1)
@@ -116,36 +114,37 @@ GEM
rouge (>= 2.0, < 4.0) rouge (>= 2.0, < 4.0)
jekyll-default-layout (0.1.4) jekyll-default-layout (0.1.4)
jekyll (~> 3.0) jekyll (~> 3.0)
jekyll-feed (0.11.0) jekyll-feed (0.15.1)
jekyll (~> 3.3) jekyll (>= 3.7, < 5.0)
jekyll-gist (1.5.0) jekyll-gist (1.5.0)
octokit (~> 4.2) octokit (~> 4.2)
jekyll-github-metadata (2.12.1) jekyll-github-metadata (2.13.0)
jekyll (~> 3.4) jekyll (>= 3.4, < 5.0)
octokit (~> 4.0, != 4.4.0) octokit (~> 4.0, != 4.4.0)
jekyll-mentions (1.4.1) jekyll-mentions (1.6.0)
html-pipeline (~> 2.3) html-pipeline (~> 2.3)
jekyll (~> 3.0) jekyll (>= 3.7, < 5.0)
jekyll-optional-front-matter (0.3.0) jekyll-optional-front-matter (0.3.2)
jekyll (~> 3.0) jekyll (>= 3.0, < 5.0)
jekyll-paginate (1.1.0) jekyll-paginate (1.1.0)
jekyll-readme-index (0.2.0) jekyll-readme-index (0.3.0)
jekyll (~> 3.0) jekyll (>= 3.0, < 5.0)
jekyll-redirect-from (0.14.0) jekyll-redirect-from (0.16.0)
jekyll (~> 3.3) jekyll (>= 3.3, < 5.0)
jekyll-relative-links (0.6.0) jekyll-relative-links (0.6.1)
jekyll (~> 3.3) jekyll (>= 3.3, < 5.0)
jekyll-remote-theme (0.4.0) jekyll-remote-theme (0.4.2)
addressable (~> 2.0) addressable (~> 2.0)
jekyll (~> 3.5) jekyll (>= 3.5, < 5.0)
rubyzip (>= 1.2.1, < 3.0) jekyll-sass-converter (>= 1.0, <= 3.0.0, != 2.0.0)
rubyzip (>= 1.3.0, < 3.0)
jekyll-sass-converter (1.5.2) jekyll-sass-converter (1.5.2)
sass (~> 3.4) sass (~> 3.4)
jekyll-seo-tag (2.5.0) jekyll-seo-tag (2.6.1)
jekyll (~> 3.3) jekyll (>= 3.3, < 5.0)
jekyll-sitemap (1.2.0) jekyll-sitemap (1.4.0)
jekyll (~> 3.3) jekyll (>= 3.7, < 5.0)
jekyll-swiss (0.4.0) jekyll-swiss (1.0.0)
jekyll-theme-architect (0.1.1) jekyll-theme-architect (0.1.1)
jekyll (~> 3.5) jekyll (~> 3.5)
jekyll-seo-tag (~> 2.0) jekyll-seo-tag (~> 2.0)
@@ -155,8 +154,8 @@ GEM
jekyll-theme-dinky (0.1.1) jekyll-theme-dinky (0.1.1)
jekyll (~> 3.5) jekyll (~> 3.5)
jekyll-seo-tag (~> 2.0) jekyll-seo-tag (~> 2.0)
jekyll-theme-hacker (0.1.1) jekyll-theme-hacker (0.1.2)
jekyll (~> 3.5) jekyll (> 3.5, < 5.0)
jekyll-seo-tag (~> 2.0) jekyll-seo-tag (~> 2.0)
jekyll-theme-leap-day (0.1.1) jekyll-theme-leap-day (0.1.1)
jekyll (~> 3.5) jekyll (~> 3.5)
@@ -173,8 +172,8 @@ GEM
jekyll-theme-modernist (0.1.1) jekyll-theme-modernist (0.1.1)
jekyll (~> 3.5) jekyll (~> 3.5)
jekyll-seo-tag (~> 2.0) jekyll-seo-tag (~> 2.0)
jekyll-theme-primer (0.5.3) jekyll-theme-primer (0.5.4)
jekyll (~> 3.5) jekyll (> 3.5, < 5.0)
jekyll-github-metadata (~> 2.9) jekyll-github-metadata (~> 2.9)
jekyll-seo-tag (~> 2.0) jekyll-seo-tag (~> 2.0)
jekyll-theme-slate (0.1.1) jekyll-theme-slate (0.1.1)
@@ -186,45 +185,49 @@ GEM
jekyll-theme-time-machine (0.1.1) jekyll-theme-time-machine (0.1.1)
jekyll (~> 3.5) jekyll (~> 3.5)
jekyll-seo-tag (~> 2.0) jekyll-seo-tag (~> 2.0)
jekyll-titles-from-headings (0.5.1) jekyll-titles-from-headings (0.5.3)
jekyll (~> 3.3) jekyll (>= 3.3, < 5.0)
jekyll-watch (2.2.1) jekyll-watch (2.2.1)
listen (~> 3.0) listen (~> 3.0)
jemoji (0.10.2) jemoji (0.12.0)
gemoji (~> 3.0) gemoji (~> 3.0)
html-pipeline (~> 2.2) html-pipeline (~> 2.2)
jekyll (~> 3.0) jekyll (>= 3.0, < 5.0)
kramdown (1.17.0) kramdown (2.3.0)
liquid (4.0.0) rexml
listen (3.1.5) kramdown-parser-gfm (1.1.0)
rb-fsevent (~> 0.9, >= 0.9.4) kramdown (~> 2.0)
rb-inotify (~> 0.9, >= 0.9.7) liquid (4.0.3)
ruby_dep (~> 1.2) listen (3.3.1)
rb-fsevent (~> 0.10, >= 0.10.3)
rb-inotify (~> 0.9, >= 0.9.10)
mercenary (0.3.6) mercenary (0.3.6)
mini_portile2 (2.4.0) mini_portile2 (2.4.0)
minima (2.5.0) minima (2.5.1)
jekyll (~> 3.5) jekyll (>= 3.5, < 5.0)
jekyll-feed (~> 0.9) jekyll-feed (~> 0.9)
jekyll-seo-tag (~> 2.1) jekyll-seo-tag (~> 2.1)
minitest (5.12.2) multi_json (1.15.0)
multipart-post (2.1.1) multipart-post (2.1.1)
nokogiri (1.10.4) nokogiri (1.10.10)
mini_portile2 (~> 2.4.0) mini_portile2 (~> 2.4.0)
nokogiri (1.10.4-x64-mingw32) nokogiri (1.10.10-x64-mingw32)
mini_portile2 (~> 2.4.0) mini_portile2 (~> 2.4.0)
octokit (4.14.0) octokit (4.19.0)
faraday (>= 0.9)
sawyer (~> 0.8.0, >= 0.5.3) sawyer (~> 0.8.0, >= 0.5.3)
pathutil (0.16.2) pathutil (0.16.2)
forwardable-extended (~> 2.6) forwardable-extended (~> 2.6)
public_suffix (3.1.1) public_suffix (3.1.1)
rb-fsevent (0.10.3) rb-fsevent (0.10.4)
rb-inotify (0.10.0) rb-inotify (0.10.1)
ffi (~> 1.0) ffi (~> 1.0)
rouge (3.11.0) rexml (3.2.4)
ruby-enum (0.7.2) rouge (3.23.0)
ruby-enum (0.8.0)
i18n i18n
ruby_dep (1.5.0) ruby2_keywords (0.0.2)
rubyzip (2.0.0) rubyzip (2.3.0)
safe_yaml (1.0.5) safe_yaml (1.0.5)
sass (3.7.4) sass (3.7.4)
sass-listen (~> 4.0.0) sass-listen (~> 4.0.0)
@@ -234,16 +237,21 @@ GEM
sawyer (0.8.2) sawyer (0.8.2)
addressable (>= 2.3.5) addressable (>= 2.3.5)
faraday (> 0.8, < 2.0) faraday (> 0.8, < 2.0)
simpleidn (0.1.1)
unf (~> 0.1.4)
terminal-table (1.8.0) terminal-table (1.8.0)
unicode-display_width (~> 1.1, >= 1.1.1) unicode-display_width (~> 1.1, >= 1.1.1)
thread_safe (0.3.6) typhoeus (1.4.0)
typhoeus (1.3.1)
ethon (>= 0.9.0) ethon (>= 0.9.0)
tzinfo (1.2.5) tzinfo (2.0.3)
thread_safe (~> 0.1) concurrent-ruby (~> 1.0)
tzinfo-data (1.2019.3) tzinfo-data (1.2020.4)
tzinfo (>= 1.0.0) tzinfo (>= 1.0.0)
unicode-display_width (1.6.0) unf (0.1.4)
unf_ext
unf_ext (0.0.7.7)
unf_ext (0.0.7.7-x64-mingw32)
unicode-display_width (1.7.0)
wdm (0.1.1) wdm (0.1.1)
PLATFORMS PLATFORMS
@@ -256,4 +264,4 @@ DEPENDENCIES
wdm (~> 0.1.0) wdm (~> 0.1.0)
BUNDLED WITH BUNDLED WITH
2.0.2 2.1.4

View File

@@ -1,9 +1,9 @@
<Project> <Project>
<PropertyGroup> <PropertyGroup>
<AssemblyVersion>7.4.1.0</AssemblyVersion> <AssemblyVersion>7.6.0.0</AssemblyVersion>
<FileVersion>7.4.1.0</FileVersion> <FileVersion>7.6.0.0</FileVersion>
<Authors>danieljsummers</Authors> <Authors>danieljsummers</Authors>
<Company>Bit Badger Solutions</Company> <Company>Bit Badger Solutions</Company>
<Version>7.4.1</Version> <Version>7.6.0</Version>
</PropertyGroup> </PropertyGroup>
</Project> </Project>

View File

@@ -1,7 +1,6 @@
[<AutoOpen>] [<AutoOpen>]
module PrayerTracker.DataAccess module PrayerTracker.DataAccess
open FSharp.Control.Tasks.ContextInsensitive
open Microsoft.EntityFrameworkCore open Microsoft.EntityFrameworkCore
open PrayerTracker.Entities open PrayerTracker.Entities
open System.Collections.Generic open System.Collections.Generic
@@ -239,7 +238,7 @@ type AppDbContext with
} }
let! grps = q.ToListAsync () let! grps = q.ToListAsync ()
return grps return grps
|> Seq.map (fun grp -> grp.smallGroupId.ToString "N", sprintf "%s | %s" grp.church.name grp.name) |> Seq.map (fun grp -> grp.smallGroupId.ToString "N", $"{grp.church.name} | {grp.name}")
|> List.ofSeq |> List.ofSeq
} }

View File

@@ -6,6 +6,8 @@ open NodaTime
open System open System
open System.Collections.Generic open System.Collections.Generic
// fsharplint:disable RecordFieldNames MemberNames
(*-- SUPPORT TYPES --*) (*-- SUPPORT TYPES --*)
/// How as-of dates should (or should not) be displayed with requests /// How as-of dates should (or should not) be displayed with requests

View File

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

View File

@@ -1,7 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup> <PropertyGroup>
<TargetFramework>netstandard2.1</TargetFramework> <TargetFramework>net6.0</TargetFramework>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
@@ -14,14 +14,9 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="FSharp.EFCore.OptionConverter" Version="1.0.0" /> <PackageReference Include="FSharp.EFCore.OptionConverter" Version="1.0.0" />
<PackageReference Include="Microsoft.FSharpLu" Version="0.11.5" /> <PackageReference Include="Microsoft.FSharpLu" Version="0.11.7" />
<PackageReference Include="NodaTime" Version="2.4.7" /> <PackageReference Include="NodaTime" Version="3.0.5" />
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="3.0.1" /> <PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="5.0.10" />
<PackageReference Include="TaskBuilder.fs" Version="2.1.0" />
</ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.7.0" />
</ItemGroup> </ItemGroup>
</Project> </Project>

View File

@@ -2,7 +2,7 @@
<PropertyGroup> <PropertyGroup>
<OutputType>Exe</OutputType> <OutputType>Exe</OutputType>
<TargetFramework>netcoreapp3.0</TargetFramework> <TargetFramework>net6.0</TargetFramework>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
@@ -15,9 +15,9 @@
</ItemGroup> </ItemGroup>
<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="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>
<ItemGroup> <ItemGroup>
@@ -26,8 +26,4 @@
<ProjectReference Include="..\PrayerTracker\PrayerTracker.fsproj" /> <ProjectReference Include="..\PrayerTracker\PrayerTracker.fsproj" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.7.0" />
</ItemGroup>
</Project> </Project>

View File

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

View File

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

View File

@@ -1,6 +1,6 @@
module PrayerTracker.Views.Church module PrayerTracker.Views.Church
open Giraffe.GiraffeViewEngine open Giraffe.ViewEngine
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
@@ -74,15 +74,15 @@ let maintain (churches : Church list) (stats : Map<string, ChurchStats>) ctx vi
churches churches
|> List.map (fun ch -> |> List.map (fun ch ->
let chId = flatGuid ch.churchId let chId = flatGuid ch.churchId
let delAction = sprintf "/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.", let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.",
sprintf "%s (%s)" (s.["Church"].Value.ToLower ()) ch.name] $"""{s.["Church"].Value.ToLower ()} ({ch.name})"""]
tr [] [ tr [] [
td [] [ td [] [
a [ _href (sprintf "/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 a [ _href delAction
_title s.["Delete This Church"].Value _title s.["Delete This Church"].Value
_onclick (sprintf "return PT.confirmDelete('%s','%A')" delAction delPrompt) ] _onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ] [ icon "delete_forever" ]
] ]
td [] [ str ch.name ] td [] [ str ch.name ]
@@ -96,7 +96,7 @@ let maintain (churches : Church list) (stats : Map<string, ChurchStats>) ctx vi
] ]
[ div [ _class "pt-center-text" ] [ [ div [ _class "pt-center-text" ] [
br [] br []
a [ _href (sprintf "/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 " &nbsp;"; locStr s.["Add a New Church"] ] [ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New Church"] ]
br [] br []
br [] br []

View File

@@ -2,8 +2,9 @@
module PrayerTracker.Views.CommonFunctions module PrayerTracker.Views.CommonFunctions
open Giraffe open Giraffe
open Giraffe.GiraffeViewEngine open Giraffe.ViewEngine
open Microsoft.AspNetCore.Antiforgery open Microsoft.AspNetCore.Antiforgery
open Microsoft.AspNetCore.Html
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Mvc.Localization open Microsoft.AspNetCore.Mvc.Localization
open Microsoft.Extensions.Localization open Microsoft.Extensions.Localization
@@ -28,7 +29,7 @@ let space = rawText " "
let icon name = i [ _class "material-icons" ] [ rawText name ] let icon name = i [ _class "material-icons" ] [ rawText name ]
/// Generate a Material Design icon, specifying the point size (must be defined in CSS) /// Generate a Material Design icon, specifying the point size (must be defined in CSS)
let iconSized size name = i [ _class (sprintf "material-icons md-%i" size) ] [ rawText name ] let iconSized size name = i [ _class $"material-icons md-{size}" ] [ rawText name ]
/// Generate a CSRF prevention token /// Generate a CSRF prevention token
let csrfToken (ctx : HttpContext) = let csrfToken (ctx : HttpContext) =
@@ -72,7 +73,7 @@ let namedColorList name selected attrs (s : IStringLocalizer) =
|> Seq.map (fun color -> |> Seq.map (fun color ->
let (colorName, dispText, txtColor) = color let (colorName, dispText, txtColor) = color
option [ yield _value colorName option [ yield _value colorName
yield _style (sprintf "background-color:%s;color:%s;" colorName txtColor) yield _style $"background-color:{colorName};color:{txtColor};"
match colorName = selected with true -> yield _selected | false -> () ] [ match colorName = selected with true -> yield _selected | false -> () ] [
encodedText (dispText.Value.ToLower ()) encodedText (dispText.Value.ToLower ())
]) ])
@@ -97,7 +98,7 @@ let selectList name selected attrs items =
|> select (List.concat [ [ _name name; _id name ]; attrs ]) |> select (List.concat [ [ _name name; _id name ]; attrs ])
/// Generate the text for a default entry at the top of a select list /// Generate the text for a default entry at the top of a select list
let selectDefault text = sprintf "— %s —" text let selectDefault text = $"— {text} —"
/// Generate a standard submit button with icon and text /// Generate a standard submit button with icon and text
let submit attrs ico text = button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ] let submit attrs ico text = button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ]
@@ -115,7 +116,7 @@ let blockquote = tag "blockquote"
/// role attribute /// role attribute
let _role = attr "role" let _role = attr "role"
/// aria-* attribute /// aria-* attribute
let _aria typ = attr (sprintf "aria-%s" typ) let _aria typ = attr $"aria-{typ}"
/// onclick attribute /// onclick attribute
let _onclick = attr "onclick" let _onclick = attr "onclick"
/// onsubmit attribute /// onsubmit attribute
@@ -125,6 +126,13 @@ let _onsubmit = attr "onsubmit"
let _scoped = flag "scoped" 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) /// Utility methods to help with time zones (and localization of their names)
module TimeZones = module TimeZones =

View File

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

View File

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

View File

@@ -1,7 +1,7 @@
/// Layout items for PrayerTracker /// Layout items for PrayerTracker
module PrayerTracker.Views.Layout module PrayerTracker.Views.Layout
open Giraffe.GiraffeViewEngine open Giraffe.ViewEngine
open PrayerTracker open PrayerTracker
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open System open System
@@ -76,7 +76,7 @@ module Navigation =
[ icon "list"; space; locStr s.["View Request List"] ] [ icon "list"; space; locStr s.["View Request List"] ]
] ]
li [] [ li [] [
a [ _href (sprintf "https://docs.prayer.bitbadger.solutions/%s" <| langCode ()) a [ _href $"https://docs.prayer.bitbadger.solutions/{langCode ()}"
_aria "label" s.["Help"].Value; _aria "label" s.["Help"].Value;
_title s.["View Help"].Value _title s.["View Help"].Value
_target "_blank" _target "_blank"
@@ -183,9 +183,9 @@ let private htmlHead m pageTitle =
title [] [ locStr pageTitle; titleSep; locStr s.["PrayerTracker"] ] title [] [ locStr pageTitle; titleSep; locStr s.["PrayerTracker"] ]
yield! commonHead yield! commonHead
for cssFile in m.style do for cssFile in m.style do
link [ _rel "stylesheet"; _href (sprintf "/css/%s.css" cssFile); _type "text/css" ] link [ _rel "stylesheet"; _href $"/css/{cssFile}.css"; _type "text/css" ]
for jsFile in m.script do for jsFile in m.script do
script [ _src (sprintf "/js/%s.js" jsFile) ] [] script [ _src $"/js/{jsFile}.js" ] []
] ]
/// Render a link to the help page for the current page /// Render a link to the help page for the current page
@@ -194,7 +194,7 @@ let private helpLink link =
sup [] [ sup [] [
a [ _href link a [ _href link
_title s.["Click for Help on This Page"].Value _title s.["Click for Help on This Page"].Value
_onclick (sprintf "return PT.showHelp('%s')" link) ] [ _onclick $"return PT.showHelp('{link}')" ] [
icon "help_outline" icon "help_outline"
] ]
] ]
@@ -211,7 +211,7 @@ let private messages m =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
m.messages m.messages
|> List.map (fun msg -> |> List.map (fun msg ->
table [ _class (sprintf "pt-msg %s" (msg.level.ToLower ())) ] [ table [ _class $"pt-msg {msg.level.ToLower ()}" ] [
tr [] [ tr [] [
td [] [ td [] [
match msg.level with match msg.level with
@@ -249,7 +249,7 @@ let private htmlFooter m =
] ]
div [ _id "pt-footer" ] [ div [ _id "pt-footer" ] [
a [ _href "/web/"; _style "line-height:28px;" ] [ a [ _href "/web/"; _style "line-height:28px;" ] [
img [ _src (sprintf "/img/%O.png" s.["footer_en"]); _alt imgText; _title imgText ] img [ _src $"""/img/%O{s.["footer_en"]}.png"""; _alt imgText; _title imgText ]
] ]
str m.version str m.version
space space

View File

@@ -1,7 +1,7 @@
module PrayerTracker.Views.PrayerRequest module PrayerTracker.Views.PrayerRequest
open Giraffe open Giraffe
open Giraffe.GiraffeViewEngine open Giraffe.ViewEngine
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open NodaTime open NodaTime
open PrayerTracker open PrayerTracker
@@ -55,7 +55,7 @@ let edit (m : EditRequest) today ctx vi =
label [] [ locStr s.["Expiration"] ] label [] [ locStr s.["Expiration"] ]
ReferenceList.expirationList s ((m.isNew >> not) ()) ReferenceList.expirationList s ((m.isNew >> not) ())
|> List.map (fun exp -> |> List.map (fun exp ->
let radioId = sprintf "expiration_%s" (fst exp) let radioId = $"expiration_{fst exp}"
span [ _class "text-nowrap" ] [ span [ _class "text-nowrap" ] [
radio "expiration" radioId (fst exp) m.expiration radio "expiration" radioId (fst exp) m.expiration
label [ _for radioId ] [ locStr (snd exp) ] label [ _for radioId ] [ locStr (snd exp) ]
@@ -80,13 +80,13 @@ let edit (m : EditRequest) today ctx vi =
/// View for the request e-mail results page /// View for the request e-mail results page
let email m vi = let email m vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = sprintf "%s %s" s.["Prayer Requests"].Value m.listGroup.name let pageTitle = $"""{s.["Prayer Requests"].Value} {m.listGroup.name}"""
let prefs = m.listGroup.preferences let prefs = m.listGroup.preferences
let addresses = let addresses =
m.recipients m.recipients
|> List.fold (fun (acc : StringBuilder) mbr -> acc.AppendFormat(", {0} <{1}>", mbr.memberName, mbr.email)) |> List.fold (fun (acc : StringBuilder) mbr -> acc.AppendFormat(", {0} <{1}>", mbr.memberName, mbr.email))
(StringBuilder ()) (StringBuilder ())
[ p [ _style (sprintf "font-family:%s;font-size:%ipt;" prefs.listFonts prefs.textFontSize) ] [ [ p [ _style $"font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;" ] [
locStr s.["The request list was sent to the following people, via individual e-mails"] locStr s.["The request list was sent to the following people, via individual e-mails"]
rawText ":" rawText ":"
br [] br []
@@ -143,9 +143,9 @@ let lists (grps : SmallGroup list) vi =
tr [] [ tr [] [
match grp.preferences.isPublic with match grp.preferences.isPublic with
| true -> | true ->
a [ _href (sprintf "/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 -> | 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" ] [ icon "verified_user" ]
|> List.singleton |> List.singleton
|> td [] |> td []
@@ -179,8 +179,8 @@ let maintain m (ctx : HttpContext) vi =
m.requests m.requests
|> Seq.map (fun req -> |> Seq.map (fun req ->
let reqId = flatGuid req.prayerRequestId let reqId = flatGuid req.prayerRequestId
let reqText = Utils.htmlToPlainText req.text let reqText = htmlToPlainText req.text
let delAction = sprintf "/web/prayer-request/%s/delete" reqId let delAction = $"/web/prayer-request/{reqId}/delete"
let delPrompt = let delPrompt =
[ s.["Are you sure you want to delete this {0}? This action cannot be undone.", [ s.["Are you sure you want to delete this {0}? This action cannot be undone.",
s.["Prayer Request"].Value.ToLower() ] s.["Prayer Request"].Value.ToLower() ]
@@ -192,36 +192,36 @@ let maintain m (ctx : HttpContext) vi =
|> String.concat "" |> String.concat ""
tr [] [ tr [] [
td [] [ 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" ] [ icon "edit" ]
match req.isExpired now m.smallGroup.preferences.daysToExpire with match req.isExpired now m.smallGroup.preferences.daysToExpire with
| true -> | true ->
a [ _href (sprintf "/web/prayer-request/%s/restore" reqId) a [ _href $"/web/prayer-request/{reqId}/restore"
_title l.["Restore This Inactive Request"].Value ] _title l.["Restore This Inactive Request"].Value ]
[ icon "visibility" ] [ icon "visibility" ]
| false -> | false ->
a [ _href (sprintf "/web/prayer-request/%s/expire" reqId) a [ _href $"/web/prayer-request/{reqId}/expire"
_title l.["Expire This Request Immediately"].Value ] _title l.["Expire This Request Immediately"].Value ]
[ icon "visibility_off" ] [ icon "visibility_off" ]
a [ _href delAction; _title l.["Delete This Request"].Value; a [ _href delAction; _title l.["Delete This Request"].Value;
_onclick (sprintf "return PT.confirmDelete('%s','%s')" delAction delPrompt) ] _onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ] [ icon "delete_forever" ]
] ]
td [ updReq req ] [ td [ updReq req ] [
str (req.updatedDate.ToString(s.["MMMM d, yyyy"].Value, System.Globalization.CultureInfo.CurrentUICulture)) str (req.updatedDate.ToString(s.["MMMM d, yyyy"].Value, Globalization.CultureInfo.CurrentUICulture))
] ]
td [] [ locStr typs.[req.requestType] ] td [] [ locStr typs.[req.requestType] ]
td [ reqExp req ] [ str (match req.requestor with Some r -> r | None -> " ") ] td [ reqExp req ] [ str (match req.requestor with Some r -> r | None -> " ") ]
td [] [ td [] [
match reqText.Length with match reqText.Length with
| len when len < 60 -> rawText reqText | len when len < 60 -> rawText reqText
| _ -> rawText (sprintf "%s&hellip;" reqText.[0..59]) | _ -> rawText $"{reqText.[0..59]}&hellip;"
] ]
]) ])
|> List.ofSeq |> List.ofSeq
[ div [ _class "pt-center-text" ] [ [ div [ _class "pt-center-text" ] [
br [] 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 " &nbsp;"; locStr s.["Add a New Request"] ] [ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New Request"] ]
rawText " &nbsp; &nbsp; &nbsp; " rawText " &nbsp; &nbsp; &nbsp; "
a [ _href "/web/prayer-requests/view"; _title s.["View Prayer Request List"].Value ] a [ _href "/web/prayer-requests/view"; _title s.["View Prayer Request List"].Value ]
@@ -302,14 +302,14 @@ let maintain m (ctx : HttpContext) vi =
/// View for the printable prayer request list /// View for the printable prayer request list
let print m version = let print m version =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = sprintf "%s %s" s.["Prayer Requests"].Value m.listGroup.name let pageTitle = $"""{s.["Prayer Requests"].Value} {m.listGroup.name}"""
let imgAlt = sprintf "%s %s" s.["PrayerTracker"].Value s.["from Bit Badger Solutions"].Value let imgAlt = $"""{s.["PrayerTracker"].Value} {s.["from Bit Badger Solutions"].Value}"""
article [] [ article [] [
rawText (m.asHtml s) rawText (m.asHtml s)
br [] br []
hr [] hr []
div [ _style "font-size:70%;font-family:@Model.ListGroup.preferences.listFonts;" ] [ div [ _style $"font-size:70%%;font-family:{m.listGroup.preferences.listFonts};" ] [
img [ _src (sprintf "/img/%s.png" s.["footer_en"].Value) img [ _src $"""/img/{s.["footer_en"].Value}.png"""
_style "vertical-align:text-bottom;" _style "vertical-align:text-bottom;"
_alt imgAlt _alt imgAlt
_title imgAlt ] _title imgAlt ]
@@ -323,13 +323,13 @@ let print m version =
/// View for the prayer request list /// View for the prayer request list
let view m vi = let view m vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = sprintf "%s %s" s.["Prayer Requests"].Value m.listGroup.name let pageTitle = $"""{s.["Prayer Requests"].Value} {m.listGroup.name}"""
let spacer = rawText " &nbsp; &nbsp; &nbsp; " let spacer = rawText " &nbsp; &nbsp; &nbsp; "
let dtString = m.date.ToString "yyyy-MM-dd" let dtString = m.date.ToString "yyyy-MM-dd"
[ div [ _class "pt-center-text" ] [ [ div [ _class "pt-center-text" ] [
br [] br []
a [ _class "pt-icon-link" a [ _class "pt-icon-link"
_href (sprintf "/web/prayer-requests/print/%s" dtString) _href $"/web/prayer-requests/print/{dtString}"
_title s.["View Printable"].Value ] [ _title s.["View Printable"].Value ] [
icon "print"; rawText " &nbsp;"; locStr s.["View Printable"] icon "print"; rawText " &nbsp;"; locStr s.["View Printable"]
] ]
@@ -345,16 +345,16 @@ let view m vi =
| false -> findSunday (date.AddDays 1.) | false -> findSunday (date.AddDays 1.)
let sunday = findSunday m.date let sunday = findSunday m.date
a [ _class "pt-icon-link" a [ _class "pt-icon-link"
_href (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 ] [ _title s.["List for Next Sunday"].Value ] [
icon "update"; rawText " &nbsp;"; locStr s.["List for Next Sunday"] icon "update"; rawText " &nbsp;"; locStr s.["List for Next Sunday"]
] ]
spacer spacer
let emailPrompt = s.["This will e-mail the current list to every member of your group, without further prompting. Are you sure this is what you are ready to do?"].Value let emailPrompt = s.["This will e-mail the current list to every member of your group, without further prompting. Are you sure this is what you are ready to do?"].Value
a [ _class "pt-icon-link" 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 _title s.["Send via E-mail"].Value
_onclick (sprintf "return PT.requests.view.promptBeforeEmail('%s')" emailPrompt) ] [ _onclick $"return PT.requests.view.promptBeforeEmail('{emailPrompt}')" ] [
icon "mail_outline"; rawText " &nbsp;"; locStr s.["Send via E-mail"] icon "mail_outline"; rawText " &nbsp;"; locStr s.["Send via E-mail"]
] ]
spacer spacer

View File

@@ -1,7 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup> <PropertyGroup>
<TargetFramework>netstandard2.1</TargetFramework> <TargetFramework>net6.0</TargetFramework>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
@@ -18,13 +18,14 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Giraffe" Version="4.0.1" /> <PackageReference Include="Giraffe" Version="5.0.0" />
<PackageReference Include="MailKit" Version="2.3.2" /> <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.Html.Abstractions" Version="2.2.0" />
<PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" /> <PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" />
<PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" /> <PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" />
<PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" /> <PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" />
<PackageReference Include="Newtonsoft.Json" Version="12.0.2" /> <PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
@@ -61,8 +62,4 @@
</EmbeddedResource> </EmbeddedResource>
</ItemGroup> </ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.7.0" />
</ItemGroup>
</Project> </Project>

View File

@@ -1,6 +1,6 @@
module PrayerTracker.Views.SmallGroup module PrayerTracker.Views.SmallGroup
open Giraffe.GiraffeViewEngine open Giraffe.ViewEngine
open Microsoft.Extensions.Localization open Microsoft.Extensions.Localization
open PrayerTracker open PrayerTracker
open PrayerTracker.Entities open PrayerTracker.Entities
@@ -147,7 +147,7 @@ let logOn (grps : SmallGroup list) grpId ctx vi =
| _ -> | _ ->
"", selectDefault s.["Select Group"].Value "", selectDefault s.["Select Group"].Value
yield! grps yield! grps
|> List.map (fun grp -> flatGuid grp.smallGroupId, sprintf "%s | %s" grp.church.name grp.name) |> List.map (fun grp -> flatGuid grp.smallGroupId, $"{grp.church.name} | {grp.name}")
} }
|> selectList "smallGroupId" grpId [ _required ] |> selectList "smallGroupId" grpId [ _required ]
] ]
@@ -190,15 +190,15 @@ let maintain (grps : SmallGroup list) ctx vi =
grps grps
|> List.map (fun g -> |> List.map (fun g ->
let grpId = flatGuid g.smallGroupId let grpId = flatGuid g.smallGroupId
let delAction = sprintf "/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.", let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.",
sprintf "%s (%s)" (s.["Small Group"].Value.ToLower ()) g.name].Value $"""{s.["Small Group"].Value.ToLower ()} ({g.name})""" ].Value
tr [] [ tr [] [
td [] [ td [] [
a [ _href (sprintf "/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 a [ _href delAction
_title s.["Delete This Group"].Value _title s.["Delete This Group"].Value
_onclick (sprintf "return PT.confirmDelete('%s','%s')" delAction delPrompt) ] _onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ] [ icon "delete_forever" ]
] ]
td [] [ str g.name ] td [] [ str g.name ]
@@ -209,7 +209,7 @@ let maintain (grps : SmallGroup list) ctx vi =
] ]
[ div [ _class "pt-center-text" ] [ [ div [ _class "pt-center-text" ] [
br [] br []
a [ _href (sprintf "/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" icon "add_circle"
rawText " &nbsp;" rawText " &nbsp;"
locStr s.["Add a New Group"] locStr s.["Add a New Group"]
@@ -244,18 +244,18 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
mbrs mbrs
|> List.map (fun mbr -> |> List.map (fun mbr ->
let mbrId = flatGuid mbr.memberId let mbrId = flatGuid mbr.memberId
let delAction = sprintf "/web/small-group/member/%s/delete" mbrId let delAction = $"/web/small-group/member/{mbrId}/delete"
let delPrompt = let delPrompt =
s.["Are you sure you want to delete this {0}? This action cannot be undone.", s.["group member"]] s.["Are you sure you want to delete this {0}? This action cannot be undone.", s.["group member"]]
.Value .Value
.Replace("?", sprintf " (%s)?" mbr.memberName) .Replace("?", $" ({mbr.memberName})?")
tr [] [ tr [] [
td [] [ td [] [
a [ _href (sprintf "/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" ] [ icon "edit" ]
a [ _href delAction a [ _href delAction
_title s.["Delete This Group Member"].Value _title s.["Delete This Group Member"].Value
_onclick (sprintf "return PT.confirmDelete('%s','%s')" delAction delPrompt) ] _onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ] [ icon "delete_forever" ]
] ]
td [] [ str mbr.memberName ] td [] [ str mbr.memberName ]
@@ -266,7 +266,7 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
] ]
[ div [ _class"pt-center-text" ] [ [ div [ _class"pt-center-text" ] [
br [] br []
a [ _href (sprintf "/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 " &nbsp;"; locStr s.["Add a New Group Member"] ] [ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New Group Member"] ]
br [] br []
br [] br []

View File

@@ -1,6 +1,6 @@
module PrayerTracker.Views.User module PrayerTracker.Views.User
open Giraffe.GiraffeViewEngine open Giraffe.ViewEngine
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
@@ -21,7 +21,7 @@ let assignGroups m groups curGroups ctx vi =
] ]
groups groups
|> List.map (fun (grpId, grpName) -> |> List.map (fun (grpId, grpName) ->
let inputId = sprintf "id-%s" grpId let inputId = $"id-{grpId}"
tr [] [ tr [] [
td [] [ td [] [
input [ _type "checkbox" input [ _type "checkbox"
@@ -49,7 +49,7 @@ let changePassword ctx vi =
] ]
form [ _action "/web/user/password/change" form [ _action "/web/user/password/change"
_method "post" _method "post"
_onsubmit (sprintf "return PT.compareValidation('newPassword','newPasswordConfirm','%A')" s.["The passwords do not match"]) ] [ _onsubmit $"""return PT.compareValidation('newPassword','newPasswordConfirm','%A{s.["The passwords do not match"]}')""" ] [
style [ _scoped ] [ rawText "#oldPassword, #newPassword, #newPasswordConfirm { width: 10rem; } "] style [ _scoped ] [ rawText "#oldPassword, #newPassword, #newPasswordConfirm { width: 10rem; } "]
csrfToken ctx csrfToken ctx
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
@@ -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 pageTitle = match m.isNew () with true -> "Add a New User" | false -> "Edit User"
let pwPlaceholder = s.[match m.isNew () with true -> "" | false -> "No change"].Value let pwPlaceholder = s.[match m.isNew () with true -> "" | false -> "No change"].Value
[ form [ _action "/web/user/edit/save"; _method "post"; _class "pt-center-columns" [ form [ _action "/web/user/edit/save"; _method "post"; _class "pt-center-columns"
_onsubmit (sprintf "return PT.compareValidation('password','passwordConfirm','%A')" s.["The passwords do not match"]) ] [ _onsubmit $"""return PT.compareValidation('password','passwordConfirm','%A{s.["The passwords do not match"]}')""" ] [
style [ _scoped ] style [ _scoped ]
[ rawText "#firstName, #lastName, #password, #passwordConfirm { width: 10rem; } #emailAddress { width: 20rem; } " ] [ rawText "#firstName, #lastName, #password, #passwordConfirm { width: 10rem; } #emailAddress { width: 20rem; } " ]
csrfToken ctx csrfToken ctx
@@ -123,7 +123,7 @@ let edit (m : EditUser) ctx vi =
] ]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save User"] ] div [ _class "pt-field-row" ] [ submit [] "save" s.["Save User"] ]
] ]
script [] [ rawText (sprintf "PT.onLoad(PT.user.edit.onPageLoad(%s))" ((string (m.isNew ())).ToLower ())) ] script [] [ rawText $"PT.onLoad(PT.user.edit.onPageLoad({(string (m.isNew ())).ToLower ()}))" ]
] ]
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard vi pageTitle |> Layout.standard vi pageTitle
@@ -189,17 +189,17 @@ let maintain (users : User list) ctx vi =
users users
|> List.map (fun user -> |> List.map (fun user ->
let userId = flatGuid user.userId let userId = flatGuid user.userId
let delAction = sprintf "/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.", let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.",
(sprintf "%s (%s)" (s.["User"].Value.ToLower()) user.fullName)].Value $"""{s.["User"].Value.ToLower ()} ({user.fullName})"""].Value
tr [] [ tr [] [
td [] [ td [] [
a [ _href (sprintf "/web/user/%s/edit" userId); _title s.["Edit This User"].Value ] [ icon "edit" ] a [ _href $"/web/user/{userId}/edit"; _title s.["Edit This User"].Value ] [ icon "edit" ]
a [ _href (sprintf "/web/user/%s/small-groups" userId); _title s.["Assign Groups to This User"].Value ] a [ _href $"/web/user/{userId}/small-groups"; _title s.["Assign Groups to This User"].Value ]
[ icon "group" ] [ icon "group" ]
a [ _href delAction a [ _href delAction
_title s.["Delete This User"].Value _title s.["Delete This User"].Value
_onclick (sprintf "return PT.confirmDelete('%s','%s')" delAction delPrompt) ] _onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ] [ icon "delete_forever" ]
] ]
td [] [ str user.fullName ] td [] [ str user.fullName ]
@@ -213,7 +213,7 @@ let maintain (users : User list) ctx vi =
] ]
[ div [ _class "pt-center-text" ] [ [ div [ _class "pt-center-text" ] [
br [] 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 " &nbsp;"; locStr s.["Add a New User"] ] [ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New User"] ]
br [] br []
br [] br []

View File

@@ -54,9 +54,9 @@ let stripTags allowedTags input =
|> List.fold |> List.fold
(fun acc t -> (fun acc t ->
acc acc
|| htmlTag.IndexOf (sprintf "<%s>" t) = 0 || htmlTag.IndexOf $"<{t}>" = 0
|| htmlTag.IndexOf (sprintf "<%s " t) = 0 || htmlTag.IndexOf $"<{t} " = 0
|| htmlTag.IndexOf (sprintf "</%s" t) = 0) false || htmlTag.IndexOf $"</{t}" = 0) false
match isAllowed with match isAllowed with
| true -> () | true -> ()
| false -> output <- String.replaceFirst tag.Value "" output | false -> output <- String.replaceFirst tag.Value "" output
@@ -200,7 +200,7 @@ module Help =
/// Help link for user password change page /// Help link for user password change page
let changePassword = "user/password" let changePassword = "user/password"
/// Create a full link for a help page /// Create a full link for a help page
let fullLink lang url = sprintf "https://docs.prayer.bitbadger.solutions/%s/%s.html" lang url let fullLink lang url = $"https://docs.prayer.bitbadger.solutions/%s{lang}/%s{url}.html"
/// This class serves as a common anchor for resources /// This class serves as a common anchor for resources
type Common () = type Common () =

View File

@@ -25,7 +25,7 @@ module ReferenceList =
| HtmlFormat -> s.["HTML Format"].Value | HtmlFormat -> s.["HTML Format"].Value
| PlainTextFormat -> s.["Plain-Text Format"].Value | PlainTextFormat -> s.["Plain-Text Format"].Value
seq { seq {
"", LocalizedString ("", sprintf "%s (%s)" s.["Group Default"].Value defaultType) "", LocalizedString ("", $"""{s.["Group Default"].Value} ({defaultType})""")
HtmlFormat.code, s.["HTML Format"] HtmlFormat.code, s.["HTML Format"]
PlainTextFormat.code, s.["Plain-Text Format"] PlainTextFormat.code, s.["Plain-Text Format"]
} }
@@ -46,6 +46,7 @@ module ReferenceList =
Announcement, s.["Announcements"] Announcement, s.["Announcements"]
] ]
// fsharplint:disable RecordFieldNames MemberNames
/// This is used to create a message that is displayed to the user /// This is used to create a message that is displayed to the user
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
@@ -57,25 +58,25 @@ type UserMessage =
/// The description (further information) /// The description (further information)
description : HtmlString option description : HtmlString option
} }
with module UserMessage =
/// Error message template /// Error message template
static member Error = let error =
{ level = "ERROR" { level = "ERROR"
text = HtmlString.Empty text = HtmlString.Empty
description = None description = None
} }
/// Warning message template /// Warning message template
static member Warning = let warning =
{ level = "WARNING" { level = "WARNING"
text = HtmlString.Empty text = HtmlString.Empty
description = None description = None
} }
/// Info message template /// Info message template
static member Info = let info =
{ level = "Info" { level = "Info"
text = HtmlString.Empty text = HtmlString.Empty
description = None description = None
} }
/// View model required by the layout template, given as first parameter for all pages in PrayerTracker /// View model required by the layout template, given as first parameter for all pages in PrayerTracker
@@ -98,18 +99,18 @@ type AppViewInfo =
/// The currently logged on small group, if there is one /// The currently logged on small group, if there is one
group : SmallGroup option group : SmallGroup option
} }
with module AppViewInfo =
/// A fresh version that can be populated to process the current request /// A fresh version that can be populated to process the current request
static member fresh = let fresh =
{ style = [] { style = []
script = [] script = []
helpLink = None helpLink = None
messages = [] messages = []
version = "" version = ""
requestStart = DateTime.Now.Ticks requestStart = DateTime.Now.Ticks
user = None user = None
group = None group = None
} }
/// Form for sending a small group or system-wide announcement /// Form for sending a small group or system-wide announcement
@@ -139,9 +140,9 @@ type AssignGroups =
/// The Ids of the small groups to which the user is authorized /// The Ids of the small groups to which the user is authorized
smallGroups : string smallGroups : string
} }
with module AssignGroups =
/// Create an instance of this form from an existing user /// Create an instance of this form from an existing user
static member fromUser (u : User) = let fromUser (u : User) =
{ userId = u.userId { userId = u.userId
userName = u.fullName userName = u.fullName
smallGroups = "" smallGroups = ""
@@ -177,24 +178,6 @@ type EditChurch =
interfaceAddress : string option interfaceAddress : string option
} }
with with
/// Create an instance from an existing church
static member fromChurch (ch : Church) =
{ churchId = ch.churchId
name = ch.name
city = ch.city
st = ch.st
hasInterface = match ch.hasInterface with true -> Some true | false -> None
interfaceAddress = ch.interfaceAddress
}
/// An instance to use for adding churches
static member empty =
{ churchId = Guid.Empty
name = ""
city = ""
st = ""
hasInterface = None
interfaceAddress = None
}
/// Is this a new church? /// Is this a new church?
member this.isNew () = Guid.Empty = this.churchId member this.isNew () = Guid.Empty = this.churchId
/// Populate a church from this form /// Populate a church from this form
@@ -206,6 +189,25 @@ with
hasInterface = match this.hasInterface with Some x -> x | None -> false hasInterface = match this.hasInterface with Some x -> x | None -> false
interfaceAddress = match this.hasInterface with Some x when x -> this.interfaceAddress | _ -> None interfaceAddress = match this.hasInterface with Some x when x -> this.interfaceAddress | _ -> None
} }
module EditChurch =
/// Create an instance from an existing church
let fromChurch (ch : Church) =
{ churchId = ch.churchId
name = ch.name
city = ch.city
st = ch.st
hasInterface = match ch.hasInterface with true -> Some true | false -> None
interfaceAddress = ch.interfaceAddress
}
/// An instance to use for adding churches
let empty =
{ churchId = Guid.Empty
name = ""
city = ""
st = ""
hasInterface = None
interfaceAddress = None
}
/// Form for adding/editing small group members /// Form for adding/editing small group members
@@ -221,22 +223,23 @@ type EditMember =
emailType : string emailType : string
} }
with with
/// Is this a new member?
member this.isNew () = Guid.Empty = this.memberId
module EditMember =
/// Create an instance from an existing member /// Create an instance from an existing member
static member fromMember (m : Member) = let fromMember (m : Member) =
{ memberId = m.memberId { memberId = m.memberId
memberName = m.memberName memberName = m.memberName
emailAddress = m.email emailAddress = m.email
emailType = match m.format with Some f -> f | None -> "" emailType = match m.format with Some f -> f | None -> ""
} }
/// An empty instance /// An empty instance
static member empty = let empty =
{ memberId = Guid.Empty { memberId = Guid.Empty
memberName = "" memberName = ""
emailAddress = "" emailAddress = ""
emailType = "" emailType = ""
} }
/// Is this a new member?
member this.isNew () = Guid.Empty = this.memberId
/// This form allows the user to set class preferences /// This form allows the user to set class preferences
@@ -282,32 +285,6 @@ type EditPreferences =
asOfDate : string asOfDate : string
} }
with with
static member fromPreferences (prefs : ListPreferences) =
let setType (x : string) = match x.StartsWith "#" with true -> "RGB" | false -> "Name"
{ expireDays = prefs.daysToExpire
daysToKeepNew = prefs.daysToKeepNew
longTermUpdateWeeks = prefs.longTermUpdateWeeks
requestSort = prefs.requestSort.code
emailFromName = prefs.emailFromName
emailFromAddress = prefs.emailFromAddress
defaultEmailType = prefs.defaultEmailType.code
headingLineType = setType prefs.lineColor
headingLineColor = prefs.lineColor
headingTextType = setType prefs.headingColor
headingTextColor = prefs.headingColor
listFonts = prefs.listFonts
headingFontSize = prefs.headingFontSize
listFontSize = prefs.textFontSize
timeZone = prefs.timeZoneId
groupPassword = Some prefs.groupPassword
pageSize = prefs.pageSize
asOfDate = prefs.asOfDateDisplay.code
listVisibility =
match true with
| _ when prefs.isPublic -> RequestVisibility.``public``
| _ when prefs.groupPassword = "" -> RequestVisibility.``private``
| _ -> RequestVisibility.passwordProtected
}
/// Set the properties of a small group based on the form's properties /// Set the properties of a small group based on the form's properties
member this.populatePreferences (prefs : ListPreferences) = member this.populatePreferences (prefs : ListPreferences) =
let isPublic, grpPw = let isPublic, grpPw =
@@ -335,6 +312,34 @@ with
pageSize = this.pageSize pageSize = this.pageSize
asOfDateDisplay = AsOfDateDisplay.fromCode this.asOfDate asOfDateDisplay = AsOfDateDisplay.fromCode this.asOfDate
} }
module EditPreferences =
/// Populate an edit form from existing preferences
let fromPreferences (prefs : ListPreferences) =
let setType (x : string) = match x.StartsWith "#" with true -> "RGB" | false -> "Name"
{ expireDays = prefs.daysToExpire
daysToKeepNew = prefs.daysToKeepNew
longTermUpdateWeeks = prefs.longTermUpdateWeeks
requestSort = prefs.requestSort.code
emailFromName = prefs.emailFromName
emailFromAddress = prefs.emailFromAddress
defaultEmailType = prefs.defaultEmailType.code
headingLineType = setType prefs.lineColor
headingLineColor = prefs.lineColor
headingTextType = setType prefs.headingColor
headingTextColor = prefs.headingColor
listFonts = prefs.listFonts
headingFontSize = prefs.headingFontSize
listFontSize = prefs.textFontSize
timeZone = prefs.timeZoneId
groupPassword = Some prefs.groupPassword
pageSize = prefs.pageSize
asOfDate = prefs.asOfDateDisplay.code
listVisibility =
match true with
| _ when prefs.isPublic -> RequestVisibility.``public``
| _ when prefs.groupPassword = "" -> RequestVisibility.``private``
| _ -> RequestVisibility.passwordProtected
}
/// Form for adding or editing prayer requests /// Form for adding or editing prayer requests
@@ -357,8 +362,11 @@ type EditRequest =
text : string text : string
} }
with with
/// Is this a new request?
member this.isNew () = Guid.Empty = this.requestId
module EditRequest =
/// An empty instance to use for new requests /// An empty instance to use for new requests
static member empty = let empty =
{ requestId = Guid.Empty { requestId = Guid.Empty
requestType = CurrentRequest.code requestType = CurrentRequest.code
enteredDate = None enteredDate = None
@@ -368,16 +376,14 @@ with
text = "" text = ""
} }
/// Create an instance from an existing request /// Create an instance from an existing request
static member fromRequest req = let fromRequest req =
{ EditRequest.empty with { empty with
requestId = req.prayerRequestId requestId = req.prayerRequestId
requestType = req.requestType.code requestType = req.requestType.code
requestor = req.requestor requestor = req.requestor
expiration = req.expiration.code expiration = req.expiration.code
text = req.text text = req.text
} }
/// Is this a new request?
member this.isNew () = Guid.Empty = this.requestId
/// Form for the admin-level editing of small groups /// Form for the admin-level editing of small groups
@@ -391,18 +397,6 @@ type EditSmallGroup =
churchId : ChurchId churchId : ChurchId
} }
with with
/// Create an instance from an existing small group
static member fromGroup (g : SmallGroup) =
{ smallGroupId = g.smallGroupId
name = g.name
churchId = g.churchId
}
/// An empty instance (used when adding a new group)
static member empty =
{ smallGroupId = Guid.Empty
name = ""
churchId = Guid.Empty
}
/// Is this a new small group? /// Is this a new small group?
member this.isNew () = Guid.Empty = this.smallGroupId member this.isNew () = Guid.Empty = this.smallGroupId
/// Populate a small group from this form /// Populate a small group from this form
@@ -411,6 +405,19 @@ with
name = this.name name = this.name
churchId = this.churchId churchId = this.churchId
} }
module EditSmallGroup =
/// Create an instance from an existing small group
let fromGroup (g : SmallGroup) =
{ smallGroupId = g.smallGroupId
name = g.name
churchId = g.churchId
}
/// An empty instance (used when adding a new group)
let empty =
{ smallGroupId = Guid.Empty
name = ""
churchId = Guid.Empty
}
/// Form for the user edit page /// Form for the user edit page
@@ -432,25 +439,6 @@ type EditUser =
isAdmin : bool option isAdmin : bool option
} }
with with
/// An empty instance
static member empty =
{ userId = Guid.Empty
firstName = ""
lastName = ""
emailAddress = ""
password = ""
passwordConfirm = ""
isAdmin = None
}
/// Create an instance from an existing user
static member fromUser (user : User) =
{ EditUser.empty with
userId = user.userId
firstName = user.firstName
lastName = user.lastName
emailAddress = user.emailAddress
isAdmin = match user.isAdmin with true -> Some true | false -> None
}
/// Is this a new user? /// Is this a new user?
member this.isNew () = Guid.Empty = this.userId member this.isNew () = Guid.Empty = this.userId
/// Populate a user from the form /// Populate a user from the form
@@ -462,8 +450,28 @@ with
isAdmin = match this.isAdmin with Some x -> x | None -> false isAdmin = match this.isAdmin with Some x -> x | None -> false
} }
|> function |> function
| u when this.password = null || this.password = "" -> u | u when isNull this.password || this.password = "" -> u
| u -> { u with passwordHash = hasher this.password } | u -> { u with passwordHash = hasher this.password }
module EditUser =
/// An empty instance
let empty =
{ userId = Guid.Empty
firstName = ""
lastName = ""
emailAddress = ""
password = ""
passwordConfirm = ""
isAdmin = None
}
/// Create an instance from an existing user
let fromUser (user : User) =
{ empty with
userId = user.userId
firstName = user.firstName
lastName = user.lastName
emailAddress = user.emailAddress
isAdmin = match user.isAdmin with true -> Some true | false -> None
}
/// Form for the small group log on page /// Form for the small group log on page
@@ -476,8 +484,9 @@ type GroupLogOn =
/// Whether to remember the login /// Whether to remember the login
rememberMe : bool option rememberMe : bool option
} }
with module GroupLogOn =
static member empty = /// An empty instance
let empty =
{ smallGroupId = Guid.Empty { smallGroupId = Guid.Empty
password = "" password = ""
rememberMe = None rememberMe = None
@@ -498,8 +507,9 @@ type MaintainRequests =
/// The page number of the results /// The page number of the results
pageNbr : int option pageNbr : int option
} }
with module MaintainRequests =
static member empty = /// An empty instance
let empty =
{ requests = Seq.empty { requests = Seq.empty
smallGroup = SmallGroup.empty smallGroup = SmallGroup.empty
onlyActive = None onlyActive = None
@@ -536,8 +546,9 @@ type UserLogOn =
/// The URL to which the user should be redirected once login is successful /// The URL to which the user should be redirected once login is successful
redirectUrl : string option redirectUrl : string option
} }
with module UserLogOn =
static member empty = /// An empty instance
let empty =
{ emailAddress = "" { emailAddress = ""
password = "" password = ""
smallGroupId = Guid.Empty smallGroupId = Guid.Empty
@@ -546,7 +557,7 @@ with
} }
open Giraffe.GiraffeViewEngine open Giraffe.ViewEngine
/// This represents a list of requests /// This represents a list of requests
type RequestList = type RequestList =
@@ -583,12 +594,12 @@ with
let asOfSize = Math.Round (float prefs.textFontSize * 0.8, 2) let asOfSize = Math.Round (float prefs.textFontSize * 0.8, 2)
[ match this.showHeader with [ match this.showHeader with
| true -> | true ->
div [ _style (sprintf "text-align:center;font-family:%s" prefs.listFonts) ] [ div [ _style $"text-align:center;font-family:{prefs.listFonts}" ] [
span [ _style (sprintf "font-size:%ipt;" prefs.headingFontSize) ] [ span [ _style $"font-size:%i{prefs.headingFontSize}pt;" ] [
strong [] [ str s.["Prayer Requests"].Value ] strong [] [ str s.["Prayer Requests"].Value ]
] ]
br [] br []
span [ _style (sprintf "font-size:%ipt;" prefs.textFontSize) ] [ span [ _style $"font-size:%i{prefs.textFontSize}pt;" ] [
strong [] [ str this.listGroup.name ] strong [] [ str this.listGroup.name ]
br [] br []
str (this.date.ToString s.["MMMM d, yyyy"].Value) str (this.date.ToString s.["MMMM d, yyyy"].Value)
@@ -605,10 +616,9 @@ with
let reqs = this.requestsInCategory cat let reqs = this.requestsInCategory cat
let catName = typs |> List.filter (fun t -> fst t = cat) |> List.head |> snd let catName = typs |> List.filter (fun t -> fst t = cat) |> List.head |> snd
div [ _style "padding-left:10px;padding-bottom:.5em;" ] [ div [ _style "padding-left:10px;padding-bottom:.5em;" ] [
table [ _style (sprintf "font-family:%s;page-break-inside:avoid;" prefs.listFonts) ] [ table [ _style $"font-family:{prefs.listFonts};page-break-inside:avoid;" ] [
tr [] [ tr [] [
td [ _style (sprintf "font-size:%ipt;color:%s;padding:3px 0;border-top:solid 3px %s;border-bottom:solid 3px %s;font-weight:bold;" td [ _style $"font-size:%i{prefs.headingFontSize}pt;color:{prefs.headingColor};padding:3px 0;border-top:solid 3px {prefs.lineColor};border-bottom:solid 3px {prefs.lineColor};font-weight:bold;" ] [
prefs.headingFontSize prefs.headingColor prefs.lineColor prefs.lineColor) ] [
rawText "&nbsp; &nbsp; "; str catName.Value; rawText "&nbsp; &nbsp; " rawText "&nbsp; &nbsp; "; str catName.Value; rawText "&nbsp; &nbsp; "
] ]
] ]
@@ -617,8 +627,7 @@ with
reqs reqs
|> List.map (fun req -> |> List.map (fun req ->
let bullet = match this.isNew req with true -> "circle" | false -> "disc" let bullet = match this.isNew req with true -> "circle" | false -> "disc"
li [ _style (sprintf "list-style-type:%s;font-family:%s;font-size:%ipt;padding-bottom:.25em;" li [ _style $"list-style-type:{bullet};font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;padding-bottom:.25em;" ] [
bullet prefs.listFonts prefs.textFontSize) ] [
match req.requestor with match req.requestor with
| Some rqstr when rqstr <> "" -> | Some rqstr when rqstr <> "" ->
strong [] [ str rqstr ] strong [] [ str rqstr ]
@@ -635,14 +644,14 @@ with
| ShortDate -> req.updatedDate.ToShortDateString () | ShortDate -> req.updatedDate.ToShortDateString ()
| LongDate -> req.updatedDate.ToLongDateString () | LongDate -> req.updatedDate.ToLongDateString ()
| _ -> "" | _ -> ""
i [ _style (sprintf "font-size:%.2fpt" asOfSize) ] [ i [ _style $"font-size:%.2f{asOfSize}pt" ] [
rawText "&nbsp; ("; str s.["as of"].Value; str " "; str dt; rawText ")" rawText "&nbsp; ("; str s.["as of"].Value; str " "; str dt; rawText ")"
] ]
]) ])
|> ul [] |> ul []
br [] br []
] ]
|> renderHtmlNodes |> RenderView.AsString.htmlNodes
/// Generate this list as plain text /// Generate this list as plain text
member this.asText (s : IStringLocalizer) = member this.asText (s : IStringLocalizer) =
@@ -661,7 +670,7 @@ with
let typ = (typs |> List.filter (fun t -> fst t = cat) |> List.head |> snd).Value let typ = (typs |> List.filter (fun t -> fst t = cat) |> List.head |> snd).Value
let dashes = String.replicate (typ.Length + 4) "-" let dashes = String.replicate (typ.Length + 4) "-"
dashes dashes
sprintf @" %s" (typ.ToUpper ()) $" {typ.ToUpper ()}"
dashes dashes
for req in reqs do for req in reqs do
let bullet = match this.isNew req with true -> "+" | false -> "-" let bullet = match this.isNew req with true -> "+" | false -> "-"
@@ -674,7 +683,7 @@ with
| ShortDate -> req.updatedDate.ToShortDateString () | ShortDate -> req.updatedDate.ToShortDateString ()
| LongDate -> req.updatedDate.ToLongDateString () | LongDate -> req.updatedDate.ToLongDateString ()
| _ -> "" | _ -> ""
sprintf " (%s %s)" s.["as of"].Value dt $""" ({s.["as of"].Value} {dt})"""
|> sprintf " %s %s%s%s" bullet requestor (htmlToPlainText req.text) |> sprintf " %s %s%s%s" bullet requestor (htmlToPlainText req.text)
" " " "
} }

View File

@@ -14,6 +14,7 @@ EndProject
Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{B290BA27-C8B8-44F3-BF01-D103302D815F}" Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{B290BA27-C8B8-44F3-BF01-D103302D815F}"
ProjectSection(SolutionItems) = preProject ProjectSection(SolutionItems) = preProject
Directory.Build.props = Directory.Build.props Directory.Build.props = Directory.Build.props
global.json = global.json
EndProjectSection EndProjectSection
EndProject EndProject
Global Global

View File

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

View File

@@ -9,7 +9,7 @@ module Configure =
open Cookies open Cookies
open Giraffe open Giraffe
open Giraffe.TokenRouter open Giraffe.EndpointRouting
open Microsoft.AspNetCore.Localization open Microsoft.AspNetCore.Localization
open Microsoft.AspNetCore.Server.Kestrel.Core open Microsoft.AspNetCore.Server.Kestrel.Core
open Microsoft.EntityFrameworkCore open Microsoft.EntityFrameworkCore
@@ -26,7 +26,7 @@ module Configure =
let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) = let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) =
cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath) cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath)
.AddJsonFile("appsettings.json", optional = true, reloadOnChange = true) .AddJsonFile("appsettings.json", optional = true, reloadOnChange = true)
.AddJsonFile(sprintf "appsettings.%s.json" ctx.HostingEnvironment.EnvironmentName, optional = true) .AddJsonFile($"appsettings.{ctx.HostingEnvironment.EnvironmentName}.json", optional = true)
.AddEnvironmentVariables() .AddEnvironmentVariables()
|> ignore |> ignore
@@ -49,22 +49,22 @@ module Configure =
.AddDistributedMemoryCache() .AddDistributedMemoryCache()
.AddSession() .AddSession()
.AddAntiforgery() .AddAntiforgery()
.AddRouting()
.AddSingleton<IClock>(SystemClock.Instance) .AddSingleton<IClock>(SystemClock.Instance)
|> ignore |> ignore
let config = svc.BuildServiceProvider().GetRequiredService<IConfiguration>() let config = svc.BuildServiceProvider().GetRequiredService<IConfiguration>()
let crypto = config.GetSection "CookieCrypto" let crypto = config.GetSection "CookieCrypto"
CookieCrypto (crypto.["Key"], crypto.["IV"]) |> setCrypto CookieCrypto (crypto.["Key"], crypto.["IV"]) |> setCrypto
svc.AddDbContext<AppDbContext>( svc.AddDbContext<AppDbContext>(
fun options -> (fun options ->
options.UseNpgsql (config.GetConnectionString "PrayerTracker") |> ignore) options.UseNpgsql (config.GetConnectionString "PrayerTracker") |> ignore),
ServiceLifetime.Scoped, ServiceLifetime.Singleton)
|> ignore |> ignore
/// Routes for PrayerTracker /// Routes for PrayerTracker
let webApp = let routes =
router Handlers.CommonFunctions.fourOhFour [ [ subRoute "/web" [
// Traditional web app routes GET_HEAD [
subRoute"/web" [
GET [
subRoute "/church" [ subRoute "/church" [
route "es" Handlers.Church.maintain route "es" Handlers.Church.maintain
routef "/%O/edit" Handlers.Church.edit routef "/%O/edit" Handlers.Church.edit
@@ -145,6 +145,7 @@ module Configure =
route "/" (redirectTo false "/web/") route "/" (redirectTo false "/web/")
] ]
/// Giraffe error handler
let errorHandler (ex : exn) (logger : ILogger) = let errorHandler (ex : exn) (logger : ILogger) =
logger.LogError(EventId(), ex, "An unhandled exception has occurred while executing the request.") logger.LogError(EventId(), ex, "An unhandled exception has occurred while executing the request.")
clearResponse >=> setStatusCode 500 >=> text ex.Message clearResponse >=> setStatusCode 500 >=> text ex.Message
@@ -171,9 +172,10 @@ module Configure =
app.UseGiraffeErrorHandler errorHandler) app.UseGiraffeErrorHandler errorHandler)
.UseStatusCodePagesWithReExecute("/error/{0}") .UseStatusCodePagesWithReExecute("/error/{0}")
.UseStaticFiles() .UseStaticFiles()
.UseRouting()
.UseSession() .UseSession()
.UseRequestLocalization(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value) .UseRequestLocalization(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value)
.UseGiraffe(webApp) .UseEndpoints (fun e -> e.MapGiraffeEndpoints routes)
|> ignore |> ignore
Views.I18N.setUpFactories <| app.ApplicationServices.GetRequiredService<IStringLocalizerFactory> () Views.I18N.setUpFactories <| app.ApplicationServices.GetRequiredService<IStringLocalizerFactory> ()

View File

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

View File

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

View File

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

View File

@@ -1,7 +1,6 @@
/// Methods for sending e-mails /// Methods for sending e-mails
module PrayerTracker.Email module PrayerTracker.Email
open FSharp.Control.Tasks.ContextInsensitive
open MailKit.Net.Smtp open MailKit.Net.Smtp
open MailKit.Security open MailKit.Security
open Microsoft.Extensions.Localization open Microsoft.Extensions.Localization
@@ -14,12 +13,11 @@ let private fromAddress = "prayer@bitbadger.solutions"
/// Get an SMTP client connection /// Get an SMTP client connection
// FIXME: make host configurable // FIXME: make host configurable
let getConnection () = let getConnection () = task {
task { let client = new SmtpClient ()
let client = new SmtpClient () do! client.ConnectAsync ("127.0.0.1", 25, SecureSocketOptions.None)
do! client.ConnectAsync ("127.0.0.1", 25, SecureSocketOptions.None) return client
return client }
}
/// Create a mail message object, filled with everything but the body content /// Create a mail message object, filled with everything but the body content
let createMessage (grp : SmallGroup) subj = let createMessage (grp : SmallGroup) subj =
@@ -32,9 +30,9 @@ let createMessage (grp : SmallGroup) subj =
/// Create an HTML-format e-mail message /// Create an HTML-format e-mail message
let createHtmlMessage grp subj body (s : IStringLocalizer) = let createHtmlMessage grp subj body (s : IStringLocalizer) =
let bodyText = let bodyText =
[ @"<!DOCTYPE html><html xmlns=""http://www.w3.org/1999/xhtml""><head><title></title></head><body>" [ """<!DOCTYPE html><html xmlns="http://www.w3.org/1999/xhtml"><head><title></title></head><body>"""
body body
@"<hr><div style=""text-align:right;font-family:Arial,Helvetica,sans-serif;font-size:8pt;padding-right:10px;"">" """<hr><div style="text-align:right;font-family:Arial,Helvetica,sans-serif;font-size:8pt;padding-right:10px;">"""
s.["Generated by P R A Y E R T R A C K E R"].Value s.["Generated by P R A Y E R T R A C K E R"].Value
"<br><small>" "<br><small>"
s.["from Bit Badger Solutions"].Value s.["from Bit Badger Solutions"].Value
@@ -60,21 +58,20 @@ let createTextMessage grp subj body (s : IStringLocalizer) =
msg msg
/// Send e-mails to a class /// Send e-mails to a class
let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html text s = let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html text s = task {
task { let htmlMsg = createHtmlMessage grp subj html s
let htmlMsg = createHtmlMessage grp subj html s let plainTextMsg = createTextMessage grp subj text s
let plainTextMsg = createTextMessage grp subj text s
for mbr in recipients do for mbr in recipients do
let emailType = match mbr.format with Some f -> EmailFormat.fromCode f | None -> grp.preferences.defaultEmailType let emailType = match mbr.format with Some f -> EmailFormat.fromCode f | None -> grp.preferences.defaultEmailType
let emailTo = MailboxAddress (mbr.memberName, mbr.email) let emailTo = MailboxAddress (mbr.memberName, mbr.email)
match emailType with match emailType with
| HtmlFormat -> | HtmlFormat ->
htmlMsg.To.Add emailTo htmlMsg.To.Add emailTo
do! client.SendAsync htmlMsg do! client.SendAsync htmlMsg
htmlMsg.To.Clear () htmlMsg.To.Clear ()
| PlainTextFormat -> | PlainTextFormat ->
plainTextMsg.To.Add emailTo plainTextMsg.To.Add emailTo
do! client.SendAsync plainTextMsg do! client.SendAsync plainTextMsg
plainTextMsg.To.Clear () plainTextMsg.To.Clear ()
} }

View File

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

View File

@@ -35,7 +35,7 @@ let language culture : HttpHandler =
| "" | ""
| "en" -> "en-US" | "en" -> "en-US"
| "es" -> "es-MX" | "es" -> "es-MX"
| _ -> sprintf "%s-%s" culture (culture.ToUpper ()) | _ -> $"{culture}-{culture.ToUpper ()}"
|> (CultureInfo >> Option.ofObj) |> (CultureInfo >> Option.ofObj)
with with
| :? CultureNotFoundException | :? CultureNotFoundException

View File

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

View File

@@ -1,7 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk.Web"> <Project Sdk="Microsoft.NET.Sdk.Web">
<PropertyGroup> <PropertyGroup>
<TargetFramework>netcoreapp3.0</TargetFramework> <TargetFramework>net6.0</TargetFramework>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
@@ -23,10 +23,9 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Giraffe" Version="4.0.1" /> <PackageReference Include="Giraffe" Version="5.0.0" />
<PackageReference Include="Giraffe.TokenRouter" Version="1.0.0" /> <PackageReference Include="Microsoft.VisualStudio.Web.CodeGeneration.Design" Version="3.1.1" />
<PackageReference Include="Microsoft.VisualStudio.Web.CodeGeneration.Design" Version="3.0.0" /> <PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="5.0.10" />
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="3.0.1" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
@@ -34,8 +33,4 @@
<ProjectReference Include="..\PrayerTracker.UI\PrayerTracker.UI.fsproj" /> <ProjectReference Include="..\PrayerTracker.UI\PrayerTracker.UI.fsproj" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.7.0" />
</ItemGroup>
</Project> </Project>

View File

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

View File

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

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

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

View File

@@ -1,5 +0,0 @@
{
"sdk": {
"version": "3.0.100"
}
}