bit-badger/PrayerTracker
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 16 Wiki Activity

Version 8 #43

Merged
danieljsummers merged 37 commits from version-8 into main 2022-08-19 19:08:31 +00:00
Conversation 0 Commits 37 Files Changed 58 +7525 -7159
58 changed files with 7525 additions and 7159 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
.config/dotnet-tools.json Normal file
View File

@ -0,0 +1,12 @@
{
"version": 1,
"isRoot": true,
"tools": {
"fake-cli": {
"version": "5.23.0",
"commands": [
"fake"
]
}
}
}

1
.gitignore vendored
View File

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

44
build.fsx Normal file
View File

@ -0,0 +1,44 @@
#r "paket:
nuget Fake.DotNet.Cli
nuget Fake.DotNet.Testing.Expecto
nuget Fake.IO.FileSystem
nuget Fake.Core.Target //"
#load ".fake/build.fsx/intellisense.fsx"
open Fake.Core
open Fake.DotNet
open Fake.DotNet.Testing
open Fake.IO
open Fake.IO.Globbing.Operators
open Fake.Core.TargetOperators
Target.initEnvironment ()
/// The root path to the projects within this solution
let projPath = "src/PrayerTracker"
Target.create "Clean" (fun _ ->
!! "src/**/bin"
++ "src/**/obj"
|> Shell.cleanDirs
)
Target.create "Test" (fun _ ->
let testPath = $"{projPath}.Tests"
DotNet.build (fun opts -> { opts with NoLogo = true }) $"{testPath}/PrayerTracker.Tests.fsproj"
Expecto.run
(fun opts -> { opts with WorkingDirectory = $"{testPath}/bin/Release/net6.0" })
[ "PrayerTracker.Tests.dll" ])
Target.create "Publish" (fun _ ->
DotNet.publish
(fun opts -> { opts with Runtime = Some "linux-x64"; SelfContained = Some false; NoLogo = true })
$"{projPath}/PrayerTracker.fsproj")
Target.create "All" ignore
"Clean"
==> "Test"
==> "Publish"
==> "All"
Target.runOrDefault "All"

233
build.fsx.lock Normal file
View File

@ -0,0 +1,233 @@
STORAGE: NONE
RESTRICTION: || (== net6.0) (== netstandard2.0)
NUGET
remote: https://api.nuget.org/v3/index.json
BlackFox.VsWhere (1.1)
FSharp.Core (>= 4.2.3)
Microsoft.Win32.Registry (>= 4.7)
Fake.Core.CommandLineParsing (5.23)
FParsec (>= 1.1.1)
FSharp.Core (>= 6.0)
Fake.Core.Context (5.23)
FSharp.Core (>= 6.0)
Fake.Core.Environment (5.23)
FSharp.Core (>= 6.0)
Fake.Core.FakeVar (5.23)
Fake.Core.Context (>= 5.23)
FSharp.Core (>= 6.0)
Fake.Core.Process (5.23)
Fake.Core.Environment (>= 5.23)
Fake.Core.FakeVar (>= 5.23)
Fake.Core.String (>= 5.23)
Fake.Core.Trace (>= 5.23)
Fake.IO.FileSystem (>= 5.23)
FSharp.Core (>= 6.0)
System.Collections.Immutable (>= 5.0)
Fake.Core.SemVer (5.23)
FSharp.Core (>= 6.0)
Fake.Core.String (5.23)
FSharp.Core (>= 6.0)
Fake.Core.Target (5.23)
Fake.Core.CommandLineParsing (>= 5.23)
Fake.Core.Context (>= 5.23)
Fake.Core.Environment (>= 5.23)
Fake.Core.FakeVar (>= 5.23)
Fake.Core.Process (>= 5.23)
Fake.Core.String (>= 5.23)
Fake.Core.Trace (>= 5.23)
FSharp.Control.Reactive (>= 5.0.2)
FSharp.Core (>= 6.0)
Fake.Core.Tasks (5.23)
Fake.Core.Trace (>= 5.23)
FSharp.Core (>= 6.0)
Fake.Core.Trace (5.23)
Fake.Core.Environment (>= 5.23)
Fake.Core.FakeVar (>= 5.23)
FSharp.Core (>= 6.0)
Fake.Core.Xml (5.23)
Fake.Core.String (>= 5.23)
FSharp.Core (>= 6.0)
Fake.DotNet.Cli (5.23)
Fake.Core.Environment (>= 5.23)
Fake.Core.Process (>= 5.23)
Fake.Core.String (>= 5.23)
Fake.Core.Trace (>= 5.23)
Fake.DotNet.MSBuild (>= 5.23)
Fake.DotNet.NuGet (>= 5.23)
Fake.IO.FileSystem (>= 5.23)
FSharp.Core (>= 6.0)
Mono.Posix.NETStandard (>= 1.0)
Newtonsoft.Json (>= 13.0.1)
Fake.DotNet.MSBuild (5.23)
BlackFox.VsWhere (>= 1.1)
Fake.Core.Environment (>= 5.23)
Fake.Core.Process (>= 5.23)
Fake.Core.String (>= 5.23)
Fake.Core.Trace (>= 5.23)
Fake.IO.FileSystem (>= 5.23)
FSharp.Core (>= 6.0)
MSBuild.StructuredLogger (>= 2.1.545)
Fake.DotNet.NuGet (5.23)
Fake.Core.Environment (>= 5.23)
Fake.Core.Process (>= 5.23)
Fake.Core.SemVer (>= 5.23)
Fake.Core.String (>= 5.23)
Fake.Core.Tasks (>= 5.23)
Fake.Core.Trace (>= 5.23)
Fake.Core.Xml (>= 5.23)
Fake.IO.FileSystem (>= 5.23)
Fake.Net.Http (>= 5.23)
FSharp.Core (>= 6.0)
Newtonsoft.Json (>= 13.0.1)
NuGet.Protocol (>= 5.11)
Fake.DotNet.Testing.Expecto (5.23)
Fake.Core.Process (>= 5.23)
Fake.Core.String (>= 5.23)
Fake.Core.Trace (>= 5.23)
Fake.IO.FileSystem (>= 5.23)
Fake.Testing.Common (>= 5.23)
FSharp.Core (>= 6.0)
Fake.IO.FileSystem (5.23)
Fake.Core.String (>= 5.23)
FSharp.Core (>= 6.0)
Fake.Net.Http (5.23)
Fake.Core.Trace (>= 5.23)
FSharp.Core (>= 6.0)
Fake.Testing.Common (5.23)
Fake.Core.Trace (>= 5.23)
FSharp.Core (>= 6.0)
FParsec (1.1.1)
FSharp.Core (>= 4.3.4)
FSharp.Control.Reactive (5.0.5)
FSharp.Core (>= 4.7.2)
System.Reactive (>= 5.0 < 6.0)
FSharp.Core (6.0.5)
Microsoft.Build (17.2)
Microsoft.Build.Framework (>= 17.2) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
Microsoft.NET.StringTools (>= 1.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
Microsoft.Win32.Registry (>= 4.3) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net6.0))
System.Collections.Immutable (>= 5.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
System.Configuration.ConfigurationManager (>= 4.7) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
System.Reflection.Metadata (>= 1.6) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net6.0))
System.Security.Principal.Windows (>= 4.7) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net6.0))
System.Text.Encoding.CodePages (>= 4.0.1) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net6.0))
System.Text.Json (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
System.Threading.Tasks.Dataflow (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
Microsoft.Build.Framework (17.2)
Microsoft.Win32.Registry (>= 4.3)
System.Security.Permissions (>= 4.7)
Microsoft.Build.Tasks.Core (17.2)
Microsoft.Build.Framework (>= 17.2)
Microsoft.Build.Utilities.Core (>= 17.2)
Microsoft.NET.StringTools (>= 1.0)
Microsoft.Win32.Registry (>= 4.3)
System.CodeDom (>= 4.4)
System.Collections.Immutable (>= 5.0)
System.Reflection.Metadata (>= 1.6)
System.Resources.Extensions (>= 4.6)
System.Security.Cryptography.Pkcs (>= 4.7)
System.Security.Cryptography.Xml (>= 4.7)
System.Security.Permissions (>= 4.7)
System.Threading.Tasks.Dataflow (>= 6.0)
Microsoft.Build.Utilities.Core (17.2)
Microsoft.Build.Framework (>= 17.2)
Microsoft.NET.StringTools (>= 1.0)
Microsoft.Win32.Registry (>= 4.3)
System.Collections.Immutable (>= 5.0)
System.Configuration.ConfigurationManager (>= 4.7)
System.Security.Permissions (>= 4.7) - restriction: == netstandard2.0
System.Text.Encoding.CodePages (>= 4.0.1) - restriction: == netstandard2.0
Microsoft.NET.StringTools (1.0)
System.Memory (>= 4.5.4)
System.Runtime.CompilerServices.Unsafe (>= 5.0)
Microsoft.NETCore.Platforms (6.0.5) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard1.2)) (&& (== net6.0) (< netstandard1.3)) (&& (== net6.0) (< netstandard1.5)) (== netstandard2.0)
Microsoft.NETCore.Targets (5.0) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard1.2)) (&& (== net6.0) (< netstandard1.3)) (&& (== net6.0) (< netstandard1.5)) (== netstandard2.0)
Microsoft.Win32.Registry (5.0)
System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (>= monoandroid) (< netstandard1.3)) (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0)
System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (< netcoreapp2.1)) (&& (== net6.0) (>= uap10.1)) (== netstandard2.0)
System.Security.AccessControl (>= 5.0)
System.Security.Principal.Windows (>= 5.0)
Microsoft.Win32.SystemEvents (6.0.1) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
Mono.Posix.NETStandard (1.0)
MSBuild.StructuredLogger (2.1.669)
Microsoft.Build (>= 16.10)
Microsoft.Build.Framework (>= 16.10)
Microsoft.Build.Tasks.Core (>= 16.10)
Microsoft.Build.Utilities.Core (>= 16.10)
Newtonsoft.Json (13.0.1)
NuGet.Common (6.3)
NuGet.Frameworks (>= 6.3)
NuGet.Configuration (6.3)
NuGet.Common (>= 6.3)
System.Security.Cryptography.ProtectedData (>= 4.4)
NuGet.Frameworks (6.3)
NuGet.Packaging (6.3)
Newtonsoft.Json (>= 13.0.1)
NuGet.Configuration (>= 6.3)
NuGet.Versioning (>= 6.3)
System.Security.Cryptography.Cng (>= 5.0)
System.Security.Cryptography.Pkcs (>= 5.0)
NuGet.Protocol (6.3)
NuGet.Packaging (>= 6.3)
NuGet.Versioning (6.3)
System.Buffers (4.5.1) - restriction: || (&& (== net6.0) (>= monoandroid) (< netstandard1.3)) (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0)
System.CodeDom (6.0)
System.Collections.Immutable (6.0)
System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
System.Runtime.CompilerServices.Unsafe (>= 6.0)
System.Configuration.ConfigurationManager (6.0)
System.Security.Cryptography.ProtectedData (>= 6.0)
System.Security.Permissions (>= 6.0)
System.Drawing.Common (6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
Microsoft.Win32.SystemEvents (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
System.Formats.Asn1 (6.0)
System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
System.Memory (4.5.5)
System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (>= net461)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (< netstandard1.1)) (&& (== net6.0) (< netstandard2.0)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0)
System.Numerics.Vectors (>= 4.4) - restriction: || (&& (== net6.0) (< netcoreapp2.0)) (== netstandard2.0)
System.Runtime.CompilerServices.Unsafe (>= 4.5.3) - restriction: || (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (>= net461)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (< netcoreapp2.1)) (&& (== net6.0) (< netstandard1.1)) (&& (== net6.0) (< netstandard2.0)) (&& (== net6.0) (>= uap10.1)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0)
System.Numerics.Vectors (4.5) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
System.Reactive (5.0)
System.Runtime.InteropServices.WindowsRuntime (>= 4.3) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (== netstandard2.0)
System.Threading.Tasks.Extensions (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net472)) (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (>= uap10.1)) (== netstandard2.0)
System.Reflection.Metadata (6.0.1)
System.Collections.Immutable (>= 6.0)
System.Resources.Extensions (6.0)
System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
System.Runtime (4.3.1) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (== netstandard2.0)
Microsoft.NETCore.Platforms (>= 1.1.1)
Microsoft.NETCore.Targets (>= 1.1.3)
System.Runtime.CompilerServices.Unsafe (6.0)
System.Runtime.InteropServices.WindowsRuntime (4.3) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (== netstandard2.0)
System.Runtime (>= 4.3)
System.Security.AccessControl (6.0)
System.Security.Principal.Windows (>= 5.0) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
System.Security.Cryptography.Cng (5.0)
System.Formats.Asn1 (>= 5.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.0))
System.Security.Cryptography.Pkcs (6.0.1)
System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0)
System.Formats.Asn1 (>= 6.0)
System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0)
System.Security.Cryptography.Cng (>= 5.0) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0)
System.Security.Cryptography.ProtectedData (6.0)
System.Security.Cryptography.Xml (6.0.1)
System.Memory (>= 4.5.4) - restriction: == netstandard2.0
System.Security.AccessControl (>= 6.0)
System.Security.Cryptography.Pkcs (>= 6.0.1)
System.Security.Permissions (6.0)
System.Security.AccessControl (>= 6.0)
System.Windows.Extensions (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
System.Security.Principal.Windows (5.0)
System.Text.Encoding.CodePages (6.0)
System.Runtime.CompilerServices.Unsafe (>= 6.0)
System.Text.Encodings.Web (6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
System.Runtime.CompilerServices.Unsafe (>= 6.0)
System.Text.Json (6.0.5) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
System.Runtime.CompilerServices.Unsafe (>= 6.0)
System.Text.Encodings.Web (>= 6.0)
System.Threading.Tasks.Dataflow (6.0)
System.Threading.Tasks.Extensions (4.5.4) - restriction: || (&& (== net6.0) (>= net472)) (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (>= uap10.1)) (== netstandard2.0)
System.Runtime.CompilerServices.Unsafe (>= 4.5.3) - restriction: || (&& (== net6.0) (>= net461)) (&& (== net6.0) (< netcoreapp2.1)) (&& (== net6.0) (< netstandard1.0)) (&& (== net6.0) (< netstandard2.0)) (&& (== net6.0) (>= wp8)) (== netstandard2.0)
System.Windows.Extensions (6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
System.Drawing.Common (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))

4
docs/en/requests/maintain.md
View File

@ -14,7 +14,7 @@ If you are looking for a particular requests, enter some text in the search box
## Edit Request ## Edit Request
To edit a request, click the blue pencil icon; it's the first icon under the “Actions” column heading. To edit a request, click the pencil icon; it's the first icon under the “Actions” column heading.
## Expire a Request ## Expire a Request
@ -26,4 +26,4 @@ When the page is first displayed, it does not display inactive requests. However
## Delete a Request ## Delete a Request
Deleting a request is contrary to the intent of PrayerTracker, as you can retrieve requests that have expired. However, if there is a request that needs to be deleted, clicking the blue trash can icon in the “Actions” column will allow you to do it. Use this option carefully, as these deletions cannot be undone; once a request is deleted, it is gone for good. Deleting a request is contrary to the intent of PrayerTracker, as you can retrieve requests that have expired. However, if there is a request that needs to be deleted, clicking the trash can icon in the “Actions” column will allow you to do it. Use this option carefully, as these deletions cannot be undone; once a request is deleted, it is gone for good.

4
docs/en/small-group/members.md
View File

@ -10,8 +10,8 @@ To add an e-mail address, click the icon or text in the center of the page, belo
## Edit Group Member ## Edit Group Member
To edit an e-mail address, click the blue pencil icon; it's the first icon under the “Actions” column heading. This will allow you to update the name and/or the e-mail address for that member. To edit an e-mail address, click the pencil icon; it's the first icon under the “Actions” column heading. This will allow you to update the name and/or the e-mail address for that member.
## Delete a Group Member ## Delete a Group Member
To delete an e-mail address, click the blue trash can icon in the “Actions” column. Note that once an e-mail address has been deleted, it is gone. (Of course, if you delete it in error, you can enter it again using the “Add” instructions above.) To delete an e-mail address, click the trash can icon in the “Actions” column. Note that once an e-mail address has been deleted, it is gone. (Of course, if you delete it in error, you can enter it again using the “Add” instructions above.)

25
docs/en/small-group/preferences.md
View File

@ -34,7 +34,10 @@ You can customize the colors that are used for the headings and lines in your re
## Fonts for List ## Fonts for List
This is a comma-separated list of fonts that will be used for your request list. A warning is good here; just because you have an obscure font and like the way that it looks does not mean that others have that same font. It is generally best to stick with the fonts that come with Windows - fonts like “Arial”, “Times New Roman”, “Tahoma”, and “Comic Sans MS”. You should also end the font list with either “serif” or “sans-serif”, which will use the browser's default serif (like “Times New Roman”) or sans-serif (like “Arial”) font. There are two options for fonts that will be used in the prayer request list.
* “Native Fonts” uses a list of fonts that will render the prayer requests in the best available font for their device, whether that is a desktop or laptop computer, mobile device, or tablet. (This is the default for new small groups.)
* “Named Fonts” uses a comma-separated list of fonts that you specify. A warning is good here; just because you have an obscure font and like the way that it looks does not mean that others have that same font. It is generally best to stick with the fonts that come with Windows - fonts like “Arial”, “Times New Roman”, “Tahoma”, and “Comic Sans MS”. You should also end the font list with either “serif” or “sans-serif”, which will use the browser's default serif (like “Times New Roman”) or sans-serif (like “Arial”) font.
## Heading / List Text Size ## Heading / List Text Size
@ -44,23 +47,23 @@ This is the point size to use for each. The default for the heading is 16pt, and
If your group is comprised mostly of people who prefer large print, the following settings will make your list look like the typical large-print publication: If your group is comprised mostly of people who prefer large print, the following settings will make your list look like the typical large-print publication:
> _Fonts_<br> > **Fonts**<br>
> &#8212; 'Times New Roman',serif > Named Fonts: "Times New Roman",serif
> >
> _Heading Text Size_<br> > **Heading Text Size**<br>
> &#8212; 18pt > 18pt
> >
> _List Text Size_<br> > **List Text Size**<br>
> &#8212; 16pt > 16pt
## Time Zone
This is the time zone that you would like to use for your group. If you do not see your time zone listed, just [contact Daniel](mailto:daniel@djs-consulting.com?subject=PrayerTracker%20Time%20Zone) and tell him what time zone you need.
## Request List Visibility ## Request List Visibility
The group's request list can be either public, private, or password-protected. Public lists are available without logging in, and private lists are only available online to administrators (though the list can still be sent via e-mail by an administrator). Password-protected lists allow group members to log in and view the current request list online, using the “Group Log On” link and providing this password. As this is a shared password, it is stored in plain text, so you can easily see what it is. If you select “Password Protected” but do not enter a password, the list remains private, which is also the default value. (Changing this password will force all members of the group who logged in with the “Remember Me” box checked to provide the new password.) The group's request list can be either public, private, or password-protected. Public lists are available without logging in, and private lists are only available online to administrators (though the list can still be sent via e-mail by an administrator). Password-protected lists allow group members to log in and view the current request list online, using the “Group Log On” link and providing this password. As this is a shared password, it is stored in plain text, so you can easily see what it is. If you select “Password Protected” but do not enter a password, the list remains private, which is also the default value. (Changing this password will force all members of the group who logged in with the “Remember Me” box checked to provide the new password.)
## Time Zone
This is the time zone that you would like to use for your group. If you do not see your time zone listed, just [contact Daniel](mailto:daniel@bitbadger.solutions?subject=PrayerTracker%20Time%20Zone) and tell him what time zone you need.
## Page Size ## Page Size
As small groups use PrayerTracker, they accumulate many expired requests. When lists of requests that include expired requests, the results will be broken up into pages. The default value is 100 requests per page, but may be set as low as 10 or as high as 255. As small groups use PrayerTracker, they accumulate many expired requests. When lists of requests that include expired requests, the results will be broken up into pages. The default value is 100 requests per page, but may be set as low as 10 or as high as 255.

2
docs/en/user/password.md
View File

@ -4,4 +4,4 @@ title: Change Your Password
This page will let you change your password. Enter your existing password in the top box, then enter your new password in the bottom two boxes. Entering your existing password is a security measure; with the “Remember Me” box on the log in page, this will prevent someone else who may be using your computer from being able to simply go to the site and change your password. This page will let you change your password. Enter your existing password in the top box, then enter your new password in the bottom two boxes. Entering your existing password is a security measure; with the “Remember Me” box on the log in page, this will prevent someone else who may be using your computer from being able to simply go to the site and change your password.
"If you cannot remember your existing password, we cannot retrieve it, but we can set it to something known so that you can then change it to your password. [Click here to request help resetting your password](mailto:daniel@djs-consulting.com?subject=PrayerTracker%20Password%20Help). "If you cannot remember your existing password, we cannot retrieve it, but we can set it to something known so that you can then change it to your password. [Click here to request help resetting your password](mailto:daniel@bitbadger.solutions?subject=PrayerTracker%20Password%20Help).

4
docs/es/requests/maintain.md
View File

@ -14,7 +14,7 @@ Si está buscando una solicitud en particular, ingrese un texto en el cuadro de
## Editar la Petición ## Editar la Petición
Para editar una petición, haga clic en el icono de lápiz azul, el primer icono bajo el título de columna “Acciones”. Para editar una petición, haga clic en el icono de lápiz, el primer icono bajo el título de columna “Acciones”.
## Expirar una petición ## Expirar una petición
@ -26,4 +26,4 @@ Cuando la página se muestra por primera vez, que no muestra peticiones inactivo
## Eliminar una Petición ## Eliminar una Petición
Eliminación de una petición es contraria a la intención de SeguidorOración, como se puede recuperar peticiones que han expirado. Sin embargo, si hay una solicitud que debe ser eliminado, haga clic en el icono azul de la papelera en la columna “Acciones” le permitirá hacerlo. Utilice esta opción con cuidado, ya que estas supresiones no se puede deshacer, una vez a la petición se ha borrado, ha desaparecido para siempre. Eliminación de una petición es contraria a la intención de SeguidorOración, como se puede recuperar peticiones que han expirado. Sin embargo, si hay una solicitud que debe ser eliminado, haga clic en el icono de la papelera en la columna “Acciones” le permitirá hacerlo. Utilice esta opción con cuidado, ya que estas supresiones no se puede deshacer, una vez a la petición se ha borrado, ha desaparecido para siempre.

4
docs/es/small-group/members.md
View File

@ -10,8 +10,8 @@ Para agregar una dirección de correo electrónico, haga clic en el icono o el t
## Editar el Miembro del Grupo ## Editar el Miembro del Grupo
Para editar una dirección de correo electrónico, haga clic en el icono de lápiz azul, es el primer icono bajo el título de columna “Acciones”. Esto le permitirá actualizar el nombre y / o la dirección de correo electrónico para ese miembro. Para editar una dirección de correo electrónico, haga clic en el icono de lápiz, es el primer icono bajo el título de columna “Acciones”. Esto le permitirá actualizar el nombre y / o la dirección de correo electrónico para ese miembro.
## Eliminar un Miembro del Grupo ## Eliminar un Miembro del Grupo
Para eliminar una dirección de correo electrónico, haga clic en el icono azul de la papelera en la columna “Acciones”. Tenga en cuenta que una vez que la dirección de correo electrónico se ha eliminado, se ha ido. (Por supuesto, si usted lo elimine por error, se puede entrar de nuevo utilizando la opción “Agregar” instrucciones de arriba.) Para eliminar una dirección de correo electrónico, haga clic en el icono de la papelera en la columna “Acciones”. Tenga en cuenta que una vez que la dirección de correo electrónico se ha eliminado, se ha ido. (Por supuesto, si usted lo elimine por error, se puede entrar de nuevo utilizando la opción “Agregar” instrucciones de arriba.)

25
docs/es/small-group/preferences.md
View File

@ -34,7 +34,10 @@ Usted puede personalizar los colores que se utilizan para las partidas y líneas
## Fuentes de la Lista ## Fuentes de la Lista
Esta es una lista separada por comas de fuentes que se utilizarán para su lista de peticiones. Una advertencia de que es bueno aquí, sólo porque usted tiene una fuente oscura y gusta la forma en que se vea no significa que los demás tienen de que la misma fuente. Generalmente es mejor quedarse con las fuentes que vienen con Windows - Fuentes como “Arial”, “Times New Roman”, “Tahoma”, y “Comic Sans MS”. También debe poner fin a la lista de fuentes, ya sea con “serif” o el “sans-serif”, que utilizará el fuente serif predeterminado (como “Times New Roman”) o el fuente sans-serif predeterminado (como “Arial”). Hay dos opciones para las fuentes que se utilizarán en la lista de peticiones de oración.
* “Fuentes Nativas” utiliza una lista de fuentes que representarán las peticiones de oración en la mejor fuente disponible para su dispositivo, ya sea una computadora de escritorio o portátil, un dispositivo móvil o una tableta. (Este es el valor predeterminado para los nuevos grupos pequeños).
* “Fuentes con Nombre” utiliza una lista de fuentes separadas por comas que usted especifica. Una advertencia de que es bueno aquí, sólo porque usted tiene una fuente oscura y gusta la forma en que se vea no significa que los demás tienen de que la misma fuente. Generalmente es mejor quedarse con las fuentes que vienen con Windows - Fuentes como “Arial”, “Times New Roman”, “Tahoma”, y “Comic Sans MS”. También debe poner fin a la lista de fuentes, ya sea con “serif” o el “sans-serif”, que utilizará el fuente serif predeterminado (como “Times New Roman”) o el fuente sans-serif predeterminado (como “Arial”).
## Tamaño del Texto de Partida y Lista ## Tamaño del Texto de Partida y Lista
@ -44,23 +47,23 @@ Este es el tamaño de punto a utilizar para cada uno. El valor predeterminado pa
Si el grupo está compuesta en su mayoría de la gente que prefiere letras grandes, los siguientes ajustes harán que su lista de parecerse a la típica la publicación “Letra Grande”: Si el grupo está compuesta en su mayoría de la gente que prefiere letras grandes, los siguientes ajustes harán que su lista de parecerse a la típica la publicación “Letra Grande”:
> _Fuentes_<br> > **Fuentes**<br>
> &#8212; 'Times New Roman',serif > Fuentes con Nombre: "Times New Roman",serif
> >
> _Partida el Tamaño del Texto_<br> > **Partida el Tamaño del Texto**<br>
> &#8212; 18pt > 18pt
> >
> _Lista el Tamaño del Texto_<br> > **Lista el Tamaño del Texto**<br>
> &#8212; 16pt > 16pt
## Zona Horaria
Esta es la zona horaria que desea utilizar para su clase. Si no puede ver la zona horaria en la lista, ponte en [contacto con Daniel](mailto:daniel@djs-consulting.com?subject=Zona%20Horaria%20por%20SeguidorOración) y decirle lo que la zona horaria que usted necesita.
## La Visibilidad del la Lista de las Peticiones ## La Visibilidad del la Lista de las Peticiones
La lista de peticiones del grupo puede ser pública, privada o protegida por contraseña. Las listas públicas están disponibles sin iniciar sesión, y listas privadas sólo están disponibles en línea a los administradores (aunque la lista todavía puede ser enviado por correo electrónico por el administrador). Protegidos con contraseña listas permiten miembros del grupo iniciar sesión y ver la lista de peticiones actual en el sito, utilizando el "Iniciar Sesión como Grupo" enlace y proporcionar la contraseña. Como se trata de una contraseña compartida, se almacena en texto plano, así que usted puede ver fácilmente lo que es. Si selecciona "Protegido por Contraseña" pero no introduce una contraseña, la lista sigue siendo privado, que también es el valor predeterminado. (Cambiar esta contraseña obligará a todos los miembros del grupo que se iniciar sesión en el "Acuérdate de Mí" caja marcada para proporcionar la nueva contraseña.) La lista de peticiones del grupo puede ser pública, privada o protegida por contraseña. Las listas públicas están disponibles sin iniciar sesión, y listas privadas sólo están disponibles en línea a los administradores (aunque la lista todavía puede ser enviado por correo electrónico por el administrador). Protegidos con contraseña listas permiten miembros del grupo iniciar sesión y ver la lista de peticiones actual en el sito, utilizando el "Iniciar Sesión como Grupo" enlace y proporcionar la contraseña. Como se trata de una contraseña compartida, se almacena en texto plano, así que usted puede ver fácilmente lo que es. Si selecciona "Protegido por Contraseña" pero no introduce una contraseña, la lista sigue siendo privado, que también es el valor predeterminado. (Cambiar esta contraseña obligará a todos los miembros del grupo que se iniciar sesión en el "Acuérdate de Mí" caja marcada para proporcionar la nueva contraseña.)
## Zona Horaria
Esta es la zona horaria que desea utilizar para su clase. Si no puede ver la zona horaria en la lista, ponte en [contacto con Daniel](mailto:daniel@bitbadger.solutions?subject=Zona%20Horaria%20por%20SeguidorOración) y decirle lo que la zona horaria que usted necesita.
## Tamaño de Página ## Tamaño de Página
A medida que los grupos pequeños utilizan SeguidorOración, acumulan muchas solicitudes caducadas. Cuando las listas de solicitudes que incluyen solicitudes caducadas, los resultados se dividirán en páginas. El valor predeterminado es de 100 solicitudes por página, pero se puede establecer tan bajo como 10 o tan alto como 255. A medida que los grupos pequeños utilizan SeguidorOración, acumulan muchas solicitudes caducadas. Cuando las listas de solicitudes que incluyen solicitudes caducadas, los resultados se dividirán en páginas. El valor predeterminado es de 100 solicitudes por página, pero se puede establecer tan bajo como 10 o tan alto como 255.

2
docs/es/user/password.md
View File

@ -4,4 +4,4 @@ title: Cambiar Su Contraseña
Esta página le permitirá cambiar su contraseña. Ingrese su contraseña actual en la caja superior y introduzca la nueva contraseña en la parte inferior dos cajas. Al entrar su contraseña actual es una medida de seguridad, con el “Acuérdate de Mí” caja de la página inicio de sesión, esto evitará que otra persona que pueda estar usando su computadora de la posibilidad de simplemente ir a el sitio y cambiar la contraseña. Esta página le permitirá cambiar su contraseña. Ingrese su contraseña actual en la caja superior y introduzca la nueva contraseña en la parte inferior dos cajas. Al entrar su contraseña actual es una medida de seguridad, con el “Acuérdate de Mí” caja de la página inicio de sesión, esto evitará que otra persona que pueda estar usando su computadora de la posibilidad de simplemente ir a el sitio y cambiar la contraseña.
Si no recuerdas tu contraseña actual, no podemos recuperar, pero podemos ponerlo en algo que se conoce de modo que usted puede cambiarlo a su contraseña. [Haga clic aquí para solicitar ayuda para restablecer su contraseña](mailto:daniel@djs-consulting.com?subject=Ayuda%20de%20Contraseña%20de%20SeguidorOración). Si no recuerdas tu contraseña actual, no podemos recuperar, pero podemos ponerlo en algo que se conoce de modo que usted puede cambiarlo a su contraseña. [Haga clic aquí para solicitar ayuda para restablecer su contraseña](mailto:daniel@bitbadger.solutions?subject=Ayuda%20de%20Contraseña%20de%20SeguidorOración).

2
fake.cmd Normal file
View File

@ -0,0 +1,2 @@
dotnet tool restore
dotnet fake %*

7
fake.sh Executable file
View File

@ -0,0 +1,7 @@
#!/usr/bin/env bash
set -eu
set -o pipefail
dotnet tool restore
dotnet fake "$@"

8
src/Directory.Build.props
View File

@ -1,9 +1,11 @@
<Project> <Project>
<PropertyGroup> <PropertyGroup>
<AssemblyVersion>7.6.1.0</AssemblyVersion> <TargetFramework>net6.0</TargetFramework>
<FileVersion>7.6.1.0</FileVersion> <AssemblyVersion>8.0.0.0</AssemblyVersion>
<FileVersion>8.0.0.0</FileVersion>
<Authors>danieljsummers</Authors> <Authors>danieljsummers</Authors>
<Company>Bit Badger Solutions</Company> <Company>Bit Badger Solutions</Company>
<Version>7.6.1</Version> <Version>8.0.0</Version>
<DebugType>Embedded</DebugType>
</PropertyGroup> </PropertyGroup>
</Project> </Project>

724
src/PrayerTracker.Data/Access.fs Normal file
View File

@ -0,0 +1,724 @@
namespace PrayerTracker.Data
open NodaTime
open Npgsql
open Npgsql.FSharp
open PrayerTracker.Entities
/// Helper functions for the PostgreSQL data implementation
[<AutoOpen>]
module private Helpers =
/// Map a row to a Church instance
let mapToChurch (row : RowReader) =
{ Id = ChurchId (row.uuid "id")
Name = row.string "church_name"
City = row.string "city"
State = row.string "state"
HasVpsInterface = row.bool "has_vps_interface"
InterfaceAddress = row.stringOrNone "interface_address"
}
/// Map a row to a ListPreferences instance
let mapToListPreferences (row : RowReader) =
{ SmallGroupId = SmallGroupId (row.uuid "small_group_id")
DaysToKeepNew = row.int "days_to_keep_new"
DaysToExpire = row.int "days_to_expire"
LongTermUpdateWeeks = row.int "long_term_update_weeks"
EmailFromName = row.string "email_from_name"
EmailFromAddress = row.string "email_from_address"
Fonts = row.string "fonts"
HeadingColor = row.string "heading_color"
LineColor = row.string "line_color"
HeadingFontSize = row.int "heading_font_size"
TextFontSize = row.int "text_font_size"
GroupPassword = row.string "group_password"
IsPublic = row.bool "is_public"
PageSize = row.int "page_size"
TimeZoneId = TimeZoneId (row.string "time_zone_id")
RequestSort = RequestSort.fromCode (row.string "request_sort")
DefaultEmailType = EmailFormat.fromCode (row.string "default_email_type")
AsOfDateDisplay = AsOfDateDisplay.fromCode (row.string "as_of_date_display")
}
/// Map a row to a Member instance
let mapToMember (row : RowReader) =
{ Id = MemberId (row.uuid "id")
SmallGroupId = SmallGroupId (row.uuid "small_group_id")
Name = row.string "member_name"
Email = row.string "email"
Format = row.stringOrNone "email_format" |> Option.map EmailFormat.fromCode
}
/// Map a row to a Prayer Request instance
let mapToPrayerRequest (row : RowReader) =
{ Id = PrayerRequestId (row.uuid "id")
UserId = UserId (row.uuid "user_id")
SmallGroupId = SmallGroupId (row.uuid "small_group_id")
EnteredDate = row.fieldValue<Instant> "entered_date"
UpdatedDate = row.fieldValue<Instant> "updated_date"
Requestor = row.stringOrNone "requestor"
Text = row.string "request_text"
NotifyChaplain = row.bool "notify_chaplain"
RequestType = PrayerRequestType.fromCode (row.string "request_type")
Expiration = Expiration.fromCode (row.string "expiration")
}
/// Map a row to a Small Group instance
let mapToSmallGroup (row : RowReader) =
{ Id = SmallGroupId (row.uuid "id")
ChurchId = ChurchId (row.uuid "church_id")
Name = row.string "group_name"
Preferences = ListPreferences.empty
}
/// Map a row to a Small Group information set
let mapToSmallGroupInfo (row : RowReader) =
{ Id = Giraffe.ShortGuid.fromGuid (row.uuid "id")
Name = row.string "group_name"
ChurchName = row.string "church_name"
TimeZoneId = TimeZoneId (row.string "time_zone_id")
IsPublic = row.bool "is_public"
}
/// Map a row to a Small Group list item
let mapToSmallGroupItem (row : RowReader) =
Giraffe.ShortGuid.fromGuid (row.uuid "id"), $"""{row.string "church_name"} | {row.string "group_name"}"""
/// Map a row to a Small Group instance with populated list preferences
let mapToSmallGroupWithPreferences (row : RowReader) =
{ mapToSmallGroup row with
Preferences = mapToListPreferences row
}
/// Map a row to a User instance
let mapToUser (row : RowReader) =
{ Id = UserId (row.uuid "id")
FirstName = row.string "first_name"
LastName = row.string "last_name"
Email = row.string "email"
IsAdmin = row.bool "is_admin"
PasswordHash = row.string "password_hash"
LastSeen = row.fieldValueOrNone<Instant> "last_seen"
}
/// Functions to manipulate churches
module Churches =
/// Get a list of all churches
let all conn =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.church ORDER BY church_name"
|> Sql.executeAsync mapToChurch
/// Delete a church by its ID
let deleteById (churchId : ChurchId) conn = backgroundTask {
let idParam = [ [ "@churchId", Sql.uuid churchId.Value ] ]
let where = "WHERE small_group_id IN (SELECT id FROM pt.small_group WHERE church_id = @churchId)"
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync
[ $"DELETE FROM pt.prayer_request {where}", idParam
$"DELETE FROM pt.user_small_group {where}", idParam
$"DELETE FROM pt.list_preference {where}", idParam
"DELETE FROM pt.small_group WHERE church_id = @churchId", idParam
"DELETE FROM pt.church WHERE id = @churchId", idParam ]
return ()
}
/// Save a church's information
let save (church : Church) conn = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query """
INSERT INTO pt.church (
id, church_name, city, state, has_vps_interface, interface_address
) VALUES (
@id, @name, @city, @state, @hasVpsInterface, @interfaceAddress
) ON CONFLICT (id) DO UPDATE
SET church_name = EXCLUDED.church_name,
city = EXCLUDED.city,
state = EXCLUDED.state,
has_vps_interface = EXCLUDED.has_vps_interface,
interface_address = EXCLUDED.interface_address"""
|> Sql.parameters
[ "@id", Sql.uuid church.Id.Value
"@name", Sql.string church.Name
"@city", Sql.string church.City
"@state", Sql.string church.State
"@hasVpsInterface", Sql.bool church.HasVpsInterface
"@interfaceAddress", Sql.stringOrNone church.InterfaceAddress ]
|> Sql.executeNonQueryAsync
return ()
}
/// Find a church by its ID
let tryById (churchId : ChurchId) conn = backgroundTask {
let! church =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.church WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid churchId.Value ]
|> Sql.executeAsync mapToChurch
return List.tryHead church
}
/// Functions to manipulate small group members
module Members =
/// Count members for the given small group
let countByGroup (groupId : SmallGroupId) conn =
Sql.existingConnection conn
|> Sql.query "SELECT COUNT(id) AS mbr_count FROM pt.member WHERE small_group_id = @groupId"
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "mbr_count")
/// Delete a small group member by its ID
let deleteById (memberId : MemberId) conn = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query "DELETE FROM pt.member WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid memberId.Value ]
|> Sql.executeNonQueryAsync
return ()
}
/// Retrieve all members for a given small group
let forGroup (groupId : SmallGroupId) conn =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.member WHERE small_group_id = @groupId ORDER BY member_name"
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeAsync mapToMember
/// Save a small group member
let save (mbr : Member) conn = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query """
INSERT INTO pt.member (
id, small_group_id, member_name, email, email_format
) VALUES (
@id, @groupId, @name, @email, @format
) ON CONFLICT (id) DO UPDATE
SET member_name = EXCLUDED.member_name,
email = EXCLUDED.email,
email_format = EXCLUDED.email_format"""
|> Sql.parameters
[ "@id", Sql.uuid mbr.Id.Value
"@groupId", Sql.uuid mbr.SmallGroupId.Value
"@name", Sql.string mbr.Name
"@email", Sql.string mbr.Email
"@format", Sql.stringOrNone (mbr.Format |> Option.map EmailFormat.toCode) ]
|> Sql.executeNonQueryAsync
return ()
}
/// Retrieve a small group member by its ID
let tryById (memberId : MemberId) conn = backgroundTask {
let! mbr =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.member WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid memberId.Value ]
|> Sql.executeAsync mapToMember
return List.tryHead mbr
}
/// Options to retrieve a list of requests
type PrayerRequestOptions =
{ /// The small group for which requests should be retrieved
SmallGroup : SmallGroup
/// The clock instance to use for date/time manipulation
Clock : IClock
/// The date for which the list is being retrieved
ListDate : LocalDate option
/// Whether only active requests should be retrieved
ActiveOnly : bool
/// The page number, for paged lists
PageNumber : int
}
/// Functions to manipulate prayer requests
module PrayerRequests =
/// Central place to append sort criteria for prayer request queries
let private orderBy sort =
match sort with
| SortByDate -> "updated_date DESC, entered_date DESC, requestor"
| SortByRequestor -> "requestor, updated_date DESC, entered_date DESC"
/// Paginate a prayer request query
let private paginate (pageNbr : int) pageSize =
if pageNbr > 0 then $"LIMIT {pageSize} OFFSET {(pageNbr - 1) * pageSize}" else ""
/// Count the number of prayer requests for a church
let countByChurch (churchId : ChurchId) conn =
Sql.existingConnection conn
|> Sql.query """
SELECT COUNT(id) AS req_count
FROM pt.prayer_request
WHERE small_group_id IN (SELECT id FROM pt.small_group WHERE church_id = @churchId)"""
|> Sql.parameters [ "@churchId", Sql.uuid churchId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "req_count")
/// Count the number of prayer requests for a small group
let countByGroup (groupId : SmallGroupId) conn =
Sql.existingConnection conn
|> Sql.query "SELECT COUNT(id) AS req_count FROM pt.prayer_request WHERE small_group_id = @groupId"
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "req_count")
/// Delete a prayer request by its ID
let deleteById (reqId : PrayerRequestId) conn = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query "DELETE FROM pt.prayer_request WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid reqId.Value ]
|> Sql.executeNonQueryAsync
return ()
}
/// Get all (or active) requests for a small group as of now or the specified date
let forGroup (opts : PrayerRequestOptions) conn =
let theDate = defaultArg opts.ListDate (SmallGroup.localDateNow opts.Clock opts.SmallGroup)
let where, parameters =
if opts.ActiveOnly then
let asOf = NpgsqlParameter (
"@asOf",
(theDate.AtStartOfDayInZone(SmallGroup.timeZone opts.SmallGroup)
- Duration.FromDays opts.SmallGroup.Preferences.DaysToExpire)
.ToInstant ())
""" AND ( updated_date > @asOf
OR expiration = @manual
OR request_type = @longTerm
OR request_type = @expecting)
AND expiration <> @forced""",
[ "@asOf", Sql.parameter asOf
"@manual", Sql.string (Expiration.toCode Manual)
"@longTerm", Sql.string (PrayerRequestType.toCode LongTermRequest)
"@expecting", Sql.string (PrayerRequestType.toCode Expecting)
"@forced", Sql.string (Expiration.toCode Forced) ]
else "", []
Sql.existingConnection conn
|> Sql.query $"""
SELECT *
FROM pt.prayer_request
WHERE small_group_id = @groupId {where}
ORDER BY {orderBy opts.SmallGroup.Preferences.RequestSort}
{paginate opts.PageNumber opts.SmallGroup.Preferences.PageSize}"""
|> Sql.parameters (("@groupId", Sql.uuid opts.SmallGroup.Id.Value) :: parameters)
|> Sql.executeAsync mapToPrayerRequest
/// Save a prayer request
let save (req : PrayerRequest) conn = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query """
INSERT into pt.prayer_request (
id, request_type, user_id, small_group_id, entered_date, updated_date, requestor, request_text,
notify_chaplain, expiration
) VALUES (
@id, @type, @userId, @groupId, @entered, @updated, @requestor, @text,
@notifyChaplain, @expiration
) ON CONFLICT (id) DO UPDATE
SET request_type = EXCLUDED.request_type,
updated_date = EXCLUDED.updated_date,
requestor = EXCLUDED.requestor,
request_text = EXCLUDED.request_text,
notify_chaplain = EXCLUDED.notify_chaplain,
expiration = EXCLUDED.expiration"""
|> Sql.parameters
[ "@id", Sql.uuid req.Id.Value
"@type", Sql.string (PrayerRequestType.toCode req.RequestType)
"@userId", Sql.uuid req.UserId.Value
"@groupId", Sql.uuid req.SmallGroupId.Value
"@entered", Sql.parameter (NpgsqlParameter ("@entered", req.EnteredDate))
"@updated", Sql.parameter (NpgsqlParameter ("@updated", req.UpdatedDate))
"@requestor", Sql.stringOrNone req.Requestor
"@text", Sql.string req.Text
"@notifyChaplain", Sql.bool req.NotifyChaplain
"@expiration", Sql.string (Expiration.toCode req.Expiration)
]
|> Sql.executeNonQueryAsync
return ()
}
/// Search prayer requests for the given term
let searchForGroup group searchTerm pageNbr conn =
Sql.existingConnection conn
|> Sql.query $"""
SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND request_text ILIKE @search
UNION
SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND COALESCE(requestor, '') ILIKE @search
ORDER BY {orderBy group.Preferences.RequestSort}
{paginate pageNbr group.Preferences.PageSize}"""
|> Sql.parameters [ "@groupId", Sql.uuid group.Id.Value; "@search", Sql.string $"%%%s{searchTerm}%%" ]
|> Sql.executeAsync mapToPrayerRequest
/// Retrieve a prayer request by its ID
let tryById (reqId : PrayerRequestId) conn = backgroundTask {
let! req =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.prayer_request WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid reqId.Value ]
|> Sql.executeAsync mapToPrayerRequest
return List.tryHead req
}
/// Update the expiration for the given prayer request
let updateExpiration (req : PrayerRequest) withTime conn = backgroundTask {
let sql, parameters =
if withTime then
", updated_date = @updated",
[ "@updated", Sql.parameter (NpgsqlParameter ("@updated", req.UpdatedDate)) ]
else "", []
let! _ =
Sql.existingConnection conn
|> Sql.query $"UPDATE pt.prayer_request SET expiration = @expiration{sql} WHERE id = @id"
|> Sql.parameters
([ "@expiration", Sql.string (Expiration.toCode req.Expiration)
"@id", Sql.uuid req.Id.Value ]
|> List.append parameters)
|> Sql.executeNonQueryAsync
return ()
}
/// Functions to retrieve small group information
module SmallGroups =
/// Count the number of small groups for a church
let countByChurch (churchId : ChurchId) conn =
Sql.existingConnection conn
|> Sql.query "SELECT COUNT(id) AS group_count FROM pt.small_group WHERE church_id = @churchId"
|> Sql.parameters [ "@churchId", Sql.uuid churchId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "group_count")
/// Delete a small group by its ID
let deleteById (groupId : SmallGroupId) conn = backgroundTask {
let idParam = [ [ "@groupId", Sql.uuid groupId.Value ] ]
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync
[ "DELETE FROM pt.prayer_request WHERE small_group_id = @groupId", idParam
"DELETE FROM pt.user_small_group WHERE small_group_id = @groupId", idParam
"DELETE FROM pt.list_preference WHERE small_group_id = @groupId", idParam
"DELETE FROM pt.small_group WHERE id = @groupId", idParam ]
return ()
}
/// Get information for all small groups
let infoForAll conn =
Sql.existingConnection conn
|> Sql.query """
SELECT sg.id, sg.group_name, c.church_name, lp.time_zone_id, lp.is_public
FROM pt.small_group sg
INNER JOIN pt.church c ON c.id = sg.church_id
INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id
ORDER BY sg.group_name"""
|> Sql.executeAsync mapToSmallGroupInfo
/// Get a list of small group IDs along with a description that includes the church name
let listAll conn =
Sql.existingConnection conn
|> Sql.query """
SELECT g.group_name, g.id, c.church_name
FROM pt.small_group g
INNER JOIN pt.church c ON c.id = g.church_id
ORDER BY c.church_name, g.group_name"""
|> Sql.executeAsync mapToSmallGroupItem
/// Get a list of small group IDs and descriptions for groups with a group password
let listProtected conn =
Sql.existingConnection conn
|> Sql.query """
SELECT g.group_name, g.id, c.church_name, lp.is_public
FROM pt.small_group g
INNER JOIN pt.church c ON c.id = g.church_id
INNER JOIN pt.list_preference lp ON lp.small_group_id = g.id
WHERE COALESCE(lp.group_password, '') <> ''
ORDER BY c.church_name, g.group_name"""
|> Sql.executeAsync mapToSmallGroupItem
/// Get a list of small group IDs and descriptions for groups that are public or have a group password
let listPublicAndProtected conn =
Sql.existingConnection conn
|> Sql.query """
SELECT g.group_name, g.id, c.church_name, lp.time_zone_id, lp.is_public
FROM pt.small_group g
INNER JOIN pt.church c ON c.id = g.church_id
INNER JOIN pt.list_preference lp ON lp.small_group_id = g.id
WHERE lp.is_public = TRUE
OR COALESCE(lp.group_password, '') <> ''
ORDER BY c.church_name, g.group_name"""
|> Sql.executeAsync mapToSmallGroupInfo
/// Log on for a small group (includes list preferences)
let logOn (groupId : SmallGroupId) password conn = backgroundTask {
let! group =
Sql.existingConnection conn
|> Sql.query """
SELECT sg.*, lp.*
FROM pt.small_group sg
INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id
WHERE sg.id = @id
AND lp.group_password = @password"""
|> Sql.parameters [ "@id", Sql.uuid groupId.Value; "@password", Sql.string password ]
|> Sql.executeAsync mapToSmallGroupWithPreferences
return List.tryHead group
}
/// Save a small group
let save (group : SmallGroup) isNew conn = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
""" INSERT INTO pt.small_group (
id, church_id, group_name
) VALUES (
@id, @churchId, @name
) ON CONFLICT (id) DO UPDATE
SET church_id = EXCLUDED.church_id,
group_name = EXCLUDED.group_name""",
[ [ "@id", Sql.uuid group.Id.Value
"@churchId", Sql.uuid group.ChurchId.Value
"@name", Sql.string group.Name ] ]
if isNew then
"INSERT INTO pt.list_preference (small_group_id) VALUES (@id)",
[ [ "@id", Sql.uuid group.Id.Value ] ]
]
return ()
}
/// Save a small group's list preferences
let savePreferences (pref : ListPreferences) conn = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query """
UPDATE pt.list_preference
SET days_to_keep_new = @daysToKeepNew,
days_to_expire = @daysToExpire,
long_term_update_weeks = @longTermUpdateWeeks,
email_from_name = @emailFromName,
email_from_address = @emailFromAddress,
fonts = @fonts,
heading_color = @headingColor,
line_color = @lineColor,
heading_font_size = @headingFontSize,
text_font_size = @textFontSize,
request_sort = @requestSort,
group_password = @groupPassword,
default_email_type = @defaultEmailType,
is_public = @isPublic,
time_zone_id = @timeZoneId,
page_size = @pageSize,
as_of_date_display = @asOfDateDisplay
WHERE small_group_id = @groupId"""
|> Sql.parameters
[ "@groupId", Sql.uuid pref.SmallGroupId.Value
"@daysToKeepNew", Sql.int pref.DaysToKeepNew
"@daysToExpire", Sql.int pref.DaysToExpire
"@longTermUpdateWeeks", Sql.int pref.LongTermUpdateWeeks
"@emailFromName", Sql.string pref.EmailFromName
"@emailFromAddress", Sql.string pref.EmailFromAddress
"@fonts", Sql.string pref.Fonts
"@headingColor", Sql.string pref.HeadingColor
"@lineColor", Sql.string pref.LineColor
"@headingFontSize", Sql.int pref.HeadingFontSize
"@textFontSize", Sql.int pref.TextFontSize
"@requestSort", Sql.string (RequestSort.toCode pref.RequestSort)
"@groupPassword", Sql.string pref.GroupPassword
"@defaultEmailType", Sql.string (EmailFormat.toCode pref.DefaultEmailType)
"@isPublic", Sql.bool pref.IsPublic
"@timeZoneId", Sql.string (TimeZoneId.toString pref.TimeZoneId)
"@pageSize", Sql.int pref.PageSize
"@asOfDateDisplay", Sql.string (AsOfDateDisplay.toCode pref.AsOfDateDisplay)
]
|> Sql.executeNonQueryAsync
return ()
}
/// Get a small group by its ID
let tryById (groupId : SmallGroupId) conn = backgroundTask {
let! group =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.small_group WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid groupId.Value ]
|> Sql.executeAsync mapToSmallGroup
return List.tryHead group
}
/// Get a small group by its ID with its list preferences populated
let tryByIdWithPreferences (groupId : SmallGroupId) conn = backgroundTask {
let! group =
Sql.existingConnection conn
|> Sql.query """
SELECT sg.*, lp.*
FROM pt.small_group sg
INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id
WHERE sg.id = @id"""
|> Sql.parameters [ "@id", Sql.uuid groupId.Value ]
|> Sql.executeAsync mapToSmallGroupWithPreferences
return List.tryHead group
}
/// Functions to manipulate users
module Users =
/// Retrieve all PrayerTracker users
let all conn =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.pt_user ORDER BY last_name, first_name"
|> Sql.executeAsync mapToUser
/// Count the number of users for a church
let countByChurch (churchId : ChurchId) conn =
Sql.existingConnection conn
|> Sql.query """
SELECT COUNT(u.id) AS user_count
FROM pt.pt_user u
WHERE EXISTS (
SELECT 1
FROM pt.user_small_group usg
INNER JOIN pt.small_group sg ON sg.id = usg.small_group_id
WHERE usg.user_id = u.id
AND sg.church_id = @churchId)"""
|> Sql.parameters [ "@churchId", Sql.uuid churchId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "user_count")
/// Count the number of users for a small group
let countByGroup (groupId : SmallGroupId) conn =
Sql.existingConnection conn
|> Sql.query "SELECT COUNT(user_id) AS user_count FROM pt.user_small_group WHERE small_group_id = @groupId"
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "user_count")
/// Delete a user by its database ID
let deleteById (userId : UserId) conn = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query "DELETE FROM pt.pt_user WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value ]
|> Sql.executeNonQueryAsync
return ()
}
/// Get the IDs of the small groups for which the given user is authorized
let groupIdsByUserId (userId : UserId) conn =
Sql.existingConnection conn
|> Sql.query "SELECT small_group_id FROM pt.user_small_group WHERE user_id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value ]
|> Sql.executeAsync (fun row -> SmallGroupId (row.uuid "small_group_id"))
/// Get a list of users authorized to administer the given small group
let listByGroupId (groupId : SmallGroupId) conn =
Sql.existingConnection conn
|> Sql.query """
SELECT u.*
FROM pt.pt_user u
INNER JOIN pt.user_small_group usg ON usg.user_id = u.id
WHERE usg.small_group_id = @groupId
ORDER BY u.last_name, u.first_name"""
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeAsync mapToUser
/// Save a user's information
let save (user : User) conn = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query """
INSERT INTO pt.pt_user (
id, first_name, last_name, email, is_admin, password_hash
) VALUES (
@id, @firstName, @lastName, @email, @isAdmin, @passwordHash
) ON CONFLICT (id) DO UPDATE
SET first_name = EXCLUDED.first_name,
last_name = EXCLUDED.last_name,
email = EXCLUDED.email,
is_admin = EXCLUDED.is_admin,
password_hash = EXCLUDED.password_hash"""
|> Sql.parameters
[ "@id", Sql.uuid user.Id.Value
"@firstName", Sql.string user.FirstName
"@lastName", Sql.string user.LastName
"@email", Sql.string user.Email
"@isAdmin", Sql.bool user.IsAdmin
"@passwordHash", Sql.string user.PasswordHash
]
|> Sql.executeNonQueryAsync
return ()
}
/// Find a user by its e-mail address and authorized small group
let tryByEmailAndGroup email (groupId : SmallGroupId) conn = backgroundTask {
let! user =
Sql.existingConnection conn
|> Sql.query """
SELECT u.*
FROM pt.pt_user u
INNER JOIN pt.user_small_group usg ON usg.user_id = u.id AND usg.small_group_id = @groupId
WHERE u.email = @email"""
|> Sql.parameters [ "@email", Sql.string email; "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeAsync mapToUser
return List.tryHead user
}
/// Find a user by their database ID
let tryById (userId : UserId) conn = backgroundTask {
let! user =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.pt_user WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value ]
|> Sql.executeAsync mapToUser
return List.tryHead user
}
/// Update a user's last seen date/time
let updateLastSeen (userId : UserId) (now : Instant) conn = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query "UPDATE pt.pt_user SET last_seen = @now WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value; "@now", Sql.parameter (NpgsqlParameter ("@now", now)) ]
|> Sql.executeNonQueryAsync
return ()
}
/// Update a user's password hash
let updatePassword (user : User) conn = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query "UPDATE pt.pt_user SET password_hash = @passwordHash WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid user.Id.Value; "@passwordHash", Sql.string user.PasswordHash ]
|> Sql.executeNonQueryAsync
return ()
}
/// Update a user's authorized small groups
let updateSmallGroups (userId : UserId) groupIds conn = backgroundTask {
let! existingGroupIds = groupIdsByUserId userId conn
let toAdd =
groupIds |> List.filter (fun it -> existingGroupIds |> List.exists (fun grpId -> grpId = it) |> not)
let toDelete =
existingGroupIds |> List.filter (fun it -> groupIds |> List.exists (fun grpId -> grpId = it) |> not)
let queries = seq {
if not (List.isEmpty toAdd) then
"INSERT INTO pt.user_small_group VALUES (@userId, @smallGroupId)",
toAdd |> List.map (fun it -> [ "@userId", Sql.uuid userId.Value; "@smallGroupId", Sql.uuid it.Value ])
if not (List.isEmpty toDelete) then
"DELETE FROM pt.user_small_group WHERE user_id = @userId AND small_group_id = @smallGroupId",
toDelete
|> List.map (fun it -> [ "@userId", Sql.uuid userId.Value; "@smallGroupId", Sql.uuid it.Value ])
}
if not (Seq.isEmpty queries) then
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync (List.ofSeq queries)
()
}

86
src/PrayerTracker.Data/AppDbContext.fs
View File

@ -1,86 +0,0 @@
namespace PrayerTracker
open Microsoft.EntityFrameworkCore
open PrayerTracker.Entities
/// EF Core data context for PrayerTracker
[<AllowNullLiteral>]
type AppDbContext (options : DbContextOptions<AppDbContext>) =
inherit DbContext (options)
[<DefaultValue>]
val mutable private churches : DbSet<Church>
[<DefaultValue>]
val mutable private members : DbSet<Member>
[<DefaultValue>]
val mutable private prayerRequests : DbSet<PrayerRequest>
[<DefaultValue>]
val mutable private preferences : DbSet<ListPreferences>
[<DefaultValue>]
val mutable private smallGroups : DbSet<SmallGroup>
[<DefaultValue>]
val mutable private timeZones : DbSet<TimeZone>
[<DefaultValue>]
val mutable private users : DbSet<User>
[<DefaultValue>]
val mutable private userGroupXref : DbSet<UserSmallGroup>
/// Churches
member this.Churches
with get() = this.churches
and set v = this.churches <- v
/// Small group members
member this.Members
with get() = this.members
and set v = this.members <- v
/// Prayer requests
member this.PrayerRequests
with get() = this.prayerRequests
and set v = this.prayerRequests <- v
/// Request list preferences (by class)
member this.Preferences
with get() = this.preferences
and set v = this.preferences <- v
/// Small groups
member this.SmallGroups
with get() = this.smallGroups
and set v = this.smallGroups <- v
/// Time zones
member this.TimeZones
with get() = this.timeZones
and set v = this.timeZones <- v
/// Users
member this.Users
with get() = this.users
and set v = this.users <- v
/// User / small group cross-reference
member this.UserGroupXref
with get() = this.userGroupXref
and set v = this.userGroupXref <- v
/// F#-style async for saving changes
member this.AsyncSaveChanges () =
this.SaveChangesAsync () |> Async.AwaitTask
override __.OnModelCreating (modelBuilder : ModelBuilder) =
base.OnModelCreating modelBuilder
modelBuilder.HasDefaultSchema "pt" |> ignore
[ Church.configureEF
ListPreferences.configureEF
Member.configureEF
PrayerRequest.configureEF
SmallGroup.configureEF
TimeZone.configureEF
User.configureEF
UserSmallGroup.configureEF
]
|> List.iter (fun x -> x modelBuilder)

373
src/PrayerTracker.Data/DataAccess.fs
View File

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

218
src/PrayerTracker.Data/DistributedCache.fs Normal file
View File

@ -0,0 +1,218 @@
namespace PrayerTracker.Data
open System.Threading
open System.Threading.Tasks
open Microsoft.Extensions.Caching.Distributed
open NodaTime
open Npgsql
open Npgsql.FSharp
/// Helper types and functions for the cache
[<AutoOpen>]
module private CacheHelpers =
open System
/// The cache entry
type Entry =
{ /// The ID of the cache entry
Id : string
/// The value to be cached
Payload : byte[]
/// When this entry will expire
ExpireAt : Instant
/// The duration by which the expiration should be pushed out when being refreshed
SlidingExpiration : Duration option
/// The must-expire-by date/time for the cache entry
AbsoluteExpiration : Instant option
}
/// Run a task synchronously
let sync<'T> (it : Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously)
/// Get the current instant
let getNow () = SystemClock.Instance.GetCurrentInstant ()
/// Create a parameter for the expire-at time
let expireParam (it : Instant) =
"@expireAt", Sql.parameter (NpgsqlParameter ("@expireAt", it))
/// Create a parameter for a possibly-missing NodaTime type
let optParam<'T> name (it : 'T option) =
let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value)
p.ParameterName, Sql.parameter p
/// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog
type DistributedCache (connStr : string) =
// ~~~ INITIALIZATION ~~~
do
task {
let! exists =
Sql.connect connStr
|> Sql.query $"
SELECT EXISTS
(SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session')
AS does_exist"
|> Sql.executeRowAsync (fun row -> row.bool "does_exist")
if not exists then
let! _ =
Sql.connect connStr
|> Sql.query
"CREATE TABLE session (
id TEXT NOT NULL PRIMARY KEY,
payload BYTEA NOT NULL,
expire_at TIMESTAMPTZ NOT NULL,
sliding_expiration INTERVAL,
absolute_expiration TIMESTAMPTZ);
CREATE INDEX idx_session_expiration ON session (expire_at)"
|> Sql.executeNonQueryAsync
()
} |> sync
// ~~~ SUPPORT FUNCTIONS ~~~
/// Get an entry, updating it for sliding expiration
let getEntry key = backgroundTask {
let idParam = "@id", Sql.string key
let! tryEntry =
Sql.connect connStr
|> Sql.query "SELECT * FROM session WHERE id = @id"
|> Sql.parameters [ idParam ]
|> Sql.executeAsync (fun row ->
{ Id = row.string "id"
Payload = row.bytea "payload"
ExpireAt = row.fieldValue<Instant> "expire_at"
SlidingExpiration = row.fieldValueOrNone<Duration> "sliding_expiration"
AbsoluteExpiration = row.fieldValueOrNone<Instant> "absolute_expiration" })
match List.tryHead tryEntry with
| Some entry ->
let now = getNow ()
let slideExp = defaultArg entry.SlidingExpiration Duration.MinValue
let absExp = defaultArg entry.AbsoluteExpiration Instant.MinValue
let needsRefresh, item =
if entry.ExpireAt = absExp then false, entry
elif slideExp = Duration.MinValue && absExp = Instant.MinValue then false, entry
elif absExp > Instant.MinValue && entry.ExpireAt.Plus slideExp > absExp then
true, { entry with ExpireAt = absExp }
else true, { entry with ExpireAt = now.Plus slideExp }
if needsRefresh then
let! _ =
Sql.connect connStr
|> Sql.query "UPDATE session SET expire_at = @expireAt WHERE id = @id"
|> Sql.parameters [ expireParam item.ExpireAt; idParam ]
|> Sql.executeNonQueryAsync
()
return if item.ExpireAt > now then Some entry else None
| None -> return None
}
/// The last time expired entries were purged (runs every 30 minutes)
let mutable lastPurge = Instant.MinValue
/// Purge expired entries every 30 minutes
let purge () = backgroundTask {
let now = getNow ()
if lastPurge.Plus (Duration.FromMinutes 30L) < now then
let! _ =
Sql.connect connStr
|> Sql.query "DELETE FROM session WHERE expire_at < @expireAt"
|> Sql.parameters [ expireParam now ]
|> Sql.executeNonQueryAsync
lastPurge <- now
}
/// Remove a cache entry
let removeEntry key = backgroundTask {
let! _ =
Sql.connect connStr
|> Sql.query "DELETE FROM session WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string key ]
|> Sql.executeNonQueryAsync
()
}
/// Save an entry
let saveEntry (opts : DistributedCacheEntryOptions) key payload = backgroundTask {
let now = getNow ()
let expireAt, slideExp, absExp =
if opts.SlidingExpiration.HasValue then
let slide = Duration.FromTimeSpan opts.SlidingExpiration.Value
now.Plus slide, Some slide, None
elif opts.AbsoluteExpiration.HasValue then
let exp = Instant.FromDateTimeOffset opts.AbsoluteExpiration.Value
exp, None, Some exp
elif opts.AbsoluteExpirationRelativeToNow.HasValue then
let exp = now.Plus (Duration.FromTimeSpan opts.AbsoluteExpirationRelativeToNow.Value)
exp, None, Some exp
else
// Default to 2 hour sliding expiration
let slide = Duration.FromHours 2
now.Plus slide, Some slide, None
let! _ =
Sql.connect connStr
|> Sql.query
"INSERT INTO session (
id, payload, expire_at, sliding_expiration, absolute_expiration
) VALUES (
@id, @payload, @expireAt, @slideExp, @absExp
) ON CONFLICT (id) DO UPDATE
SET payload = EXCLUDED.payload,
expire_at = EXCLUDED.expire_at,
sliding_expiration = EXCLUDED.sliding_expiration,
absolute_expiration = EXCLUDED.absolute_expiration"
|> Sql.parameters
[ "@id", Sql.string key
"@payload", Sql.bytea payload
expireParam expireAt
optParam "slideExp" slideExp
optParam "absExp" absExp ]
|> Sql.executeNonQueryAsync
()
}
// ~~~ IMPLEMENTATION FUNCTIONS ~~~
/// Retrieve the data for a cache entry
let get key (_ : CancellationToken) = backgroundTask {
match! getEntry key with
| Some entry ->
do! purge ()
return entry.Payload
| None -> return null
}
/// Refresh an entry
let refresh key (cancelToken : CancellationToken) = backgroundTask {
let! _ = get key cancelToken
()
}
/// Remove an entry
let remove key (_ : CancellationToken) = backgroundTask {
do! removeEntry key
do! purge ()
}
/// Set an entry
let set key value options (_ : CancellationToken) = backgroundTask {
do! saveEntry options key value
do! purge ()
}
interface IDistributedCache with
member this.Get key = get key CancellationToken.None |> sync
member this.GetAsync (key, token) = get key token
member this.Refresh key = refresh key CancellationToken.None |> sync
member this.RefreshAsync (key, token) = refresh key token
member this.Remove key = remove key CancellationToken.None |> sync
member this.RemoveAsync (key, token) = remove key token
member this.Set (key, value, options) = set key value options CancellationToken.None |> sync
member this.SetAsync (key, value, options, token) = set key value options token

1149
src/PrayerTracker.Data/Entities.fs
View File

File diff suppressed because it is too large Load Diff

514
src/PrayerTracker.Data/Migrations/20161217153124_InitialDatabase.fs
View File

@ -1,514 +0,0 @@
namespace PrayerTracker.Migrations
open Microsoft.EntityFrameworkCore
open Microsoft.EntityFrameworkCore.Infrastructure
open Microsoft.EntityFrameworkCore.Migrations
open Microsoft.EntityFrameworkCore.Migrations.Operations
open Microsoft.EntityFrameworkCore.Migrations.Operations.Builders
open Npgsql.EntityFrameworkCore.PostgreSQL.Metadata
open PrayerTracker
open PrayerTracker.Entities
open System
// fsharplint:disable RecordFieldNames
type ChurchTable =
{ churchId : OperationBuilder<AddColumnOperation>
city : OperationBuilder<AddColumnOperation>
hasInterface : OperationBuilder<AddColumnOperation>
interfaceAddress : OperationBuilder<AddColumnOperation>
name : OperationBuilder<AddColumnOperation>
st : OperationBuilder<AddColumnOperation>
}
type ListPreferencesTable =
{ smallGroupId : OperationBuilder<AddColumnOperation>
daysToExpire : OperationBuilder<AddColumnOperation>
daysToKeepNew : OperationBuilder<AddColumnOperation>
defaultEmailType : OperationBuilder<AddColumnOperation>
emailFromAddress : OperationBuilder<AddColumnOperation>
emailFromName : OperationBuilder<AddColumnOperation>
groupPassword : OperationBuilder<AddColumnOperation>
headingColor : OperationBuilder<AddColumnOperation>
headingFontSize : OperationBuilder<AddColumnOperation>
isPublic : OperationBuilder<AddColumnOperation>
lineColor : OperationBuilder<AddColumnOperation>
listFonts : OperationBuilder<AddColumnOperation>
longTermUpdateWeeks : OperationBuilder<AddColumnOperation>
requestSort : OperationBuilder<AddColumnOperation>
textFontSize : OperationBuilder<AddColumnOperation>
timeZoneId : OperationBuilder<AddColumnOperation>
pageSize : OperationBuilder<AddColumnOperation>
asOfDateDisplay : OperationBuilder<AddColumnOperation>
}
type MemberTable =
{ memberId : OperationBuilder<AddColumnOperation>
email : OperationBuilder<AddColumnOperation>
format : OperationBuilder<AddColumnOperation>
memberName : OperationBuilder<AddColumnOperation>
smallGroupId : OperationBuilder<AddColumnOperation>
}
type PrayerRequestTable =
{ prayerRequestId : OperationBuilder<AddColumnOperation>
enteredDate : OperationBuilder<AddColumnOperation>
expiration : OperationBuilder<AddColumnOperation>
notifyChaplain : OperationBuilder<AddColumnOperation>
requestType : OperationBuilder<AddColumnOperation>
requestor : OperationBuilder<AddColumnOperation>
smallGroupId : OperationBuilder<AddColumnOperation>
text : OperationBuilder<AddColumnOperation>
updatedDate : OperationBuilder<AddColumnOperation>
userId : OperationBuilder<AddColumnOperation>
}
type SmallGroupTable =
{ smallGroupId : OperationBuilder<AddColumnOperation>
churchId : OperationBuilder<AddColumnOperation>
name : OperationBuilder<AddColumnOperation>
}
type TimeZoneTable =
{ timeZoneId : OperationBuilder<AddColumnOperation>
description : OperationBuilder<AddColumnOperation>
isActive : OperationBuilder<AddColumnOperation>
sortOrder : OperationBuilder<AddColumnOperation>
}
type UserSmallGroupTable =
{ userId : OperationBuilder<AddColumnOperation>
smallGroupId : OperationBuilder<AddColumnOperation>
}
type UserTable =
{ userId : OperationBuilder<AddColumnOperation>
emailAddress : OperationBuilder<AddColumnOperation>
firstName : OperationBuilder<AddColumnOperation>
isAdmin : OperationBuilder<AddColumnOperation>
lastName : OperationBuilder<AddColumnOperation>
passwordHash : OperationBuilder<AddColumnOperation>
salt : OperationBuilder<AddColumnOperation>
}
[<DbContext (typeof<AppDbContext>)>]
[<Migration "20161217153124_InitialDatabase">]
type InitialDatabase () =
inherit Migration ()
override __.Up (migrationBuilder : MigrationBuilder) =
migrationBuilder.EnsureSchema (name = "pt")
|> ignore
migrationBuilder.CreateTable (
name = "Church",
schema = "pt",
columns =
(fun table ->
{ churchId = table.Column<Guid> (name = "ChurchId", nullable = false)
city = table.Column<string> (name = "City", nullable = false)
hasInterface = table.Column<bool> (name = "HasVirtualPrayerRoomInterface", nullable = false)
interfaceAddress = table.Column<string> (name = "InterfaceAddress", nullable = true)
name = table.Column<string> (name = "Name", nullable = false)
st = table.Column<string> (name = "ST", nullable = false, maxLength = Nullable<int> 2)
}),
constraints =
fun table ->
table.PrimaryKey ("PK_Church", fun x -> upcast x.churchId) |> ignore)
|> ignore
migrationBuilder.CreateTable (
name = "TimeZone",
schema = "pt",
columns =
(fun table ->
{ timeZoneId = table.Column<string> (name = "TimeZoneId", nullable = false)
description = table.Column<string> (name = "Description", nullable = false)
isActive = table.Column<bool> (name = "IsActive", nullable = false)
sortOrder = table.Column<int> (name = "SortOrder", nullable = false)
}),
constraints =
fun table ->
table.PrimaryKey ("PK_TimeZone", fun x -> upcast x.timeZoneId) |> ignore)
|> ignore
migrationBuilder.CreateTable (
name = "User",
schema = "pt",
columns =
(fun table ->
{ userId = table.Column<Guid> (name = "UserId", nullable = false)
emailAddress = table.Column<string> (name = "EmailAddress", nullable = false)
firstName = table.Column<string> (name = "FirstName", nullable = false)
isAdmin = table.Column<bool> (name = "IsSystemAdmin", nullable = false)
lastName = table.Column<string> (name = "LastName", nullable = false)
passwordHash = table.Column<string> (name = "PasswordHash", nullable = false)
salt = table.Column<Guid> (name = "Salt", nullable = true)
}),
constraints =
fun table ->
table.PrimaryKey("PK_User", fun x -> upcast x.userId) |> ignore)
|> ignore
migrationBuilder.CreateTable (
name = "SmallGroup",
schema = "pt",
columns =
(fun table ->
{ smallGroupId = table.Column<Guid> (name = "SmallGroupId", nullable = false)
churchId = table.Column<Guid> (name = "ChurchId", nullable = false)
name = table.Column<string> (name = "Name", nullable = false)
}),
constraints =
fun table ->
table.PrimaryKey ("PK_SmallGroup", fun x -> upcast x.smallGroupId) |> ignore
table.ForeignKey (
name = "FK_SmallGroup_Church_ChurchId",
column = (fun x -> upcast x.churchId),
principalSchema = "pt",
principalTable = "Church",
principalColumn = "ChurchId",
onDelete = ReferentialAction.Cascade)
|> ignore)
|> ignore
migrationBuilder.CreateTable (
name = "ListPreference",
schema = "pt",
columns =
(fun table ->
{ smallGroupId = table.Column<Guid> (name = "SmallGroupId", nullable = false)
daysToExpire = table.Column<int> (name = "DaysToExpire", nullable = false, defaultValue = 14)
daysToKeepNew = table.Column<int> (name = "DaysToKeepNew", nullable = false, defaultValue = 7)
defaultEmailType = table.Column<string> (name = "DefaultEmailType", nullable = false, defaultValue = "Html")
emailFromAddress = table.Column<string> (name = "EmailFromAddress", nullable = false, defaultValue = "prayer@djs-consulting.com")
emailFromName = table.Column<string> (name = "EmailFromName", nullable = false, defaultValue = "PrayerTracker")
groupPassword = table.Column<string> (name = "GroupPassword", nullable = false, defaultValue = "")
headingColor = table.Column<string> (name = "HeadingColor", nullable = false, defaultValue = "maroon")
headingFontSize = table.Column<int> (name = "HeadingFontSize", nullable = false, defaultValue = 16)
isPublic = table.Column<bool> (name = "IsPublic", nullable = false, defaultValue = false)
lineColor = table.Column<string> (name = "LineColor", nullable = false, defaultValue = "navy")
listFonts = table.Column<string> (name = "ListFonts", nullable = false, defaultValue = "Century Gothic,Tahoma,Luxi Sans,sans-serif")
longTermUpdateWeeks = table.Column<int> (name = "LongTermUpdateWeeks", nullable = false, defaultValue = 4)
requestSort = table.Column<string> (name = "RequestSort", nullable = false, defaultValue = "D", maxLength = Nullable<int> 1)
textFontSize = table.Column<int> (name = "TextFontSize", nullable = false, defaultValue = 12)
timeZoneId = table.Column<string> (name = "TimeZoneId", nullable = false, defaultValue = "America/Denver")
pageSize = table.Column<int> (name = "PageSize", nullable = false, defaultValue = 100)
asOfDateDisplay = table.Column<string> (name = "AsOfDateDisplay", nullable = false, defaultValue = "N", maxLength = Nullable<int> 1)
}),
constraints =
fun table ->
table.PrimaryKey ("PK_ListPreference", fun x -> upcast x.smallGroupId) |> ignore
table.ForeignKey (
name = "FK_ListPreference_SmallGroup_SmallGroupId",
column = (fun x -> upcast x.smallGroupId),
principalSchema = "pt",
principalTable = "SmallGroup",
principalColumn = "SmallGroupId",
onDelete = ReferentialAction.Cascade)
|> ignore
table.ForeignKey (
name = "FK_ListPreference_TimeZone_TimeZoneId",
column = (fun x -> upcast x.timeZoneId),
principalSchema = "pt",
principalTable = "TimeZone",
principalColumn = "TimeZoneId",
onDelete = ReferentialAction.Cascade)
|> ignore)
|> ignore
migrationBuilder.CreateTable (
name = "Member",
schema = "pt",
columns =
(fun table ->
{ memberId = table.Column<Guid> (name = "MemberId", nullable = false)
email = table.Column<string> (name = "Email", nullable = false)
format = table.Column<string> (name = "Format", nullable = true)
memberName = table.Column<string> (name = "MemberName", nullable = false)
smallGroupId = table.Column<Guid> (name = "SmallGroupId", nullable = false)
}),
constraints =
fun table ->
table.PrimaryKey ("PK_Member", fun x -> upcast x.memberId) |> ignore
table.ForeignKey (
name = "FK_Member_SmallGroup_SmallGroupId",
column = (fun x -> upcast x.smallGroupId),
principalSchema = "pt",
principalTable = "SmallGroup",
principalColumn = "SmallGroupId",
onDelete = ReferentialAction.Cascade)
|> ignore)
|> ignore
migrationBuilder.CreateTable (
name = "PrayerRequest",
schema = "pt",
columns =
(fun table ->
{ prayerRequestId = table.Column<Guid> (name = "PrayerRequestId", nullable = false)
expiration = table.Column<bool> (name = "Expiration", nullable = false)
enteredDate = table.Column<DateTime> (name = "EnteredDate", nullable = false)
notifyChaplain = table.Column<bool> (name = "NotifyChaplain", nullable = false)
requestType = table.Column<string> (name = "RequestType", nullable = false)
requestor = table.Column<string> (name = "Requestor", nullable = true)
smallGroupId = table.Column<Guid> (name = "SmallGroupId", nullable = false)
text = table.Column<string> (name = "Text", nullable = false)
updatedDate = table.Column<DateTime> (name = "UpdatedDate", nullable = false)
userId = table.Column<Guid> (name = "UserId", nullable = false)
}),
constraints =
fun table ->
table.PrimaryKey ("PK_PrayerRequest", fun x -> upcast x.prayerRequestId) |> ignore
table.ForeignKey (
name = "FK_PrayerRequest_SmallGroup_SmallGroupId",
column = (fun x -> upcast x.smallGroupId),
principalSchema = "pt",
principalTable = "SmallGroup",
principalColumn = "SmallGroupId",
onDelete = ReferentialAction.Cascade)
|> ignore
table.ForeignKey (
name = "FK_PrayerRequest_User_UserId",
column = (fun x -> upcast x.userId),
principalSchema = "pt",
principalTable = "User",
principalColumn = "UserId",
onDelete = ReferentialAction.Cascade)
|> ignore)
|> ignore
migrationBuilder.CreateTable(
name = "User_SmallGroup",
schema = "pt",
columns =
(fun table ->
{ userId = table.Column<Guid> (name = "UserId", nullable = false)
smallGroupId = table.Column<Guid> (name = "SmallGroupId", nullable = false)
}),
constraints =
fun table ->
table.PrimaryKey ("PK_User_SmallGroup", fun x -> upcast x) |> ignore
table.ForeignKey (
name = "FK_User_SmallGroup_SmallGroup_SmallGroupId",
column = (fun x -> upcast x.smallGroupId),
principalSchema = "pt",
principalTable = "SmallGroup",
principalColumn = "SmallGroupId",
onDelete = ReferentialAction.Cascade)
|> ignore
table.ForeignKey (
name = "FK_User_SmallGroup_User_UserId",
column = (fun x -> upcast x.userId),
principalSchema = "pt",
principalTable = "User",
principalColumn = "UserId",
onDelete = ReferentialAction.Cascade)
|> ignore)
|> ignore
migrationBuilder.CreateIndex (name = "IX_ListPreference_TimeZoneId", schema = "pt", table = "ListPreference", column = "TimeZoneId") |> ignore
migrationBuilder.CreateIndex (name = "IX_Member_SmallGroupId", schema = "pt", table = "Member", column = "SmallGroupId") |> ignore
migrationBuilder.CreateIndex (name = "IX_PrayerRequest_SmallGroupId", schema = "pt", table = "PrayerRequest", column = "SmallGroupId") |> ignore
migrationBuilder.CreateIndex (name = "IX_PrayerRequest_UserId", schema = "pt", table = "PrayerRequest", column = "UserId") |> ignore
migrationBuilder.CreateIndex (name = "IX_SmallGroup_ChurchId", schema = "pt", table = "SmallGroup", column = "ChurchId") |> ignore
migrationBuilder.CreateIndex (name = "IX_User_SmallGroup_SmallGroupId", schema = "pt", table = "User_SmallGroup", column = "SmallGroupId") |> ignore
override __.Down (migrationBuilder : MigrationBuilder) =
migrationBuilder.DropTable (name = "ListPreference", schema = "pt") |> ignore
migrationBuilder.DropTable (name = "Member", schema = "pt") |> ignore
migrationBuilder.DropTable (name = "PrayerRequest", schema = "pt") |> ignore
migrationBuilder.DropTable (name = "User_SmallGroup", schema = "pt") |> ignore
migrationBuilder.DropTable (name = "TimeZone", schema = "pt") |> ignore
migrationBuilder.DropTable (name = "SmallGroup", schema = "pt") |> ignore
migrationBuilder.DropTable (name = "User", schema = "pt") |> ignore
migrationBuilder.DropTable (name = "Church", schema = "pt") |> ignore
override __.BuildTargetModel (modelBuilder : ModelBuilder) =
modelBuilder
.HasDefaultSchema("pt")
.HasAnnotation("Npgsql:ValueGenerationStrategy", NpgsqlValueGenerationStrategy.SerialColumn)
.HasAnnotation("ProductVersion", "1.1.0-rtm-22752")
|> ignore
modelBuilder.Entity (
typeof<Church>,
fun b ->
b.Property<Guid>("churchId").ValueGeneratedOnAdd() |> ignore
b.Property<string>("city").IsRequired() |> ignore
b.Property<bool>("hasInterface") |> ignore
b.Property<string>("interfaceAddress") |> ignore
b.Property<string>("name").IsRequired() |> ignore
b.Property<string>("st").IsRequired().HasMaxLength(2) |> ignore
b.HasKey("churchId") |> ignore
b.ToTable("Church") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<ListPreferences>,
fun b ->
b.Property<Guid>("smallGroupId") |> ignore
b.Property<int>("daysToExpire").ValueGeneratedOnAdd().HasDefaultValue(14) |> ignore
b.Property<int>("daysToKeepNew").ValueGeneratedOnAdd().HasDefaultValue(7) |> ignore
b.Property<string>("defaultEmailType").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("H") |> ignore
b.Property<string>("emailFromAddress").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("prayer@djs-consulting.com") |> ignore
b.Property<string>("emailFromName").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("PrayerTracker") |> ignore
b.Property<string>("groupPassword").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("") |> ignore
b.Property<string>("headingColor").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("maroon") |> ignore
b.Property<int>("headingFontSize").ValueGeneratedOnAdd().HasDefaultValue(16) |> ignore
b.Property<bool>("isPublic").ValueGeneratedOnAdd().HasDefaultValue(false) |> ignore
b.Property<string>("lineColor").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("navy") |> ignore
b.Property<string>("listFonts").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("Century Gothic,Tahoma,Luxi Sans,sans-serif") |> ignore
b.Property<int>("longTermUpdateWeeks").ValueGeneratedOnAdd().HasDefaultValue(4) |> ignore
b.Property<string>("requestSort").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("D").HasMaxLength(1) |> ignore
b.Property<int>("textFontSize").ValueGeneratedOnAdd().HasDefaultValue(12) |> ignore
b.Property<string>("timeZoneId").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("America/Denver") |> ignore
b.Property<int>("pageSize").IsRequired().ValueGeneratedOnAdd().HasDefaultValue(100) |> ignore
b.Property<string>("asOfDateDisplay").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("N").HasMaxLength(1) |> ignore
b.HasKey("smallGroupId") |> ignore
b.HasIndex("timeZoneId") |> ignore
b.ToTable("ListPreference") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<Member>,
fun b ->
b.Property<Guid>("memberId").ValueGeneratedOnAdd() |> ignore
b.Property<string>("email").IsRequired() |> ignore
b.Property<string>("format") |> ignore
b.Property<string>("memberName").IsRequired() |> ignore
b.Property<Guid>("smallGroupId") |> ignore
b.HasKey("memberId") |> ignore
b.HasIndex("smallGroupId") |> ignore
b.ToTable("Member") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<PrayerRequest>,
fun b ->
b.Property<Guid>("prayerRequestId").ValueGeneratedOnAdd() |> ignore
b.Property<DateTime>("enteredDate").IsRequired() |> ignore
b.Property<string>("expiration").IsRequired().HasMaxLength 1 |> ignore
b.Property<bool>("notifyChaplain") |> ignore
b.Property<string>("requestType").IsRequired().HasMaxLength 1 |> ignore
b.Property<string>("requestor") |> ignore
b.Property<Guid>("smallGroupId") |> ignore
b.Property<string>("text").IsRequired() |> ignore
b.Property<DateTime>("updatedDate") |> ignore
b.Property<Guid>("userId") |> ignore
b.HasKey("prayerRequestId") |> ignore
b.HasIndex("smallGroupId") |> ignore
b.HasIndex("userId") |> ignore
b.ToTable("PrayerRequest") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<SmallGroup>,
fun b ->
b.Property<Guid>("smallGroupId").ValueGeneratedOnAdd() |> ignore
b.Property<Guid>("churchId") |> ignore
b.Property<string>("name").IsRequired() |> ignore
b.HasKey("smallGroupId") |> ignore
b.HasIndex("churchId") |> ignore
b.ToTable("SmallGroup") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<PrayerTracker.Entities.TimeZone>,
fun b ->
b.Property<string>("timeZoneId").ValueGeneratedOnAdd() |> ignore
b.Property<string>("description").IsRequired() |> ignore
b.Property<bool>("isActive") |> ignore
b.Property<int>("sortOrder") |> ignore
b.HasKey("timeZoneId") |> ignore
b.ToTable("TimeZone") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<User>,
fun b ->
b.Property<Guid>("userId").ValueGeneratedOnAdd() |> ignore
b.Property<string>("emailAddress").IsRequired() |> ignore
b.Property<string>("firstName").IsRequired() |> ignore
b.Property<bool>("isAdmin") |> ignore
b.Property<string>("lastName").IsRequired() |> ignore
b.Property<string>("passwordHash").IsRequired() |> ignore
b.Property<Guid>("salt") |> ignore
b.HasKey("userId") |> ignore
b.ToTable("User") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<UserSmallGroup>,
fun b ->
b.Property<Guid>("userId") |> ignore
b.Property<Guid>("smallGroupId") |> ignore
b.HasKey("userId", "smallGroupId") |> ignore
b.HasIndex("smallGroupId") |> ignore
b.ToTable("User_SmallGroup") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<ListPreferences>,
fun b ->
b.HasOne("PrayerTracker.Entities.SmallGroup")
.WithOne("preferences")
.HasForeignKey("PrayerTracker.Entities.ListPreferences", "smallGroupId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore
b.HasOne("PrayerTracker.Entities.TimeZone", "timeZone")
.WithMany()
.HasForeignKey("timeZoneId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore)
|> ignore
modelBuilder.Entity (
typeof<Member>,
fun b ->
b.HasOne("PrayerTracker.Entities.SmallGroup", "smallGroup")
.WithMany("members")
.HasForeignKey("smallGroupId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore)
|> ignore
modelBuilder.Entity (
typeof<PrayerRequest>,
fun b ->
b.HasOne("PrayerTracker.Entities.SmallGroup", "smallGroup")
.WithMany("prayerRequests")
.HasForeignKey("smallGroupId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore
b.HasOne("PrayerTracker.Entities.User", "user")
.WithMany()
.HasForeignKey("userId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore)
|> ignore
modelBuilder.Entity (
typeof<SmallGroup>,
fun b ->
b.HasOne("PrayerTracker.Entities.Church", "Church")
.WithMany("SmallGroups")
.HasForeignKey("ChurchId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore)
|> ignore
modelBuilder.Entity (
typeof<UserSmallGroup>,
fun b ->
b.HasOne("PrayerTracker.Entities.SmallGroup", "smallGroup")
.WithMany("users")
.HasForeignKey("smallGroupId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore
b.HasOne("PrayerTracker.Entities.User", "user")
.WithMany("smallGroups")
.HasForeignKey("userId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore)
|> ignore

200
src/PrayerTracker.Data/Migrations/AppDbContextModelSnapshot.fs
View File

@ -1,200 +0,0 @@
namespace PrayerTracker.Migrations
open Microsoft.EntityFrameworkCore
open Microsoft.EntityFrameworkCore.Infrastructure
open Npgsql.EntityFrameworkCore.PostgreSQL.Metadata
open PrayerTracker
open PrayerTracker.Entities
open System
[<DbContext (typeof<AppDbContext>)>]
type AppDbContextModelSnapshot () =
inherit ModelSnapshot ()
override __.BuildModel (modelBuilder : ModelBuilder) =
modelBuilder
.HasDefaultSchema("pt")
.HasAnnotation("Npgsql:ValueGenerationStrategy", NpgsqlValueGenerationStrategy.SerialColumn)
.HasAnnotation("ProductVersion", "1.1.0-rtm-22752")
|> ignore
modelBuilder.Entity (
typeof<Church>,
fun b ->
b.Property<Guid>("churchId").ValueGeneratedOnAdd() |> ignore
b.Property<string>("city").IsRequired() |> ignore
b.Property<bool>("hasInterface") |> ignore
b.Property<string>("interfaceAddress") |> ignore
b.Property<string>("name").IsRequired() |> ignore
b.Property<string>("st").IsRequired().HasMaxLength(2) |> ignore
b.HasKey("churchId") |> ignore
b.ToTable("Church") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<ListPreferences>,
fun b ->
b.Property<Guid>("smallGroupId") |> ignore
b.Property<int>("daysToExpire").ValueGeneratedOnAdd().HasDefaultValue(14) |> ignore
b.Property<int>("daysToKeepNew").ValueGeneratedOnAdd().HasDefaultValue(7) |> ignore
b.Property<string>("defaultEmailType").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("H").HasMaxLength(1) |> ignore
b.Property<string>("emailFromAddress").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("prayer@djs-consulting.com") |> ignore
b.Property<string>("emailFromName").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("PrayerTracker") |> ignore
b.Property<string>("groupPassword").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("") |> ignore
b.Property<string>("headingColor").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("maroon") |> ignore
b.Property<int>("headingFontSize").ValueGeneratedOnAdd().HasDefaultValue(16) |> ignore
b.Property<bool>("isPublic").ValueGeneratedOnAdd().HasDefaultValue(false) |> ignore
b.Property<string>("lineColor").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("navy") |> ignore
b.Property<string>("listFonts").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("Century Gothic,Tahoma,Luxi Sans,sans-serif") |> ignore
b.Property<int>("longTermUpdateWeeks").ValueGeneratedOnAdd().HasDefaultValue(4) |> ignore
b.Property<string>("requestSort").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("D").HasMaxLength(1) |> ignore
b.Property<int>("textFontSize").ValueGeneratedOnAdd().HasDefaultValue(12) |> ignore
b.Property<string>("timeZoneId").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("America/Denver") |> ignore
b.Property<int>("pageSize").IsRequired().ValueGeneratedOnAdd().HasDefaultValue(100) |> ignore
b.Property<string>("asOfDateDisplay").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("N").HasMaxLength(1) |> ignore
b.HasKey("smallGroupId") |> ignore
b.HasIndex("timeZoneId") |> ignore
b.ToTable("ListPreference") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<Member>,
fun b ->
b.Property<Guid>("memberId").ValueGeneratedOnAdd() |> ignore
b.Property<string>("email").IsRequired() |> ignore
b.Property<string>("format") |> ignore
b.Property<string>("memberName").IsRequired() |> ignore
b.Property<Guid>("smallGroupId") |> ignore
b.HasKey("memberId") |> ignore
b.HasIndex("smallGroupId") |> ignore
b.ToTable("Member") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<PrayerRequest>,
fun b ->
b.Property<Guid>("prayerRequestId").ValueGeneratedOnAdd() |> ignore
b.Property<DateTime>("enteredDate") |> ignore
b.Property<string>("expiration").IsRequired().HasMaxLength(1) |> ignore
b.Property<bool>("notifyChaplain") |> ignore
b.Property<string>("requestType").IsRequired().HasMaxLength(1) |> ignore
b.Property<string>("requestor") |> ignore
b.Property<Guid>("smallGroupId") |> ignore
b.Property<string>("text").IsRequired() |> ignore
b.Property<DateTime>("updatedDate") |> ignore
b.Property<Guid>("userId") |> ignore
b.HasKey("prayerRequestId") |> ignore
b.HasIndex("smallGroupId") |> ignore
b.HasIndex("userId") |> ignore
b.ToTable("PrayerRequest") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<SmallGroup>,
fun b ->
b.Property<Guid>("smallGroupId").ValueGeneratedOnAdd() |> ignore
b.Property<Guid>("churchId") |> ignore
b.Property<string>("name").IsRequired() |> ignore
b.HasKey("smallGroupId") |> ignore
b.HasIndex("churchId") |> ignore
b.ToTable("SmallGroup") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<PrayerTracker.Entities.TimeZone>,
fun b ->
b.Property<string>("timeZoneId").ValueGeneratedOnAdd() |> ignore
b.Property<string>("description").IsRequired() |> ignore
b.Property<bool>("isActive") |> ignore
b.Property<int>("sortOrder") |> ignore
b.HasKey("timeZoneId") |> ignore
b.ToTable("TimeZone") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<User>,
fun b ->
b.Property<Guid>("userId").ValueGeneratedOnAdd() |> ignore
b.Property<string>("emailAddress").IsRequired() |> ignore
b.Property<string>("firstName").IsRequired() |> ignore
b.Property<bool>("isAdmin") |> ignore
b.Property<string>("lastName").IsRequired() |> ignore
b.Property<string>("passwordHash").IsRequired() |> ignore
b.Property<Guid>("salt") |> ignore
b.HasKey("userId") |> ignore
b.ToTable("User") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<UserSmallGroup>,
fun b ->
b.Property<Guid>("userId") |> ignore
b.Property<Guid>("smallGroupId") |> ignore
b.HasKey("userId", "smallGroupId") |> ignore
b.HasIndex("smallGroupId") |> ignore
b.ToTable("User_SmallGroup") |> ignore)
|> ignore
modelBuilder.Entity (
typeof<ListPreferences>,
fun b ->
b.HasOne("PrayerTracker.Entities.SmallGroup")
.WithOne("preferences")
.HasForeignKey("PrayerTracker.Entities.ListPreferences", "smallGroupId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore
b.HasOne("PrayerTracker.Entities.TimeZone", "timeZone")
.WithMany()
.HasForeignKey("timeZoneId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore)
|> ignore
modelBuilder.Entity (
typeof<Member>,
fun b ->
b.HasOne("PrayerTracker.Entities.SmallGroup", "smallGroup")
.WithMany("members")
.HasForeignKey("smallGroupId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore)
|> ignore
modelBuilder.Entity (
typeof<PrayerRequest>,
fun b ->
b.HasOne("PrayerTracker.Entities.SmallGroup", "smallGroup")
.WithMany("prayerRequests")
.HasForeignKey("smallGroupId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore
b.HasOne("PrayerTracker.Entities.User", "user")
.WithMany()
.HasForeignKey("userId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore)
|> ignore
modelBuilder.Entity (
typeof<SmallGroup>,
fun b ->
b.HasOne("PrayerTracker.Entities.Church", "Church")
.WithMany("SmallGroups")
.HasForeignKey("ChurchId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore)
|> ignore
modelBuilder.Entity (
typeof<UserSmallGroup>,
fun b ->
b.HasOne("PrayerTracker.Entities.SmallGroup", "smallGroup")
.WithMany("users")
.HasForeignKey("smallGroupId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore
b.HasOne("PrayerTracker.Entities.User", "user")
.WithMany("smallGroups")
.HasForeignKey("userId")
.OnDelete(DeleteBehavior.Cascade)
|> ignore)
|> ignore

15
src/PrayerTracker.Data/PrayerTracker.Data.fsproj
View File

@ -6,17 +6,16 @@
<ItemGroup> <ItemGroup>
<Compile Include="Entities.fs" /> <Compile Include="Entities.fs" />
<Compile Include="AppDbContext.fs" /> <Compile Include="Access.fs" />
<Compile Include="DataAccess.fs" /> <Compile Include="DistributedCache.fs" />
<Compile Include="Migrations\20161217153124_InitialDatabase.fs" />
<Compile Include="Migrations\AppDbContextModelSnapshot.fs" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="FSharp.EFCore.OptionConverter" Version="1.0.0" /> <PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Microsoft.FSharpLu" Version="0.11.7" /> <PackageReference Include="NodaTime" Version="3.1.2" />
<PackageReference Include="NodaTime" Version="3.0.5" /> <PackageReference Update="FSharp.Core" Version="6.0.5" />
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="5.0.10" /> <PackageReference Include="Npgsql.FSharp" Version="5.3.0" />
<PackageReference Include="Npgsql.NodaTime" Version="6.0.6" />
</ItemGroup> </ItemGroup>
</Project> </Project>

615
src/PrayerTracker.Tests/Data/EntitiesTests.fs
View File

@ -7,356 +7,355 @@ open System
[<Tests>] [<Tests>]
let asOfDateDisplayTests = let asOfDateDisplayTests =
testList "AsOfDateDisplay" [ testList "AsOfDateDisplay" [
test "NoDisplay code is correct" { test "NoDisplay code is correct" {
Expect.equal NoDisplay.code "N" "The code for NoDisplay should have been \"N\"" Expect.equal (AsOfDateDisplay.toCode NoDisplay) "N" "The code for NoDisplay should have been \"N\""
} }
test "ShortDate code is correct" { test "ShortDate code is correct" {
Expect.equal ShortDate.code "S" "The code for ShortDate should have been \"S\"" Expect.equal (AsOfDateDisplay.toCode ShortDate) "S" "The code for ShortDate should have been \"S\""
} }
test "LongDate code is correct" { test "LongDate code is correct" {
Expect.equal LongDate.code "L" "The code for LongDate should have been \"N\"" Expect.equal (AsOfDateDisplay.toCode LongDate) "L" "The code for LongDate should have been \"N\""
} }
test "fromCode N should return NoDisplay" { test "fromCode N should return NoDisplay" {
Expect.equal (AsOfDateDisplay.fromCode "N") NoDisplay "\"N\" should have been converted to NoDisplay" Expect.equal (AsOfDateDisplay.fromCode "N") NoDisplay "\"N\" should have been converted to NoDisplay"
} }
test "fromCode S should return ShortDate" { test "fromCode S should return ShortDate" {
Expect.equal (AsOfDateDisplay.fromCode "S") ShortDate "\"S\" should have been converted to ShortDate" Expect.equal (AsOfDateDisplay.fromCode "S") ShortDate "\"S\" should have been converted to ShortDate"
} }
test "fromCode L should return LongDate" { test "fromCode L should return LongDate" {
Expect.equal (AsOfDateDisplay.fromCode "L") LongDate "\"L\" should have been converted to LongDate" Expect.equal (AsOfDateDisplay.fromCode "L") LongDate "\"L\" should have been converted to LongDate"
} }
test "fromCode X should raise" { test "fromCode X should raise" {
Expect.throws (fun () -> AsOfDateDisplay.fromCode "X" |> ignore) Expect.throws (fun () -> AsOfDateDisplay.fromCode "X" |> ignore)
"An unknown code should have raised an exception" "An unknown code should have raised an exception"
} }
] ]
[<Tests>] [<Tests>]
let churchTests = let churchTests =
testList "Church" [ testList "Church" [
test "empty is as expected" { test "empty is as expected" {
let mt = Church.empty let mt = Church.empty
Expect.equal mt.churchId Guid.Empty "The church ID should have been an empty GUID" Expect.equal mt.Id.Value Guid.Empty "The church ID should have been an empty GUID"
Expect.equal mt.name "" "The name should have been blank" Expect.equal mt.Name "" "The name should have been blank"
Expect.equal mt.city "" "The city should have been blank" Expect.equal mt.City "" "The city should have been blank"
Expect.equal mt.st "" "The state should have been blank" Expect.equal mt.State "" "The state should have been blank"
Expect.isFalse mt.hasInterface "The church should not show that it has an interface" Expect.isFalse mt.HasVpsInterface "The church should not show that it has an interface"
Expect.isNone mt.interfaceAddress "The interface address should not exist" Expect.isNone mt.InterfaceAddress "The interface address should not exist"
Expect.isNotNull mt.smallGroups "The small groups navigation property should not be null" }
Expect.isEmpty mt.smallGroups "There should be no small groups for an empty church"
}
] ]
[<Tests>] [<Tests>]
let emailFormatTests = let emailFormatTests =
testList "EmailFormat" [ testList "EmailFormat" [
test "HtmlFormat code is correct" { test "HtmlFormat code is correct" {
Expect.equal HtmlFormat.code "H" "The code for HtmlFormat should have been \"H\"" Expect.equal (EmailFormat.toCode HtmlFormat) "H" "The code for HtmlFormat should have been \"H\""
} }
test "PlainTextFormat code is correct" { test "PlainTextFormat code is correct" {
Expect.equal PlainTextFormat.code "P" "The code for PlainTextFormat should have been \"P\"" Expect.equal (EmailFormat.toCode PlainTextFormat) "P" "The code for PlainTextFormat should have been \"P\""
} }
test "fromCode H should return HtmlFormat" { test "fromCode H should return HtmlFormat" {
Expect.equal (EmailFormat.fromCode "H") HtmlFormat "\"H\" should have been converted to HtmlFormat" Expect.equal (EmailFormat.fromCode "H") HtmlFormat "\"H\" should have been converted to HtmlFormat"
} }
test "fromCode P should return ShortDate" { test "fromCode P should return ShortDate" {
Expect.equal (EmailFormat.fromCode "P") PlainTextFormat "\"P\" should have been converted to PlainTextFormat" Expect.equal (EmailFormat.fromCode "P") PlainTextFormat
} "\"P\" should have been converted to PlainTextFormat"
test "fromCode Z should raise" { }
Expect.throws (fun () -> EmailFormat.fromCode "Z" |> ignore) "An unknown code should have raised an exception" test "fromCode Z should raise" {
} Expect.throws (fun () -> EmailFormat.fromCode "Z" |> ignore)
"An unknown code should have raised an exception"
}
] ]
[<Tests>] [<Tests>]
let expirationTests = let expirationTests =
testList "Expiration" [ testList "Expiration" [
test "Automatic code is correct" { test "Automatic code is correct" {
Expect.equal Automatic.code "A" "The code for Automatic should have been \"A\"" Expect.equal (Expiration.toCode Automatic) "A" "The code for Automatic should have been \"A\""
} }
test "Manual code is correct" { test "Manual code is correct" {
Expect.equal Manual.code "M" "The code for Manual should have been \"M\"" Expect.equal (Expiration.toCode Manual) "M" "The code for Manual should have been \"M\""
} }
test "Forced code is correct" { test "Forced code is correct" {
Expect.equal Forced.code "F" "The code for Forced should have been \"F\"" Expect.equal (Expiration.toCode Forced) "F" "The code for Forced should have been \"F\""
} }
test "fromCode A should return Automatic" { test "fromCode A should return Automatic" {
Expect.equal (Expiration.fromCode "A") Automatic "\"A\" should have been converted to Automatic" Expect.equal (Expiration.fromCode "A") Automatic "\"A\" should have been converted to Automatic"
} }
test "fromCode M should return Manual" { test "fromCode M should return Manual" {
Expect.equal (Expiration.fromCode "M") Manual "\"M\" should have been converted to Manual" Expect.equal (Expiration.fromCode "M") Manual "\"M\" should have been converted to Manual"
} }
test "fromCode F should return Forced" { test "fromCode F should return Forced" {
Expect.equal (Expiration.fromCode "F") Forced "\"F\" should have been converted to Forced" Expect.equal (Expiration.fromCode "F") Forced "\"F\" should have been converted to Forced"
} }
test "fromCode V should raise" { test "fromCode V should raise" {
Expect.throws (fun () -> Expiration.fromCode "V" |> ignore) "An unknown code should have raised an exception" Expect.throws (fun () -> Expiration.fromCode "V" |> ignore)
} "An unknown code should have raised an exception"
}
] ]
[<Tests>] [<Tests>]
let listPreferencesTests = let listPreferencesTests =
testList "ListPreferences" [ testList "ListPreferences" [
test "empty is as expected" { test "FontStack is correct for native fonts" {
let mt = ListPreferences.empty Expect.equal ListPreferences.empty.FontStack
Expect.equal mt.smallGroupId Guid.Empty "The small group ID should have been an empty GUID" """system-ui,-apple-system,"Segoe UI",Roboto,Ubuntu,"Liberation Sans",Cantarell,"Helvetica Neue",sans-serif"""
Expect.equal mt.daysToExpire 14 "The default days to expire should have been 14" "The expected native font stack was incorrect"
Expect.equal mt.daysToKeepNew 7 "The default days to keep new should have been 7" }
Expect.equal mt.longTermUpdateWeeks 4 "The default long term update weeks should have been 4" test "FontStack is correct for specific fonts" {
Expect.equal mt.emailFromName "PrayerTracker" "The default e-mail from name should have been PrayerTracker" Expect.equal { ListPreferences.empty with Fonts = "Arial,sans-serif" }.FontStack "Arial,sans-serif"
Expect.equal mt.emailFromAddress "prayer@djs-consulting.com" "The specified fonts were not returned correctly"
"The default e-mail from address should have been prayer@djs-consulting.com" }
Expect.equal mt.listFonts "Century Gothic,Tahoma,Luxi Sans,sans-serif" "The default list fonts were incorrect" test "empty is as expected" {
Expect.equal mt.headingColor "maroon" "The default heading text color should have been maroon" let mt = ListPreferences.empty
Expect.equal mt.lineColor "navy" "The default heding line color should have been navy" Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID"
Expect.equal mt.headingFontSize 16 "The default heading font size should have been 16" Expect.equal mt.DaysToExpire 14 "The default days to expire should have been 14"
Expect.equal mt.textFontSize 12 "The default text font size should have been 12" Expect.equal mt.DaysToKeepNew 7 "The default days to keep new should have been 7"
Expect.equal mt.requestSort SortByDate "The default request sort should have been by date" Expect.equal mt.LongTermUpdateWeeks 4 "The default long term update weeks should have been 4"
Expect.equal mt.groupPassword "" "The default group password should have been blank" Expect.equal mt.EmailFromName "PrayerTracker" "The default e-mail from name should have been PrayerTracker"
Expect.equal mt.defaultEmailType HtmlFormat "The default e-mail type should have been HTML" Expect.equal mt.EmailFromAddress "prayer@bitbadger.solutions"
Expect.isFalse mt.isPublic "The isPublic flag should not have been set" "The default e-mail from address should have been prayer@bitbadger.solutions"
Expect.equal mt.timeZoneId "America/Denver" "The default time zone should have been America/Denver" Expect.equal mt.Fonts "native" "The default list fonts were incorrect"
Expect.equal mt.timeZone.timeZoneId "" "The default preferences should have included an empty time zone" Expect.equal mt.HeadingColor "maroon" "The default heading text color should have been maroon"
Expect.equal mt.pageSize 100 "The default page size should have been 100" Expect.equal mt.LineColor "navy" "The default heading line color should have been navy"
Expect.equal mt.asOfDateDisplay NoDisplay "The as-of date display should have been No Display" Expect.equal mt.HeadingFontSize 16 "The default heading font size should have been 16"
} Expect.equal mt.TextFontSize 12 "The default text font size should have been 12"
Expect.equal mt.RequestSort SortByDate "The default request sort should have been by date"
Expect.equal mt.GroupPassword "" "The default group password should have been blank"
Expect.equal mt.DefaultEmailType HtmlFormat "The default e-mail type should have been HTML"
Expect.isFalse mt.IsPublic "The isPublic flag should not have been set"
Expect.equal (TimeZoneId.toString mt.TimeZoneId) "America/Denver"
"The default time zone should have been America/Denver"
Expect.equal mt.PageSize 100 "The default page size should have been 100"
Expect.equal mt.AsOfDateDisplay NoDisplay "The as-of date display should have been No Display"
}
] ]
[<Tests>] [<Tests>]
let memberTests = let memberTests =
testList "Member" [ testList "Member" [
test "empty is as expected" { test "empty is as expected" {
let mt = Member.empty let mt = Member.empty
Expect.equal mt.memberId Guid.Empty "The member ID should have been an empty GUID" Expect.equal mt.Id.Value Guid.Empty "The member ID should have been an empty GUID"
Expect.equal mt.smallGroupId Guid.Empty "The small group ID should have been an empty GUID" Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID"
Expect.equal mt.memberName "" "The member name should have been blank" Expect.equal mt.Name "" "The member name should have been blank"
Expect.equal mt.email "" "The member e-mail address should have been blank" Expect.equal mt.Email "" "The member e-mail address should have been blank"
Expect.isNone mt.format "The preferred e-mail format should not exist" Expect.isNone mt.Format "The preferred e-mail format should not exist"
Expect.equal mt.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one" }
}
] ]
[<Tests>] [<Tests>]
let prayerRequestTests = let prayerRequestTests =
testList "PrayerRequest" [ let instantNow = SystemClock.Instance.GetCurrentInstant
test "empty is as expected" { let localDateNow () = (instantNow ()).InUtc().Date
let mt = PrayerRequest.empty testList "PrayerRequest" [
Expect.equal mt.prayerRequestId Guid.Empty "The request ID should have been an empty GUID" test "empty is as expected" {
Expect.equal mt.requestType CurrentRequest "The request type should have been Current" let mt = PrayerRequest.empty
Expect.equal mt.userId Guid.Empty "The user ID should have been an empty GUID" Expect.equal mt.Id.Value Guid.Empty "The request ID should have been an empty GUID"
Expect.equal mt.smallGroupId Guid.Empty "The small group ID should have been an empty GUID" Expect.equal mt.RequestType CurrentRequest "The request type should have been Current"
Expect.equal mt.enteredDate DateTime.MinValue "The entered date should have been the minimum" Expect.equal mt.UserId.Value Guid.Empty "The user ID should have been an empty GUID"
Expect.equal mt.updatedDate DateTime.MinValue "The updated date should have been the minimum" Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID"
Expect.isNone mt.requestor "The requestor should not exist" Expect.equal mt.EnteredDate Instant.MinValue "The entered date should have been the minimum"
Expect.equal mt.text "" "The request text should have been blank" Expect.equal mt.UpdatedDate Instant.MinValue "The updated date should have been the minimum"
Expect.isFalse mt.notifyChaplain "The notify chaplain flag should not have been set" Expect.isNone mt.Requestor "The requestor should not exist"
Expect.equal mt.expiration Automatic "The expiration should have been Automatic" Expect.equal mt.Text "" "The request text should have been blank"
Expect.equal mt.user.userId Guid.Empty "The user should have been an empty one" Expect.isFalse mt.NotifyChaplain "The notify chaplain flag should not have been set"
Expect.equal mt.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one" Expect.equal mt.Expiration Automatic "The expiration should have been Automatic"
} }
test "isExpired always returns false for expecting requests" { test "isExpired always returns false for expecting requests" {
let req = { PrayerRequest.empty with requestType = Expecting } PrayerRequest.isExpired (localDateNow ()) SmallGroup.empty
Expect.isFalse (req.isExpired DateTime.Now 0) "An expecting request should never be considered expired" { PrayerRequest.empty with RequestType = Expecting }
} |> Flip.Expect.isFalse "An expecting request should never be considered expired"
test "isExpired always returns false for manually-expired requests" { }
let req = { PrayerRequest.empty with updatedDate = DateTime.Now.AddMonths -1; expiration = Manual } test "isExpired always returns false for manually-expired requests" {
Expect.isFalse (req.isExpired DateTime.Now 4) "A never-expired request should never be considered expired" PrayerRequest.isExpired (localDateNow ()) SmallGroup.empty
} { PrayerRequest.empty with UpdatedDate = (instantNow ()) - Duration.FromDays 1; Expiration = Manual }
test "isExpired always returns false for long term/recurring requests" { |> Flip.Expect.isFalse "A never-expired request should never be considered expired"
let req = { PrayerRequest.empty with requestType = LongTermRequest } }
Expect.isFalse (req.isExpired DateTime.Now 0) "A recurring/long-term request should never be considered expired" test "isExpired always returns false for long term/recurring requests" {
} PrayerRequest.isExpired (localDateNow ()) SmallGroup.empty
test "isExpired always returns true for force-expired requests" { { PrayerRequest.empty with RequestType = LongTermRequest }
let req = { PrayerRequest.empty with updatedDate = DateTime.Now; expiration = Forced } |> Flip.Expect.isFalse "A recurring/long-term request should never be considered expired"
Expect.isTrue (req.isExpired DateTime.Now 5) "A force-expired request should always be considered expired" }
} test "isExpired always returns true for force-expired requests" {
test "isExpired returns false for non-expired requests" { PrayerRequest.isExpired (localDateNow ()) SmallGroup.empty
let now = DateTime.Now { PrayerRequest.empty with UpdatedDate = (instantNow ()); Expiration = Forced }
let req = { PrayerRequest.empty with updatedDate = now.AddDays -5. } |> Flip.Expect.isTrue "A force-expired request should always be considered expired"
Expect.isFalse (req.isExpired now 7) "A request updated 5 days ago should not be considered expired" }
} test "isExpired returns false for non-expired requests" {
test "isExpired returns true for expired requests" { let now = instantNow ()
let now = DateTime.Now PrayerRequest.isExpired (now.InUtc().Date) SmallGroup.empty
let req = { PrayerRequest.empty with updatedDate = now.AddDays -8. } { PrayerRequest.empty with UpdatedDate = now - Duration.FromDays 5 }
Expect.isTrue (req.isExpired now 7) "A request updated 8 days ago should be considered expired" |> Flip.Expect.isFalse "A request updated 5 days ago should not be considered expired"
} }
test "isExpired returns true for same-day expired requests" { test "isExpired returns true for expired requests" {
let now = DateTime.Now let now = instantNow ()
let req = { PrayerRequest.empty with updatedDate = now.Date.AddDays(-7.).AddSeconds -1. } PrayerRequest.isExpired (now.InUtc().Date) SmallGroup.empty
Expect.isTrue (req.isExpired now 7) "A request entered a second before midnight should be considered expired" { PrayerRequest.empty with UpdatedDate = now - Duration.FromDays 15 }
} |> Flip.Expect.isTrue "A request updated 15 days ago should be considered expired"
test "updateRequired returns false for expired requests" { }
let req = { PrayerRequest.empty with expiration = Forced } test "isExpired returns true for same-day expired requests" {
Expect.isFalse (req.updateRequired DateTime.Now 7 4) "An expired request should not require an update" let now = instantNow ()
} PrayerRequest.isExpired (now.InUtc().Date) SmallGroup.empty
test "updateRequired returns false when an update is not required for an active request" { { PrayerRequest.empty with UpdatedDate = now - (Duration.FromDays 14) - (Duration.FromSeconds 1L) }
let now = DateTime.Now |> Flip.Expect.isTrue "A request entered a second before midnight should be considered expired"
let req = }
{ PrayerRequest.empty with test "updateRequired returns false for expired requests" {
requestType = LongTermRequest PrayerRequest.updateRequired (localDateNow ()) SmallGroup.empty
updatedDate = now.AddDays -14. { PrayerRequest.empty with Expiration = Forced }
} |> Flip.Expect.isFalse "An expired request should not require an update"
Expect.isFalse (req.updateRequired now 7 4) }
"An active request updated 14 days ago should not require an update until 28 days" test "updateRequired returns false when an update is not required for an active request" {
} let now = instantNow ()
test "updateRequired returns true when an update is required for an active request" { PrayerRequest.updateRequired (localDateNow ()) SmallGroup.empty
let now = DateTime.Now { PrayerRequest.empty with RequestType = LongTermRequest; UpdatedDate = now - Duration.FromDays 14 }
let req = |> Flip.Expect.isFalse "An active request updated 14 days ago should not require an update until 28 days"
{ PrayerRequest.empty with }
requestType = LongTermRequest test "UpdateRequired returns true when an update is required for an active request" {
updatedDate = now.AddDays -34. let now = instantNow ()
} PrayerRequest.updateRequired (localDateNow ()) SmallGroup.empty
Expect.isTrue (req.updateRequired now 7 4) { PrayerRequest.empty with RequestType = LongTermRequest; UpdatedDate = now - Duration.FromDays 34 }
"An active request updated 34 days ago should require an update (past 28 days)" |> Flip.Expect.isTrue "An active request updated 34 days ago should require an update (past 28 days)"
} }
] ]
[<Tests>] [<Tests>]
let prayerRequestTypeTests = let prayerRequestTypeTests =
testList "PrayerRequestType" [ testList "PrayerRequestType" [
test "CurrentRequest code is correct" { test "CurrentRequest code is correct" {
Expect.equal CurrentRequest.code "C" "The code for CurrentRequest should have been \"C\"" Expect.equal (PrayerRequestType.toCode CurrentRequest) "C"
} "The code for CurrentRequest should have been \"C\""
test "LongTermRequest code is correct" { }
Expect.equal LongTermRequest.code "L" "The code for LongTermRequest should have been \"L\"" test "LongTermRequest code is correct" {
} Expect.equal (PrayerRequestType.toCode LongTermRequest) "L"
test "PraiseReport code is correct" { "The code for LongTermRequest should have been \"L\""
Expect.equal PraiseReport.code "P" "The code for PraiseReport should have been \"P\"" }
} test "PraiseReport code is correct" {
test "Expecting code is correct" { Expect.equal (PrayerRequestType.toCode PraiseReport) "P" "The code for PraiseReport should have been \"P\""
Expect.equal Expecting.code "E" "The code for Expecting should have been \"E\"" }
} test "Expecting code is correct" {
test "Announcement code is correct" { Expect.equal (PrayerRequestType.toCode Expecting) "E" "The code for Expecting should have been \"E\""
Expect.equal Announcement.code "A" "The code for Announcement should have been \"A\"" }
} test "Announcement code is correct" {
test "fromCode C should return CurrentRequest" { Expect.equal (PrayerRequestType.toCode Announcement) "A" "The code for Announcement should have been \"A\""
Expect.equal (PrayerRequestType.fromCode "C") CurrentRequest }
"\"C\" should have been converted to CurrentRequest" test "fromCode C should return CurrentRequest" {
} Expect.equal (PrayerRequestType.fromCode "C") CurrentRequest
test "fromCode L should return LongTermRequest" { "\"C\" should have been converted to CurrentRequest"
Expect.equal (PrayerRequestType.fromCode "L") LongTermRequest }
"\"L\" should have been converted to LongTermRequest" test "fromCode L should return LongTermRequest" {
} Expect.equal (PrayerRequestType.fromCode "L") LongTermRequest
test "fromCode P should return PraiseReport" { "\"L\" should have been converted to LongTermRequest"
Expect.equal (PrayerRequestType.fromCode "P") PraiseReport "\"P\" should have been converted to PraiseReport" }
} test "fromCode P should return PraiseReport" {
test "fromCode E should return Expecting" { Expect.equal (PrayerRequestType.fromCode "P") PraiseReport
Expect.equal (PrayerRequestType.fromCode "E") Expecting "\"E\" should have been converted to Expecting" "\"P\" should have been converted to PraiseReport"
} }
test "fromCode A should return Announcement" { test "fromCode E should return Expecting" {
Expect.equal (PrayerRequestType.fromCode "A") Announcement "\"A\" should have been converted to Announcement" Expect.equal (PrayerRequestType.fromCode "E") Expecting "\"E\" should have been converted to Expecting"
} }
test "fromCode R should raise" { test "fromCode A should return Announcement" {
Expect.throws (fun () -> PrayerRequestType.fromCode "R" |> ignore) Expect.equal (PrayerRequestType.fromCode "A") Announcement
"An unknown code should have raised an exception" "\"A\" should have been converted to Announcement"
} }
test "fromCode R should raise" {
Expect.throws (fun () -> PrayerRequestType.fromCode "R" |> ignore)
"An unknown code should have raised an exception"
}
] ]
[<Tests>] [<Tests>]
let requestSortTests = let requestSortTests =
testList "RequestSort" [ testList "RequestSort" [
test "SortByDate code is correct" { test "SortByDate code is correct" {
Expect.equal SortByDate.code "D" "The code for SortByDate should have been \"D\"" Expect.equal (RequestSort.toCode SortByDate) "D" "The code for SortByDate should have been \"D\""
} }
test "SortByRequestor code is correct" { test "SortByRequestor code is correct" {
Expect.equal SortByRequestor.code "R" "The code for SortByRequestor should have been \"R\"" Expect.equal (RequestSort.toCode SortByRequestor) "R" "The code for SortByRequestor should have been \"R\""
} }
test "fromCode D should return SortByDate" { test "fromCode D should return SortByDate" {
Expect.equal (RequestSort.fromCode "D") SortByDate "\"D\" should have been converted to SortByDate" Expect.equal (RequestSort.fromCode "D") SortByDate "\"D\" should have been converted to SortByDate"
} }
test "fromCode R should return SortByRequestor" { test "fromCode R should return SortByRequestor" {
Expect.equal (RequestSort.fromCode "R") SortByRequestor "\"R\" should have been converted to SortByRequestor" Expect.equal (RequestSort.fromCode "R") SortByRequestor
} "\"R\" should have been converted to SortByRequestor"
test "fromCode Q should raise" { }
Expect.throws (fun () -> RequestSort.fromCode "Q" |> ignore) "An unknown code should have raised an exception" test "fromCode Q should raise" {
} Expect.throws (fun () -> RequestSort.fromCode "Q" |> ignore)
"An unknown code should have raised an exception"
}
] ]
[<Tests>] [<Tests>]
let smallGroupTests = let smallGroupTests =
testList "SmallGroup" [ testList "SmallGroup" [
let now = DateTime (2017, 5, 12, 12, 15, 0, DateTimeKind.Utc) let now = Instant.FromDateTimeUtc (DateTime (2017, 5, 12, 12, 15, 0, DateTimeKind.Utc))
let withFakeClock f () = let withFakeClock f () =
FakeClock (Instant.FromDateTimeUtc now) |> f FakeClock now |> f
yield test "empty is as expected" { yield test "empty is as expected" {
let mt = SmallGroup.empty let mt = SmallGroup.empty
Expect.equal mt.smallGroupId Guid.Empty "The small group ID should have been an empty GUID" Expect.equal mt.Id.Value Guid.Empty "The small group ID should have been an empty GUID"
Expect.equal mt.churchId Guid.Empty "The church ID should have been an empty GUID" Expect.equal mt.ChurchId.Value Guid.Empty "The church ID should have been an empty GUID"
Expect.equal mt.name "" "The name should have been blank" Expect.equal mt.Name "" "The name should have been blank"
Expect.equal mt.church.churchId Guid.Empty "The church should have been an empty one" }
Expect.isNotNull mt.members "The members navigation property should not be null" yield! testFixture withFakeClock [
Expect.isEmpty mt.members "There should be no members for an empty small group" "LocalTimeNow adjusts the time ahead of UTC",
Expect.isNotNull mt.prayerRequests "The prayer requests navigation property should not be null" fun clock ->
Expect.isEmpty mt.prayerRequests "There should be no prayer requests for an empty small group" let grp =
Expect.isNotNull mt.users "The users navigation property should not be null" { SmallGroup.empty with
Expect.isEmpty mt.users "There should be no users for an empty small group" Preferences = { ListPreferences.empty with TimeZoneId = TimeZoneId "Europe/Berlin" }
} }
yield! testFixture withFakeClock [ Expect.isGreaterThan (SmallGroup.localTimeNow clock grp) (now.InUtc().LocalDateTime)
"localTimeNow adjusts the time ahead of UTC", "UTC to Europe/Berlin should have added hours"
fun clock -> "LocalTimeNow adjusts the time behind UTC",
let grp = { SmallGroup.empty with preferences = { ListPreferences.empty with timeZoneId = "Europe/Berlin" } } fun clock ->
Expect.isGreaterThan (grp.localTimeNow clock) now "UTC to Europe/Berlin should have added hours" Expect.isLessThan (SmallGroup.localTimeNow clock SmallGroup.empty) (now.InUtc().LocalDateTime)
"localTimeNow adjusts the time behind UTC", "UTC to America/Denver should have subtracted hours"
fun clock -> "LocalTimeNow returns UTC when the time zone is invalid",
Expect.isLessThan (SmallGroup.empty.localTimeNow clock) now fun clock ->
"UTC to America/Denver should have subtracted hours" let grp =
"localTimeNow returns UTC when the time zone is invalid", { SmallGroup.empty with
fun clock -> Preferences = { ListPreferences.empty with TimeZoneId = TimeZoneId "garbage" }
let grp = { SmallGroup.empty with preferences = { ListPreferences.empty with timeZoneId = "garbage" } } }
Expect.equal (grp.localTimeNow clock) now "UTC should have been returned for an invalid time zone" Expect.equal (SmallGroup.localTimeNow clock grp) (now.InUtc().LocalDateTime)
] "UTC should have been returned for an invalid time zone"
yield test "localTimeNow fails when clock is not passed" { ]
Expect.throws (fun () -> (SmallGroup.empty.localTimeNow >> ignore) null) yield test "localTimeNow fails when clock is not passed" {
"Should have raised an exception for null clock" Expect.throws (fun () -> (SmallGroup.localTimeNow null SmallGroup.empty |> ignore))
} "Should have raised an exception for null clock"
yield test "localDateNow returns the date portion" { }
let now' = DateTime (2017, 5, 12, 1, 15, 0, DateTimeKind.Utc) yield test "LocalDateNow returns the date portion" {
let clock = FakeClock (Instant.FromDateTimeUtc now') let clock = FakeClock (Instant.FromDateTimeUtc (DateTime (2017, 5, 12, 1, 15, 0, DateTimeKind.Utc)))
Expect.isLessThan (SmallGroup.empty.localDateNow clock) now.Date "The date should have been a day earlier" Expect.isLessThan (SmallGroup.localDateNow clock SmallGroup.empty) (now.InUtc().Date)
} "The date should have been a day earlier"
] }
[<Tests>]
let timeZoneTests =
testList "TimeZone" [
test "empty is as expected" {
let mt = TimeZone.empty
Expect.equal mt.timeZoneId "" "The time zone ID should have been blank"
Expect.equal mt.description "" "The description should have been blank"
Expect.equal mt.sortOrder 0 "The sort order should have been zero"
Expect.isFalse mt.isActive "The is-active flag should not have been set"
}
] ]
[<Tests>] [<Tests>]
let userTests = let userTests =
testList "User" [ testList "User" [
test "empty is as expected" { test "empty is as expected" {
let mt = User.empty let mt = User.empty
Expect.equal mt.userId Guid.Empty "The user ID should have been an empty GUID" Expect.equal mt.Id.Value Guid.Empty "The user ID should have been an empty GUID"
Expect.equal mt.firstName "" "The first name should have been blank" Expect.equal mt.FirstName "" "The first name should have been blank"
Expect.equal mt.lastName "" "The last name should have been blank" Expect.equal mt.LastName "" "The last name should have been blank"
Expect.equal mt.emailAddress "" "The e-mail address should have been blank" Expect.equal mt.Email "" "The e-mail address should have been blank"
Expect.isFalse mt.isAdmin "The is admin flag should not have been set" Expect.isFalse mt.IsAdmin "The is admin flag should not have been set"
Expect.equal mt.passwordHash "" "The password hash should have been blank" Expect.equal mt.PasswordHash "" "The password hash should have been blank"
Expect.isNone mt.salt "The password salt should not exist" }
Expect.isNotNull mt.smallGroups "The small groups navigation property should not have been null" test "Name concatenates first and last names" {
Expect.isEmpty mt.smallGroups "There should be no small groups for an empty user" let user = { User.empty with FirstName = "Unit"; LastName = "Test" }
} Expect.equal user.Name "Unit Test" "The full name should be the first and last, separated by a space"
test "fullName concatenates first and last names" { }
let user = { User.empty with firstName = "Unit"; lastName = "Test" }
Expect.equal user.fullName "Unit Test" "The full name should be the first and last, separated by a space"
}
] ]
[<Tests>] [<Tests>]
let userSmallGroupTests = let userSmallGroupTests =
testList "UserSmallGroup" [ testList "UserSmallGroup" [
test "empty is as expected" { test "empty is as expected" {
let mt = UserSmallGroup.empty let mt = UserSmallGroup.empty
Expect.equal mt.userId Guid.Empty "The user ID should have been an empty GUID" Expect.equal mt.UserId.Value Guid.Empty "The user ID should have been an empty GUID"
Expect.equal mt.smallGroupId Guid.Empty "The small group ID should have been an empty GUID" Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID"
Expect.equal mt.user.userId Guid.Empty "The user should have been an empty one" }
Expect.equal mt.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one"
}
] ]

4
src/PrayerTracker.Tests/PrayerTracker.Tests.fsproj
View File

@ -16,8 +16,8 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="Expecto" Version="9.0.4" /> <PackageReference Include="Expecto" Version="9.0.4" />
<PackageReference Include="Expecto.VisualStudio.TestAdapter" Version="10.0.2" /> <PackageReference Include="NodaTime.Testing" Version="3.1.2" />
<PackageReference Include="NodaTime.Testing" Version="3.0.5" /> <PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

2
src/PrayerTracker.Tests/Program.fs
View File

@ -2,4 +2,4 @@
[<EntryPoint>] [<EntryPoint>]
let main argv = let main argv =
runTestsInAssembly defaultConfig argv runTestsInAssembly defaultConfig argv

307
src/PrayerTracker.Tests/UI/CommonFunctionsTests.fs
View File

@ -1,208 +1,215 @@
module PrayerTracker.UI.CommonFunctionsTests module PrayerTracker.UI.CommonFunctionsTests
open System.IO
open Expecto open Expecto
open Giraffe.ViewEngine 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
open PrayerTracker.Views open PrayerTracker.Views
open System.IO
[<Tests>] [<Tests>]
let iconSizedTests = let iconSizedTests =
testList "iconSized" [ testList "iconSized" [
test "succeeds" { test "succeeds" {
let ico = iconSized 18 "tom-&-jerry" |> renderHtmlNode let ico = iconSized 18 "tom-&-jerry" |> renderHtmlNode
Expect.equal ico "<i class=\"material-icons md-18\">tom-&-jerry</i>" "icon HTML not correct" Expect.equal ico """<i class="material-icons md-18">tom-&-jerry</i>""" "icon HTML not correct"
} }
] ]
[<Tests>] [<Tests>]
let iconTests = let iconTests =
testList "icon" [ testList "icon" [
test "succeeds" { test "succeeds" {
let ico = icon "bob-&-tom" |> renderHtmlNode let ico = icon "bob-&-tom" |> renderHtmlNode
Expect.equal ico "<i class=\"material-icons\">bob-&-tom</i>" "icon HTML not correct" Expect.equal ico """<i class="material-icons">bob-&-tom</i>""" "icon HTML not correct"
} }
] ]
[<Tests>] [<Tests>]
let locStrTests = let locStrTests =
testList "locStr" [ testList "locStr" [
test "succeeds" { test "succeeds" {
let enc = locStr (LocalizedString ("test", "test&")) |> renderHtmlNode let enc = locStr (LocalizedString ("test", "test&")) |> renderHtmlNode
Expect.equal enc "test&amp;" "string not encoded correctly" Expect.equal enc "test&amp;" "string not encoded correctly"
} }
] ]
[<Tests>] [<Tests>]
let namedColorListTests = let namedColorListTests =
testList "namedColorList" [ testList "namedColorList" [
test "succeeds with default values" { test "succeeds with default values" {
let expected = let expected =
[ "<select name=\"the-name\">" [ """<select name="the-name">"""
"<option value=\"aqua\" style=\"background-color:aqua;color:black;\">aqua</option>" """<option value="aqua" style="background-color:aqua;color:black;">aqua</option>"""
"<option value=\"black\" style=\"background-color:black;color:white;\">black</option>" """<option value="black" style="background-color:black;color:white;">black</option>"""
"<option value=\"blue\" style=\"background-color:blue;color:white;\">blue</option>" """<option value="blue" style="background-color:blue;color:white;">blue</option>"""
"<option value=\"fuchsia\" style=\"background-color:fuchsia;color:black;\">fuchsia</option>" """<option value="fuchsia" style="background-color:fuchsia;color:black;">fuchsia</option>"""
"<option value=\"gray\" style=\"background-color:gray;color:white;\">gray</option>" """<option value="gray" style="background-color:gray;color:white;">gray</option>"""
"<option value=\"green\" style=\"background-color:green;color:white;\">green</option>" """<option value="green" style="background-color:green;color:white;">green</option>"""
"<option value=\"lime\" style=\"background-color:lime;color:black;\">lime</option>" """<option value="lime" style="background-color:lime;color:black;">lime</option>"""
"<option value=\"maroon\" style=\"background-color:maroon;color:white;\">maroon</option>" """<option value="maroon" style="background-color:maroon;color:white;">maroon</option>"""
"<option value=\"navy\" style=\"background-color:navy;color:white;\">navy</option>" """<option value="navy" style="background-color:navy;color:white;">navy</option>"""
"<option value=\"olive\" style=\"background-color:olive;color:white;\">olive</option>" """<option value="olive" style="background-color:olive;color:white;">olive</option>"""
"<option value=\"purple\" style=\"background-color:purple;color:white;\">purple</option>" """<option value="purple" style="background-color:purple;color:white;">purple</option>"""
"<option value=\"red\" style=\"background-color:red;color:black;\">red</option>" """<option value="red" style="background-color:red;color:black;">red</option>"""
"<option value=\"silver\" style=\"background-color:silver;color:black;\">silver</option>" """<option value="silver" style="background-color:silver;color:black;">silver</option>"""
"<option value=\"teal\" style=\"background-color:teal;color:white;\">teal</option>" """<option value="teal" style="background-color:teal;color:white;">teal</option>"""
"<option value=\"white\" style=\"background-color:white;color:black;\">white</option>" """<option value="white" style="background-color:white;color:black;">white</option>"""
"<option value=\"yellow\" style=\"background-color:yellow;color:black;\">yellow</option>" """<option value="yellow" style="background-color:yellow;color:black;">yellow</option>"""
"</select>" "</select>"
] ]
|> String.concat "" |> String.concat ""
let selectList = namedColorList "the-name" "" [] _s |> renderHtmlNode let selectList = namedColorList "the-name" "" [] _s |> renderHtmlNode
Expect.equal expected selectList "The default select list was not generated correctly" Expect.equal expected selectList "The default select list was not generated correctly"
} }
test "succeeds with a selected value" { test "succeeds with a selected value" {
let selectList = namedColorList "the-name" "white" [] _s |> renderHtmlNode let selectList = namedColorList "the-name" "white" [] _s |> renderHtmlNode
Expect.stringContains selectList " selected>white</option>" "Selected option not generated correctly" Expect.stringContains selectList " selected>white</option>" "Selected option not generated correctly"
} }
test "succeeds with extra attributes" { test "succeeds with extra attributes" {
let selectList = namedColorList "the-name" "" [ _id "myId" ] _s |> renderHtmlNode let selectList = namedColorList "the-name" "" [ _id "myId" ] _s |> renderHtmlNode
Expect.stringStarts selectList "<select name=\"the-name\" id=\"myId\">" "Attributes not included correctly" Expect.stringStarts selectList """<select name="the-name" id="myId">""" "Attributes not included correctly"
} }
] ]
[<Tests>] [<Tests>]
let radioTests = let radioTests =
testList "radio" [ testList "radio" [
test "succeeds when not selected" { test "succeeds when not selected" {
let rad = radio "a-name" "anId" "test" "unit" |> renderHtmlNode let rad = radio "a-name" "anId" "test" "unit" |> renderHtmlNode
Expect.equal rad "<input type=\"radio\" name=\"a-name\" id=\"anId\" value=\"test\">" Expect.equal rad """<input type="radio" name="a-name" id="anId" value="test">"""
"Unselected radio button not generated correctly" "Unselected radio button not generated correctly"
} }
test "succeeds when selected" { test "succeeds when selected" {
let rad = radio "a-name" "anId" "unit" "unit" |> renderHtmlNode let rad = radio "a-name" "anId" "unit" "unit" |> renderHtmlNode
Expect.equal rad "<input type=\"radio\" name=\"a-name\" id=\"anId\" value=\"unit\" checked>" Expect.equal rad """<input type="radio" name="a-name" id="anId" value="unit" checked>"""
"Selected radio button not generated correctly" "Selected radio button not generated correctly"
} }
] ]
[<Tests>] [<Tests>]
let rawLocTextTests = let rawLocTextTests =
testList "rawLocText" [ testList "rawLocText" [
test "succeeds" { test "succeeds" {
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw (LocalizedHtmlString ("test", "test&")) |> renderHtmlNode let raw = rawLocText sw (LocalizedHtmlString ("test", "test&")) |> renderHtmlNode
Expect.equal raw "test&" "string not written correctly" Expect.equal raw "test&" "string not written correctly"
} }
] ]
[<Tests>] [<Tests>]
let selectDefaultTests = let selectDefaultTests =
testList "selectDefault" [ testList "selectDefault" [
test "succeeds" { test "succeeds" {
Expect.equal (selectDefault "a&b") "— a&b —" "Default selection not generated correctly" Expect.equal (selectDefault "a&b") "— a&b —" "Default selection not generated correctly"
} }
] ]
[<Tests>] [<Tests>]
let selectListTests = let selectListTests =
testList "selectList" [ testList "selectList" [
test "succeeds with minimum options" { test "succeeds with minimum options" {
let theList = selectList "a-list" "" [] [] |> renderHtmlNode let theList = selectList "a-list" "" [] [] |> renderHtmlNode
Expect.equal theList "<select name=\"a-list\" id=\"a-list\"></select>" "Empty select list not generated correctly" Expect.equal theList """<select name="a-list" id="a-list"></select>"""
} "Empty select list not generated correctly"
test "succeeds with all options" { }
let theList = test "succeeds with all options" {
[ "tom", "Tom&" let theList =
"bob", "Bob" [ "tom", "Tom&"
"jan", "Jan" "bob", "Bob"
] "jan", "Jan"
|> selectList "the-list" "bob" [ _style "ugly" ] ]
|> renderHtmlNode |> selectList "the-list" "bob" [ _style "ugly" ]
let expected = |> renderHtmlNode
[ "<select name=\"the-list\" id=\"the-list\" style=\"ugly\">" let expected =
"<option value=\"tom\">Tom&amp;</option>" [ """<select name="the-list" id="the-list" style="ugly">"""
"<option value=\"bob\" selected>Bob</option>" """<option value="tom">Tom&amp;</option>"""
"<option value=\"jan\">Jan</option>" """<option value="bob" selected>Bob</option>"""
"</select>" """<option value="jan">Jan</option>"""
] """</select>"""
|> String.concat "" ]
Expect.equal theList expected "Filled select list not generated correctly" |> String.concat ""
} Expect.equal theList expected "Filled select list not generated correctly"
}
] ]
[<Tests>] [<Tests>]
let spaceTests = let spaceTests =
testList "space" [ testList "space" [
test "succeeds" { test "succeeds" {
Expect.equal (renderHtmlNode space) " " "space literal not correct" Expect.equal (renderHtmlNode space) " " "space literal not correct"
} }
] ]
[<Tests>] [<Tests>]
let submitTests = let submitTests =
testList "submit" [ testList "submit" [
test "succeeds" { test "succeeds" {
let btn = submit [ _class "slick" ] "file-ico" _s.["a&b"] |> renderHtmlNode let btn = submit [ _class "slick" ] "file-ico" _s["a&b"] |> renderHtmlNode
Expect.equal Expect.equal
btn btn
"<button type=\"submit\" class=\"slick\"><i class=\"material-icons\">file-ico</i> &nbsp;a&amp;b</button>" """<button type="submit" class="slick"><i class="material-icons">file-ico</i> &nbsp;a&amp;b</button>"""
"Submit button not generated correctly" "Submit button not generated correctly"
} }
] ]
[<Tests>] [<Tests>]
let tableSummaryTests = let tableSummaryTests =
testList "tableSummary" [ testList "tableSummary" [
test "succeeds for no entries" { test "succeeds for no entries" {
let sum = tableSummary 0 _s |> renderHtmlNode let sum = tableSummary 0 _s |> renderHtmlNode
Expect.equal sum "<div class=\"pt-center-text\"><small>No Entries to Display</small></div>" Expect.equal sum """<div class="pt-center-text"><small>No Entries to Display</small></div>"""
"Summary for no items is incorrect" "Summary for no items is incorrect"
} }
test "succeeds for one entry" { test "succeeds for one entry" {
let sum = tableSummary 1 _s |> renderHtmlNode let sum = tableSummary 1 _s |> renderHtmlNode
Expect.equal sum "<div class=\"pt-center-text\"><small>Displaying 1 Entry</small></div>" Expect.equal sum """<div class="pt-center-text"><small>Displaying 1 Entry</small></div>"""
"Summary for one item is incorrect" "Summary for one item is incorrect"
} }
test "succeeds for many entries" { test "succeeds for many entries" {
let sum = tableSummary 5 _s |> renderHtmlNode let sum = tableSummary 5 _s |> renderHtmlNode
Expect.equal sum "<div class=\"pt-center-text\"><small>Displaying 5 Entries</small></div>" Expect.equal sum """<div class="pt-center-text"><small>Displaying 5 Entries</small></div>"""
"Summary for many items is incorrect" "Summary for many items is incorrect"
} }
] ]
module TimeZones = module TimeZones =
open PrayerTracker.Views.CommonFunctions.TimeZones open PrayerTracker.Entities
open PrayerTracker.Views.CommonFunctions.TimeZones
[<Tests>] [<Tests>]
let nameTests = let nameTests =
testList "TimeZones.name" [ testList "TimeZones.name" [
test "succeeds for US Eastern time" { test "succeeds for US Eastern time" {
Expect.equal (name "America/New_York" _s |> string) "Eastern" "US Eastern time zone not returned correctly" Expect.equal (name (TimeZoneId "America/New_York") _s |> string) "Eastern"
} "US Eastern time zone not returned correctly"
test "succeeds for US Central time" { }
Expect.equal (name "America/Chicago" _s |> string) "Central" "US Central time zone not returned correctly" test "succeeds for US Central time" {
} Expect.equal (name (TimeZoneId "America/Chicago") _s |> string) "Central"
test "succeeds for US Mountain time" { "US Central time zone not returned correctly"
Expect.equal (name "America/Denver" _s |> string) "Mountain" "US Mountain time zone not returned correctly" }
} test "succeeds for US Mountain time" {
test "succeeds for US Mountain (AZ) time" { Expect.equal (name (TimeZoneId "America/Denver") _s |> string) "Mountain"
Expect.equal (name "America/Phoenix" _s |> string) "Mountain (Arizona)" "US Mountain time zone not returned correctly"
"US Mountain (AZ) time zone not returned correctly" }
} test "succeeds for US Mountain (AZ) time" {
test "succeeds for US Pacific time" { Expect.equal (name (TimeZoneId "America/Phoenix") _s |> string) "Mountain (Arizona)"
Expect.equal (name "America/Los_Angeles" _s |> string) "Pacific" "US Pacific time zone not returned correctly" "US Mountain (AZ) time zone not returned correctly"
} }
test "succeeds for Central European time" { test "succeeds for US Pacific time" {
Expect.equal (name "Europe/Berlin" _s |> string) "Central European" Expect.equal (name (TimeZoneId "America/Los_Angeles") _s |> string) "Pacific"
"Central European time zone not returned correctly" "US Pacific time zone not returned correctly"
} }
test "fails for unexpected time zone" { test "succeeds for Central European time" {
Expect.equal (name "Wakanda" _s |> string) "Wakanda" "Unexpected time zone should have returned the original ID" Expect.equal (name (TimeZoneId "Europe/Berlin") _s |> string) "Central European"
} "Central European time zone not returned correctly"
] }
test "fails for unexpected time zone" {
Expect.equal (name (TimeZoneId "Wakanda") _s |> string) "Wakanda"
"Unexpected time zone should have returned the original ID"
}
]

313
src/PrayerTracker.Tests/UI/UtilsTests.fs
View File

@ -5,189 +5,192 @@ open PrayerTracker
[<Tests>] [<Tests>]
let ckEditorToTextTests = let ckEditorToTextTests =
testList "ckEditorToText" [ testList "ckEditorToText" [
test "replaces newline/tab sequence with nothing" { test "replaces newline/tab sequence with nothing" {
Expect.equal (ckEditorToText "Here is some \n\ttext") "Here is some text" Expect.equal (ckEditorToText "Here is some \n\ttext") "Here is some text"
"Newline/tab sequence should have been removed" "Newline/tab sequence should have been removed"
} }
test "replaces &nbsp; with a space" { test "replaces &nbsp; with a space" {
Expect.equal (ckEditorToText "Test&nbsp;text") "Test text" "&nbsp; should have been replaced with a space" Expect.equal (ckEditorToText "Test&nbsp;text") "Test text" "&nbsp; should have been replaced with a space"
} }
test "replaces double space with one non-breaking space and one regular space" { test "replaces double space with one non-breaking space and one regular space" {
Expect.equal (ckEditorToText "Test text") "Test&#xa0; text" Expect.equal (ckEditorToText "Test text") "Test&#xa0; text"
"double space should have been replaced with one non-breaking space and one regular space" "double space should have been replaced with one non-breaking space and one regular space"
} }
test "replaces paragraph break with two line breaks" { test "replaces paragraph break with two line breaks" {
Expect.equal (ckEditorToText "some</p><p>text") "some<br><br>text" Expect.equal (ckEditorToText "some</p><p>text") "some<br><br>text"
"paragraph break should have been replaced with two line breaks" "paragraph break should have been replaced with two line breaks"
} }
test "removes start and end paragraph tags" { test "removes start and end paragraph tags" {
Expect.equal (ckEditorToText "<p>something something</p>") "something something" Expect.equal (ckEditorToText "<p>something something</p>") "something something"
"start/end paragraph tags should have been removed" "start/end paragraph tags should have been removed"
} }
test "trims the result" { test "trims the result" {
Expect.equal (ckEditorToText " abc ") "abc" "Should have trimmed the resulting text" Expect.equal (ckEditorToText " abc ") "abc" "Should have trimmed the resulting text"
} }
test "does all the replacements and removals at one time" { test "does all the replacements and removals at one time" {
Expect.equal (ckEditorToText " <p>Paragraph&nbsp;1\n\t line two</p><p>Paragraph 2 x</p>") Expect.equal (ckEditorToText " <p>Paragraph&nbsp;1\n\t line two</p><p>Paragraph 2 x</p>")
"Paragraph 1 line two<br><br>Paragraph 2&#xa0; x" "Paragraph 1 line two<br><br>Paragraph 2&#xa0; x"
"all replacements and removals were not made correctly" "all replacements and removals were not made correctly"
} }
] ]
[<Tests>] [<Tests>]
let htmlToPlainTextTests = let htmlToPlainTextTests =
testList "htmlToPlainText" [ testList "htmlToPlainText" [
test "decodes HTML-encoded entities" { test "decodes HTML-encoded entities" {
Expect.equal (htmlToPlainText "1 &gt; 0") "1 > 0" "HTML-encoded entities should have been decoded" Expect.equal (htmlToPlainText "1 &gt; 0") "1 > 0" "HTML-encoded entities should have been decoded"
} }
test "trims the input HTML" { test "trims the input HTML" {
Expect.equal (htmlToPlainText " howdy ") "howdy" "HTML input string should have been trimmed" Expect.equal (htmlToPlainText " howdy ") "howdy" "HTML input string should have been trimmed"
} }
test "replaces line breaks with new lines" { test "replaces line breaks with new lines" {
Expect.equal (htmlToPlainText "Lots<br>of<br />new<br>lines") "Lots\nof\nnew\nlines" Expect.equal (htmlToPlainText "Lots<br>of<br />new<br>lines") "Lots\nof\nnew\nlines"
"Break tags should have been converted to newline characters" "Break tags should have been converted to newline characters"
} }
test "replaces non-breaking spaces with spaces" { test "replaces non-breaking spaces with spaces" {
Expect.equal (htmlToPlainText "Here&nbsp;is&#xa0;some&nbsp;more&#xa0;text") "Here is some more text" Expect.equal (htmlToPlainText "Here&nbsp;is&#xa0;some&nbsp;more&#xa0;text") "Here is some more text"
"Non-breaking spaces should have been replaced with spaces" "Non-breaking spaces should have been replaced with spaces"
} }
test "does all replacements at one time" { test "does all replacements at one time" {
Expect.equal (htmlToPlainText " &lt;&nbsp;&lt;<br>test") "< <\ntest" "All replacements were not made correctly" Expect.equal (htmlToPlainText " &lt;&nbsp;&lt;<br>test") "< <\ntest"
} "All replacements were not made correctly"
test "does not fail when passed null" { }
Expect.equal (htmlToPlainText null) "" "Should return an empty string for null input" test "does not fail when passed null" {
} Expect.equal (htmlToPlainText null) "" "Should return an empty string for null input"
test "does not fail when passed an empty string" { }
Expect.equal (htmlToPlainText "") "" "Should return an empty string when given an empty string" test "does not fail when passed an empty string" {
} Expect.equal (htmlToPlainText "") "" "Should return an empty string when given an empty string"
test "preserves blank lines for two consecutive line breaks" { }
let expected = "Paragraph 1\n\nParagraph 2\n\n...and paragraph 3" test "preserves blank lines for two consecutive line breaks" {
Expect.equal (htmlToPlainText "Paragraph 1<br><br>Paragraph 2<br><br>...and <strong>paragraph</strong> <i>3</i>") let expected = "Paragraph 1\n\nParagraph 2\n\n...and paragraph 3"
expected "Blank lines not preserved for consecutive line breaks" Expect.equal
} (htmlToPlainText "Paragraph 1<br><br>Paragraph 2<br><br>...and <strong>paragraph</strong> <i>3</i>")
expected "Blank lines not preserved for consecutive line breaks"
}
] ]
[<Tests>] [<Tests>]
let makeUrlTests = let makeUrlTests =
testList "makeUrl" [ testList "makeUrl" [
test "returns the URL when there are no parameters" { test "returns the URL when there are no parameters" {
Expect.equal (makeUrl "/test" []) "/test" "The URL should not have had any query string parameters added" Expect.equal (makeUrl "/test" []) "/test" "The URL should not have had any query string parameters added"
} }
test "returns the URL with one query string parameter" { test "returns the URL with one query string parameter" {
Expect.equal (makeUrl "/test" [ "unit", "true" ]) "/test?unit=true" "The URL was not constructed properly" Expect.equal (makeUrl "/test" [ "unit", "true" ]) "/test?unit=true" "The URL was not constructed properly"
} }
test "returns the URL with multiple encoded query string parameters" { test "returns the URL with multiple encoded query string parameters" {
let url = makeUrl "/test" [ "space", "a space"; "turkey", "=" ] let url = makeUrl "/test" [ "space", "a space"; "turkey", "=" ]
Expect.equal url "/test?space=a+space&turkey=%3D" "The URL was not constructed properly" Expect.equal url "/test?space=a+space&turkey=%3D" "The URL was not constructed properly"
} }
] ]
[<Tests>] [<Tests>]
let sndAsStringTests = let sndAsStringTests =
testList "sndAsString" [ testList "sndAsString" [
test "converts the second item to a string" { test "converts the second item to a string" {
Expect.equal (sndAsString ("a", 5)) "5" "The second part of the tuple should have been converted to a string" Expect.equal (sndAsString ("a", 5)) "5"
} "The second part of the tuple should have been converted to a string"
}
] ]
module StringTests = module StringTests =
open PrayerTracker.Utils.String open PrayerTracker.Utils.String
[<Tests>] [<Tests>]
let replaceFirstTests = let replaceFirstTests =
testList "String.replaceFirst" [ testList "String.replaceFirst" [
test "replaces the first occurrence when it is found at the beginning of the string" { test "replaces the first occurrence when it is found at the beginning of the string" {
let testString = "unit unit unit" let testString = "unit unit unit"
Expect.equal (replaceFirst "unit" "test" testString) "test unit unit" Expect.equal (replaceFirst "unit" "test" testString) "test unit unit"
"First occurrence of a substring was not replaced properly at the beginning of the string" "First occurrence of a substring was not replaced properly at the beginning of the string"
} }
test "replaces the first occurrence when it is found in the center of the string" { test "replaces the first occurrence when it is found in the center of the string" {
let testString = "test unit test" let testString = "test unit test"
Expect.equal (replaceFirst "unit" "test" testString) "test test test" Expect.equal (replaceFirst "unit" "test" testString) "test test test"
"First occurrence of a substring was not replaced properly when it is in the center of the string" "First occurrence of a substring was not replaced properly when it is in the center of the string"
} }
test "returns the original string if the replacement isn't found" { test "returns the original string if the replacement isn't found" {
let testString = "unit tests" let testString = "unit tests"
Expect.equal (replaceFirst "tested" "testing" testString) "unit tests" Expect.equal (replaceFirst "tested" "testing" testString) "unit tests"
"String which did not have the target substring was not returned properly" "String which did not have the target substring was not returned properly"
} }
] ]
[<Tests>] [<Tests>]
let replaceTests = let replaceTests =
testList "String.replace" [ testList "String.replace" [
test "succeeds" { test "succeeds" {
Expect.equal (replace "a" "b" "abacab") "bbbcbb" "String did not replace properly" Expect.equal (replace "a" "b" "abacab") "bbbcbb" "String did not replace properly"
} }
] ]
[<Tests>] [<Tests>]
let trimTests = let trimTests =
testList "String.trim" [ testList "String.trim" [
test "succeeds" { test "succeeds" {
Expect.equal (trim " abc ") "abc" "Space not trimmed from string properly" Expect.equal (trim " abc ") "abc" "Space not trimmed from string properly"
} }
] ]
[<Tests>] [<Tests>]
let stripTagsTests = let stripTagsTests =
let testString = "<p class=\"testing\">Here is some text<br> <br />and some more</p>" let testString = """<p class="testing">Here is some text<br> <br />and some more</p>"""
testList "stripTags" [ testList "stripTags" [
test "does nothing if all tags are allowed" { test "does nothing if all tags are allowed" {
Expect.equal (stripTags [ "p"; "br" ] testString) testString Expect.equal (stripTags [ "p"; "br" ] testString) testString
"There should have been no replacements in the target string" "There should have been no replacements in the target string"
} }
test "strips the start/end tag for non allowed tag" { test "strips the start/end tag for non allowed tag" {
Expect.equal (stripTags [ "br" ] testString) "Here is some text<br> <br />and some more" Expect.equal (stripTags [ "br" ] testString) "Here is some text<br> <br />and some more"
"There should have been no \"p\" tag, but all \"br\" tags, in the returned string" "There should have been no \"p\" tag, but all \"br\" tags, in the returned string"
} }
test "strips void/self-closing tags" { test "strips void/self-closing tags" {
Expect.equal (stripTags [] testString) "Here is some text and some more" Expect.equal (stripTags [] testString) "Here is some text and some more"
"There should have been no tags; all void and self-closing tags should have been stripped" "There should have been no tags; all void and self-closing tags should have been stripped"
} }
] ]
[<Tests>] [<Tests>]
let wordWrapTests = let wordWrapTests =
testList "wordWrap" [ testList "wordWrap" [
test "breaks where it is supposed to" { test "breaks where it is supposed to" {
let testString = "The quick brown fox jumps over the lazy dog\nIt does!" let testString = "The quick brown fox jumps over the lazy dog\nIt does!"
Expect.equal (wordWrap 20 testString) "The quick brown fox\njumps over the lazy\ndog\nIt does!\n" Expect.equal (wordWrap 20 testString) "The quick brown fox\njumps over the lazy\ndog\nIt does!\n"
"Line not broken correctly" "Line not broken correctly"
} }
test "wraps long line without a space" { test "wraps long line without a space" {
let testString = "Asamatteroffact, the dog does too" let testString = "Asamatteroffact, the dog does too"
Expect.equal (wordWrap 10 testString) "Asamattero\nffact, the\ndog does\ntoo\n" Expect.equal (wordWrap 10 testString) "Asamattero\nffact, the\ndog does\ntoo\n"
"Longer line not broken correctly" "Longer line not broken correctly"
} }
test "preserves blank lines" { test "preserves blank lines" {
let testString = "Here is\n\na string with blank lines" let testString = "Here is\n\na string with blank lines"
Expect.equal (wordWrap 80 testString) testString "Blank lines were not preserved" Expect.equal (wordWrap 80 testString) testString "Blank lines were not preserved"
} }
] ]
[<Tests>] [<Tests>]
let wordWrapBTests = let wordWrapBTests =
testList "wordWrapB" [ testList "wordWrapB" [
test "breaks where it is supposed to" { test "breaks where it is supposed to" {
let testString = "The quick brown fox jumps over the lazy dog\nIt does!" let testString = "The quick brown fox jumps over the lazy dog\nIt does!"
Expect.equal (wordWrap 20 testString) "The quick brown fox\njumps over the lazy\ndog\nIt does!\n" Expect.equal (wordWrap 20 testString) "The quick brown fox\njumps over the lazy\ndog\nIt does!\n"
"Line not broken correctly" "Line not broken correctly"
} }
test "wraps long line without a space and a line with exact length" { test "wraps long line without a space and a line with exact length" {
let testString = "Asamatteroffact, the dog does too" let testString = "Asamatteroffact, the dog does too"
Expect.equal (wordWrap 10 testString) "Asamattero\nffact, the\ndog does\ntoo\n" Expect.equal (wordWrap 10 testString) "Asamattero\nffact, the\ndog does\ntoo\n"
"Longer line not broken correctly" "Longer line not broken correctly"
} }
test "wraps long line without a space and a line with non-exact length" { test "wraps long line without a space and a line with non-exact length" {
let testString = "Asamatteroffact, that dog does too" let testString = "Asamatteroffact, that dog does too"
Expect.equal (wordWrap 10 testString) "Asamattero\nffact,\nthat dog\ndoes too\n" Expect.equal (wordWrap 10 testString) "Asamattero\nffact,\nthat dog\ndoes too\n"
"Longer line not broken correctly" "Longer line not broken correctly"
} }
test "preserves blank lines" { test "preserves blank lines" {
let testString = "Here is\n\na string with blank lines" let testString = "Here is\n\na string with blank lines"
Expect.equal (wordWrap 80 testString) testString "Blank lines were not preserved" Expect.equal (wordWrap 80 testString) testString "Blank lines were not preserved"
} }
] ]

1272
src/PrayerTracker.Tests/UI/ViewModelsTests.fs
View File

File diff suppressed because it is too large Load Diff

199
src/PrayerTracker.UI/Church.fs
View File

@ -1,109 +1,122 @@
module PrayerTracker.Views.Church module PrayerTracker.Views.Church
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Giraffe.ViewEngine.Accessibility
open Giraffe.ViewEngine.Htmx
open PrayerTracker
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
/// View for the church edit page /// View for the church edit page
let edit (m : EditChurch) ctx vi = let edit (model : EditChurch) ctx viewInfo =
let pageTitle = match m.isNew () with true -> "Add a New Church" | false -> "Edit Church" let pageTitle = if model.IsNew then "Add a New Church" else "Edit Church"
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
[ form [ _action "/web/church/save"; _method "post"; _class "pt-center-columns" ] [ let vi =
style [ _scoped ] viewInfo
[ rawText "#name { width: 20rem; } #city { width: 10rem; } #st { width: 3rem; } #interfaceAddress { width: 30rem; }" ] |> AppViewInfo.withScopedStyles [
csrfToken ctx $"#{nameof model.Name} {{ width: 20rem; }}"
input [ _type "hidden"; _name "churchId"; _value (flatGuid m.churchId) ] $"#{nameof model.City} {{ width: 10rem; }}"
div [ _class "pt-field-row" ] [ $"#{nameof model.State} {{ width: 3rem; }}"
div [ _class "pt-field" ] [ $"#{nameof model.InterfaceAddress} {{ width: 30rem; }}"
label [ _for "name" ] [ locStr s.["Church Name"] ]
input [ _type "text"; _name "name"; _id "name"; _required; _autofocus; _value m.name ]
]
div [ _class "pt-field" ] [
label [ _for "City"] [ locStr s.["City"] ]
input [ _type "text"; _name "city"; _id "city"; _required; _value m.city ]
]
div [ _class "pt-field" ] [
label [ _for "ST" ] [ locStr s.["State"] ]
input [ _type "text"; _name "st"; _id "st"; _required; _minlength "2"; _maxlength "2"; _value m.st ]
]
] ]
div [ _class "pt-field-row" ] [ |> AppViewInfo.withOnLoadScript "PT.church.edit.onPageLoad"
div [ _class "pt-checkbox-field" ] [ form [ _action "/church/save"; _method "post"; _class "pt-center-columns"; Target.content ] [
input [ _type "checkbox" csrfToken ctx
_name "hasInterface" input [ _type "hidden"; _name (nameof model.ChurchId); _value model.ChurchId ]
_id "hasInterface" div [ _fieldRow ] [
_value "True" div [ _inputField ] [
match m.hasInterface with Some x when x -> _checked | _ -> () ] label [ _for (nameof model.Name) ] [ locStr s["Church Name"] ]
label [ _for "hasInterface" ] [ locStr s.["Has an interface with Virtual Prayer Room"] ] inputField "text" (nameof model.Name) model.Name [ _required; _autofocus ]
] ]
div [ _inputField ] [
label [ _for (nameof model.City) ] [ locStr s["City"] ]
inputField "text" (nameof model.City) model.City [ _required ]
]
div [ _inputField ] [
label [ _for (nameof model.State) ] [ locStr s["State or Province"] ]
inputField "text" (nameof model.State) model.State [ _minlength "2"; _maxlength "2"; _required ]
]
] ]
div [ _class "pt-field-row pt-fadeable"; _id "divInterfaceAddress" ] [ div [ _fieldRow ] [
div [ _class "pt-field" ] [ div [ _checkboxField ] [
label [ _for "interfaceAddress" ] [ locStr s.["VPR Interface URL"] ] inputField "checkbox" (nameof model.HasInterface) "True"
input [ _type "url"; _name "interfaceAddress"; _id "interfaceAddress"; [ if defaultArg model.HasInterface false then _checked ]
_value (match m.interfaceAddress with Some ia -> ia | None -> "") ] label [ _for (nameof model.HasInterface) ] [
] locStr s["Has an Interface with “{0}”", "Virtual Prayer Space"]
]
]
] ]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save Church"] ] div [ _fieldRowWith [ "pt-fadeable" ]; _id "divInterfaceAddress" ] [
] div [ _inputField ] [
script [] [ rawText "PT.onLoad(PT.church.edit.onPageLoad)" ] label [ _for (nameof model.InterfaceAddress) ] [ locStr s["Interface URL"] ]
inputField "url" (nameof model.InterfaceAddress) (defaultArg model.InterfaceAddress "") []
]
]
div [ _fieldRow ] [ submit [] "save" s["Save Church"] ]
] ]
|> Layout.Content.standard |> List.singleton
|> Layout.standard vi pageTitle |> Layout.Content.standard
|> Layout.standard vi pageTitle
/// View for church maintenance page /// View for church maintenance page
let maintain (churches : Church list) (stats : Map<string, ChurchStats>) ctx vi = let maintain (churches : Church list) (stats : Map<string, ChurchStats>) ctx viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let chTbl = let vi = AppViewInfo.withScopedStyles [ "#churchList { grid-template-columns: repeat(7, auto); }" ] viewInfo
match churches with let churchTable =
| [] -> space match churches with
| _ -> | [] -> space
table [ _class "pt-table pt-action-table" ] [ | _ ->
thead [] [ section [ _id "churchList"; _class "pt-table"; _ariaLabel "Church list" ] [
tr [] [ div [ _class "row head" ] [
th [] [ locStr s.["Actions"] ] header [ _class "cell" ] [ locStr s["Actions"] ]
th [] [ locStr s.["Name"] ] header [ _class "cell" ] [ locStr s["Name"] ]
th [] [ locStr s.["Location"] ] header [ _class "cell" ] [ locStr s["Location"] ]
th [] [ locStr s.["Groups"] ] header [ _class "cell" ] [ locStr s["Groups"] ]
th [] [ locStr s.["Requests"] ] header [ _class "cell" ] [ locStr s["Requests"] ]
th [] [ locStr s.["Users"] ] header [ _class "cell" ] [ locStr s["Users"] ]
th [] [ locStr s.["Interface?"] ] header [ _class "cell" ] [ locStr s["Interface?"] ]
] ]
for church in churches do
let churchId = shortGuid church.Id.Value
let delAction = $"/church/{churchId}/delete"
let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.",
$"""{s["Church"].Value.ToLower ()} ({church.Name})"""]
div [ _class "row" ] [
div [ _class "cell actions" ] [
a [ _href $"/church/{churchId}/edit"; _title s["Edit This Church"].Value ] [
iconSized 18 "edit"
]
a [ _href delAction
_title s["Delete This Church"].Value
_hxPost delAction
_hxConfirm delPrompt.Value ] [
iconSized 18 "delete_forever"
]
]
div [ _class "cell" ] [ str church.Name ]
div [ _class "cell" ] [ str church.City; rawText ", "; str church.State ]
div [ _class "cell pt-right-text" ] [ rawText (stats[churchId].SmallGroups.ToString "N0") ]
div [ _class "cell pt-right-text" ] [ rawText (stats[churchId].PrayerRequests.ToString "N0") ]
div [ _class "cell pt-right-text" ] [ rawText (stats[churchId].Users.ToString "N0") ]
div [ _class "cell pt-center-text" ] [
locStr s[if church.HasVpsInterface then "Yes" else "No"]
]
]
] ]
churches [ div [ _class "pt-center-text" ] [
|> List.map (fun ch -> br []
let chId = flatGuid ch.churchId a [ _href $"/church/{emptyGuid}/edit"; _title s["Add a New Church"].Value ] [
let delAction = $"/web/church/{chId}/delete" icon "add_circle"; rawText " &nbsp;"; locStr s["Add a New Church"]
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.", ]
$"""{s.["Church"].Value.ToLower ()} ({ch.name})"""] br []
tr [] [ br []
td [] [ ]
a [ _href $"/web/church/{chId}/edit"; _title s.["Edit This Church"].Value ] [ icon "edit" ] tableSummary churches.Length s
a [ _href delAction form [ _method "post" ] [
_title s.["Delete This Church"].Value csrfToken ctx
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ] churchTable
[ icon "delete_forever" ] ]
]
td [] [ str ch.name ]
td [] [ str ch.city; rawText ", "; str ch.st ]
td [ _class "pt-right-text" ] [ rawText (stats.[chId].smallGroups.ToString "N0") ]
td [ _class "pt-right-text" ] [ rawText (stats.[chId].prayerRequests.ToString "N0") ]
td [ _class "pt-right-text" ] [ rawText (stats.[chId].users.ToString "N0") ]
td [ _class "pt-center-text" ] [ locStr s.[match ch.hasInterface with true -> "Yes" | false -> "No"] ]
])
|> tbody []
]
[ div [ _class "pt-center-text" ] [
br []
a [ _href $"/web/church/{emptyGuid}/edit"; _title s.["Add a New Church"].Value ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New Church"] ]
br []
br []
]
tableSummary churches.Length s
chTbl
form [ _id "DeleteForm"; _action ""; _method "post" ] [ csrfToken ctx ]
] ]
|> Layout.Content.wide |> Layout.Content.wide
|> Layout.standard vi "Maintain Churches" |> Layout.standard vi "Maintain Churches"

248
src/PrayerTracker.UI/CommonFunctions.fs
View File

@ -1,26 +1,24 @@
[<AutoOpen>] [<AutoOpen>]
module PrayerTracker.Views.CommonFunctions module PrayerTracker.Views.CommonFunctions
open System.IO
open System.Text.Encodings.Web
open Giraffe open Giraffe
open Giraffe.ViewEngine 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
open System
open System.IO
open System.Text.Encodings.Web
/// Encoded text for a localized string /// Encoded text for a localized string
let locStr (text : LocalizedString) = str text.Value let locStr (text : LocalizedString) = str text.Value
/// Raw text for a localized HTML string /// Raw text for a localized HTML string
let rawLocText (writer : StringWriter) (text : LocalizedHtmlString) = let rawLocText (writer : StringWriter) (text : LocalizedHtmlString) =
text.WriteTo (writer, HtmlEncoder.Default) text.WriteTo (writer, HtmlEncoder.Default)
let txt = string writer let txt = string writer
writer.GetStringBuilder().Clear () |> ignore writer.GetStringBuilder().Clear () |> ignore
rawText txt rawText txt
/// A space (used for back-to-back localization string breaks) /// A space (used for back-to-back localization string breaks)
let space = rawText " " let space = rawText " "
@ -29,106 +27,153 @@ 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 $"material-icons md-{size}" ] [ rawText name ] let iconSized size name = i [ _class $"material-icons md-%i{size}" ] [ rawText name ]
/// Generate a CSRF prevention token /// Generate a CSRF prevention token
let csrfToken (ctx : HttpContext) = let csrfToken (ctx : HttpContext) =
let antiForgery = ctx.GetService<IAntiforgery> () let antiForgery = ctx.GetService<IAntiforgery> ()
let tokenSet = antiForgery.GetAndStoreTokens ctx let tokenSet = antiForgery.GetAndStoreTokens ctx
input [ _type "hidden"; _name tokenSet.FormFieldName; _value tokenSet.RequestToken ] input [ _type "hidden"; _name tokenSet.FormFieldName; _value tokenSet.RequestToken ]
/// Create a summary for a table of items /// Create a summary for a table of items
let tableSummary itemCount (s : IStringLocalizer) = let tableSummary itemCount (s : IStringLocalizer) =
div [ _class "pt-center-text" ] [ div [ _class "pt-center-text" ] [
small [] [ small [] [
match itemCount with match itemCount with
| 0 -> s.["No Entries to Display"] | 0 -> s["No Entries to Display"]
| 1 -> s.["Displaying {0} Entry", itemCount] | 1 -> s["Displaying {0} Entry", itemCount]
| _ -> s.["Displaying {0} Entries", itemCount] | _ -> s["Displaying {0} Entries", itemCount]
|> locStr |> locStr
] ]
] ]
/// Generate a list of named HTML colors /// Generate a list of named HTML colors
let namedColorList name selected attrs (s : IStringLocalizer) = let namedColorList name selected attrs (s : IStringLocalizer) =
/// The list of HTML named colors (name, display, text color) // The list of HTML named colors (name, display, text color)
seq { seq {
("aqua", s.["Aqua"], "black") ("aqua", s["Aqua"], "black")
("black", s.["Black"], "white") ("black", s["Black"], "white")
("blue", s.["Blue"], "white") ("blue", s["Blue"], "white")
("fuchsia", s.["Fuchsia"], "black") ("fuchsia", s["Fuchsia"], "black")
("gray", s.["Gray"], "white") ("gray", s["Gray"], "white")
("green", s.["Green"], "white") ("green", s["Green"], "white")
("lime", s.["Lime"], "black") ("lime", s["Lime"], "black")
("maroon", s.["Maroon"], "white") ("maroon", s["Maroon"], "white")
("navy", s.["Navy"], "white") ("navy", s["Navy"], "white")
("olive", s.["Olive"], "white") ("olive", s["Olive"], "white")
("purple", s.["Purple"], "white") ("purple", s["Purple"], "white")
("red", s.["Red"], "black") ("red", s["Red"], "black")
("silver", s.["Silver"], "black") ("silver", s["Silver"], "black")
("teal", s.["Teal"], "white") ("teal", s["Teal"], "white")
("white", s.["White"], "black") ("white", s["White"], "black")
("yellow", s.["Yellow"], "black") ("yellow", s["Yellow"], "black")
} }
|> Seq.map (fun color -> |> Seq.map (fun color ->
let (colorName, dispText, txtColor) = color let colorName, text, txtColor = color
option [ yield _value colorName option
yield _style $"background-color:{colorName};color:{txtColor};" [ _value colorName
match colorName = selected with true -> yield _selected | false -> () ] [ _style $"background-color:{colorName};color:{txtColor};"
encodedText (dispText.Value.ToLower ()) if colorName = selected then _selected
]) ] [ encodedText (text.Value.ToLower ()) ])
|> List.ofSeq |> List.ofSeq
|> select (_name name :: attrs) |> select (_name name :: attrs)
/// Convert a named color to its hex notation
let colorToHex (color : string) =
match color with
| it when it.StartsWith "#" -> color
| "aqua" -> "#00ffff"
| "black" -> "#000000"
| "blue" -> "#0000ff"
| "fuchsia" -> "#ff00ff"
| "gray" -> "#808080"
| "green" -> "#008000"
| "lime" -> "#00ff00"
| "maroon" -> "#800000"
| "navy" -> "#000080"
| "olive" -> "#808000"
| "purple" -> "#800080"
| "red" -> "#ff0000"
| "silver" -> "#c0c0c0"
| "teal" -> "#008080"
| "white" -> "#ffffff"
| "yellow" -> "#ffff00"
| it -> it
/// Generate an input[type=radio] that is selected if its value is the current value /// Generate an input[type=radio] that is selected if its value is the current value
let radio name domId value current = let radio name domId value current =
input [ _type "radio" input [ _type "radio"
_name name _name name
_id domId if domId <> "" then _id domId
_value value _value value
match value = current with true -> _checked | false -> () ] if value = current then _checked ]
/// Generate a select list with the current value selected /// Generate a select list with the current value selected
let selectList name selected attrs items = let selectList name selected attrs items =
items items
|> Seq.map (fun (value, text) -> |> Seq.map (fun (value, text) ->
option [ _value value option
match value = selected with true -> _selected | false -> () ] [ encodedText text ]) [ _value value
|> List.ofSeq if value = selected then _selected
|> select (List.concat [ [ _name name; _id name ]; attrs ]) ] [ encodedText text ])
|> List.ofSeq
|> select (List.concat [ [ _name name; _id name ]; attrs ])
/// Generate the text for a default entry at the top of a select list /// Generate the text for a default entry at the top of a select list
let selectDefault text = $"— {text} —" let selectDefault text = $"— %s{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 ]
/// Format a GUID with no dashes (used for URLs and forms) /// Create an HTML onsubmit event handler
let flatGuid (x : Guid) = x.ToString "N"
/// An empty GUID string (used for "add" actions)
let emptyGuid = flatGuid Guid.Empty
/// blockquote tag
let blockquote = tag "blockquote"
/// role attribute
let _role = attr "role"
/// aria-* attribute
let _aria typ = attr $"aria-{typ}"
/// onclick attribute
let _onclick = attr "onclick"
/// onsubmit attribute
let _onsubmit = attr "onsubmit" let _onsubmit = attr "onsubmit"
/// scoped flag (used for <style> tag) /// A "rel='noopener'" attribute
let _scoped = flag "scoped" let _relNoOpener = _rel "noopener"
/// A class attribute that designates a row of fields, with the additional classes passed
let _fieldRowWith classes =
let extraClasses = if List.isEmpty classes then "" else $""" {classes |> String.concat " "}"""
_class $"pt-field-row{extraClasses}"
/// The class that designates a row of fields
let _fieldRow = _fieldRowWith []
/// A class attribute that designates an input field, with the additional classes passed
let _inputFieldWith classes =
let extraClasses = if List.isEmpty classes then "" else $""" {classes |> String.concat " "}"""
_class $"pt-field{extraClasses}"
/// The class that designates an input field / label pair
let _inputField = _inputFieldWith []
/// The class that designates a checkbox / label pair
let _checkboxField = _class "pt-checkbox-field"
/// A group of related fields, inputs, links, etc., displayed in a row
let _group = _class "pt-group"
/// Create an input field of the given type, with matching name and ID and the given value
let inputField typ name value attrs =
List.concat [ [ _type typ; _name name; _id name; if value <> "" then _value value ]; attrs ] |> input
/// Generate a table heading with the given localized column names
let tableHeadings (s : IStringLocalizer) (headings : string list) =
headings
|> List.map (fun heading -> th [ _scope "col" ] [ locStr s[heading] ])
|> tr []
|> List.singleton
|> thead []
/// For a list of strings, prepend a pound sign and string them together with commas (CSS selector by ID)
let toHtmlIds it = it |> List.map (fun x -> $"#%s{x}") |> String.concat ", "
/// The name this function used to have when the view engine was part of Giraffe /// The name this function used to have when the view engine was part of Giraffe
let renderHtmlNode = RenderView.AsString.htmlNode let renderHtmlNode = RenderView.AsString.htmlNode
open Microsoft.AspNetCore.Html
/// Render an HTML node, then return the value as an HTML string /// Render an HTML node, then return the value as an HTML string
let renderHtmlString = renderHtmlNode >> HtmlString let renderHtmlString = renderHtmlNode >> HtmlString
@ -136,20 +181,37 @@ 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 =
open System.Collections.Generic open PrayerTracker.Entities
/// Cross-reference between time zone Ids and their English names /// Cross-reference between time zone Ids and their English names
let private xref = let private xref = [
[ "America/Chicago", "Central" TimeZoneId "America/Chicago", "Central"
"America/Denver", "Mountain" TimeZoneId "America/Denver", "Mountain"
"America/Los_Angeles", "Pacific" TimeZoneId "America/Los_Angeles", "Pacific"
"America/New_York", "Eastern" TimeZoneId "America/New_York", "Eastern"
"America/Phoenix", "Mountain (Arizona)" TimeZoneId "America/Phoenix", "Mountain (Arizona)"
"Europe/Berlin", "Central European" TimeZoneId "Europe/Berlin", "Central European"
] ]
|> Map.ofList
/// Get the name of a time zone, given its Id /// Get the name of a time zone, given its Id
let name tzId (s : IStringLocalizer) = let name timeZoneId (s : IStringLocalizer) =
try s.[xref.[tzId]] match xref |> List.tryFind (fun it -> fst it = timeZoneId) with
with :? KeyNotFoundException -> LocalizedString (tzId, tzId) | Some tz -> s[snd tz]
| None ->
let tzId = TimeZoneId.toString timeZoneId
LocalizedString (tzId, tzId)
/// All known time zones in their defined order
let all = xref |> List.map fst
open Giraffe.ViewEngine.Htmx
/// Known htmx targets
module Target =
/// htmx links target the body element
let body = _hxTarget "body"
/// htmx links target the #pt-body element
let content = _hxTarget "#pt-body"

457
src/PrayerTracker.UI/Home.fs
View File

@ -1,262 +1,259 @@
/// 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.ViewEngine
open Microsoft.AspNetCore.Html
open PrayerTracker.ViewModels
open System.IO open System.IO
open Giraffe.ViewEngine
open PrayerTracker.ViewModels
/// The error page /// The error page
let error code vi = let error code viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let l = I18N.forView "Home/Error" let l = I18N.forView "Home/Error"
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
let is404 = "404" = code let is404 = "404" = code
let pageTitle = match is404 with true -> "Page Not Found" | false -> "Server Error" let pageTitle = if is404 then "Page Not Found" else "Server Error"
[ yield! [ yield!
match is404 with if is404 then
| true -> [ p [] [
[ p [] [ raw l["The page you requested cannot be found."]
raw l.["The page you requested cannot be found."] raw l["Please use your &ldquo;Back&rdquo; button to return to {0}.", s["PrayerTracker"]]
raw l.["Please use your &ldquo;Back&rdquo; button to return to {0}.", s.["PrayerTracker"]] ]
] p [] [
p [] [ raw l["If you reached this page from a link within {0}, please copy the link from the browser's address bar, and send it to support, along with the group for which you were currently authenticated (if any).",
raw l.["If you reached this page from a link within {0}, please copy the link from the browser's address bar, and send it to support, along with the group for which you were currently authenticated (if any).", s["PrayerTracker"]]
s.["PrayerTracker"]] ]
] ]
] else
| false -> [ p [] [
[ p [] [ raw l["An error ({0}) has occurred.", code]
raw l.["An error ({0}) has occurred.", code] raw l["Please use your &ldquo;Back&rdquo; button to return to {0}.", s["PrayerTracker"]]
raw l.["Please use your &ldquo;Back&rdquo; button to return to {0}.", s.["PrayerTracker"]] ]
] ]
] 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 $"""/img/%A{s["footer_en"]}.png"""
img [ _src $"""/img/%A{s.["footer_en"]}.png""" _alt $"""%A{s["PrayerTracker"]} %A{s["from Bit Badger Solutions"]}"""
_alt $"""%A{s.["PrayerTracker"]} %A{s.["from Bit Badger Solutions"]}""" _title $"""%A{s["PrayerTracker"]} %A{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 viewInfo.Version
str vi.version ]
]
] ]
|> div [] |> div []
|> Layout.bare pageTitle |> Layout.bare pageTitle
/// The home page /// The home page
let index vi = let index viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let l = I18N.forView "Home/Index" let l = I18N.forView "Home/Index"
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
[ p [] [
[ p [] [ raw l["Welcome to <strong>{0}</strong>!", s["PrayerTracker"]]
raw l.["Welcome to <strong>{0}</strong>!", s.["PrayerTracker"]] space
space raw l["{0} is an interactive website that provides churches, Sunday School classes, and other organizations an easy way to keep up with their prayer requests.",
raw l.["{0} is an interactive website that provides churches, Sunday School classes, and other organizations an easy way to keep up with their prayer requests.", s["PrayerTracker"]]
s.["PrayerTracker"]] space
space raw l["It is provided at no charge, as a ministry and a community service."]
raw l.["It is provided at no charge, as a ministry and a community service."]
]
h4 [] [ raw l.["What Does It Do?"] ]
p [] [
raw l.["{0} has what you need to make maintaining a prayer request list a breeze.", s.["PrayerTracker"]]
space
raw l.["Some of the things it can do..."]
]
ul [] [
li [] [
raw l.["It drops old requests off the list automatically."]
space
raw l.["Requests other than “{0}” requests will expire at 14 days, though this can be changed by the organization.",
s.["Long-Term Requests"]]
space
raw l.["This expiration is based on the last update, not the initial request."]
space
raw l.["(And, once requests do “drop off”, they are not gone - they may be recovered if needed.)"]
] ]
li [] [ h4 [] [ raw l["What Does It Do?"] ]
raw l.["Requests can be viewed any time."] p [] [
space raw l["{0} has what you need to make maintaining a prayer request list a breeze.", s["PrayerTracker"]]
raw l.["Lists can be made public, or they can be secured with a password, if desired."] space
raw l["Some of the things it can do..."]
] ]
li [] [ ul [] [
raw l.["Lists can be e-mailed to a pre-defined list of members."] li [] [
space raw l["It drops old requests off the list automatically."]
raw l.["This can be useful for folks who may not be able to write down all the requests during class, but want a list so that they can pray for them the rest of week."] space
space raw l["Requests other than “{0}” requests will expire at 14 days, though this can be changed by the organization.",
raw l.["E-mails are sent individually to each person, which keeps the e-mail list private and keeps the messages from being flagged as spam."] s["Long-Term Requests"]]
space
raw l["This expiration is based on the last update, not the initial request."]
space
raw l["(And, once requests do “drop off”, they are not gone - they may be recovered if needed.)"]
]
li [] [
raw l["Requests can be viewed any time."]
space
raw l["Lists can be made public, or they can be secured with a password, if desired."]
]
li [] [
raw l["Lists can be e-mailed to a pre-defined list of members."]
space
raw l["This can be useful for folks who may not be able to write down all the requests during class, but want a list so that they can pray for them the rest of week."]
space
raw l["E-mails are sent individually to each person, which keeps the e-mail list private and keeps the messages from being flagged as spam."]
]
li [] [
raw l["The look and feel of the list can be configured for each group."]
space
raw l["All fonts, colors, and sizes can be customized."]
space
raw l["This allows for configuration of large-print lists, among other things."]
]
] ]
li [] [ h4 [] [ raw l["How Can Your Organization Use {0}?", s["PrayerTracker"]] ]
raw l.["The look and feel of the list can be configured for each group."] p [] [
space raw l["Like God’s gift of salvation, {0} is free for the asking for any church, Sunday School class, or other organization who wishes to use it.",
raw l.["All fonts, colors, and sizes can be customized."] s["PrayerTracker"]]
space space
raw l.["This allows for configuration of large-print lists, among other things."] raw l["If your organization would like to get set up, just <a href=\"mailto:daniel@djs-consulting.com?subject=New%20{0}%20Class\">e-mail</a> Daniel and let him know.",
s["PrayerTracker"]]
]
h4 [] [ raw l["Do I Have to Register to See the Requests?"] ]
p [] [
raw l["This depends on the group."]
space
raw l["Lists can be configured to be password-protected, but they do not have to be."]
space
raw l["If you click on the “{0}” link above, you will see a list of groups - those that do not indicate that they require logging in are publicly viewable.",
s["View Request List"]]
]
h4 [] [ raw l["How Does It Work?"] ]
p [] [
raw l["Check out the “{0}” link above - it details each of the processes and how they work.", s["Help"]]
] ]
]
h4 [] [ raw l.["How Can Your Organization Use {0}?", s.["PrayerTracker"]] ]
p [] [
raw l.["Like God’s gift of salvation, {0} is free for the asking for any church, Sunday School class, or other organization who wishes to use it.",
s.["PrayerTracker"]]
space
raw l.["If your organization would like to get set up, just <a href=\"mailto:daniel@djs-consulting.com?subject=New%20{0}%20Class\">e-mail</a> Daniel and let him know.",
s.["PrayerTracker"]]
]
h4 [] [ raw l.["Do I Have to Register to See the Requests?"] ]
p [] [
raw l.["This depends on the group."]
space
raw l.["Lists can be configured to be password-protected, but they do not have to be."]
space
raw l.["If you click on the “{0}” link above, you will see a list of groups - those that do not indicate that they require logging in are publicly viewable.",
s.["View Request List"]]
]
h4 [] [ raw l.["How Does It Work?"] ]
p [] [
raw l.["Check out the “{0}” link above - it details each of the processes and how they work.", s.["Help"]]
]
] ]
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard vi "Welcome!" |> Layout.standard viewInfo "Welcome!"
/// Privacy Policy page /// Privacy Policy page
let privacyPolicy vi = let privacyPolicy viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let l = I18N.forView "Home/PrivacyPolicy" let l = I18N.forView "Home/PrivacyPolicy"
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
[ p [ _class "pt-right-text" ] [ small [] [ em [] [ raw l["(as of July 31, 2018)"] ] ] ]
[ p [ _class "pt-right-text" ] [ small[] [ em [] [ raw l.["(as of July 31, 2018)"] ] ] ] p [] [
p [] [ raw l["The nature of the service is one where privacy is a must."]
raw l.["The nature of the service is one where privacy is a must."] space
space raw l["The items below will help you understand the data we collect, access, and store on your behalf as you use this service."]
raw l.["The items below will help you understand the data we collect, access, and store on your behalf as you use this service."]
]
h3 [] [ raw l.["What We Collect"] ]
ul [] [
li [] [
strong [] [ raw l.["Identifying Data"] ]
rawText " &ndash; "
raw l.["{0} stores the first and last names, e-mail addresses, and hashed passwords of all authorized users.", s.["PrayerTracker"]]
space
raw l.["Users are also associated with one or more small groups."]
] ]
li [] [ h3 [] [ raw l["What We Collect"] ]
strong [] [ raw l.["User Provided Data"] ] ul [] [
rawText " &ndash; " li [] [
raw l.["{0} stores the text of prayer requests.", s.["PrayerTracker"]] strong [] [ raw l["Identifying Data"] ]
space rawText " &ndash; "
raw l.["It also stores names and e-mail addreses of small group members, and plain-text passwords for small groups with password-protected lists."] raw l["{0} stores the first and last names, e-mail addresses, and hashed passwords of all authorized users.",
s["PrayerTracker"]]
space
raw l["Users are also associated with one or more small groups."]
]
li [] [
strong [] [ raw l["User Provided Data"] ]
rawText " &ndash; "
raw l["{0} stores the text of prayer requests.", s["PrayerTracker"]]
space
raw l["It also stores names and e-mail addresses of small group members, and plain-text passwords for small groups with password-protected lists."]
]
] ]
] h3 [] [ raw l["How Your Data Is Accessed / Secured"] ]
h3 [] [ raw l.["How Your Data Is Accessed / Secured"] ] ul [] [
ul [] [ li [] [
li [] [ raw l["While you are signed in, {0} utilizes a session cookie, and transmits that cookie to the server to establish your identity.",
raw l.["While you are signed in, {0} utilizes a session cookie, and transmits that cookie to the server to establish your identity.", s["PrayerTracker"]]
s.["PrayerTracker"]] space
space raw l["If you utilize the “{0}” box on sign in, a second cookie is stored, and transmitted to establish a session; this cookie is removed by clicking the “{1}” link.",
raw l.["If you utilize the “{0}” box on sign in, a second cookie is stored, and transmitted to establish a session; this cookie is removed by clicking the “{1}” link.", s["Remember Me"], s["Log Off"]]
s.["Remember Me"], s.["Log Off"]] space
space raw l["Both of these cookies are encrypted, both in your browser and in transit."]
raw l.["Both of these cookies are encrypted, both in your browser and in transit."] space
space raw l["Finally, a third cookie is used to maintain your currently selected language, so that this selection is maintained across browser sessions."]
raw l.["Finally, a third cookie is used to maintain your currently selected language, so that this selection is maintained across browser sessions."] ]
li [] [
raw l["Data for your small group is returned to you, as required, to display and edit."]
space
raw l["{0} also sends e-mails on behalf of the configured owner of a small group; these e-mails are sent from prayer@djs-consulting.com, with the “Reply To” header set to the configured owner of the small group.",
s["PrayerTracker"]]
space
raw l["Distinct e-mails are sent to each user, as to not disclose the other recipients."]
space
raw l["On the server, all data is stored in a controlled-access database."]
]
li [] [
raw l["Your data is backed up, along with other Bit Badger Solutions hosted systems, in a rolling manner; backups are preserved for the prior 7 days, and backups from the 1st and 15th are preserved for 3 months."]
space
raw l["These backups are stored in a private cloud data repository."]
]
li [] [
raw l["Access to servers and backups is strictly controlled and monitored for unauthorized access attempts."]
]
] ]
li [] [ h3 [] [ raw l["Removing Your Data"] ]
raw l.["Data for your small group is returned to you, as required, to display and edit."] p [] [
space raw l["At any time, you may choose to discontinue using {0}; just e-mail Daniel, as you did to register, and request deletion of your small group.",
raw l.["{0} also sends e-mails on behalf of the configured owner of a small group; these e-mails are sent from prayer@djs-consulting.com, with the “Reply To” header set to the configured owner of the small group.", s["PrayerTracker"]]
s.["PrayerTracker"]]
space
raw l.["Distinct e-mails are sent to each user, as to not disclose the other recipients."]
space
raw l.["On the server, all data is stored in a controlled-access database."]
] ]
li [] [
raw l.["Your data is backed up, along with other Bit Badger Solutions hosted systems, in a rolling manner; backups are preserved for the prior 7 days, and backups from the 1st and 15th are preserved for 3 months."]
space
raw l.["These backups are stored in a private cloud data repository."]
]
li [] [
raw l.["Access to servers and backups is strictly controlled and monitored for unauthorized access attempts."]
]
]
h3 [] [ raw l.["Removing Your Data"] ]
p [] [
raw l.["At any time, you may choose to discontinue using {0}; just e-mail Daniel, as you did to register, and request deletion of your small group.",
s.["PrayerTracker"]]
]
] ]
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard vi "Privacy Policy" |> Layout.standard viewInfo "Privacy Policy"
/// Terms of Service page /// Terms of Service page
let termsOfService vi = let termsOfService viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let l = I18N.forView "Home/TermsOfService" let l = I18N.forView "Home/TermsOfService"
use sw = new StringWriter () use sw = new StringWriter ()
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 "/legal/privacy-policy" ] [ str (s["Privacy Policy"].Value.ToLower ()) ]
|> renderHtmlString |> 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"] ]
p [] [ p [] [
raw l.["By accessing this web site, you are agreeing to be bound by these Terms and Conditions, and that you are responsible to ensure that your use of this site complies with all applicable laws."] raw l["By accessing this web site, you are agreeing to be bound by these Terms and Conditions, and that you are responsible to ensure that your use of this site complies with all applicable laws."]
space space
raw l.["Your continued use of this site implies your acceptance of these terms."] raw l["Your continued use of this site implies your acceptance of these terms."]
] ]
h3 [] [ str "2. "; raw l.["Description of Service and Registration"] ] h3 [] [ str "2. "; raw l["Description of Service and Registration"] ]
p [] [ p [] [
raw l.["{0} is a service that allows individuals to enter and amend prayer requests on behalf of organizations.", raw l["{0} is a service that allows individuals to enter and amend prayer requests on behalf of organizations.",
s.["PrayerTracker"]] s["PrayerTracker"]]
space space
raw l.["Registration is accomplished via e-mail to Daniel Summers (daniel at bitbadger dot solutions, substituting punctuation)."] raw l["Registration is accomplished via e-mail to Daniel Summers (daniel at bitbadger dot solutions, substituting punctuation)."]
space space
raw l.["See our {0} for details on the personal (user) information we maintain.", ppLink] raw l["See our {0} for details on the personal (user) information we maintain.", ppLink]
] ]
h3 [] [ str "3. "; raw l.["Liability"] ] h3 [] [ str "3. "; raw l["Liability"] ]
p [] [ p [] [
raw l.["This service is provided “as is”, and no warranty (express or implied) exists."] raw l["This service is provided “as is”, and no warranty (express or implied) exists."]
space space
raw l.["The service and its developers may not be held liable for any damages that may arise through the use of this service."] raw l["The service and its developers may not be held liable for any damages that may arise through the use of this service."]
] ]
h3 [] [ str "4. "; raw l.["Updates to Terms"] ] h3 [] [ str "4. "; raw l["Updates to Terms"] ]
p [] [ p [] [
raw l.["These terms and conditions may be updated at any time."] raw l["These terms and conditions may be updated at any time."]
space space
raw l.["When these terms are updated, users will be notified by a system-generated announcement."] raw l["When these terms are updated, users will be notified by a system-generated announcement."]
space space
raw l.["Additionally, the date at the top of this page will be updated."] raw l["Additionally, the date at the top of this page will be updated."]
] ]
hr [] hr []
p [] [ raw l.["You may also wish to review our {0} to learn how we handle your data.", ppLink] ] p [] [ raw l["You may also wish to review our {0} to learn how we handle your data.", ppLink] ]
] ]
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard vi "Terms of Service" |> Layout.standard viewInfo "Terms of Service"
/// View for unauthorized page /// View for unauthorized page
let unauthorized vi = let unauthorized viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let l = I18N.forView "Home/Unauthorized" let l = I18N.forView "Home/Unauthorized"
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
[ p [] [ [ p [] [
raw l.["If you feel you have reached this page in error, please <a href=\"mailto:daniel@djs-consulting.com?Subject={0}%20Unauthorized%20Access\">contact Daniel</a> and provide the details as to what you were doing (i.e., what link did you click, where had you been, etc.).", raw l["If you feel you have reached this page in error, please <a href=\"mailto:daniel@djs-consulting.com?Subject={0}%20Unauthorized%20Access\">contact Daniel</a> and provide the details as to what you were doing (i.e., what link did you click, where had you been, etc.).",
s.["PrayerTracker"]] s["PrayerTracker"]]
] ]
p [] [ p [] [
raw l.["Otherwise, you may select one of the links above to get back into an authorized portion of {0}.", raw l["Otherwise, you may select one of the links above to get back into an authorized portion of {0}.",
s.["PrayerTracker"]] s["PrayerTracker"]]
] ]
] ]
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard vi "Unauthorized Access" |> Layout.standard viewInfo "Unauthorized Access"

6
src/PrayerTracker.UI/I18N.fs
View File

@ -11,12 +11,12 @@ let private resAsmName = typeof<Common>.Assembly.GetName().Name
/// Set up the string and HTML localizer factories /// Set up the string and HTML localizer factories
let setUpFactories fac = let setUpFactories fac =
stringLocFactory <- fac stringLocFactory <- fac
htmlLocFactory <- HtmlLocalizerFactory stringLocFactory htmlLocFactory <- HtmlLocalizerFactory stringLocFactory
/// An instance of the common string localizer /// An instance of the common string localizer
let localizer = lazy (stringLocFactory.Create ("Common", resAsmName)) 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 ($"""Views.{view.Replace ('/', '.')}""", resAsmName) htmlLocFactory.Create ($"""Views.{view.Replace ('/', '.')}""", resAsmName)

554
src/PrayerTracker.UI/Layout.fs
View File

@ -2,289 +2,365 @@
module PrayerTracker.Views.Layout module PrayerTracker.Views.Layout
open Giraffe.ViewEngine open Giraffe.ViewEngine
open PrayerTracker open Giraffe.ViewEngine.Accessibility
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open System
open System.Globalization open System.Globalization
/// Get the two-character language code for the current request /// Get the two-character language code for the current request
let langCode () = match CultureInfo.CurrentCulture.Name.StartsWith "es" with true -> "es" | _ -> "en" let langCode () = if CultureInfo.CurrentCulture.Name.StartsWith "es" then "es" else "en"
/// Navigation items /// Navigation items
module Navigation = module Navigation =
/// Top navigation bar /// Top navigation bar
let top m = let top m =
let s = PrayerTracker.Views.I18N.localizer.Force () let s = I18N.localizer.Force ()
let menuSpacer = rawText "&nbsp; " let menuSpacer = rawText "&nbsp; "
let leftLinks = [ let _dropdown = _class "dropdown-btn"
match m.user with let leftLinks = [
| Some u -> match m.User with
li [ _class "dropdown" ] [
a [ _class "dropbtn"; _role "button"; _aria "label" s.["Requests"].Value; _title s.["Requests"].Value ]
[ icon "question_answer"; space; locStr s.["Requests"]; space; icon "keyboard_arrow_down" ]
div [ _class "dropdown-content"; _role "menu" ] [
a [ _href "/web/prayer-requests" ] [ icon "compare_arrows"; menuSpacer; locStr s.["Maintain"] ]
a [ _href "/web/prayer-requests/view" ] [ icon "list"; menuSpacer; locStr s.["View List"] ]
]
]
li [ _class "dropdown" ] [
a [ _class "dropbtn"; _role "button"; _aria "label" s.["Group"].Value; _title s.["Group"].Value ]
[ icon "group"; space; locStr s.["Group"]; space; icon "keyboard_arrow_down" ]
div [ _class "dropdown-content"; _role "menu" ] [
a [ _href "/web/small-group/members" ] [ icon "email"; menuSpacer; locStr s.["Maintain Group Members"] ]
a [ _href "/web/small-group/announcement" ] [ icon "send"; menuSpacer; locStr s.["Send Announcement"] ]
a [ _href "/web/small-group/preferences" ] [ icon "build"; menuSpacer; locStr s.["Change Preferences"] ]
]
]
match u.isAdmin with
| true ->
li [ _class "dropdown" ] [
a [ _class "dropbtn"; _role "button"; _aria "label" s.["Administration"].Value; _title s.["Administration"].Value ]
[ icon "settings"; space; locStr s.["Administration"]; space; icon "keyboard_arrow_down" ]
div [ _class "dropdown-content"; _role "menu" ] [
a [ _href "/web/churches" ] [ icon "home"; menuSpacer; locStr s.["Churches"] ]
a [ _href "/web/small-groups" ] [ icon "send"; menuSpacer; locStr s.["Groups"] ]
a [ _href "/web/users" ] [ icon "build"; menuSpacer; locStr s.["Users"] ]
]
]
| false -> ()
| None ->
match m.group with
| Some _ ->
li [] [
a [ _href "/web/prayer-requests/view"
_aria "label" s.["View Request List"].Value
_title s.["View Request List"].Value ]
[ icon "list"; space; locStr s.["View Request List"] ]
]
| None ->
li [ _class "dropdown" ] [
a [ _class "dropbtn"; _role "button"; _aria "label" s.["Log On"].Value; _title s.["Log On"].Value ]
[ icon "security"; space; locStr s.["Log On"]; space; icon "keyboard_arrow_down" ]
div [ _class "dropdown-content"; _role "menu" ] [
a [ _href "/web/user/log-on" ] [ icon "person"; menuSpacer; locStr s.["User"] ]
a [ _href "/web/small-group/log-on" ] [ icon "group"; menuSpacer; locStr s.["Group"] ]
]
]
li [] [
a [ _href "/web/prayer-requests/lists"
_aria "label" s.["View Request List"].Value
_title s.["View Request List"].Value ]
[ icon "list"; space; locStr s.["View Request List"] ]
]
li [] [
a [ _href $"https://docs.prayer.bitbadger.solutions/{langCode ()}"
_aria "label" s.["Help"].Value;
_title s.["View Help"].Value
_target "_blank"
]
[ icon "help"; space; locStr s.["Help"] ]
]
]
let rightLinks =
match m.group with
| Some _ ->
[ match m.user with
| Some _ ->
li [] [
a [ _href "/web/user/password"
_aria "label" s.["Change Your Password"].Value
_title s.["Change Your Password"].Value ]
[ icon "lock"; space; locStr s.["Change Your Password"] ]
]
| None -> ()
li [] [
a [ _href "/web/log-off"; _aria "label" s.["Log Off"].Value; _title s.["Log Off"].Value ]
[ icon "power_settings_new"; space; locStr s.["Log Off"] ]
]
]
| None -> List.empty
header [ _class "pt-title-bar" ] [
section [ _class "pt-title-bar-left" ] [
span [ _class "pt-title-bar-home" ] [
a [ _href "/web/"; _title s.["Home"].Value ] [ locStr s.["PrayerTracker"] ]
]
ul [] leftLinks
]
section [ _class "pt-title-bar-center" ] []
section [ _class "pt-title-bar-right"; _role "toolbar" ] [
ul [] rightLinks
]
]
/// Identity bar (below top nav)
let identity m =
let s = I18N.localizer.Force ()
header [ _id "pt-language" ] [
div [] [
span [ _class "u" ] [ locStr s.["Language"]; rawText ": " ]
match langCode () with
| "es" ->
locStr s.["Spanish"]
rawText " &nbsp; &bull; &nbsp; "
a [ _href "/web/language/en" ] [ locStr s.["Change to English"] ]
| _ ->
locStr s.["English"]
rawText " &nbsp; &bull; &nbsp; "
a [ _href "/web/language/es" ] [ locStr s.["Cambie a Español"] ]
]
match m.group with
| Some g ->
[ match m.user with
| Some u -> | Some u ->
span [ _class "u" ] [ locStr s.["Currently Logged On"] ] li [ _class "dropdown" ] [
rawText "&nbsp; &nbsp;" a [ _dropdown; _ariaLabel s["Requests"].Value; _title s["Requests"].Value; _roleButton ] [
icon "person" icon "question_answer"; space; locStr s["Requests"]; space; icon "keyboard_arrow_down"
strong [] [ str u.fullName ] ]
rawText "&nbsp; &nbsp; " div [ _class "dropdown-content"; _roleMenuBar ] [
a [ _href "/prayer-requests"; _roleMenuItem ] [
icon "compare_arrows"; menuSpacer; locStr s["Maintain"]
]
a [ _href "/prayer-requests/view"; _roleMenuItem ] [
icon "list"; menuSpacer; locStr s["View List"]
]
]
]
li [ _class "dropdown" ] [
a [ _dropdown; _ariaLabel s["Group"].Value; _title s["Group"].Value; _roleButton ] [
icon "group"; space; locStr s["Group"]; space; icon "keyboard_arrow_down"
]
div [ _class "dropdown-content"; _roleMenuBar ] [
a [ _href "/small-group/members"; _roleMenuItem ] [
icon "email"; menuSpacer; locStr s["Maintain Group Members"]
]
a [ _href "/small-group/announcement"; _roleMenuItem ] [
icon "send"; menuSpacer; locStr s["Send Announcement"]
]
a [ _href "/small-group/preferences"; _roleMenuItem ] [
icon "build"; menuSpacer; locStr s["Change Preferences"]
]
]
]
if u.IsAdmin then
li [ _class "dropdown" ] [
a [ _dropdown
_ariaLabel s["Administration"].Value
_title s["Administration"].Value
_roleButton ] [
icon "settings"; space; locStr s["Administration"]; space; icon "keyboard_arrow_down"
]
div [ _class "dropdown-content"; _roleMenuBar ] [
a [ _href "/churches"; _roleMenuItem ] [ icon "home"; menuSpacer; locStr s["Churches"] ]
a [ _href "/small-groups"; _roleMenuItem ] [ icon "send"; menuSpacer; locStr s["Groups"] ]
a [ _href "/users"; _roleMenuItem ] [ icon "build"; menuSpacer; locStr s["Users"] ]
]
]
| None -> | None ->
locStr s.["Logged On as a Member of"] match m.Group with
rawText "&nbsp; " | Some _ ->
icon "group" li [] [
space a [ _href "/prayer-requests/view"
match m.user with _ariaLabel s["View Request List"].Value
| Some _ -> a [ _href "/web/small-group" ] [ strong [] [ str g.name ] ] _title s["View Request List"].Value ] [
| None -> strong [] [ str g.name ] icon "list"; space; locStr s["View Request List"]
rawText " &nbsp;" ]
]
| None ->
li [ _class "dropdown" ] [
a [ _dropdown; _ariaLabel s["Log On"].Value; _title s["Log On"].Value; _roleButton ] [
icon "security"; space; locStr s["Log On"]; space; icon "keyboard_arrow_down"
]
div [ _class "dropdown-content"; _roleMenuBar ] [
a [ _href "/user/log-on"; _roleMenuItem ] [ icon "person"; menuSpacer; locStr s["User"] ]
a [ _href "/small-group/log-on"; _roleMenuItem ] [
icon "group"; menuSpacer; locStr s["Group"]
]
]
]
li [] [
a [ _href "/prayer-requests/lists"
_ariaLabel s["View Request List"].Value
_title s["View Request List"].Value ] [
icon "list"; space; locStr s["View Request List"]
]
]
li [] [
a [ _href $"https://docs.prayer.bitbadger.solutions/{langCode ()}"
_ariaLabel s["Help"].Value
_title s["View Help"].Value
_target "_blank"
_relNoOpener ] [
icon "help"; space; locStr s["Help"]
]
] ]
| None -> [] ]
|> div [] let rightLinks =
] match m.Group with
| Some _ ->
[ match m.User with
| Some _ ->
li [] [
a [ _href "/user/password"
_ariaLabel s["Change Your Password"].Value
_title s["Change Your Password"].Value ] [
icon "lock"; space; locStr s["Change Your Password"]
]
]
| None -> ()
li [] [
a [ _href "/log-off"; _ariaLabel s["Log Off"].Value; _title s["Log Off"].Value; Target.body ] [
icon "power_settings_new"; space; locStr s["Log Off"]
]
]
]
| None -> []
header [ _class "pt-title-bar"; Target.content ] [
section [ _class "pt-title-bar-left"; _ariaLabel "Left side of top menu" ] [
span [ _class "pt-title-bar-home" ] [
a [ _href "/"; _title s["Home"].Value ] [ locStr s["PrayerTracker"] ]
]
ul [] leftLinks
]
section [ _class "pt-title-bar-center"; _ariaLabel "Empty center space in top menu" ] []
section [ _class "pt-title-bar-right"; _roleToolBar; _ariaLabel "Right side of top menu" ] [
ul [] rightLinks
]
]
/// Identity bar (below top nav)
let identity m =
let s = I18N.localizer.Force ()
header [ _id "pt-language"; Target.body ] [
div [] [
span [ _title s["Language"].Value ] [ icon "record_voice_over"; space ]
match langCode () with
| "es" ->
strong [] [ locStr s["Spanish"] ]
rawText " &nbsp; &nbsp; "
a [ _href "/language/en" ] [ locStr s["Change to English"] ]
| _ ->
strong [] [ locStr s["English"] ]
rawText " &nbsp; &nbsp; "
a [ _href "/language/es" ] [ locStr s["Cambie a Español"] ]
]
match m.Group with
| Some g ->
[ match m.User with
| Some u ->
span [ _class "u" ] [ locStr s["Currently Logged On"] ]
rawText "&nbsp; &nbsp;"
icon "person"
strong [] [ str u.Name ]
rawText "&nbsp; &nbsp; "
| None ->
locStr s["Logged On as a Member of"]
rawText "&nbsp; "
icon "group"
space
match m.User with
| Some _ -> a [ _href "/small-group"; Target.content ] [ strong [] [ str g.Name ] ]
| None -> strong [] [ str g.Name ]
]
| None -> []
|> div []
]
/// Content layouts /// Content layouts
module Content = module Content =
/// Content layout that tops at 60rem
let standard = div [ _class "pt-content" ] /// Content layout that tops at 60rem
let standard = div [ _class "pt-content" ]
/// Content layout that uses the full width of the browser window /// Content layout that uses the full width of the browser window
let wide = div [ _class "pt-content pt-full-width" ] let wide = div [ _class "pt-content pt-full-width" ]
/// Separator for parts of the title /// Separator for parts of the title
let private titleSep = rawText " &#xab; " let private titleSep = rawText " &#xab; "
let private commonHead = /// Common HTML head tag items
[ meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ] let private commonHead = [
meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
meta [ _name "generator"; _content "Giraffe" ] meta [ _name "generator"; _content "Giraffe" ]
link [ _rel "stylesheet"; _href "https://fonts.googleapis.com/icon?family=Material+Icons" ] link [ _rel "stylesheet"; _href "https://fonts.googleapis.com/icon?family=Material+Icons" ]
link [ _rel "stylesheet"; _href "/css/app.css" ] link [ _rel "stylesheet"; _href "/css/app.css" ]
script [ _src "/js/app.js" ] [] ]
]
/// Render the <head> portion of the page /// Render the <head> portion of the page
let private htmlHead m pageTitle = let private htmlHead viewInfo pgTitle =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
head [] [ head [] [
meta [ _charset "UTF-8" ] meta [ _charset "UTF-8" ]
title [] [ locStr pageTitle; titleSep; locStr s.["PrayerTracker"] ] title [] [ locStr pgTitle; titleSep; locStr s["PrayerTracker"] ]
yield! commonHead yield! commonHead
for cssFile in m.style do for cssFile in viewInfo.Style do
link [ _rel "stylesheet"; _href $"/css/{cssFile}.css"; _type "text/css" ] link [ _rel "stylesheet"; _href $"/css/{cssFile}.css"; _type "text/css" ]
for jsFile in m.script do
script [ _src $"/js/{jsFile}.js" ] []
] ]
open Giraffe.ViewEngine.Htmx
/// Render a link to the help page for the current page /// Render a link to the help page for the current page
let private helpLink link = let private helpLink link =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
sup [] [ sup [ _class "pt-help-link" ] [
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 $"return PT.showHelp('{link}')" ] [ _onclick $"return PT.showHelp('{link}')"
icon "help_outline" _hxNoBoost ] [
] iconSized 18 "help_outline"
]
] ]
/// Render the page title, and optionally a help link /// Render the page title, and optionally a help link
let private renderPageTitle m pageTitle = let private renderPageTitle viewInfo pgTitle =
h2 [ _id "pt-page-title" ] [ h2 [ _id "pt-page-title" ] [
match m.helpLink with Some link -> Help.fullLink (langCode ()) link |> helpLink | None -> () match viewInfo.HelpLink with
locStr pageTitle | Some link -> PrayerTracker.Utils.Help.fullLink (langCode ()) link |> helpLink
| None -> ()
locStr pgTitle
] ]
/// Render the messages that may need to be displayed to the user /// Render the messages that may need to be displayed to the user
let private messages m = let private messages viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
m.messages if List.isEmpty viewInfo.Messages then []
|> List.map (fun msg -> else
table [ _class $"pt-msg {msg.level.ToLower ()}" ] [ viewInfo.Messages
tr [] [ |> List.map (fun msg ->
td [] [ div [ _class $"pt-msg {MessageLevel.toCssClass msg.Level}" ] [
match msg.level with match msg.Level with
| "Info" -> () | Info -> ()
| lvl -> | lvl ->
strong [] [ locStr s.[lvl] ] strong [] [ locStr s[MessageLevel.toString lvl] ]
rawText " &#xbb; " rawText " &#xbb; "
rawText msg.text.Value rawText msg.Text.Value
match msg.description with match msg.Description with
| Some desc -> | Some desc ->
br [] br []
div [ _class "description" ] [ rawText desc.Value ] div [ _class "description" ] [ rawText desc.Value ]
| None -> () | None -> ()
] ])
] |> div [ _class "pt-messages" ]
]) |> List.singleton
open NodaTime
/// Render the <footer> at the bottom of the page /// Render the <footer> at the bottom of the page
let private htmlFooter m = let private htmlFooter viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let imgText = sprintf "%O %O" s.["PrayerTracker"] s.["from Bit Badger Solutions"] let imgText = $"""%O{s["PrayerTracker"]} %O{s["from Bit Badger Solutions"]}"""
let resultTime = TimeSpan(DateTime.Now.Ticks - m.requestStart).TotalSeconds let resultTime = (SystemClock.Instance.GetCurrentInstant () - viewInfo.RequestStart).TotalSeconds
footer [] [ footer [ _class "pt-footer" ] [
div [ _id "pt-legal" ] [ div [ _id "pt-legal" ] [
a [ _href "/web/legal/privacy-policy" ] [ locStr s.["Privacy Policy"] ] a [ _href "/legal/privacy-policy" ] [ locStr s["Privacy Policy"] ]
rawText " &bull; " rawText " &nbsp; "
a [ _href "/web/legal/terms-of-service" ] [ locStr s.["Terms of Service"] ] a [ _href "/legal/terms-of-service" ] [ locStr s["Terms of Service"] ]
rawText " &bull; " rawText " &nbsp; "
a [ _href "https://github.com/bit-badger/PrayerTracker" a [ _href "https://github.com/bit-badger/PrayerTracker"
_title s.["View source code and get technical support"].Value _title s["View source code and get technical support"].Value
_target "_blank" _target "_blank"
_rel "noopener" ] [ _relNoOpener ] [
locStr s.["Source & Support"] locStr s["Source & Support"]
]
] ]
] div [ _id "pt-footer" ] [
div [ _id "pt-footer" ] [ a [ _href "/"; _style "line-height:28px;" ] [
a [ _href "/web/"; _style "line-height:28px;" ] [ img [ _src $"""/img/%O{s["footer_en"]}.png"""
img [ _src $"""/img/%O{s.["footer_en"]}.png"""; _alt imgText; _title imgText ] _alt imgText
_title imgText
_width "331"; _height "28" ]
]
span [ _id "pt-version" ] [ str viewInfo.Version ]
space
i [ _title s["This page loaded in {0:N3} seconds", resultTime].Value; _class "material-icons md-18" ] [
str "schedule"
]
] ]
str m.version
space
i [ _title s.["This page loaded in {0:N3} seconds", resultTime].Value; _class "material-icons md-18" ] [
str "schedule"
]
]
] ]
/// The standard layout for PrayerTracker /// The content portion of the PrayerTracker layout
let standard m pageTitle (content : XmlNode) = let private contentSection viewInfo pgTitle (content : XmlNode) = [
let s = I18N.localizer.Force () Navigation.identity viewInfo
let ttl = s.[pageTitle] renderPageTitle viewInfo pgTitle
html [ _lang "" ] [ yield! messages viewInfo
htmlHead m ttl match viewInfo.ScopedStyle with
body [] [ | [] -> ()
Navigation.top m | styles -> style [] [ rawText (styles |> String.concat " ") ]
div [ _id "pt-body" ] [ content
Navigation.identity m htmlFooter viewInfo
renderPageTitle m ttl match viewInfo.OnLoadScript with
yield! messages m | Some onLoad ->
content let doCall = if onLoad.EndsWith ")" then "" else "()"
htmlFooter m script [] [
rawText $"""
window.doOnLoad = () => {{
if (window.PT) {{
{onLoad}{doCall}
delete window.doOnLoad
}} else {{ setTimeout(window.doOnLoad, 500) }}
}}
window.doOnLoad()"""
] ]
] | None -> ()
]
/// The HTML head element for partial responses
let private partialHead pgTitle =
let s = I18N.localizer.Force ()
head [] [
meta [ _charset "UTF-8" ]
title [] [ locStr pgTitle; titleSep; locStr s["PrayerTracker"] ]
] ]
open Giraffe.Htmx.Common
/// The body of the PrayerTracker layout
let private pageLayout viewInfo pgTitle content =
body [ _hxBoost ] [
Navigation.top viewInfo
div [ _id "pt-body"; Target.content; _hxSwap $"{HxSwap.InnerHtml} show:window:top" ]
(contentSection viewInfo pgTitle content)
match viewInfo.Layout with
| FullPage ->
Script.minified
script [ _src "/js/ckeditor/ckeditor.js" ] []
script [ _src "/js/app.js" ] []
| _ -> ()
]
/// The standard layout(s) for PrayerTracker
let standard viewInfo pageTitle content =
let s = I18N.localizer.Force ()
let pgTitle = s[pageTitle]
html [ _lang (langCode ()) ] [
match viewInfo.Layout with
| FullPage ->
htmlHead viewInfo pgTitle
pageLayout viewInfo pgTitle content
| PartialPage ->
partialHead pgTitle
pageLayout viewInfo pgTitle content
| ContentOnly ->
partialHead pgTitle
body [] (contentSection viewInfo pgTitle content)
]
/// A layout with nothing but a title and content /// A layout with nothing but a title and content
let bare pageTitle content = let bare pageTitle content =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let ttl = s.[pageTitle] html [ _lang (langCode ()) ] [
html [ _lang "" ] [ partialHead s[pageTitle]
head [] [ body [] [ content ]
meta [ _charset "UTF-8" ]
title [] [ locStr ttl; titleSep; locStr s.["PrayerTracker"] ]
]
body [] [ content ]
] ]

635
src/PrayerTracker.UI/PrayerRequest.fs
View File

@ -1,370 +1,353 @@
module PrayerTracker.Views.PrayerRequest module PrayerTracker.Views.PrayerRequest
open System.Globalization
open System.IO
open Giraffe open Giraffe
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Giraffe.ViewEngine.Accessibility
open Giraffe.ViewEngine.Htmx
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open NodaTime open NodaTime
open PrayerTracker open PrayerTracker
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open System
open System.IO
open System.Text
/// View for the prayer request edit page /// View for the prayer request edit page
let edit (m : EditRequest) today ctx vi = let edit (model : EditRequest) today ctx viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = match m.isNew () with true -> "Add a New Request" | false -> "Edit Request" let pageTitle = if model.IsNew then "Add a New Request" else "Edit Request"
[ form [ _action "/web/prayer-request/save"; _method "post"; _class "pt-center-columns" ] [ let vi = AppViewInfo.withOnLoadScript "PT.initCKEditor" viewInfo
csrfToken ctx form [ _action "/prayer-request/save"
input [ _type "hidden"; _name "requestId"; _value (flatGuid m.requestId) ] _method "post"
div [ _class "pt-field-row" ] [ _class "pt-center-columns"
div [ _class "pt-field" ] [ _onsubmit "PT.updateCKEditor()"
label [ _for "requestType" ] [ locStr s.["Request Type"] ] Target.content ] [
ReferenceList.requestTypeList s csrfToken ctx
|> Seq.ofList inputField "hidden" (nameof model.RequestId) model.RequestId []
|> Seq.map (fun (typ, desc) -> typ.code, desc.Value) div [ _fieldRow ] [
|> selectList "requestType" m.requestType [ _required; _autofocus ] div [ _inputField ] [
] label [ _for (nameof model.RequestType) ] [ locStr s["Request Type"] ]
div [ _class "pt-field" ] [ ReferenceList.requestTypeList s
label [ _for "requestor" ] [ locStr s.["Requestor / Subject"] ] |> Seq.ofList
input [ _type "text" |> Seq.map (fun (typ, desc) -> PrayerRequestType.toCode typ, desc.Value)
_name "requestor" |> selectList (nameof model.RequestType) model.RequestType [ _required; _autofocus ]
_id "requestor" ]
_value (match m.requestor with Some x -> x | None -> "") ] div [ _inputField ] [
] label [ _for (nameof model.Requestor) ] [ locStr s["Requestor / Subject"] ]
match m.isNew () with inputField "text" (nameof model.Requestor) (defaultArg model.Requestor "") []
| true -> ]
div [ _class "pt-field" ] [ if model.IsNew then
label [ _for "enteredDate" ] [ locStr s.["Date"] ] div [ _inputField ] [
input [ _type "date"; _name "enteredDate"; _id "enteredDate"; _placeholder today ] label [ _for (nameof model.EnteredDate) ] [ locStr s["Date"] ]
] inputField "date" (nameof model.EnteredDate) "" [ _placeholder today ]
| false -> ]
div [ _class "pt-field" ] [ else
div [ _class "pt-checkbox-field" ] [ div [ _inputField ] [
br [] br []
input [ _type "checkbox"; _name "skipDateUpdate"; _id "skipDateUpdate"; _value "True" ] div [ _checkboxField ] [
label [ _for "skipDateUpdate" ] [ locStr s.["Check to not update the date"] ] inputField "checkbox" (nameof model.SkipDateUpdate) "True" []
br [] label [ _for (nameof model.SkipDateUpdate) ] [ locStr s["Check to not update the date"] ]
small [] [ em [] [ str (s.["Typo Corrections"].Value.ToLower ()); rawText ", etc." ] ] ]
small [] [ em [] [ str (s["Typo Corrections"].Value.ToLower ()); rawText ", etc." ] ]
] ]
]
] ]
div [ _class "pt-field-row" ] [ div [ _fieldRow ] [
div [ _class "pt-field" ] [ div [ _inputField ] [
label [] [ locStr s.["Expiration"] ] label [] [ locStr s["Expiration"] ]
ReferenceList.expirationList s ((m.isNew >> not) ()) span [ _group ] [
|> List.map (fun exp -> for code, name in ReferenceList.expirationList s (not model.IsNew) do
let radioId = $"expiration_{fst exp}" label [] [ radio (nameof model.Expiration) "" code model.Expiration; locStr name ]
span [ _class "text-nowrap" ] [ ]
radio "expiration" radioId (fst exp) m.expiration ]
label [ _for radioId ] [ locStr (snd exp) ]
rawText " &nbsp; &nbsp; "
])
|> div [ _class "pt-center-text" ]
]
] ]
div [ _class "pt-field-row" ] [ div [ _fieldRow ] [
div [ _class "pt-field pt-editor" ] [ div [ _inputFieldWith [ "pt-editor" ] ] [
label [ _for "text" ] [ locStr s.["Request"] ] label [ _for (nameof model.Text) ] [ locStr s["Request"] ]
textarea [ _name "text"; _id "text" ] [ str m.text ] textarea [ _name (nameof model.Text); _id (nameof model.Text) ] [ str model.Text ]
] ]
] ]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save Request"] ] div [ _fieldRow ] [ submit [] "save" s["Save Request"] ]
]
script [] [ rawText "PT.onLoad(PT.initCKEditor)" ]
] ]
|> Layout.Content.standard |> List.singleton
|> Layout.standard vi pageTitle |> Layout.Content.standard
|> Layout.standard vi pageTitle
/// View for the request e-mail results page /// View for the request e-mail results page
let email m vi = let email model viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = $"""{s.["Prayer Requests"].Value} • {m.listGroup.name}""" let pageTitle = $"""{s["Prayer Requests"].Value} • {model.SmallGroup.Name}"""
let prefs = m.listGroup.preferences let prefs = model.SmallGroup.Preferences
let addresses = let addresses = model.Recipients |> List.map (fun mbr -> $"{mbr.Name} <{mbr.Email}>") |> String.concat ", "
m.recipients [ p [ _style $"font-family:{prefs.FontStack};font-size:%i{prefs.TextFontSize}pt;" ] [
|> List.fold (fun (acc : StringBuilder) mbr -> acc.AppendFormat(", {0} <{1}>", mbr.memberName, mbr.email)) locStr s["The request list was sent to the following people, via individual e-mails"]
(StringBuilder ()) rawText ":"
[ p [ _style $"font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;" ] [ br []
locStr s.["The request list was sent to the following people, via individual e-mails"] small [] [ str addresses ]
rawText ":" ]
br [] span [ _class "pt-email-heading" ] [ locStr s["HTML Format"]; rawText ":" ]
small [] [ str (addresses.Remove(0, 2).ToString ()) ] div [ _class "pt-email-canvas" ] [ rawText (model.AsHtml s) ]
] br []
span [ _class "pt-email-heading" ] [ locStr s.["HTML Format"]; rawText ":" ] br []
div [ _class "pt-email-canvas" ] [ rawText (m.asHtml s) ] span [ _class "pt-email-heading" ] [ locStr s["Plain-Text Format"]; rawText ":" ]
br [] div [ _class "pt-email-canvas" ] [ pre [] [ str (model.AsText s) ] ]
br []
span [ _class "pt-email-heading" ] [ locStr s.["Plain-Text Format"]; rawText ":" ]
div[ _class "pt-email-canvas" ] [ pre [] [ str (m.asText s) ] ]
] ]
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard vi pageTitle |> Layout.standard viewInfo pageTitle
/// View for a small group's public prayer request list /// View for a small group's public prayer request list
let list (m : RequestList) vi = let list (model : RequestList) viewInfo =
[ br [] [ br []
I18N.localizer.Force () |> (m.asHtml >> rawText) I18N.localizer.Force () |> (model.AsHtml >> rawText)
] ]
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard vi "View Request List" |> Layout.standard viewInfo "View Request List"
/// View for the prayer request lists page /// View for the prayer request lists page
let lists (grps : SmallGroup list) vi = let lists (groups : SmallGroupInfo list) viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let l = I18N.forView "Requests/Lists" let l = I18N.forView "Requests/Lists"
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
[ p [] [ let vi = AppViewInfo.withScopedStyles [ "#groupList { grid-template-columns: repeat(3, auto); }" ] viewInfo
raw l.["The groups listed below have either public or password-protected request lists."] [ p [] [
space raw l["The groups listed below have either public or password-protected request lists."]
raw l.["Those with list icons are public, and those with log on icons are password-protected."] space
space raw l["Those with list icons are public, and those with log on icons are password-protected."]
raw l.["Click the appropriate icon to log on or view the request list."] space
] raw l["Click the appropriate icon to log on or view the request list."]
match grps.Length with ]
| 0 -> p [] [ raw l.["There are no groups with public or password-protected request lists."] ] match groups.Length with
| count -> | 0 -> p [] [ raw l["There are no groups with public or password-protected request lists."] ]
tableSummary count s | count ->
table [ _class "pt-table pt-action-table" ] [ tableSummary count s
thead [] [ section [ _id "groupList"; _class "pt-table"; _ariaLabel "Small group list" ] [
tr [] [ div [ _class "row head" ] [
th [] [ locStr s.["Actions"] ] header [ _class "cell" ] [ locStr s["Actions"] ]
th [] [ locStr s.["Church"] ] header [ _class "cell" ] [ locStr s["Church"] ]
th [] [ locStr s.["Group"] ] header [ _class "cell" ] [ locStr s["Group"] ]
] ]
for group in groups do
div [ _class "row" ] [
div [ _class "cell actions" ] [
if group.IsPublic then
a [ _href $"/prayer-requests/{group.Id}/list"; _title s["View"].Value ] [
iconSized 18 "list"
]
else
a [ _href $"/small-group/log-on/{group.Id}"; _title s["Log On"].Value ] [
iconSized 18 "verified_user"
]
]
div [ _class "cell" ] [ str group.ChurchName ]
div [ _class "cell" ] [ str group.Name ]
]
] ]
grps
|> List.map (fun grp ->
let grpId = flatGuid grp.smallGroupId
tr [] [
match grp.preferences.isPublic with
| true ->
a [ _href $"/web/prayer-requests/{grpId}/list"; _title s.["View"].Value ] [ icon "list" ]
| false ->
a [ _href $"/web/small-group/log-on/{grpId}"; _title s.["Log On"].Value ]
[ icon "verified_user" ]
|> List.singleton
|> td []
td [] [ str grp.church.name ]
td [] [ str grp.name ]
])
|> tbody []
]
] ]
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard vi "Request Lists" |> Layout.standard vi "Request Lists"
/// View for the prayer request maintenance page /// View for the prayer request maintenance page
let maintain m (ctx : HttpContext) vi = let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let l = I18N.forView "Requests/Maintain" let l = I18N.forView "Requests/Maintain"
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
let now = m.smallGroup.localDateNow (ctx.GetService<IClock> ()) let group = model.SmallGroup
let typs = ReferenceList.requestTypeList s |> Map.ofList let now = SmallGroup.localDateNow (ctx.GetService<IClock> ()) group
let updReq (req : PrayerRequest) = let types = ReferenceList.requestTypeList s |> Map.ofList
match req.updateRequired now m.smallGroup.preferences.daysToExpire m.smallGroup.preferences.longTermUpdateWeeks with let vi = AppViewInfo.withScopedStyles [ "#requestList { grid-template-columns: repeat(5, auto); }" ] viewInfo
| true -> "pt-request-update" /// Iterate the sequence once, before we render, so we can get the count of it at the top of the table
| false -> "" let requests =
|> _class model.Requests
let reqExp (req : PrayerRequest) = |> List.map (fun req ->
_class (match req.isExpired now m.smallGroup.preferences.daysToExpire with true -> "pt-request-expired" | false -> "") let updateClass =
/// Iterate the sequence once, before we render, so we can get the count of it at the top of the table _class (if PrayerRequest.updateRequired now group req then "cell pt-request-update" else "cell")
let requests = let isExpired = PrayerRequest.isExpired now group req
m.requests let expiredClass = _class (if isExpired then "cell pt-request-expired" else "cell")
|> Seq.map (fun req -> let reqId = shortGuid req.Id.Value
let reqId = flatGuid req.prayerRequestId let reqText = htmlToPlainText req.Text
let reqText = htmlToPlainText req.text let delAction = $"/prayer-request/{reqId}/delete"
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() ].Value
s.["Prayer Request"].Value.ToLower() ] "\\n"
.Value l["(If the prayer request has been answered, or an event has passed, consider inactivating it instead.)"]
"\\n" .Value
l.["(If the prayer request has been answered, or an event has passed, consider inactivating it instead.)"] ]
.Value |> String.concat ""
div [ _class "row" ] [
div [ _class "cell actions" ] [
a [ _href $"/prayer-request/{reqId}/edit"; _title l["Edit This Prayer Request"].Value ] [
iconSized 18 "edit"
]
if isExpired then
a [ _href $"/prayer-request/{reqId}/restore"
_title l["Restore This Inactive Request"].Value ] [
iconSized 18 "visibility"
]
else
a [ _href $"/prayer-request/{reqId}/expire"
_title l["Expire This Request Immediately"].Value ] [
iconSized 18 "visibility_off"
]
a [ _href delAction
_title l["Delete This Request"].Value
_hxPost delAction
_hxConfirm delPrompt ] [
iconSized 18 "delete_forever"
]
]
div [ updateClass ] [
str (req.UpdatedDate.ToString(s["MMMM d, yyyy"].Value, CultureInfo.CurrentUICulture))
]
div [ _class "cell" ] [ locStr types[req.RequestType] ]
div [ expiredClass ] [ str (match req.Requestor with Some r -> r | None -> " ") ]
div [ _class "cell" ] [
match reqText.Length with
| len when len < 60 -> rawText reqText
| _ -> rawText $"{reqText[0..59]}&hellip;"
]
])
|> List.ofSeq
[ br []
div [ _fieldRow ] [
span [ _group ] [
a [ _href $"/prayer-request/{emptyGuid}/edit"; _title s["Add a New Request"].Value ] [
icon "add_circle"; rawText " &nbsp;"; locStr s["Add a New Request"]
]
a [ _href "/prayer-requests/view"; _title s["View Prayer Request List"].Value ] [
icon "list"; rawText " &nbsp;"; locStr s["View Prayer Request List"]
]
match model.SearchTerm with
| Some _ ->
a [ _href "/prayer-requests"; _title l["Clear Search Criteria"].Value ] [
icon "highlight_off"; rawText " &nbsp;"; raw l["Clear Search Criteria"]
]
| None -> ()
] ]
|> String.concat "" ]
tr [] [ form [ _action "/prayer-requests"; _method "get"; _class "pt-center-text pt-search-form"; Target.content ] [
td [] [ inputField "text" "search" (defaultArg model.SearchTerm "") [ _placeholder l["Search requests..."].Value ]
a [ _href $"/web/prayer-request/{reqId}/edit"; _title l.["Edit This Prayer Request"].Value ] space
[ icon "edit" ] submit [] "search" s["Search"]
match req.isExpired now m.smallGroup.preferences.daysToExpire with ]
| true -> br []
a [ _href $"/web/prayer-request/{reqId}/restore" tableSummary requests.Length s
_title l.["Restore This Inactive Request"].Value ] match requests.Length with
[ icon "visibility" ] | 0 -> ()
| false -> | _ ->
a [ _href $"/web/prayer-request/{reqId}/expire" form [ _method "post" ] [
_title l.["Expire This Request Immediately"].Value ] csrfToken ctx
[ icon "visibility_off" ] section [ _id "requestList"; _class "pt-table"; _ariaLabel "Prayer request list" ] [
a [ _href delAction; _title l.["Delete This Request"].Value; div [ _class "row head" ] [
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ] header [ _class "cell" ] [ locStr s["Actions"] ]
[ icon "delete_forever" ] header [ _class "cell" ] [ locStr s["Updated Date"] ]
header [ _class "cell" ] [ locStr s["Type"] ]
header [ _class "cell" ] [ locStr s["Requestor"] ]
header [ _class "cell" ] [ locStr s["Request"] ]
]
yield! requests
]
] ]
td [ updReq req ] [ div [ _class "pt-center-text" ] [
str (req.updatedDate.ToString(s.["MMMM d, yyyy"].Value, Globalization.CultureInfo.CurrentUICulture)) br []
] match model.OnlyActive with
td [] [ locStr typs.[req.requestType] ] | Some true ->
td [ reqExp req ] [ str (match req.requestor with Some r -> r | None -> " ") ] raw l["Inactive requests are currently not shown"]
td [] [ br []
match reqText.Length with a [ _href "/prayer-requests/inactive" ] [ raw l["Show Inactive Requests"] ]
| len when len < 60 -> rawText reqText | _ ->
| _ -> rawText $"{reqText.[0..59]}&hellip;" if Option.isSome model.OnlyActive then
] raw l["Inactive requests are currently shown"]
]) br []
|> List.ofSeq a [ _href "/prayer-requests" ] [ raw l["Do Not Show Inactive Requests"] ]
[ div [ _class "pt-center-text" ] [ br []
br [] br []
a [ _href $"/web/prayer-request/{emptyGuid}/edit"; _title s.["Add a New Request"].Value ] let search = [ match model.SearchTerm with Some s -> "search", s | None -> () ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New Request"] ] let pg = defaultArg model.PageNbr 1
rawText " &nbsp; &nbsp; &nbsp; " let url =
a [ _href "/web/prayer-requests/view"; _title s.["View Prayer Request List"].Value ] match model.OnlyActive with Some true | None -> "" | _ -> "/inactive"
[ icon "list"; rawText " &nbsp;"; locStr s.["View Prayer Request List"] ] |> sprintf "/prayer-requests%s"
match m.searchTerm with match pg with
| Some _ -> | 1 -> ()
rawText " &nbsp; &nbsp; &nbsp; " | _ ->
a [ _href "/web/prayer-requests"; _title l.["Clear Search Criteria"].Value ] // button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ]
[ icon "highlight_off"; rawText " &nbsp;"; raw l.["Clear Search Criteria"] ] let withPage = match pg with 2 -> search | _ -> ("page", string (pg - 1)) :: search
| None -> () a [ _href (makeUrl url withPage) ] [ icon "keyboard_arrow_left"; space; raw l["Previous Page"] ]
] rawText " &nbsp; &nbsp; "
form [ _action "/web/prayer-requests"; _method "get"; _class "pt-center-text pt-search-form" ] [ match requests.Length = model.SmallGroup.Preferences.PageSize with
input [ _type "text" | true ->
_name "search" a [ _href (makeUrl url (("page", string (pg + 1)) :: search)) ] [
_placeholder l.["Search requests..."].Value raw l["Next Page"]; space; icon "keyboard_arrow_right"
_value (defaultArg m.searchTerm "") ]
] | false -> ()
space ]
submit [] "search" s.["Search"]
]
br []
tableSummary requests.Length s
match requests.Length with
| 0 -> ()
| _ ->
table [ _class "pt-table pt-action-table" ] [
thead [] [
tr [] [
th [] [ locStr s.["Actions"] ]
th [] [ locStr s.["Updated Date"] ]
th [] [ locStr s.["Type"] ]
th [] [ locStr s.["Requestor"] ]
th [] [ locStr s.["Request"] ]
]
]
tbody [] requests
]
div [ _class "pt-center-text" ] [
br []
match m.onlyActive with
| Some true ->
raw l.["Inactive requests are currently not shown"]
br []
a [ _href "/web/prayer-requests/inactive" ] [ raw l.["Show Inactive Requests"] ]
| _ ->
match Option.isSome m.onlyActive with
| true ->
raw l.["Inactive requests are currently shown"]
br []
a [ _href "/web/prayer-requests" ] [ raw l.["Do Not Show Inactive Requests"] ]
br []
br []
| false -> ()
let srch = [ match m.searchTerm with Some s -> "search", s | None -> () ]
let pg = defaultArg m.pageNbr 1
let url =
match m.onlyActive with Some true | None -> "" | _ -> "/inactive" |> sprintf "/web/prayer-requests%s"
match pg with
| 1 -> ()
| _ ->
// button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ]
let withPage = match pg with 2 -> srch | _ -> ("page", string (pg - 1)) :: srch
a [ _href (makeUrl url withPage) ]
[ icon "keyboard_arrow_left"; space; raw l.["Previous Page"] ]
rawText " &nbsp; &nbsp; "
match requests.Length = m.smallGroup.preferences.pageSize with
| true ->
a [ _href (makeUrl url (("page", string (pg + 1)) :: srch)) ]
[ raw l.["Next Page"]; space; icon "keyboard_arrow_right" ]
| false -> ()
]
form [ _id "DeleteForm"; _action ""; _method "post" ] [ csrfToken ctx ]
] ]
|> Layout.Content.wide |> Layout.Content.wide
|> Layout.standard vi (match m.searchTerm with Some _ -> "Search Results" | None -> "Maintain Requests") |> Layout.standard vi (match model.SearchTerm with Some _ -> "Search Results" | None -> "Maintain Requests")
/// View for the printable prayer request list /// View for the printable prayer request list
let print m version = let print model version =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = $"""{s.["Prayer Requests"].Value} • {m.listGroup.name}""" let pageTitle = $"""{s["Prayer Requests"].Value} • {model.SmallGroup.Name}"""
let imgAlt = $"""{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 (model.AsHtml s)
br [] br []
hr [] hr []
div [ _style $"font-size:70%%;font-family:{m.listGroup.preferences.listFonts};" ] [ div [ _style $"font-size:70%%;font-family:{model.SmallGroup.Preferences.FontStack};" ] [
img [ _src $"""/img/{s.["footer_en"].Value}.png""" 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 ]
space space
str version str version
] ]
] ]
|> Layout.bare pageTitle |> Layout.bare pageTitle
/// View for the prayer request list /// View for the prayer request list
let view m vi = let view model viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = $"""{s.["Prayer Requests"].Value} • {m.listGroup.name}""" let pageTitle = $"""{s["Prayer Requests"].Value} • {model.SmallGroup.Name}"""
let spacer = rawText " &nbsp; &nbsp; &nbsp; " let dtString = model.Date.ToString ("yyyy-MM-dd", CultureInfo.InvariantCulture)
let dtString = m.date.ToString "yyyy-MM-dd" [ br []
[ div [ _class "pt-center-text" ] [ div [ _fieldRow ] [
br [] span [ _group ] [
a [ _class "pt-icon-link" a [ _class "pt-icon-link"
_href $"/web/prayer-requests/print/{dtString}" _href $"/prayer-requests/print/{dtString}"
_title s.["View Printable"].Value ] [ _target "_blank"
icon "print"; rawText " &nbsp;"; locStr s.["View Printable"] _title s["View Printable"].Value ] [
] icon "print"; rawText " &nbsp;"; locStr s["View Printable"]
match m.canEmail with
| true ->
spacer
match m.date.DayOfWeek = DayOfWeek.Sunday with
| true -> ()
| false ->
let rec findSunday (date : DateTime) =
match date.DayOfWeek = DayOfWeek.Sunday with
| true -> date
| false -> findSunday (date.AddDays 1.)
let sunday = findSunday m.date
a [ _class "pt-icon-link"
_href $"""/web/prayer-requests/view/{sunday.ToString "yyyy-MM-dd"}"""
_title s.["List for Next Sunday"].Value ] [
icon "update"; rawText " &nbsp;"; locStr s.["List for Next Sunday"]
] ]
spacer if model.CanEmail then
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 if model.Date.DayOfWeek <> IsoDayOfWeek.Sunday then
a [ _class "pt-icon-link" let rec findSunday (date : LocalDate) =
_href $"/web/prayer-requests/email/{dtString}" if date.DayOfWeek = IsoDayOfWeek.Sunday then date else findSunday (date.PlusDays 1)
_title s.["Send via E-mail"].Value let sunday = findSunday model.Date
_onclick $"return PT.requests.view.promptBeforeEmail('{emailPrompt}')" ] [ a [ _class "pt-icon-link"
icon "mail_outline"; rawText " &nbsp;"; locStr s.["Send via E-mail"] _href $"""/prayer-requests/view/{sunday.ToString ("yyyy-MM-dd", CultureInfo.InvariantCulture)}"""
_title s["List for Next Sunday"].Value ] [
icon "update"; rawText " &nbsp;"; locStr s["List for Next Sunday"]
]
a [ _class "pt-icon-link"
_href $"/prayer-requests/email/{dtString}"
_title s["Send via E-mail"].Value
_hxConfirm 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 ] [
icon "mail_outline"; rawText " &nbsp;"; locStr s["Send via E-mail"]
]
a [ _class "pt-icon-link"; _href "/prayer-requests"; _title s["Maintain Prayer Requests"].Value ] [
icon "compare_arrows"; rawText " &nbsp;"; locStr s["Maintain Prayer Requests"]
]
] ]
spacer ]
a [ _class "pt-icon-link"; _href "/web/prayer-requests"; _title s.["Maintain Prayer Requests"].Value ] [ br []
icon "compare_arrows"; rawText " &nbsp;"; locStr s.["Maintain Prayer Requests"] rawText (model.AsHtml s)
]
| false -> ()
]
br []
rawText (m.asHtml s)
] ]
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard vi pageTitle |> Layout.standard viewInfo pageTitle

6
src/PrayerTracker.UI/PrayerTracker.UI.fsproj
View File

@ -18,14 +18,16 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Giraffe" Version="5.0.0" /> <PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" /> <PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" />
<PackageReference Include="MailKit" Version="2.15.0" /> <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.0" />
<PackageReference Include="MailKit" Version="3.3.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="13.0.1" /> <PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

70
src/PrayerTracker.UI/Resources/Common.es.resx
View File

@ -396,8 +396,8 @@
<data name="The group member “{0}” was deleted successfully" xml:space="preserve"> <data name="The group member “{0}” was deleted successfully" xml:space="preserve">
<value>El miembro del grupo “{0}” se eliminó con éxito</value> <value>El miembro del grupo “{0}” se eliminó con éxito</value>
</data> </data>
<data name="The group {0} and its {1} prayer request(s) was deleted successfully (revoked access from {2} user(s))" xml:space="preserve"> <data name="The group “{0}” and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)" xml:space="preserve">
<value>El grupo {0} y sus {1} peticion(es) de oración se ha eliminado correctamente (acceso revocada por {2} usuario(s))</value> <value>El grupo “{0}” y sus {1} peticion(es) de oración se ha eliminado correctamente; acceso revocada por {2} usuario(s)</value>
</data> </data>
<data name="The old password was incorrect - your password was NOT changed" xml:space="preserve"> <data name="The old password was incorrect - your password was NOT changed" xml:space="preserve">
<value>La contraseña antigua es incorrecta - la contraseña NO ha cambiado</value> <value>La contraseña antigua es incorrecta - la contraseña NO ha cambiado</value>
@ -417,8 +417,8 @@
<data name="There are no classes with passwords defined" xml:space="preserve"> <data name="There are no classes with passwords defined" xml:space="preserve">
<value>No hay clases con contraseñas se define</value> <value>No hay clases con contraseñas se define</value>
</data> </data>
<data name="This is likely due to one of the following reasons:&lt;ul&gt;&lt;li&gt;The e-mail address “{0}” is invalid.&lt;/li&gt;&lt;li&gt;The password entered does not match the password for the given e-mail address.&lt;/li&gt;&lt;li&gt;You are not authorized to administer the group “{1}”.&lt;/li&gt;&lt;/ul&gt;" xml:space="preserve"> <data name="This is likely due to one of the following reasons:&lt;ul&gt;&lt;li&gt;The e-mail address “{0}” is invalid.&lt;/li&gt;&lt;li&gt;The password entered does not match the password for the given e-mail address.&lt;/li&gt;&lt;li&gt;You are not authorized to administer the selected group.&lt;/li&gt;&lt;/ul&gt;" xml:space="preserve">
<value>Esto es probablemente debido a una de las siguientes razones:&lt;ul&gt;&lt;li&gt;La dirección de correo electrónico “{0}” no es válida.&lt;/li&gt;&lt;li&gt;La contraseña introducida no coincide con la contraseña de la determinada dirección de correo electrónico.&lt;/li&gt;&lt;li&gt;Usted no está autorizado para administrar el grupo “{1}”.&lt;/li&gt;&lt;/ul&gt;</value> <value>Esto es probablemente debido a una de las siguientes razones:&lt;ul&gt;&lt;li&gt;La dirección de correo electrónico “{0}” no es válida.&lt;/li&gt;&lt;li&gt;La contraseña introducida no coincide con la contraseña de la determinada dirección de correo electrónico.&lt;/li&gt;&lt;li&gt;Usted no está autorizado para administrar el grupo seleccionado.&lt;/li&gt;&lt;/ul&gt;</value>
</data> </data>
<data name="This page loaded in {0:N3} seconds" xml:space="preserve"> <data name="This page loaded in {0:N3} seconds" xml:space="preserve">
<value>Esta página cargada en {0:N3} segundos</value> <value>Esta página cargada en {0:N3} segundos</value>
@ -742,7 +742,7 @@
<value>Este</value> <value>Este</value>
</data> </data>
<data name="MMMM d, yyyy" xml:space="preserve"> <data name="MMMM d, yyyy" xml:space="preserve">
<value>d \de MMMM yyyy</value> <value>d \d\e MMMM yyyy</value>
</data> </data>
<data name="Mountain" xml:space="preserve"> <data name="Mountain" xml:space="preserve">
<value>Montaña</value> <value>Montaña</value>
@ -822,4 +822,64 @@
<data name="as of" xml:space="preserve"> <data name="as of" xml:space="preserve">
<value>como de</value> <value>como de</value>
</data> </data>
<data name="State or Province" xml:space="preserve">
<value>Estado o Provincia</value>
</data>
<data name="Last Seen" xml:space="preserve">
<value>Ultima vez Visto</value>
</data>
<data name="Administrators" xml:space="preserve">
<value>Administradores</value>
</data>
<data name="Native Fonts" xml:space="preserve">
<value>Fuentes Nativas</value>
</data>
<data name="Named Fonts" xml:space="preserve">
<value>Fuentes con Nombre</value>
</data>
<data name="Select Church" xml:space="preserve">
<value>Seleccione una Iglesia</value>
</data>
<data name="Select Group" xml:space="preserve">
<value>Seleccione un Grupo</value>
</data>
<data name="Member Name" xml:space="preserve">
<value>Nombre de Miembro</value>
</data>
<data name="Custom Color" xml:space="preserve">
<value>Color Personalizado</value>
</data>
<data name="Church Name" xml:space="preserve">
<value>Nombre de la Iglesia</value>
</data>
<data name="City" xml:space="preserve">
<value>Ciudad</value>
</data>
<data name="Has an Interface with “{0}”" xml:space="preserve">
<value>Tiene una Interfaz con “{0}”</value>
</data>
<data name="Interface URL" xml:space="preserve">
<value>URL de la Interfaz</value>
</data>
<data name="Successfully {0} church “{1}”" xml:space="preserve">
<value>Iglesia “{1}” {0} con éxito</value>
</data>
<data name="The church “{0}” and its {1} small group(s) (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)" xml:space="preserve">
<value>La iglesia "{0}" y sus {1} grupo(s) (con {2} peticion(es) de oración) se eliminaron correctamente; acceso revocado de {3} usuario(s)</value>
</data>
<data name="Successfully {0} group “{1}”" xml:space="preserve">
<value>El grupo “{1}” {0} con éxito</value>
</data>
<data name="First Name" xml:space="preserve">
<value>Primer Nombre</value>
</data>
<data name="Last Name" xml:space="preserve">
<value>Apellido</value>
</data>
<data name="Password Again" xml:space="preserve">
<value>Contraseña otra Vez</value>
</data>
<data name="This User Is a {0} Administrator" xml:space="preserve">
<value>Este Usuario Es un Administrador de {0}</value>
</data>
</root> </root>

2
src/PrayerTracker.UI/Resources/Views/Home/PrivacyPolicy.es.resx
View File

@ -147,7 +147,7 @@
<data name="If you utilize the “{0}” box on sign in, a second cookie is stored, and transmitted to establish a session; this cookie is removed by clicking the “{1}” link." xml:space="preserve"> <data name="If you utilize the “{0}” box on sign in, a second cookie is stored, and transmitted to establish a session; this cookie is removed by clicking the “{1}” link." xml:space="preserve">
<value>Si utilizas el cuadro "{0}" al iniciar sesión, se almacena una segunda cookie y se transmite para establecer una sesión; esta cookie se elimina haciendo clic en el enlace "{1}".</value> <value>Si utilizas el cuadro "{0}" al iniciar sesión, se almacena una segunda cookie y se transmite para establecer una sesión; esta cookie se elimina haciendo clic en el enlace "{1}".</value>
</data> </data>
<data name="It also stores names and e-mail addreses of small group members, and plain-text passwords for small groups with password-protected lists." xml:space="preserve"> <data name="It also stores names and e-mail addresses of small group members, and plain-text passwords for small groups with password-protected lists." xml:space="preserve">
<value>También almacena nombres y direcciones de correo electrónico de miembros de grupos pequeños, y contraseñas de texto sin formato para grupos pequeños con listas protegidas por contraseña.</value> <value>También almacena nombres y direcciones de correo electrónico de miembros de grupos pequeños, y contraseñas de texto sin formato para grupos pequeños con listas protegidas por contraseña.</value>
</data> </data>
<data name="On the server, all data is stored in a controlled-access database." xml:space="preserve"> <data name="On the server, all data is stored in a controlled-access database." xml:space="preserve">

12
src/PrayerTracker.UI/Resources/Views/SmallGroup/Preferences.es.resx
View File

@ -117,16 +117,16 @@
<resheader name="writer"> <resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader> </resheader>
<data name="Ending with either “serif” or “sans-serif” will cause the user's browser to use the default “serif” font (“Times New Roman” on Windows) or “sans-serif” font (“Arial” on Windows) if no other fonts in the list are found." xml:space="preserve"> <data name="Ending this list with either “serif” or “sans-serif” will cause the user's browser to use the default “serif” font (“Times New Roman” on Windows) or “sans-serif” font (“Arial” on Windows) if no other fonts in the list are found." xml:space="preserve">
<value>Con la extensión “serif” o el “sans-serif” hará que el navegador del usuario para utilizar el valor predeterminado “serif” de la fuente (“Times New Roman” en Windows) o “sans-serif” de la fuente (“Arial” en Windows) si no otras fuentes en la lista se encuentran.</value> <value>Terminar esta lista con “serif” o “sans-serif” hará que el navegador del usuario utilice la fuente predeterminado “serif” (“Times New Roman” en Windows) o “sans-serif” (“Arial” en Windows) si no se encuentran otras fuentes en la lista.</value>
</data> </data>
<data name="If you want a custom color, you may be able to get some ideas (and a list of RGB values for those colors) from the W3 School's &lt;a href=&quot;http://www.w3schools.com/html/html_colornames.asp&quot; title=&quot;HTML Color List - W3 School&quot;&gt;HTML color name list&lt;/a&gt;." xml:space="preserve"> <data name="If you want a custom color, you may be able to get some ideas (and a list of RGB values for those colors) from the W3 School's &lt;a href=&quot;http://www.w3schools.com/html/html_colornames.asp&quot; title=&quot;HTML Color List - W3 School&quot;&gt;HTML color name list&lt;/a&gt;." xml:space="preserve">
<value>Si desea un color personalizado, que puede ser capaz de obtener algunas ideas (y una lista de valores RGB para los colores) de la lista de la Escuela de W3 de &lt;a href="http://www.w3schools.com/html/html_colornames.asp" title="La Lista de Nombres de Colores HTML - La Escuela de W3"&gt;nombres de colores HTML&lt;/a&gt;.</value> <value>Si desea un color personalizado, que puede ser capaz de obtener algunas ideas (y una lista de valores RGB para los colores) de la lista de la Escuela de W3 de &lt;a href="http://www.w3schools.com/html/html_colornames.asp" title="La Lista de Nombres de Colores HTML - La Escuela de W3"&gt;nombres de colores HTML&lt;/a&gt;.</value>
</data> </data>
<data name="List font names, separated by commas." xml:space="preserve"> <data name="Native fonts match the default font based on the user's device (computer, phone, tablet, etc.)." xml:space="preserve">
<value>Lista de nombres de fuentes separados por comas.</value> <value>Las fuentes nativas coinciden con la fuente predeterminada según el dispositivo del usuario (computadora, teléfono, tableta, etc.).</value>
</data> </data>
<data name="The first font that is matched is the one that is used." xml:space="preserve"> <data name="Named fonts should be separated by commas, and will be displayed using the first one the user has in the list." xml:space="preserve">
<value>La primera fuente que se corresponde es el que se utiliza.</value> <value>Las fuentes con nombre deben estar separadas por comas y se mostrarán usando la primera que el usuario tenga en la lista.</value>
</data> </data>
</root> </root>

1050
src/PrayerTracker.UI/SmallGroup.fs
View File

File diff suppressed because it is too large Load Diff

405
src/PrayerTracker.UI/User.fs
View File

@ -1,226 +1,245 @@
module PrayerTracker.Views.User module PrayerTracker.Views.User
open Giraffe.ViewEngine open Giraffe.ViewEngine
open PrayerTracker.Entities open Giraffe.ViewEngine.Accessibility
open Giraffe.ViewEngine.Htmx
open PrayerTracker
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
/// View for the group assignment page /// View for the group assignment page
let assignGroups m groups curGroups ctx vi = let assignGroups model groups curGroups ctx viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = sprintf "%s • %A" m.userName s.["Assign Groups"] let pageTitle = sprintf "%s • %A" model.UserName s["Assign Groups"]
form [ _action "/web/user/small-groups/save"; _method "post"; _class "pt-center-columns" ] [ let vi = AppViewInfo.withScopedStyles [ "#groupList { grid-template-columns: auto; }" ] viewInfo
csrfToken ctx form [ _action "/user/small-groups/save"; _method "post"; _class "pt-center-columns"; Target.content ] [
input [ _type "hidden"; _name "userId"; _value (flatGuid m.userId) ] csrfToken ctx
input [ _type "hidden"; _name "userName"; _value m.userName ] inputField "hidden" (nameof model.UserId) model.UserId []
table [ _class "pt-table" ] [ inputField "hidden" (nameof model.UserName) model.UserName []
thead [] [ section [ _id "groupList"; _class "pt-table"; _ariaLabel "Assigned small groups" ] [
tr [] [ div [ _class "row head" ] [
th [] [ rawText "&nbsp;" ] header [ _class "cell" ] [ locStr s["Group"] ]
th [] [ locStr s.["Group"] ] ]
] for groupId, name in groups do
div [ _class "row" ] [
div [ _class "cell" ] [
input [ _type "checkbox"
_name (nameof model.SmallGroups)
_id groupId
_value groupId
if List.contains groupId curGroups then _checked ]
space
label [ _for groupId ] [ str name ]
]
]
] ]
groups div [ _fieldRow ] [ submit [] "save" s["Save Group Assignments"] ]
|> List.map (fun (grpId, grpName) ->
let inputId = $"id-{grpId}"
tr [] [
td [] [
input [ _type "checkbox"
_name "smallGroups"
_id inputId
_value grpId
match curGroups |> List.contains grpId with true -> _checked | false -> () ]
]
td [] [ label [ _for inputId ] [ str grpName ] ]
])
|> tbody []
]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save Group Assignments"] ]
] ]
|> List.singleton |> List.singleton
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard vi pageTitle |> Layout.standard vi pageTitle
/// View for the password change page /// View for the password change page
let changePassword ctx vi = let changePassword ctx viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
[ p [ _class "pt-center-text" ] [ let model = { OldPassword = ""; NewPassword = ""; NewPasswordConfirm = "" }
locStr s.["To change your password, enter your current password in the specified box below, then enter your new password twice."] let vi =
] viewInfo
form [ _action "/web/user/password/change" |> AppViewInfo.withScopedStyles [
_method "post" let fields =
_onsubmit $"""return PT.compareValidation('newPassword','newPasswordConfirm','%A{s.["The passwords do not match"]}')""" ] [ toHtmlIds [ nameof model.OldPassword; nameof model.NewPassword; nameof model.NewPasswordConfirm ]
style [ _scoped ] [ rawText "#oldPassword, #newPassword, #newPasswordConfirm { width: 10rem; } "] $"{fields} {{ width: 10rem; }}"
csrfToken ctx
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "oldPassword" ] [ locStr s.["Current Password"] ]
input [ _type "password"; _name "oldPassword"; _id "oldPassword"; _required; _autofocus ]
]
] ]
div [ _class "pt-field-row" ] [ [ p [ _class "pt-center-text" ] [
div [ _class "pt-field" ] [ locStr s["To change your password, enter your current password in the specified box below, then enter your new password twice."]
label [ _for "newPassword" ] [ locStr s.["New Password Twice"] ]
input [ _type "password"; _name "newPassword"; _id "newPassword"; _required ]
]
div [ _class "pt-field" ] [
label [] [ rawText "&nbsp;" ]
input [ _type "password"; _name "newPasswordConfirm"; _id "newPasswordConfirm"; _required ]
]
] ]
div [ _class "pt-field-row" ] [ form [ _action "/user/password/change"
submit [ _onclick "document.getElementById('newPasswordConfirm').setCustomValidity('')" ] "done" _method "post"
s.["Change Your Password"] _onsubmit $"""return PT.compareValidation('{nameof model.NewPassword}','{nameof model.NewPasswordConfirm}','%A{s["The passwords do not match"]}')"""
Target.content ] [
csrfToken ctx
div [ _fieldRow ] [
div [ _inputField ] [
label [ _for (nameof model.OldPassword) ] [ locStr s["Current Password"] ]
inputField "password" (nameof model.OldPassword) "" [ _required; _autofocus ]
]
]
div [ _fieldRow ] [
div [ _inputField ] [
label [ _for (nameof model.NewPassword) ] [ locStr s["New Password Twice"] ]
inputField "password" (nameof model.NewPassword) "" [ _required ]
]
div [ _inputField ] [
label [ _for (nameof model.NewPasswordConfirm) ] [ rawText "&nbsp;" ]
inputField "password" (nameof model.NewPasswordConfirm) "" [ _required ]
]
]
div [ _fieldRow ] [
submit [
_onclick $"document.getElementById('{nameof model.NewPasswordConfirm}').setCustomValidity('')"
] "done" s["Change Your Password"]
]
] ]
]
] ]
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard vi "Change Your Password" |> Layout.standard vi "Change Your Password"
/// View for the edit user page /// View for the edit user page
let edit (m : EditUser) ctx vi = let edit (model : EditUser) ctx viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = match m.isNew () with true -> "Add a New User" | false -> "Edit User" let pageTitle = if model.IsNew then "Add a New User" else "Edit User"
let pwPlaceholder = s.[match m.isNew () with true -> "" | false -> "No change"].Value let pwPlaceholder = s[if model.IsNew then "" else "No change"].Value
[ form [ _action "/web/user/edit/save"; _method "post"; _class "pt-center-columns" let vi =
_onsubmit $"""return PT.compareValidation('password','passwordConfirm','%A{s.["The passwords do not match"]}')""" ] [ viewInfo
style [ _scoped ] |> AppViewInfo.withScopedStyles [
[ rawText "#firstName, #lastName, #password, #passwordConfirm { width: 10rem; } #emailAddress { width: 20rem; } " ] let fields =
csrfToken ctx [ nameof model.FirstName; nameof model.LastName; nameof model.Password; nameof model.PasswordConfirm ]
input [ _type "hidden"; _name "userId"; _value (flatGuid m.userId) ] |> toHtmlIds
div [ _class "pt-field-row" ] [ $"{fields} {{ width: 10rem; }}"
div [ _class "pt-field" ] [ $"#{nameof model.Email} {{ width: 20rem; }}"
label [ _for "firstName" ] [ locStr s.["First Name"] ]
input [ _type "text"; _name "firstName"; _id "firstName"; _value m.firstName; _required; _autofocus ]
]
div [ _class "pt-field" ] [
label [ _for "lastName" ] [ locStr s.["Last Name"] ]
input [ _type "text"; _name "lastName"; _id "lastName"; _value m.lastName; _required ]
]
div [ _class "pt-field" ] [
label [ _for "emailAddress" ] [ locStr s.["E-mail Address"] ]
input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _value m.emailAddress; _required ]
]
] ]
div [ _class "pt-field-row" ] [ |> AppViewInfo.withOnLoadScript $"PT.user.edit.onPageLoad({(string model.IsNew).ToLowerInvariant ()})"
div [ _class "pt-field" ] [ form [ _action "/user/edit/save"
label [ _for "password" ] [ locStr s.["Password"] ] _method "post"
input [ _type "password"; _name "password"; _id "password"; _placeholder pwPlaceholder ] _class "pt-center-columns"
] _onsubmit $"""return PT.compareValidation('{nameof model.Password}','{nameof model.PasswordConfirm}','%A{s["The passwords do not match"]}')"""
div [ _class "pt-field" ] [ Target.content ] [
label [ _for "passwordConfirm" ] [ locStr s.["Password Again"] ] csrfToken ctx
input [ _type "password"; _name "passwordConfirm"; _id "passwordConfirm"; _placeholder pwPlaceholder ] inputField "hidden" (nameof model.UserId) model.UserId []
] div [ _fieldRow ] [
div [ _inputField ] [
label [ _for (nameof model.FirstName) ] [ locStr s["First Name"] ]
inputField "text" (nameof model.FirstName) model.FirstName [ _required; _autofocus ]
]
div [ _inputField ] [
label [ _for (nameof model.LastName) ] [ locStr s["Last Name"] ]
inputField "text" (nameof model.LastName) model.LastName [ _required ]
]
div [ _inputField ] [
label [ _for (nameof model.Email) ] [ locStr s["E-mail Address"] ]
inputField "email" (nameof model.Email) model.Email [ _required ]
]
] ]
div [ _class "pt-checkbox-field" ] [ div [ _fieldRow ] [
input [ _type "checkbox" div [ _inputField ] [
_name "isAdmin" label [ _for (nameof model.Password) ] [ locStr s["Password"] ]
_id "isAdmin" inputField "password" (nameof model.Password) "" [ _placeholder pwPlaceholder ]
_value "True" ]
match m.isAdmin with Some x when x -> _checked | _ -> () ] div [ _inputField ] [
label [ _for "isAdmin" ] [ locStr s.["This user is a PrayerTracker administrator"] ] label [ _for "passwordConfirm" ] [ locStr s["Password Again"] ]
inputField "password" (nameof model.PasswordConfirm) "" [ _placeholder pwPlaceholder ]
]
] ]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save User"] ] div [ _checkboxField ] [
] inputField "checkbox" (nameof model.IsAdmin) "True" [ if defaultArg model.IsAdmin false then _checked ]
script [] [ rawText $"PT.onLoad(PT.user.edit.onPageLoad({(string (m.isNew ())).ToLower ()}))" ] label [ _for (nameof model.IsAdmin) ] [ locStr s["This User Is a {0} Administrator", s["PrayerTracker"]] ]
]
div [ _fieldRow ] [ submit [] "save" s["Save User"] ]
] ]
|> Layout.Content.standard |> List.singleton
|> Layout.standard vi pageTitle |> Layout.Content.standard
|> Layout.standard vi pageTitle
/// View for the user log on page /// View for the user log on page
let logOn (m : UserLogOn) groups ctx vi = let logOn (model : UserLogOn) groups ctx viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
form [ _action "/web/user/log-on"; _method "post"; _class "pt-center-columns" ] [ let vi = AppViewInfo.withScopedStyles [ $"#{nameof model.Email} {{ width: 20rem; }}" ] viewInfo
style [ _scoped ] [ rawText "#emailAddress { width: 20rem; }" ] form [ _action "/user/log-on"; _method "post"; _class "pt-center-columns"; Target.body ] [
csrfToken ctx csrfToken ctx
input [ _type "hidden"; _name "redirectUrl"; _value (defaultArg m.redirectUrl "") ] inputField "hidden" (nameof model.RedirectUrl) (defaultArg model.RedirectUrl "") []
div [ _class "pt-field-row" ] [ div [ _fieldRow ] [
div [ _class "pt-field" ] [ div [ _inputField ] [
label [ _for "emailAddress"] [ locStr s.["E-mail Address"] ] label [ _for (nameof model.Email) ] [ locStr s["E-mail Address"] ]
input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _value m.emailAddress; _required; _autofocus ] inputField "email" (nameof model.Email) model.Email [ _required; _autofocus ]
]
div [ _inputField ] [
label [ _for (nameof model.Password) ] [ locStr s["Password"] ]
inputField "password" (nameof model.Password) "" [
_placeholder $"""({s["Case-Sensitive"].Value.ToLower ()})"""; _required
]
]
] ]
div [ _class "pt-field" ] [ div [ _fieldRow ] [
label [ _for "password" ] [ locStr s.["Password"] ] div [ _inputField ] [
input [ _type "password"; _name "password"; _id "password"; _required; label [ _for (nameof model.SmallGroupId) ] [ locStr s["Group"] ]
_placeholder (sprintf "(%s)" (s.["Case-Sensitive"].Value.ToLower ())) ] seq { "", selectDefault s["Select Group"].Value; yield! groups }
|> selectList (nameof model.SmallGroupId) "" [ _required ]
]
] ]
] div [ _checkboxField ] [
div [ _class "pt-field-row" ] [ inputField "checkbox" (nameof model.RememberMe) "True" []
div [ _class "pt-field" ] [ label [ _for "rememberMe" ] [ locStr s["Remember Me"] ]
label [ _for "smallGroupId" ] [ locStr s.["Group"] ] br []
seq { small [] [ em [] [ str $"""({s["Requires Cookies"].Value.ToLower ()})""" ] ]
"", selectDefault s.["Select Group"].Value
yield! groups
}
|> selectList "smallGroupId" "" [ _required ]
] ]
] div [ _fieldRow ] [ submit [] "account_circle" s["Log On"] ]
div [ _class "pt-checkbox-field" ] [
input [ _type "checkbox"; _name "rememberMe"; _id "rememberMe"; _value "True" ]
label [ _for "rememberMe" ] [ locStr s.["Remember Me"] ]
br []
small [] [ em [] [ rawText "("; str (s.["Requires Cookies"].Value.ToLower ()); rawText ")" ] ]
]
div [ _class "pt-field-row" ] [ submit [] "account_circle" s.["Log On"] ]
] ]
|> List.singleton |> List.singleton
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard vi "User Log On" |> Layout.standard vi "User Log On"
open PrayerTracker.Entities
/// View for the user maintenance page /// View for the user maintenance page
let maintain (users : User list) ctx vi = let maintain (users : User list) ctx viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let usrTbl = let vi = AppViewInfo.withScopedStyles [ "#userList { grid-template-columns: repeat(4, auto); }" ] viewInfo
match users with let userTable =
| [] -> space match users with
| _ -> | [] -> space
table [ _class "pt-table pt-action-table" ] [ | _ ->
thead [] [ section [ _id "userList"; _class "pt-table"; _ariaLabel "User list" ] [
tr [] [ div [ _class "row head" ] [
th [] [ locStr s.["Actions"] ] header [ _class "cell" ] [ locStr s["Actions"] ]
th [] [ locStr s.["Name"] ] header [ _class "cell" ] [ locStr s["Name"] ]
th [] [ locStr s.["Admin?"] ] header [ _class "cell" ] [ locStr s["Last Seen"] ]
] header [ _class "cell" ] [ locStr s["Admin?"] ]
]
for user in users do
let userId = shortGuid user.Id.Value
let delAction = $"/user/{userId}/delete"
let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.",
$"""{s["User"].Value.ToLower ()} ({user.Name})"""].Value
div [ _class "row" ] [
div [ _class "cell actions" ] [
a [ _href $"/user/{userId}/edit"; _title s["Edit This User"].Value ] [ iconSized 18 "edit" ]
a [ _href $"/user/{userId}/small-groups"; _title s["Assign Groups to This User"].Value ] [
iconSized 18 "group"
]
a [ _href delAction
_title s["Delete This User"].Value
_hxPost delAction
_hxConfirm delPrompt ] [
iconSized 18 "delete_forever"
]
]
div [ _class "cell" ] [ str user.Name ]
div [ _class "cell" ] [
match user.LastSeen with
| Some dt -> dt.ToString (s["MMMM d, yyyy"].Value, null)
| None -> "--"
|> str
]
div [ _class "cell pt-center-text" ] [
if user.IsAdmin then strong [] [ locStr s["Yes"] ] else locStr s["No"]
]
]
] ]
users [ div [ _class "pt-center-text" ] [
|> List.map (fun user -> br []
let userId = flatGuid user.userId a [ _href $"/user/{emptyGuid}/edit"; _title s["Add a New User"].Value ] [
let delAction = $"/web/user/{userId}/delete" icon "add_circle"; rawText " &nbsp;"; locStr s["Add a New User"]
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.", ]
$"""{s.["User"].Value.ToLower ()} ({user.fullName})"""].Value br []
tr [] [ br []
td [] [ ]
a [ _href $"/web/user/{userId}/edit"; _title s.["Edit This User"].Value ] [ icon "edit" ] tableSummary users.Length s
a [ _href $"/web/user/{userId}/small-groups"; _title s.["Assign Groups to This User"].Value ] form [ _method "post" ] [
[ icon "group" ] csrfToken ctx
a [ _href delAction userTable
_title s.["Delete This User"].Value ]
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ]
]
td [] [ str user.fullName ]
td [ _class "pt-center-text" ] [
match user.isAdmin with
| true -> strong [] [ locStr s.["Yes"] ]
| false -> locStr s.["No"]
]
])
|> tbody []
]
[ div [ _class "pt-center-text" ] [
br []
a [ _href $"/web/user/{emptyGuid}/edit"; _title s.["Add a New User"].Value ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New User"] ]
br []
br []
]
tableSummary users.Length s
usrTbl
form [ _id "DeleteForm"; _action ""; _method "post" ] [ csrfToken ctx ]
] ]
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard vi "Maintain Users" |> Layout.standard vi "Maintain Users"

299
src/PrayerTracker.UI/Utils.fs
View File

@ -1,207 +1,206 @@
[<AutoOpen>] [<AutoOpen>]
module PrayerTracker.Utils module PrayerTracker.Utils
open System.Net open System
open System.Security.Cryptography open System.Security.Cryptography
open System.Text open System.Text
open System.Text.RegularExpressions
open System
/// Hash a string with a SHA1 hash open Giraffe
let sha1Hash (x : string) =
use alg = SHA1.Create ()
alg.ComputeHash (Encoding.ASCII.GetBytes x)
|> Seq.map (fun chr -> chr.ToString "x2")
|> String.concat ""
/// Parse a short-GUID-based ID from a string
let idFromShort<'T> (f : Guid -> 'T) strValue =
(ShortGuid.toGuid >> f) strValue
/// Hash a string using 1,024 rounds of PBKDF2 and a salt /// Format a GUID as a short GUID
let pbkdf2Hash (salt : Guid) (x : string) = let shortGuid = ShortGuid.fromGuid
use alg = new Rfc2898DeriveBytes (x, Encoding.UTF8.GetBytes (salt.ToString "N"), 1024)
(alg.GetBytes >> Convert.ToBase64String) 64 /// An empty short GUID string (used for "add" actions)
let emptyGuid = shortGuid Guid.Empty
/// String helper functions /// String helper functions
module String = module String =
/// string.Trim() /// string.Trim()
let trim (str: string) = str.Trim () let trim (str: string) = str.Trim ()
/// string.Replace() /// string.Replace()
let replace (find : string) repl (str : string) = str.Replace (find, repl) let replace (find : string) repl (str : string) = str.Replace (find, repl)
/// Replace the first occurrence of a string with a second string within a given string /// Replace the first occurrence of a string with a second string within a given string
let replaceFirst (needle : string) replacement (haystack : string) = let replaceFirst (needle : string) replacement (haystack : string) =
match haystack.IndexOf needle with match haystack.IndexOf needle with
| -1 -> haystack | -1 -> haystack
| idx -> | idx -> String.concat "" [ haystack[0..idx - 1]; replacement; haystack[idx + needle.Length..] ]
[ haystack.[0..idx - 1]
replacement /// Convert a string to an option, with null, blank, and whitespace becoming None
haystack.[idx + needle.Length..] let noneIfBlank (str : string) =
] match str with
|> String.concat "" | null -> None
| it when it.Trim () = "" -> None
| it -> Some it
open System.Text.RegularExpressions
/// Strip HTML tags from the given string /// Strip HTML tags from the given string
// Adapted from http://www.dijksterhuis.org/safely-cleaning-html-with-strip_tags-in-csharp/ // Adapted from http://www.dijksterhuis.org/safely-cleaning-html-with-strip_tags-in-csharp/
let stripTags allowedTags input = let stripTags allowedTags input =
let stripHtmlExp = Regex @"(<\/?[^>]+>)" let stripHtmlExp = Regex @"(<\/?[^>]+>)"
let mutable output = input let mutable output = input
for tag in stripHtmlExp.Matches input do for tag in stripHtmlExp.Matches input do
let htmlTag = tag.Value.ToLower () let htmlTag = tag.Value.ToLower ()
let isAllowed = let shouldReplace =
allowedTags allowedTags
|> List.fold |> List.fold (fun acc t ->
(fun acc t -> acc
acc
|| htmlTag.IndexOf $"<{t}>" = 0 || htmlTag.IndexOf $"<{t}>" = 0
|| htmlTag.IndexOf $"<{t} " = 0 || htmlTag.IndexOf $"<{t} " = 0
|| htmlTag.IndexOf $"</{t}" = 0) false || htmlTag.IndexOf $"</{t}" = 0) false
match isAllowed with |> not
| true -> () if shouldReplace then output <- String.replaceFirst tag.Value "" output
| false -> output <- String.replaceFirst tag.Value "" output output
output
/// Wrap a string at the specified number of characters /// Wrap a string at the specified number of characters
let wordWrap charPerLine (input : string) = let wordWrap charPerLine (input : string) =
match input.Length with match input.Length with
| len when len <= charPerLine -> input | len when len <= charPerLine -> input
| _ -> | _ ->
seq { seq {
for line in input.Replace("\r", "").Split '\n' do for line in input.Replace("\r", "").Split '\n' do
let mutable remaining = line let mutable remaining = line
match remaining.Length with match remaining.Length with
| 0 -> () | 0 -> ()
| _ -> | _ ->
while charPerLine < remaining.Length do while charPerLine < remaining.Length do
match charPerLine + 1 < remaining.Length && remaining.[charPerLine] = ' ' with if charPerLine + 1 < remaining.Length && remaining[charPerLine] = ' ' then
| true -> // Line length is followed by a space; return [charPerLine] as a line
// Line length is followed by a space; return [charPerLine] as a line yield remaining[0..charPerLine - 1]
yield remaining.[0..charPerLine - 1] remaining <- remaining[charPerLine + 1..]
remaining <- remaining.[charPerLine + 1..] else
| false -> match remaining[0..charPerLine - 1].LastIndexOf ' ' with
match remaining.[0..charPerLine - 1].LastIndexOf ' ' with | -1 ->
| -1 -> // No whitespace; just break it at [characters]
// No whitespace; just break it at [characters] yield remaining[0..charPerLine - 1]
yield remaining.[0..charPerLine - 1] remaining <- remaining[charPerLine..]
remaining <- remaining.[charPerLine..] | spaceIdx ->
| spaceIdx -> // Break on the last space in the line
// Break on the last space in the line yield remaining[0..spaceIdx - 1]
yield remaining.[0..spaceIdx - 1] remaining <- remaining[spaceIdx + 1..]
remaining <- remaining.[spaceIdx + 1..] // Leftovers - yum!
// Leftovers - yum! match remaining.Length with 0 -> () | _ -> yield remaining
match remaining.Length with 0 -> () | _ -> yield remaining yield ""
} }
|> Seq.fold (fun (acc : StringBuilder) line -> acc.AppendFormat ("{0}\n", line)) (StringBuilder ()) |> String.concat "\n"
|> string
/// Modify the text returned by CKEditor into the format we need for request and announcement text /// Modify the text returned by CKEditor into the format we need for request and announcement text
let ckEditorToText (text : string) = let ckEditorToText (text : string) =
let trim (str : string) = str.Trim () [ "\n\t", ""
[ "\n\t", "" "&nbsp;", " "
"&nbsp;", " " " ", "&#xa0; "
" ", "&#xa0; " "</p><p>", "<br><br>"
"</p><p>", "<br><br>" "</p>", ""
"</p>", "" "<p>", ""
"<p>", ""
] ]
|> List.fold (fun (txt : string) (x, y) -> String.replace x y txt) text |> List.fold (fun (txt : string) (x, y) -> String.replace x y txt) text
|> trim |> String.trim
open System.Net
/// Convert an HTML piece of text to plain text /// Convert an HTML piece of text to plain text
let htmlToPlainText html = let htmlToPlainText html =
match html with match html with
| null | "" -> "" | null | "" -> ""
| _ -> | _ ->
html.Trim () html.Trim ()
|> stripTags [ "br" ] |> stripTags [ "br" ]
|> String.replace "<br />" "\n" |> String.replace "<br />" "\n"
|> String.replace "<br>" "\n" |> String.replace "<br>" "\n"
|> WebUtility.HtmlDecode |> WebUtility.HtmlDecode
|> String.replace "\u00a0" " " |> String.replace "\u00a0" " "
/// Get the second portion of a tuple as a string /// Get the second portion of a tuple as a string
let sndAsString x = (snd >> string) x let sndAsString x = (snd >> string) x
/// Make a URL with query string parameters /// Make a URL with query string parameters
let makeUrl (url : string) (qs : (string * string) list) = let makeUrl url qs =
let queryString = if List.isEmpty qs then url
qs else $"""{url}?{String.Join('&', List.map (fun (k, v) -> $"%s{k}={WebUtility.UrlEncode v}") qs)}"""
|> List.fold
(fun (acc : StringBuilder) (key, value) ->
acc.Append(key).Append("=").Append(WebUtility.UrlEncode value).Append "&")
(StringBuilder ())
match queryString.Length with
| 0 -> url
| _ -> queryString.Insert(0, "?").Insert(0, url).Remove(queryString.Length - 1, 1).ToString ()
/// "Magic string" repository /// "Magic string" repository
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Key = module Key =
/// This contains constants for session-stored objects within PrayerTracker /// The request start time (added via middleware, read when rendering the footer)
module Session = let startTime = "StartTime"
/// The currently logged-on small group
let currentGroup = "CurrentGroup" /// This contains constants for session-stored objects within PrayerTracker
/// The currently logged-on user module Session =
let currentUser = "CurrentUser"
/// User messages to be displayed the next time a page is sent /// The currently logged-on small group
let userMessages = "UserMessages" let currentGroup = "CurrentGroup"
/// The URL to which the user should be redirected once they have logged in
let redirectUrl = "RedirectUrl" /// The currently logged-on user
let currentUser = "CurrentUser"
/// Names and value names for use with cookies
module Cookie = /// User messages to be displayed the next time a page is sent
/// The name of the user cookie let userMessages = "UserMessages"
let user = "LoggedInUser"
/// The name of the class cookie /// The URL to which the user should be redirected once they have logged in
let group = "LoggedInClass" let redirectUrl = "RedirectUrl"
/// The name of the culture cookie
let culture = "CurrentCulture"
/// The name of the idle timeout cookie
let timeout = "TimeoutCookie"
/// The cookies that should be cleared when a user or group logs off
let logOffCookies = [ user; group; timeout ]
/// Enumerated values for small group request list visibility (derived from preferences, used in UI) /// Enumerated values for small group request list visibility (derived from preferences, used in UI)
module RequestVisibility = module GroupVisibility =
/// Requests are publicly accessible
[<Literal>] /// Requests are publicly accessible
let ``public`` = 1 [<Literal>]
/// The small group members can enter a password to view the request list let PublicList = 1
[<Literal>]
let passwordProtected = 2 /// The small group members can enter a password to view the request list
/// No one can see the requests for a small group except its administrators ("User" access level) [<Literal>]
[<Literal>] let HasPassword = 2
let ``private`` = 3
/// No one can see the requests for a small group except its administrators ("User" access level)
[<Literal>]
let PrivateList = 3
/// Links for help locations /// Links for help locations
module Help = module Help =
/// Help link for small group preference edit page
let groupPreferences = "small-group/preferences" /// Help link for small group preference edit page
/// Help link for send announcement page let groupPreferences = "small-group/preferences"
let sendAnnouncement = "small-group/announcement"
/// Help link for maintain group members page /// Help link for send announcement page
let maintainGroupMembers = "small-group/members" let sendAnnouncement = "small-group/announcement"
/// Help link for request edit page
let editRequest = "requests/edit" /// Help link for maintain group members page
/// Help link for maintain requests page let maintainGroupMembers = "small-group/members"
let maintainRequests = "requests/maintain"
/// Help link for view request list page /// Help link for request edit page
let viewRequestList = "requests/view" let editRequest = "requests/edit"
/// Help link for user and class login pages
let logOn = "user/log-on" /// Help link for maintain requests page
/// Help link for user password change page let maintainRequests = "requests/maintain"
let changePassword = "user/password"
/// Create a full link for a help page /// Help link for view request list page
let fullLink lang url = $"https://docs.prayer.bitbadger.solutions/%s{lang}/%s{url}.html" let viewRequestList = "requests/view"
/// Help link for user and class login pages
let logOn = "user/log-on"
/// Help link for user password change page
let changePassword = "user/password"
/// Create a full link for a help page
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 () =
do () do ()

1295
src/PrayerTracker.UI/ViewModels.fs
View File

File diff suppressed because it is too large Load Diff

1
src/PrayerTracker.sln
View File

@ -14,7 +14,6 @@ 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
Publish-App.ps1 = Publish-App.ps1
EndProjectSection EndProjectSection
EndProject EndProject
Global Global

430
src/PrayerTracker/App.fs
View File

@ -1,201 +1,277 @@
namespace PrayerTracker namespace PrayerTracker
open Microsoft.AspNetCore.Http
/// Middleware to add the starting ticks for the request
type RequestStartMiddleware (next : RequestDelegate) =
member this.InvokeAsync (ctx : HttpContext) = task {
ctx.Items[Key.startTime] <- ctx.Now
return! next.Invoke ctx
}
open System
open Microsoft.AspNetCore.Builder open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.Hosting open Microsoft.AspNetCore.Hosting
open Microsoft.Extensions.Configuration
/// Module to hold configuration for the web app /// Module to hold configuration for the web app
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Configure = module Configure =
open Cookies /// Set up the configuration for the app
open Giraffe let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) =
open Giraffe.EndpointRouting cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath)
open Microsoft.AspNetCore.Localization .AddJsonFile("appsettings.json", optional = true, reloadOnChange = true)
open Microsoft.AspNetCore.Server.Kestrel.Core .AddJsonFile($"appsettings.{ctx.HostingEnvironment.EnvironmentName}.json", optional = true)
open Microsoft.EntityFrameworkCore .AddEnvironmentVariables()
open Microsoft.Extensions.Configuration |> ignore
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Hosting
open Microsoft.Extensions.Localization
open Microsoft.Extensions.Logging
open Microsoft.Extensions.Options
open NodaTime
open System.Globalization
/// Set up the configuration for the app open Microsoft.AspNetCore.Server.Kestrel.Core
let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) =
cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath) /// Configure Kestrel from appsettings.json
.AddJsonFile("appsettings.json", optional = true, reloadOnChange = true) let kestrel (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
.AddJsonFile($"appsettings.{ctx.HostingEnvironment.EnvironmentName}.json", optional = true) (ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
.AddEnvironmentVariables()
|> ignore
/// Configure Kestrel from appsettings.json open System.Globalization
let kestrel (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) = open Microsoft.AspNetCore.Authentication.Cookies
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel" open Microsoft.AspNetCore.Localization
open Microsoft.Extensions.Caching.Distributed
let services (svc : IServiceCollection) = open Microsoft.Extensions.DependencyInjection
svc.AddOptions() open NodaTime
.AddLocalization(fun options -> options.ResourcesPath <- "Resources") open Npgsql
.Configure<RequestLocalizationOptions>( open PrayerTracker.Data
fun (opts : RequestLocalizationOptions) ->
let supportedCultures = /// Configure ASP.NET Core's service collection (dependency injection container)
[| CultureInfo "en-US"; CultureInfo "en-GB"; CultureInfo "en-AU"; CultureInfo "en" let services (svc : IServiceCollection) =
CultureInfo "es-MX"; CultureInfo "es-ES"; CultureInfo "es" let _ = svc.AddOptions ()
|] let _ = svc.AddLocalization (fun options -> options.ResourcesPath <- "Resources")
opts.DefaultRequestCulture <- RequestCulture ("en-US", "en-US") let _ =
opts.SupportedCultures <- supportedCultures svc.Configure<RequestLocalizationOptions> (fun (opts : RequestLocalizationOptions) ->
opts.SupportedUICultures <- supportedCultures) let supportedCultures =[|
.AddDistributedMemoryCache() CultureInfo "en-US"; CultureInfo "en-GB"; CultureInfo "en-AU"; CultureInfo "en"
.AddSession() CultureInfo "es-MX"; CultureInfo "es-ES"; CultureInfo "es"
.AddAntiforgery() |]
.AddRouting() opts.DefaultRequestCulture <- RequestCulture ("en-US", "en-US")
.AddSingleton<IClock>(SystemClock.Instance) opts.SupportedCultures <- supportedCultures
|> ignore opts.SupportedUICultures <- supportedCultures)
let config = svc.BuildServiceProvider().GetRequiredService<IConfiguration>() let _ =
let crypto = config.GetSection "CookieCrypto" svc.AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme)
CookieCrypto (crypto.["Key"], crypto.["IV"]) |> setCrypto .AddCookie (fun opts ->
svc.AddDbContext<AppDbContext>( opts.ExpireTimeSpan <- TimeSpan.FromMinutes 120.
(fun options -> opts.SlidingExpiration <- true
options.UseNpgsql (config.GetConnectionString "PrayerTracker") |> ignore), opts.AccessDeniedPath <- "/error/403")
ServiceLifetime.Scoped, ServiceLifetime.Singleton) let _ = svc.AddAuthorization ()
|> ignore let _ =
svc.AddSingleton<IDistributedCache> (fun sp ->
/// Routes for PrayerTracker let cfg = sp.GetService<IConfiguration> ()
let routes = DistributedCache (cfg.GetConnectionString "PrayerTracker") :> IDistributedCache)
[ subRoute "/web" [ let _ = svc.AddSession ()
let _ = svc.AddAntiforgery ()
let _ = svc.AddRouting ()
let _ = svc.AddSingleton<IClock> SystemClock.Instance
let _ =
svc.AddScoped<NpgsqlConnection>(fun sp ->
let cfg = sp.GetService<IConfiguration> ()
let conn = new NpgsqlConnection (cfg.GetConnectionString "PrayerTracker")
conn.OpenAsync () |> Async.AwaitTask |> Async.RunSynchronously
conn)
let _ = NpgsqlConnection.GlobalTypeMapper.UseNodaTime ()
()
open Giraffe
let noWeb : HttpHandler = fun next ctx ->
redirectTo true $"""/{string ctx.Request.RouteValues["path"]}""" next ctx
open Giraffe.EndpointRouting
/// Routes for PrayerTracker
let routes = [
route "/web/{**path}" noWeb
GET_HEAD [ GET_HEAD [
subRoute "/church" [ subRoute "/church" [
route "es" Handlers.Church.maintain route "es" Handlers.Church.maintain
routef "/%O/edit" Handlers.Church.edit routef "/%O/edit" Handlers.Church.edit
] ]
route "/class/logon" (redirectTo true "/web/small-group/log-on") route "/class/logon" (redirectTo true "/small-group/log-on")
routef "/error/%s" Handlers.Home.error routef "/error/%s" Handlers.Home.error
routef "/language/%s" Handlers.Home.language routef "/language/%s" Handlers.Home.language
subRoute "/legal" [ subRoute "/legal" [
route "/privacy-policy" Handlers.Home.privacyPolicy route "/privacy-policy" Handlers.Home.privacyPolicy
route "/terms-of-service" Handlers.Home.tos route "/terms-of-service" Handlers.Home.tos
] ]
route "/log-off" Handlers.Home.logOff route "/log-off" Handlers.Home.logOff
subRoute "/prayer-request" [ subRoute "/prayer-request" [
route "s" (Handlers.PrayerRequest.maintain true) route "s" (Handlers.PrayerRequest.maintain true)
routef "s/email/%s" Handlers.PrayerRequest.email routef "s/email/%s" Handlers.PrayerRequest.email
route "s/inactive" (Handlers.PrayerRequest.maintain false) route "s/inactive" (Handlers.PrayerRequest.maintain false)
route "s/lists" Handlers.PrayerRequest.lists route "s/lists" Handlers.PrayerRequest.lists
routef "s/%O/list" Handlers.PrayerRequest.list routef "s/%O/list" Handlers.PrayerRequest.list
route "s/maintain" (redirectTo true "/web/prayer-requests") route "s/maintain" (redirectTo true "/prayer-requests")
routef "s/print/%s" Handlers.PrayerRequest.print routef "s/print/%s" Handlers.PrayerRequest.print
route "s/view" (Handlers.PrayerRequest.view None) route "s/view" (Handlers.PrayerRequest.view None)
routef "s/view/%s" (Some >> Handlers.PrayerRequest.view) routef "s/view/%s" (Some >> Handlers.PrayerRequest.view)
routef "/%O/edit" Handlers.PrayerRequest.edit routef "/%O/edit" Handlers.PrayerRequest.edit
routef "/%O/expire" Handlers.PrayerRequest.expire routef "/%O/expire" Handlers.PrayerRequest.expire
routef "/%O/restore" Handlers.PrayerRequest.restore routef "/%O/restore" Handlers.PrayerRequest.restore
] ]
subRoute "/small-group" [ subRoute "/small-group" [
route "" Handlers.SmallGroup.overview route "" Handlers.SmallGroup.overview
route "s" Handlers.SmallGroup.maintain route "s" Handlers.SmallGroup.maintain
route "/announcement" Handlers.SmallGroup.announcement route "/announcement" Handlers.SmallGroup.announcement
routef "/%O/edit" Handlers.SmallGroup.edit routef "/%O/edit" Handlers.SmallGroup.edit
route "/log-on" (Handlers.SmallGroup.logOn None) route "/log-on" (Handlers.SmallGroup.logOn None)
routef "/log-on/%O" (Some >> Handlers.SmallGroup.logOn) routef "/log-on/%O" (Some >> Handlers.SmallGroup.logOn)
route "/logon" (redirectTo true "/web/small-group/log-on") route "/logon" (redirectTo true "/small-group/log-on")
routef "/member/%O/edit" Handlers.SmallGroup.editMember routef "/member/%O/edit" Handlers.SmallGroup.editMember
route "/members" Handlers.SmallGroup.members route "/members" Handlers.SmallGroup.members
route "/preferences" Handlers.SmallGroup.preferences route "/preferences" Handlers.SmallGroup.preferences
] ]
route "/unauthorized" Handlers.Home.unauthorized route "/unauthorized" Handlers.Home.unauthorized
subRoute "/user" [ subRoute "/user" [
route "s" Handlers.User.maintain route "s" Handlers.User.maintain
routef "/%O/edit" Handlers.User.edit routef "/%O/edit" Handlers.User.edit
routef "/%O/small-groups" Handlers.User.smallGroups routef "/%O/small-groups" Handlers.User.smallGroups
route "/log-on" Handlers.User.logOn route "/log-on" Handlers.User.logOn
route "/logon" (redirectTo true "/web/user/log-on") route "/logon" (redirectTo true "/user/log-on")
route "/password" Handlers.User.password route "/password" Handlers.User.password
] ]
route "/" Handlers.Home.homePage route "/" Handlers.Home.homePage
]
POST [
subRoute "/church" [
routef "/%O/delete" Handlers.Church.delete
route "/save" Handlers.Church.save
]
subRoute "/prayer-request" [
routef "/%O/delete" Handlers.PrayerRequest.delete
route "/save" Handlers.PrayerRequest.save
]
subRoute "/small-group" [
route "/announcement/send" Handlers.SmallGroup.sendAnnouncement
routef "/%O/delete" Handlers.SmallGroup.delete
route "/log-on/submit" Handlers.SmallGroup.logOnSubmit
routef "/member/%O/delete" Handlers.SmallGroup.deleteMember
route "/member/save" Handlers.SmallGroup.saveMember
route "/preferences/save" Handlers.SmallGroup.savePreferences
route "/save" Handlers.SmallGroup.save
]
subRoute "/user" [
routef "/%O/delete" Handlers.User.delete
route "/edit/save" Handlers.User.save
route "/log-on" Handlers.User.doLogOn
route "/password/change" Handlers.User.changePassword
route "/small-groups/save" Handlers.User.saveGroups
]
]
] ]
// Temp redirect to new URLs POST [
route "/" (redirectTo false "/web/") subRoute "/church" [
] routef "/%O/delete" Handlers.Church.delete
route "/save" Handlers.Church.save
]
subRoute "/prayer-request" [
routef "/%O/delete" Handlers.PrayerRequest.delete
route "/save" Handlers.PrayerRequest.save
]
subRoute "/small-group" [
route "/announcement/send" Handlers.SmallGroup.sendAnnouncement
routef "/%O/delete" Handlers.SmallGroup.delete
route "/log-on/submit" Handlers.SmallGroup.logOnSubmit
routef "/member/%O/delete" Handlers.SmallGroup.deleteMember
route "/member/save" Handlers.SmallGroup.saveMember
route "/preferences/save" Handlers.SmallGroup.savePreferences
route "/save" Handlers.SmallGroup.save
]
subRoute "/user" [
routef "/%O/delete" Handlers.User.delete
route "/edit/save" Handlers.User.save
route "/log-on" Handlers.User.doLogOn
route "/password/change" Handlers.User.changePassword
route "/small-groups/save" Handlers.User.saveGroups
]
]
]
/// Giraffe error handler open Microsoft.Extensions.Logging
let errorHandler (ex : exn) (logger : ILogger) =
logger.LogError(EventId(), ex, "An unhandled exception has occurred while executing the request.") /// Giraffe error handler
clearResponse >=> setStatusCode 500 >=> text ex.Message let errorHandler (ex : exn) (logger : ILogger) =
logger.LogError (EventId(), ex, "An unhandled exception has occurred while executing the request.")
/// Configure logging clearResponse >=> setStatusCode 500 >=> text ex.Message
let logging (log : ILoggingBuilder) =
let env = log.Services.BuildServiceProvider().GetService<IWebHostEnvironment> () open Microsoft.Extensions.Hosting
match env.IsDevelopment () with
| true -> log /// Configure logging
| false -> log.AddFilter (fun l -> l > LogLevel.Information) let logging (log : ILoggingBuilder) =
|> function l -> l.AddConsole().AddDebug() let env = log.Services.BuildServiceProvider().GetService<IWebHostEnvironment> ()
|> ignore if env.IsDevelopment () then log else log.AddFilter (fun l -> l > LogLevel.Information)
|> function l -> l.AddConsole().AddDebug()
let app (app : IApplicationBuilder) = |> ignore
let env = app.ApplicationServices.GetRequiredService<IWebHostEnvironment>()
(match env.IsDevelopment () with open Microsoft.Extensions.Localization
| true -> open Microsoft.Extensions.Options
app.UseDeveloperExceptionPage ()
| false -> /// Configure the application
try let app (app : IApplicationBuilder) =
use scope = app.ApplicationServices.GetRequiredService<IServiceScopeFactory>().CreateScope () let env = app.ApplicationServices.GetRequiredService<IWebHostEnvironment>()
scope.ServiceProvider.GetService<AppDbContext>().Database.Migrate () if env.IsDevelopment () then
with _ -> () // om nom nom let _ = app.UseDeveloperExceptionPage ()
app.UseGiraffeErrorHandler errorHandler) ()
.UseStatusCodePagesWithReExecute("/error/{0}") else
.UseStaticFiles() let _ = app.UseGiraffeErrorHandler errorHandler
.UseRouting() ()
.UseSession()
.UseRequestLocalization(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value) let _ = app.UseStatusCodePagesWithReExecute "/error/{0}"
.UseEndpoints (fun e -> e.MapGiraffeEndpoints routes) let _ = app.UseStaticFiles ()
|> ignore let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
Views.I18N.setUpFactories <| app.ApplicationServices.GetRequiredService<IStringLocalizerFactory> () let _ = app.UseMiddleware<RequestStartMiddleware> ()
let _ = app.UseRouting ()
let _ = app.UseSession ()
let _ = app.UseRequestLocalization
(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value)
let _ = app.UseAuthentication ()
let _ = app.UseAuthorization ()
let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints routes)
Views.I18N.setUpFactories <| app.ApplicationServices.GetRequiredService<IStringLocalizerFactory> ()
/// The web application /// The web application
module App = module App =
open System.IO open System.Text
open Microsoft.Extensions.DependencyInjection
open Npgsql
open Npgsql.FSharp
open PrayerTracker.Entities
let migratePasswords (app : IWebHost) =
task {
let config = app.Services.GetService<IConfiguration> ()
use conn = new NpgsqlConnection (config.GetConnectionString "PrayerTracker")
do! conn.OpenAsync ()
let! v1Users =
Sql.existingConnection conn
|> Sql.query "SELECT id, password_hash FROM pt.pt_user WHERE salt IS NULL"
|> Sql.executeAsync (fun row -> UserId (row.uuid "id"), row.string "password_hash")
for userId, oldHash in v1Users do
let pw = Convert.ToBase64String [| 254uy; yield! (Encoding.UTF8.GetBytes oldHash) |]
let! _ =
Sql.existingConnection conn
|> Sql.query "UPDATE pt.pt_user SET password_hash = @hash WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value; "@hash", Sql.string pw ]
|> Sql.executeNonQueryAsync
()
printfn $"Updated {v1Users.Length} users with version 1 password"
let! v2Users =
Sql.existingConnection conn
|> Sql.query "SELECT id, password_hash, salt FROM pt.pt_user WHERE salt IS NOT NULL"
|> Sql.executeAsync (fun row -> UserId (row.uuid "id"), row.string "password_hash", row.uuid "salt")
for userId, oldHash, salt in v2Users do
let pw =
Convert.ToBase64String
[| 255uy; yield! (salt.ToByteArray ()); yield! (Encoding.UTF8.GetBytes oldHash) |]
let! _ =
Sql.existingConnection conn
|> Sql.query "UPDATE pt.pt_user SET password_hash = @hash WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value; "@hash", Sql.string pw ]
|> Sql.executeNonQueryAsync
()
printfn $"Updated {v2Users.Length} users with version 2 password"
} |> Async.AwaitTask |> Async.RunSynchronously
open System.IO
[<EntryPoint>] [<EntryPoint>]
let main _ = let main args =
let contentRoot = Directory.GetCurrentDirectory () let contentRoot = Directory.GetCurrentDirectory ()
WebHostBuilder() let app =
.UseContentRoot(contentRoot) WebHostBuilder()
.ConfigureAppConfiguration(Configure.configuration) .UseContentRoot(contentRoot)
.UseKestrel(Configure.kestrel) .ConfigureAppConfiguration(Configure.configuration)
.UseWebRoot(Path.Combine (contentRoot, "wwwroot")) .UseKestrel(Configure.kestrel)
.ConfigureServices(Configure.services) .UseWebRoot(Path.Combine (contentRoot, "wwwroot"))
.ConfigureLogging(Configure.logging) .ConfigureServices(Configure.services)
.Configure(System.Action<IApplicationBuilder> Configure.app) .ConfigureLogging(Configure.logging)
.Build() .Configure(System.Action<IApplicationBuilder> Configure.app)
.Run () .Build()
0 if args.Length > 0 then
if args[0] = "migrate-passwords" then migratePasswords app
else printfn $"Unrecognized option {args[0]}"
else app.Run ()
0

122
src/PrayerTracker/Church.fs
View File

@ -1,98 +1,78 @@
module PrayerTracker.Handlers.Church module PrayerTracker.Handlers.Church
open System.Threading.Tasks
open Giraffe open Giraffe
open PrayerTracker open PrayerTracker
open PrayerTracker.Data
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open PrayerTracker.Views.CommonFunctions
open System
open System.Threading.Tasks
/// Find statistics for the given church /// Find statistics for the given church
let private findStats (db : AppDbContext) churchId = task { let private findStats churchId conn = task {
let! grps = db.CountGroupsByChurch churchId let! groups = SmallGroups.countByChurch churchId conn
let! reqs = db.CountRequestsByChurch churchId let! requests = PrayerRequests.countByChurch churchId conn
let! usrs = db.CountUsersByChurch churchId let! users = Users.countByChurch churchId conn
return flatGuid churchId, { smallGroups = grps; prayerRequests = reqs; users = usrs } return shortGuid churchId.Value, { SmallGroups = groups; PrayerRequests = requests; Users = users }
} }
/// POST /church/[church-id]/delete /// POST /church/[church-id]/delete
let delete churchId : HttpHandler = let delete chId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ Admin ] let churchId = ChurchId chId
>=> validateCSRF let conn = ctx.Conn
>=> fun next ctx -> task { match! Churches.tryById churchId conn with
match! ctx.db.TryChurchById churchId with
| Some church -> | Some church ->
let! _, stats = findStats ctx.db churchId let! _, stats = findStats churchId conn
ctx.db.RemoveEntry church do! Churches.deleteById churchId conn
let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
addInfo ctx addInfo ctx
s.["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)", ctx.Strings["The church “{0}” and its {1} small group(s) (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)",
church.name, stats.smallGroups, stats.prayerRequests, stats.users] church.Name, stats.SmallGroups, stats.PrayerRequests, stats.Users]
return! redirectTo false "/web/churches" next ctx return! redirectTo false "/churches" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour ctx
} }
open System
/// GET /church/[church-id]/edit /// GET /church/[church-id]/edit
let edit churchId : HttpHandler = let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
requireAccess [ Admin ] if churchId = Guid.Empty then
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
match churchId with
| x when x = Guid.Empty ->
return! return!
viewInfo ctx startTicks viewInfo ctx
|> Views.Church.edit EditChurch.empty ctx |> Views.Church.edit EditChurch.empty ctx
|> renderHtml next ctx |> renderHtml next ctx
| _ -> else
match! ctx.db.TryChurchById churchId with match! Churches.tryById (ChurchId churchId) ctx.Conn with
| Some church -> | Some church ->
return! return!
viewInfo ctx startTicks viewInfo ctx
|> Views.Church.edit (EditChurch.fromChurch church) ctx |> Views.Church.edit (EditChurch.fromChurch church) ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour ctx
} }
/// GET /churches /// GET /churches
let maintain : HttpHandler = let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
requireAccess [ Admin ] let conn = ctx.Conn
>=> fun next ctx -> task { let! churches = Churches.all conn
let startTicks = DateTime.Now.Ticks let stats = churches |> List.map (fun c -> findStats c.Id conn |> Async.AwaitTask |> Async.RunSynchronously)
let await = Async.AwaitTask >> Async.RunSynchronously
let! churches = ctx.db.AllChurches ()
let stats = churches |> List.map (fun c -> await (findStats ctx.db c.churchId))
return! return!
viewInfo ctx startTicks viewInfo ctx
|> Views.Church.maintain churches (stats |> Map.ofList) ctx |> Views.Church.maintain churches (stats |> Map.ofList) ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
/// POST /church/save /// POST /church/save
let save : HttpHandler = let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditChurch> () with match! ctx.TryBindFormAsync<EditChurch> () with
| Ok m -> | Ok model ->
let! church = let! church =
match m.isNew () with if model.IsNew then Task.FromResult (Some { Church.empty with Id = (Guid.NewGuid >> ChurchId) () })
| true -> Task.FromResult<Church option>(Some { Church.empty with churchId = Guid.NewGuid () }) else Churches.tryById (idFromShort ChurchId model.ChurchId) ctx.Conn
| false -> ctx.db.TryChurchById m.churchId
match church with match church with
| Some ch -> | Some ch ->
m.populateChurch ch do! Churches.save (model.PopulateChurch ch) ctx.Conn
|> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry) let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
let! _ = ctx.db.SaveChangesAsync () addInfo ctx ctx.Strings["Successfully {0} church “{1}”", act, model.Name]
let s = Views.I18N.localizer.Force () return! redirectTo false "/churches" next ctx
let act = s.[match m.isNew () with true -> "Added" | _ -> "Updated"].Value.ToLower () | None -> return! fourOhFour ctx
addInfo ctx s.["Successfully {0} church “{1}”", act, m.name] | Result.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
}

291
src/PrayerTracker/CommonFunctions.fs
View File

@ -2,254 +2,165 @@
[<AutoOpen>] [<AutoOpen>]
module PrayerTracker.Handlers.CommonFunctions module PrayerTracker.Handlers.CommonFunctions
open Giraffe
open Microsoft.AspNetCore.Antiforgery
open Microsoft.AspNetCore.Html
open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Http.Extensions
open Microsoft.AspNetCore.Mvc.Rendering open Microsoft.AspNetCore.Mvc.Rendering
open Microsoft.Extensions.Localization
open PrayerTracker
open PrayerTracker.Cookies
open PrayerTracker.ViewModels
open System
open System.Net
open System.Reflection
open System.Threading.Tasks
/// Create a select list from an enumeration /// Create a select list from an enumeration
let toSelectList<'T> valFunc textFunc withDefault emptyText (items : 'T seq) = let toSelectList<'T> valFunc textFunc withDefault emptyText (items : 'T seq) =
match items with null -> nullArg "items" | _ -> () if isNull items then nullArg (nameof items)
[ match withDefault with [ match withDefault with
| true -> | true ->
let s = PrayerTracker.Views.I18N.localizer.Force () let s = PrayerTracker.Views.I18N.localizer.Force ()
yield SelectListItem ($"""&mdash; %A{s.[emptyText]} &mdash;""", "") 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))
] ]
/// Create a select list from an enumeration /// Create a select list from an enumeration
let toSelectListWithEmpty<'T> valFunc textFunc emptyText (items : 'T seq) = let toSelectListWithEmpty<'T> valFunc textFunc emptyText (items : 'T seq) =
toSelectList valFunc textFunc true emptyText items toSelectList valFunc textFunc true emptyText items
/// Create a select list from an enumeration /// Create a select list from an enumeration
let toSelectListWithDefault<'T> valFunc textFunc (items : 'T seq) = let toSelectListWithDefault<'T> valFunc textFunc (items : 'T seq) =
toSelectList valFunc textFunc true "Select" items toSelectList valFunc textFunc true "Select" items
/// The version of PrayerTracker /// The version of PrayerTracker
let appVersion = let appVersion =
let v = Assembly.GetExecutingAssembly().GetName().Version let v = System.Reflection.Assembly.GetExecutingAssembly().GetName().Version
#if (DEBUG) #if (DEBUG)
$"v{v}" $"v{v}"
#else #else
seq { seq {
$"v%d{v.Major}" $"v%d{v.Major}"
match v.Minor with match v.Minor with
| 0 -> match v.Build with 0 -> () | _ -> $".0.%d{v.Build}" | 0 -> match v.Build with 0 -> () | _ -> $".0.%d{v.Build}"
| _ -> | _ ->
$".%d{v.Minor}" $".%d{v.Minor}"
match v.Build with 0 -> () | _ -> $".%d{v.Build}" match v.Build with 0 -> () | _ -> $".%d{v.Build}"
} }
|> String.concat "" |> String.concat ""
#endif #endif
/// The currently signed-in user (will raise if none exists)
let currentUser (ctx : HttpContext) =
match ctx.Session.user with Some u -> u | None -> nullArg "User"
/// The currently signed-in small group (will raise if none exists) open Giraffe
let currentGroup (ctx : HttpContext) = open Giraffe.Htmx
match ctx.Session.smallGroup with Some g -> g | None -> nullArg "SmallGroup" open Microsoft.AspNetCore.Http
open NodaTime
open PrayerTracker
open PrayerTracker.ViewModels
/// Create the common view information heading /// Create the common view information heading
let viewInfo (ctx : HttpContext) startTicks = let viewInfo (ctx : HttpContext) =
let msg = let msg =
match ctx.Session.messages with match ctx.Session.Messages with
| [] -> [] | [] -> []
| x -> | x ->
ctx.Session.messages <- [] ctx.Session.Messages <- []
x x
match ctx.Session.user with let layout =
| Some u -> match ctx.Request.Headers.HxTarget with
// The idle timeout is 2 hours; if the app pool is recycled or the actual session goes away, we will log the | Some hdr when hdr = "pt-body" -> ContentOnly
// user back in transparently using this cookie. Every request resets the timer. | Some _ -> PartialPage
let timeout = | None -> FullPage
{ Id = u.userId { AppViewInfo.fresh with
GroupId = (currentGroup ctx).smallGroupId Version = appVersion
Until = DateTime.UtcNow.AddHours(2.).Ticks Messages = msg
Password = "" RequestStart = ctx.Items[Key.startTime] :?> Instant
} User = ctx.Session.CurrentUser
ctx.Response.Cookies.Append Group = ctx.Session.CurrentGroup
(Key.Cookie.timeout, { timeout with Password = saltedTimeoutHash timeout }.toPayload (), Layout = layout
CookieOptions (Expires = Nullable<DateTimeOffset> (DateTimeOffset (DateTime timeout.Until)), HttpOnly = true)) }
| None -> ()
{ AppViewInfo.fresh with
version = appVersion
messages = msg
requestStart = startTicks
user = ctx.Session.user
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
let renderHtml next ctx view = let renderHtml next ctx view =
htmlView view next ctx htmlView view next ctx
open Microsoft.Extensions.Logging
/// Display an error regarding form submission /// Display an error regarding form submission
let bindError (msg : string) next (ctx : HttpContext) = let bindError (msg : string) =
System.Console.WriteLine msg handleContext (fun ctx ->
ctx.SetStatusCode 400 ctx.GetService<ILoggerFactory>().CreateLogger("PrayerTracker.Handlers").LogError msg
text msg next ctx (setStatusCode 400 >=> text msg) earlyReturn ctx)
/// Handler that will return a status code 404 and the text "Not Found" /// Handler that will return a status code 404 and the text "Not Found"
let fourOhFour next (ctx : HttpContext) = let fourOhFour (ctx : HttpContext) =
ctx.SetStatusCode 404 (setStatusCode 404 >=> text "Not Found") earlyReturn ctx
text "Not Found" next ctx
/// Handler to validate CSRF prevention token /// Handler to validate CSRF prevention token
let validateCSRF : HttpHandler = let validateCsrf : HttpHandler = fun next ctx -> task {
fun next ctx -> task { match! (ctx.GetService<Microsoft.AspNetCore.Antiforgery.IAntiforgery> ()).IsRequestValidAsync ctx with
match! (ctx.GetService<IAntiforgery> ()).IsRequestValidAsync ctx with
| true -> return! next ctx | true -> return! next ctx
| false -> | false -> return! (clearResponse >=> setStatusCode 400 >=> text "Quit hacking...") earlyReturn ctx
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 =
ctx.Session.messages <- msg :: ctx.Session.messages ctx.Session.Messages <- msg :: ctx.Session.Messages
open Microsoft.AspNetCore.Html
open Microsoft.Extensions.Localization
/// Convert a localized string to an HTML string /// Convert a localized string to an HTML string
let htmlLocString (x : LocalizedString) = let htmlLocString (x : LocalizedString) =
(WebUtility.HtmlEncode >> HtmlString) x.Value (System.Net.WebUtility.HtmlEncode >> HtmlString) x.Value
let htmlString (x : LocalizedString) = let htmlString (x : LocalizedString) =
HtmlString x.Value HtmlString x.Value
/// 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
type AccessLevel = type AccessLevel =
/// Administrative access /// Administrative access
| Admin | Admin
/// Small group administrative access /// Small group administrative access
| User | User
/// Small group member access /// Small group member access
| Group | Group
/// Errbody /// Errbody
| Public | Public
/// Require the given access role (also refreshes "Remember Me" user and group logons) open Microsoft.AspNetCore.Http.Extensions
let requireAccess level : HttpHandler = open PrayerTracker.Entities
/// Is there currently a user logged on?
let isUserLoggedOn (ctx : HttpContext) =
ctx.Session.user |> Option.isSome
/// Log a user on from the timeout cookie /// Require one of the given access roles
let logOnUserFromTimeoutCookie (ctx : HttpContext) = task { let requireAccess levels : HttpHandler = fun next ctx -> task {
// Make sure the cookie hasn't been tampered with // These calls fill the user and group in the session, making .Value safe to use for the rest of the request
try let! user = ctx.CurrentUser ()
match TimeoutCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.timeout] with let! group = ctx.CurrentGroup ()
| Some c when c.Password = saltedTimeoutHash c -> match user, group with
let! user = ctx.db.TryUserById c.Id | _, _ when List.contains Public levels -> return! next ctx
match user with | Some _, _ when List.contains User levels -> return! next ctx
| Some _ -> | _, Some _ when List.contains Group levels -> return! next ctx
ctx.Session.user <- user | Some u, _ when List.contains Admin levels && u.IsAdmin -> return! next ctx
let! grp = ctx.db.TryGroupById c.GroupId | _, _ when List.contains Admin levels ->
ctx.Session.smallGroup <- grp addError ctx ctx.Strings["You are not authorized to view the requested page."]
| _ -> () return! redirectTo false "/unauthorized" next ctx
| _ -> () | _, _ when List.contains User levels ->
// If something above doesn't work, the user doesn't get logged in
with _ -> ()
}
/// Attempt to log the user on from their stored cookie
let logOnUserFromCookie (ctx : HttpContext) = task {
match UserCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.user] with
| Some c ->
let! user = ctx.db.TryUserLogOnByCookie c.Id c.GroupId c.PasswordHash
match user with
| Some _ ->
ctx.Session.user <- user
let! grp = ctx.db.TryGroupById c.GroupId
ctx.Session.smallGroup <- grp
// Rewrite the cookie to extend the expiration
ctx.Response.Cookies.Append (Key.Cookie.user, c.toPayload (), autoRefresh)
| _ -> ()
| _ -> ()
}
/// Is there currently a small group (or member thereof) logged on?
let isGroupLoggedOn (ctx : HttpContext) =
ctx.Session.smallGroup |> Option.isSome
/// Attempt to log the small group on from their stored cookie
let logOnGroupFromCookie (ctx : HttpContext) =
task {
match GroupCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.group] with
| Some c ->
let! grp = ctx.db.TryGroupLogOnByCookie c.GroupId c.PasswordHash sha1Hash
match grp with
| Some _ ->
ctx.Session.smallGroup <- grp
// Rewrite the cookie to extend the expiration
ctx.Response.Cookies.Append (Key.Cookie.group, c.toPayload (), autoRefresh)
| None -> ()
| None -> ()
}
fun next ctx -> FSharp.Control.Tasks.Affine.task {
// Auto-logon user or class, if required
match isUserLoggedOn ctx with
| true -> ()
| false ->
do! logOnUserFromTimeoutCookie ctx
match isUserLoggedOn ctx with
| true -> ()
| false ->
do! logOnUserFromCookie ctx
match isGroupLoggedOn ctx with true -> () | false -> do! logOnGroupFromCookie ctx
match true with
| _ when level |> List.contains Public -> return! next ctx
| _ when level |> List.contains User && isUserLoggedOn ctx -> return! next ctx
| _ when level |> List.contains Group && isGroupLoggedOn ctx -> return! next ctx
| _ when level |> List.contains Admin && isUserLoggedOn ctx ->
match (currentUser ctx).isAdmin with
| true -> return! next ctx
| false ->
let s = Views.I18N.localizer.Force ()
addError ctx s.["You are not authorized to view the requested page."]
return! redirectTo false "/web/unauthorized" next ctx
| _ 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.GetEncodedPathAndQuery ())
return! redirectTo false "/web/user/log-on" next ctx return! redirectTo false "/user/log-on" next ctx
| _ when level |> List.contains Group -> | _, _ when List.contains Group levels ->
// 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 ()) return! redirectTo false "/small-group/log-on" next ctx
return! redirectTo false "/web/small-group/log-on" next ctx | _, _ ->
| _ -> addError ctx ctx.Strings["You are not authorized to view the requested page."]
let s = Views.I18N.localizer.Force () return! redirectTo false "/unauthorized" next ctx
addError ctx s.["You are not authorized to view the requested page."] }
return! redirectTo false "/web/unauthorized" next ctx
}

129
src/PrayerTracker/Cookies.fs
View File

@ -1,129 +0,0 @@
module PrayerTracker.Cookies
open Microsoft.AspNetCore.Http
open Newtonsoft.Json
open System
open System.Security.Cryptography
open System.IO
// fsharplint:disable MemberNames
/// Cryptography settings to use for encrypting cookies
type CookieCrypto (key : string, iv : string) =
/// The key for the AES encryptor/decryptor
member __.Key = Convert.FromBase64String key
/// The initialization vector for the AES encryptor/decryptor
member __.IV = Convert.FromBase64String iv
/// Helpers for encrypting/decrypting cookies
[<AutoOpen>]
module private Crypto =
/// An instance of the cookie cryptography settings
let mutable crypto = CookieCrypto ("", "")
/// Encrypt a cookie payload
let encrypt (payload : string) =
use aes = Aes.Create ()
use enc = aes.CreateEncryptor (crypto.Key, crypto.IV)
use ms = new MemoryStream ()
use cs = new CryptoStream (ms, enc, CryptoStreamMode.Write)
use sw = new StreamWriter (cs)
sw.Write payload
sw.Close ()
(ms.ToArray >> Convert.ToBase64String) ()
/// Decrypt a cookie payload
let decrypt payload =
use aes = Aes.Create ()
use dec = aes.CreateDecryptor (crypto.Key, crypto.IV)
use ms = new MemoryStream (Convert.FromBase64String payload)
use cs = new CryptoStream (ms, dec, CryptoStreamMode.Read)
use sr = new StreamReader (cs)
sr.ReadToEnd ()
/// Encrypt a cookie
let encryptCookie cookie =
(JsonConvert.SerializeObject >> encrypt) cookie
/// Decrypt a cookie
let decryptCookie<'T> payload =
(decrypt >> JsonConvert.DeserializeObject<'T> >> box) payload
|> function null -> None | x -> Some (unbox<'T> x)
/// Accessor so that the crypto settings instance can be set during startup
let setCrypto c = Crypto.crypto <- c
/// Properties stored in the Small Group cookie
type GroupCookie =
{ /// The Id of the small group
[<JsonProperty "g">]
GroupId : Guid
/// The password hash of the small group
[<JsonProperty "p">]
PasswordHash : string
}
with
/// Convert these properties to a cookie payload
member this.toPayload () =
encryptCookie this
/// Create a set of strongly-typed properties from the cookie payload
static member fromPayload x =
try decryptCookie<GroupCookie> x with _ -> None
/// The payload for the timeout cookie
type TimeoutCookie =
{ /// The Id of the small group to which the user is currently logged in
[<JsonProperty "g">]
GroupId : Guid
/// The Id of the user who is currently logged in
[<JsonProperty "i">]
Id : Guid
/// The salted timeout hash to ensure that there has been no tampering with the cookie
[<JsonProperty "p">]
Password : string
/// How long this cookie is valid
[<JsonProperty "u">]
Until : int64
}
with
/// Convert this set of properties to the cookie payload
member this.toPayload () =
encryptCookie this
/// Create a strongly-typed timeout cookie from the cookie payload
static member fromPayload x =
try decryptCookie<TimeoutCookie> x with _ -> None
/// The payload for the user's "Remember Me" cookie
type UserCookie =
{ /// The Id of the group into to which the user is logged
[< JsonProperty "g">]
GroupId : Guid
/// The Id of the user
[<JsonProperty "i">]
Id : Guid
/// The user's password hash
[<JsonProperty "p">]
PasswordHash : string
}
with
/// Convert this set of properties to a cookie payload
member this.toPayload () =
encryptCookie this
/// Create the strongly-typed cookie properties from a cookie payload
static member fromPayload x =
try decryptCookie<UserCookie> x with _ -> None
/// Create a salted hash to use to validate the idle timeout key
let saltedTimeoutHash (c : TimeoutCookie) =
sha1Hash $"Prayer%A{c.Id}Tracker%A{c.GroupId}Idle%d{c.Until}Timeout"
/// Cookie options to push an expiration out by 100 days
let autoRefresh =
CookieOptions (Expires = Nullable<DateTimeOffset> (DateTimeOffset (DateTime.UtcNow.AddDays 100.)), HttpOnly = true)

127
src/PrayerTracker/Email.fs
View File

@ -8,70 +8,93 @@ open MimeKit
open MimeKit.Text open MimeKit.Text
open PrayerTracker.Entities open PrayerTracker.Entities
/// Parameters required to send an e-mail
type EmailOptions =
{ /// The SMTP client
Client : SmtpClient
/// The people who should receive the e-mail
Recipients : Member list
/// The small group for which this e-mail is being sent
Group : SmallGroup
/// The subject of the e-mail
Subject : string
/// The body of the e-mail in HTML
HtmlBody : string
/// The body of the e-mail in plain text
PlainTextBody : string
/// Use the current user's preferred language
Strings : IStringLocalizer
}
/// The e-mail address from which e-mail is sent /// The e-mail address from which e-mail is sent
let private fromAddress = "prayer@bitbadger.solutions" 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 () = task { let getConnection () = 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 opts =
let msg = MimeMessage () let msg = new MimeMessage ()
msg.From.Add (MailboxAddress (grp.preferences.emailFromName, fromAddress)) msg.From.Add (MailboxAddress (opts.Group.Preferences.EmailFromName, fromAddress))
msg.Subject <- subj msg.Subject <- opts.Subject
msg.ReplyTo.Add (MailboxAddress (grp.preferences.emailFromName, grp.preferences.emailFromAddress)) msg.ReplyTo.Add (MailboxAddress (opts.Group.Preferences.EmailFromName, opts.Group.Preferences.EmailFromAddress))
msg msg
/// Create an HTML-format e-mail message /// Create an HTML-format e-mail message
let createHtmlMessage grp subj body (s : IStringLocalizer) = let createHtmlMessage opts =
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 opts.HtmlBody
"""<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 opts.Strings["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 opts.Strings["from Bit Badger Solutions"].Value
"</small></div></body></html>" "</small></div></body></html>"
] ]
|> String.concat "" |> String.concat ""
let msg = createMessage grp subj let msg = createMessage opts
msg.Body <- TextPart (TextFormat.Html, Text = bodyText) msg.Body <- new TextPart (TextFormat.Html, Text = bodyText)
msg msg
/// Create a plain-text-format e-mail message /// Create a plain-text-format e-mail message
let createTextMessage grp subj body (s : IStringLocalizer) = let createTextMessage opts =
let bodyText = let bodyText =
[ body [ opts.PlainTextBody
"\n\n--\n" "\n\n--\n"
s.["Generated by P R A Y E R T R A C K E R"].Value opts.Strings["Generated by P R A Y E R T R A C K E R"].Value
"\n" "\n"
s.["from Bit Badger Solutions"].Value opts.Strings["from Bit Badger Solutions"].Value
] ]
|> String.concat "" |> String.concat ""
let msg = createMessage grp subj let msg = createMessage opts
msg.Body <- TextPart (TextFormat.Plain, Text = bodyText) msg.Body <- new TextPart (TextFormat.Plain, Text = bodyText)
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 = task { let sendEmails opts = task {
let htmlMsg = createHtmlMessage grp subj html s use htmlMsg = createHtmlMessage opts
let plainTextMsg = createTextMessage grp subj text s use plainTextMsg = createTextMessage opts
for mbr in recipients do for mbr in opts.Recipients do
let emailType = match mbr.format with Some f -> EmailFormat.fromCode f | None -> grp.preferences.defaultEmailType let emailTo = MailboxAddress (mbr.Name, mbr.Email)
let emailTo = MailboxAddress (mbr.memberName, mbr.email) match defaultArg mbr.Format opts.Group.Preferences.DefaultEmailType with
match emailType with | HtmlFormat ->
| HtmlFormat -> htmlMsg.To.Add emailTo
htmlMsg.To.Add emailTo let! _ = opts.Client.SendAsync htmlMsg
do! client.SendAsync htmlMsg htmlMsg.To.Clear ()
htmlMsg.To.Clear () | PlainTextFormat ->
| PlainTextFormat -> plainTextMsg.To.Add emailTo
plainTextMsg.To.Add emailTo let! _ = opts.Client.SendAsync plainTextMsg
do! client.SendAsync plainTextMsg plainTextMsg.To.Clear ()
plainTextMsg.To.Clear () }
}

138
src/PrayerTracker/Extensions.fs
View File

@ -2,51 +2,117 @@
module PrayerTracker.Extensions module PrayerTracker.Extensions
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open Microsoft.Extensions.DependencyInjection
open Microsoft.FSharpLu
open Newtonsoft.Json open Newtonsoft.Json
open NodaTime
open NodaTime.Serialization.JsonNet
open PrayerTracker.Data
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
// fsharplint:disable MemberNames /// JSON.NET serializer settings for NodaTime
let private jsonSettings = JsonSerializerSettings().ConfigureForNodaTime DateTimeZoneProviders.Tzdb
/// Extensions on the .NET session object
type ISession with type ISession with
/// Set an object in the session
member this.SetObject key value =
this.SetString (key, JsonConvert.SerializeObject value)
/// Get an object from the session /// Set an object in the session
member this.GetObject<'T> key = member this.SetObject<'T> key (value : 'T) =
match this.GetString key with this.SetString (key, JsonConvert.SerializeObject (value, jsonSettings))
| null -> Unchecked.defaultof<'T>
| v -> JsonConvert.DeserializeObject<'T> v /// Get an object from the session
member this.TryGetObject<'T> key =
match this.GetString key with
| null -> None
| v -> Some (JsonConvert.DeserializeObject<'T> (v, jsonSettings))
/// The current small group for the session /// The currently logged on small group
member this.smallGroup member this.CurrentGroup
with get () = this.GetObject<SmallGroup> Key.Session.currentGroup |> Option.fromObject with get () = this.TryGetObject<SmallGroup> Key.Session.currentGroup
and set (v : SmallGroup option) = and set (v : SmallGroup option) =
match v with match v with
| Some group -> this.SetObject Key.Session.currentGroup group | Some group -> this.SetObject Key.Session.currentGroup group
| None -> this.Remove Key.Session.currentGroup | None -> this.Remove Key.Session.currentGroup
/// The current user for the session /// The currently logged on user
member this.user member this.CurrentUser
with get () = this.GetObject<User> Key.Session.currentUser |> Option.fromObject with get () = this.TryGetObject<User> Key.Session.currentUser
and set (v : User option) = and set (v : User option) =
match v with match v with
| Some user -> this.SetObject Key.Session.currentUser user | Some user -> this.SetObject Key.Session.currentUser { user with PasswordHash = "" }
| None -> this.Remove Key.Session.currentUser | None -> this.Remove Key.Session.currentUser
/// Current messages for the session /// Current messages for the session
member this.messages member this.Messages
with get () = with get () =
match box (this.GetObject<UserMessage list> Key.Session.userMessages) with this.TryGetObject<UserMessage list> Key.Session.userMessages
| null -> List.empty<UserMessage> |> Option.defaultValue List.empty<UserMessage>
| msgs -> unbox msgs and set (v : UserMessage list) = this.SetObject Key.Session.userMessages v
and set (v : UserMessage list) = this.SetObject Key.Session.userMessages v
open System.Security.Claims
/// Extensions on the claims principal
type ClaimsPrincipal with
/// The ID of the currently logged on small group
member this.SmallGroupId =
if this.HasClaim (fun c -> c.Type = ClaimTypes.GroupSid) then
Some (idFromShort SmallGroupId (this.FindFirst(fun c -> c.Type = ClaimTypes.GroupSid).Value))
else None
/// The ID of the currently signed in user
member this.UserId =
if this.HasClaim (fun c -> c.Type = ClaimTypes.NameIdentifier) then
Some (idFromShort UserId (this.FindFirst(fun c -> c.Type = ClaimTypes.NameIdentifier).Value))
else None
open Giraffe
open Npgsql
/// Extensions on the ASP.NET Core HTTP context
type HttpContext with type HttpContext with
/// The EF Core database context (via DI)
member this.db /// The system clock (via DI)
with get () = this.RequestServices.GetRequiredService<AppDbContext> () member this.Clock = this.GetService<IClock> ()
/// The PostgreSQL connection (configured via DI)
member this.Conn = this.GetService<NpgsqlConnection> ()
/// The current instant
member this.Now = this.Clock.GetCurrentInstant ()
/// The common string localizer
member this.Strings = Views.I18N.localizer.Force ()
/// The currently logged on small group (sets the value in the session if it is missing)
member this.CurrentGroup () = task {
match this.Session.CurrentGroup with
| Some group -> return Some group
| None ->
match this.User.SmallGroupId with
| Some groupId ->
match! SmallGroups.tryByIdWithPreferences groupId this.Conn with
| Some group ->
this.Session.CurrentGroup <- Some group
return Some group
| None -> return None
| None -> return None
}
/// The currently logged on user (sets the value in the session if it is missing)
member this.CurrentUser () = task {
match this.Session.CurrentUser with
| Some user -> return Some user
| None ->
match this.User.UserId with
| Some userId ->
match! Users.tryById userId this.Conn with
| Some user ->
// Set last seen for user
do! Users.updateLastSeen userId this.Now this.Conn
this.Session.CurrentUser <- Some user
return Some user
| None -> return None
| None -> return None
}

80
src/PrayerTracker/Home.fs
View File

@ -1,90 +1,72 @@
module PrayerTracker.Handlers.Home module PrayerTracker.Handlers.Home
open System
open System.Globalization
open Giraffe open Giraffe
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Localization open Microsoft.AspNetCore.Localization
open PrayerTracker open PrayerTracker
open System
open System.Globalization
/// GET /error/[error-code] /// GET /error/[error-code]
let error code : HttpHandler = let error code : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
requireAccess [ AccessLevel.Public ] viewInfo ctx
>=> fun next ctx ->
viewInfo ctx DateTime.Now.Ticks
|> Views.Home.error code |> Views.Home.error code
|> renderHtml next ctx |> renderHtml next ctx
/// GET / /// GET /
let homePage : HttpHandler = let homePage : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
requireAccess [ AccessLevel.Public ] viewInfo ctx
>=> fun next ctx ->
viewInfo ctx DateTime.Now.Ticks
|> Views.Home.index |> Views.Home.index
|> renderHtml next ctx |> renderHtml next ctx
/// GET /language/[culture] /// GET /language/[culture]
let language culture : HttpHandler = let language culture : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
try try
match culture with match culture with
| null | null
| "" | ""
| "en" -> "en-US" | "en" -> "en-US"
| "es" -> "es-MX" | "es" -> "es-MX"
| _ -> $"{culture}-{culture.ToUpper ()}" | _ -> $"{culture}-{culture.ToUpper ()}"
|> (CultureInfo >> Option.ofObj) |> (CultureInfo >> Option.ofObj)
with with
| :? CultureNotFoundException | :? CultureNotFoundException
| :? ArgumentException -> None | :? ArgumentException -> None
|> function |> function
| Some c -> | Some c ->
ctx.Response.Cookies.Append ( ctx.Response.Cookies.Append (
CookieRequestCultureProvider.DefaultCookieName, CookieRequestCultureProvider.DefaultCookieName,
CookieRequestCultureProvider.MakeCookieValue (RequestCulture c), CookieRequestCultureProvider.MakeCookieValue (RequestCulture c),
CookieOptions (Expires = Nullable<DateTimeOffset> (DateTimeOffset (DateTime.Now.AddYears 1)))) CookieOptions (Expires = Nullable<DateTimeOffset> (DateTimeOffset (DateTime.Now.AddYears 1))))
| _ -> () | _ -> ()
let url = match string ctx.Request.Headers.["Referer"] with null | "" -> "/web/" | r -> r let url = match string ctx.Request.Headers["Referer"] with null | "" -> "/" | r -> r
redirectTo false url next ctx redirectTo false url next ctx
/// GET /legal/privacy-policy /// GET /legal/privacy-policy
let privacyPolicy : HttpHandler = let privacyPolicy : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
requireAccess [ AccessLevel.Public ] viewInfo ctx
>=> fun next ctx ->
viewInfo ctx DateTime.Now.Ticks
|> Views.Home.privacyPolicy |> Views.Home.privacyPolicy
|> renderHtml next ctx |> renderHtml next ctx
/// GET /legal/terms-of-service /// GET /legal/terms-of-service
let tos : HttpHandler = let tos : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
requireAccess [ AccessLevel.Public ] viewInfo ctx
>=> fun next ctx ->
viewInfo ctx DateTime.Now.Ticks
|> Views.Home.termsOfService |> Views.Home.termsOfService
|> renderHtml next ctx |> renderHtml next ctx
open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies
/// GET /log-off /// GET /log-off
let logOff : HttpHandler = let logOff : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
ctx.Session.Clear () ctx.Session.Clear ()
// Remove cookies if they exist do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
Key.Cookie.logOffCookies |> List.iter ctx.Response.Cookies.Delete addHtmlInfo ctx ctx.Strings["Log Off Successful • Have a nice day!"]
let s = Views.I18N.localizer.Force () return! redirectTo false "/" next ctx
addHtmlInfo ctx s.["Log Off Successful • Have a nice day!"] }
redirectTo false "/web/" next ctx
/// GET /unauthorized /// GET /unauthorized
let unauthorized : HttpHandler = let unauthorized : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
requireAccess [ AccessLevel.Public ] viewInfo ctx
>=> fun next ctx ->
viewInfo ctx DateTime.Now.Ticks
|> Views.Home.unauthorized |> Views.Home.unauthorized
|> renderHtml next ctx |> renderHtml next ctx

446
src/PrayerTracker/PrayerRequest.fs
View File

@ -2,283 +2,275 @@
open Giraffe open Giraffe
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open NodaTime
open PrayerTracker open PrayerTracker
open PrayerTracker.Data
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open System
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 = task { let private findRequest (ctx : HttpContext) reqId = task {
match! ctx.db.TryRequestById reqId with match! PrayerRequests.tryById reqId ctx.Conn with
| Some req when req.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok req | Some req when req.SmallGroupId = ctx.Session.CurrentGroup.Value.Id -> return Ok req
| Some _ -> | Some _ ->
let s = Views.I18N.localizer.Force () addError ctx ctx.Strings["The prayer request you tried to access is not assigned to your group"]
addError ctx s.["The prayer request you tried to access is not assigned to your group"] return Result.Error (redirectTo false "/unauthorized" earlyReturn ctx)
return Error (redirectTo false "/web/unauthorized") | None -> return Result.Error (fourOhFour ctx)
| 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 : HttpContext) date = task {
let grp = currentGroup ctx let group = ctx.Session.CurrentGroup.Value
let clock = ctx.GetService<IClock> () let listDate = match date with Some d -> d | None -> SmallGroup.localDateNow ctx.Clock group
let listDate = let! reqs =
match date with PrayerRequests.forGroup
| Some d -> d { SmallGroup = group
| None -> grp.localDateNow clock Clock = ctx.Clock
let reqs = ctx.db.AllRequestsForSmallGroup grp clock (Some listDate) true 0 ListDate = Some listDate
{ requests = reqs |> List.ofSeq ActiveOnly = true
date = listDate PageNumber = 0
listGroup = grp } ctx.Conn
showHeader = true return
canEmail = ctx.Session.user |> Option.isSome { Requests = reqs
recipients = [] Date = listDate
} SmallGroup = group
ShowHeader = true
CanEmail = Option.isSome ctx.User.UserId
Recipients = []
}
}
open NodaTime.Text
/// Parse a string into a date (optionally, of course) /// Parse a string into a date (optionally, of course)
let private parseListDate (date : string option) = let private parseListDate (date : string option) =
match date with match date with
| Some dt -> match DateTime.TryParse dt with true, d -> Some d | false, _ -> None | Some dt -> match LocalDatePattern.Iso.Parse dt with it when it.Success -> Some it.Value | _ -> None
| None -> None | None -> None
open System
/// GET /prayer-request/[request-id]/edit /// GET /prayer-request/[request-id]/edit
let edit (reqId : PrayerRequestId) : HttpHandler = let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ] let group = ctx.Session.CurrentGroup.Value
>=> fun next ctx -> task { let now = SmallGroup.localDateNow ctx.Clock group
let startTicks = DateTime.Now.Ticks let requestId = PrayerRequestId reqId
let grp = currentGroup ctx if requestId.Value = Guid.Empty then
let now = grp.localDateNow (ctx.GetService<IClock> ())
match reqId = Guid.Empty with
| true ->
return! return!
{ viewInfo ctx startTicks with script = [ "ckeditor/ckeditor" ]; helpLink = Some Help.editRequest } { viewInfo ctx with HelpLink = Some Help.editRequest }
|> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx |> Views.PrayerRequest.edit EditRequest.empty (now.ToString ("R", null)) ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> else
match! findRequest ctx reqId with match! findRequest ctx requestId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () let s = ctx.Strings
match req.isExpired now grp.preferences.daysToExpire with if PrayerRequest.isExpired now group req then
| true ->
{ UserMessage.warning with { UserMessage.warning with
text = htmlLocString s.["This request is expired."] Text = htmlLocString s["This request is expired."]
description = Description =
s.["To make it active again, update it as necessary, leave “{0}” and “{1}” unchecked, and it will return as an active request.", s["To make it active again, update it as necessary, leave “{0}” and “{1}” unchecked, and it will return as an active request.",
s.["Expire Immediately"], s.["Check to not update the date"]] s["Expire Immediately"], s["Check to not update the date"]]
|> (htmlLocString >> Some) |> (htmlLocString >> Some)
} }
|> addUserMessage ctx |> addUserMessage ctx
| false -> ()
return! return!
{ viewInfo ctx startTicks with script = [ "ckeditor/ckeditor" ]; helpLink = Some Help.editRequest } { viewInfo ctx with HelpLink = Some Help.editRequest }
|> Views.PrayerRequest.edit (EditRequest.fromRequest req) "" ctx |> Views.PrayerRequest.edit (EditRequest.fromRequest req) "" ctx
|> renderHtml next ctx |> renderHtml next ctx
| Error e -> return! e next ctx | Result.Error e -> return! e
} }
/// GET /prayer-requests/email/[date] /// GET /prayer-requests/email/[date]
let email date : HttpHandler = let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ] let s = ctx.Strings
>=> fun next ctx -> task { let listDate = parseListDate (Some date)
let startTicks = DateTime.Now.Ticks let! list = generateRequestList ctx listDate
let s = Views.I18N.localizer.Force () let group = ctx.Session.CurrentGroup.Value
let listDate = parseListDate (Some date) let! recipients = Members.forGroup group.Id ctx.Conn
let grp = currentGroup ctx use! client = Email.getConnection ()
let list = generateRequestList ctx listDate do! Email.sendEmails
let! recipients = ctx.db.AllMembersForSmallGroup grp.smallGroupId { Client = client
use! client = Email.getConnection () Recipients = recipients
do! Email.sendEmails client recipients Group = group
grp s.["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.name, list.date].Value Subject = s["Prayer Requests for {0} - {1:MMMM d, yyyy}", group.Name, list.Date].Value
(list.asHtml s) (list.asText s) s HtmlBody = list.AsHtml s
PlainTextBody = list.AsText s
Strings = s
}
return! return!
viewInfo ctx startTicks viewInfo ctx
|> 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 ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ User ] let requestId = PrayerRequestId reqId
>=> validateCSRF match! findRequest ctx requestId with
>=> fun next ctx -> task {
match! findRequest ctx reqId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () do! PrayerRequests.deleteById req.Id ctx.Conn
ctx.db.PrayerRequests.Remove req |> ignore addInfo ctx ctx.Strings["The prayer request was deleted successfully"]
let! _ = ctx.db.SaveChangesAsync () return! redirectTo false "/prayer-requests" next ctx
addInfo ctx s.["The prayer request was deleted successfully"] | Result.Error e -> return! e
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 ] >=> fun next ctx -> task {
requireAccess [ User ] let requestId = PrayerRequestId reqId
>=> fun next ctx -> task { match! findRequest ctx requestId with
match! findRequest ctx reqId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () do! PrayerRequests.updateExpiration { req with Expiration = Forced } false ctx.Conn
ctx.db.UpdateEntry { req with expiration = Forced } addInfo ctx ctx.Strings["Successfully {0} prayer request", ctx.Strings["Expired"].Value.ToLower ()]
let! _ = ctx.db.SaveChangesAsync () return! redirectTo false "/prayer-requests" next ctx
addInfo ctx s.["Successfully {0} prayer request", s.["Expired"].Value.ToLower ()] | Result.Error e -> return! e
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 ] >=> fun next ctx -> task {
requireAccess [ AccessLevel.Public ] match! SmallGroups.tryByIdWithPreferences (SmallGroupId groupId) ctx.Conn with
>=> fun next ctx -> task { | Some group when group.Preferences.IsPublic ->
let startTicks = DateTime.Now.Ticks let! reqs =
match! ctx.db.TryGroupById groupId with PrayerRequests.forGroup
| Some grp when grp.preferences.isPublic -> { SmallGroup = group
let clock = ctx.GetService<IClock> () Clock = ctx.Clock
let reqs = ctx.db.AllRequestsForSmallGroup grp clock None true 0 ListDate = None
ActiveOnly = true
PageNumber = 0
} ctx.Conn
return! return!
viewInfo ctx startTicks viewInfo ctx
|> Views.PrayerRequest.list |> Views.PrayerRequest.list
{ requests = List.ofSeq reqs { Requests = reqs
date = grp.localDateNow clock Date = SmallGroup.localDateNow ctx.Clock group
listGroup = grp SmallGroup = group
showHeader = true ShowHeader = true
canEmail = ctx.Session.user |> Option.isSome CanEmail = Option.isSome ctx.User.UserId
recipients = [] Recipients = []
} }
|> renderHtml next ctx |> renderHtml next ctx
| Some _ -> | Some _ ->
let s = Views.I18N.localizer.Force () addError ctx ctx.Strings["The request list for the group you tried to view is not public."]
addError ctx s.["The request list for the group you tried to view is not public."] return! redirectTo false "/unauthorized" next ctx
return! redirectTo false "/web/unauthorized" next ctx | None -> return! fourOhFour ctx
| None -> return! fourOhFour next ctx }
}
/// GET /prayer-requests/lists /// GET /prayer-requests/lists
let lists : HttpHandler = let lists : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
requireAccess [ AccessLevel.Public ] let! groups = SmallGroups.listPublicAndProtected ctx.Conn
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let! grps = ctx.db.PublicAndProtectedGroups ()
return! return!
viewInfo ctx startTicks viewInfo ctx
|> Views.PrayerRequest.lists grps |> Views.PrayerRequest.lists groups
|> renderHtml next ctx |> renderHtml next ctx
} }
/// GET /prayer-requests[/inactive?] /// GET /prayer-requests[/inactive?]
/// - OR - /// - OR -
/// GET /prayer-requests?search=[search-query] /// GET /prayer-requests?search=[search-query]
let maintain onlyActive : HttpHandler = let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ] let group = ctx.Session.CurrentGroup.Value
>=> fun next ctx -> let pageNbr =
let startTicks = DateTime.Now.Ticks match ctx.GetQueryStringValue "page" with
let grp = currentGroup ctx | Ok pg -> match Int32.TryParse pg with true, p -> p | false, _ -> 1
let pageNbr = | Result.Error _ -> 1
match ctx.GetQueryStringValue "page" with let! model = backgroundTask {
| Ok pg -> match Int32.TryParse pg with true, p -> p | false, _ -> 1 match ctx.GetQueryStringValue "search" with
| Error _ -> 1 | Ok search ->
let m = let! reqs = PrayerRequests.searchForGroup group search pageNbr ctx.Conn
match ctx.GetQueryStringValue "search" with return
| Ok srch -> { MaintainRequests.empty with
{ MaintainRequests.empty with Requests = reqs
requests = ctx.db.SearchRequestsForSmallGroup grp srch pageNbr SearchTerm = Some search
searchTerm = Some srch PageNbr = Some pageNbr
pageNbr = Some pageNbr }
} | Result.Error _ ->
| Error _ -> let! reqs =
{ MaintainRequests.empty with PrayerRequests.forGroup
requests = ctx.db.AllRequestsForSmallGroup grp (ctx.GetService<IClock> ()) None onlyActive pageNbr { SmallGroup = group
onlyActive = Some onlyActive Clock = ctx.Clock
pageNbr = match onlyActive with true -> None | false -> Some pageNbr ListDate = None
} ActiveOnly = onlyActive
{ viewInfo ctx startTicks with helpLink = Some Help.maintainRequests } PageNumber = pageNbr
|> Views.PrayerRequest.maintain { m with smallGroup = grp } ctx } ctx.Conn
|> renderHtml next ctx return
{ MaintainRequests.empty with
Requests = reqs
OnlyActive = Some onlyActive
PageNbr = if onlyActive then None else Some pageNbr
}
}
return!
{ viewInfo ctx with HelpLink = Some Help.maintainRequests }
|> Views.PrayerRequest.maintain { model with SmallGroup = group } 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 ] >=> fun next ctx -> task {
requireAccess [ User; Group ] let! list = generateRequestList ctx (parseListDate (Some date))
>=> fun next ctx -> return!
let list = parseListDate (Some date) |> generateRequestList ctx Views.PrayerRequest.print list appVersion
Views.PrayerRequest.print list appVersion |> renderHtml next ctx
|> 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 ] >=> fun next ctx -> task {
requireAccess [ User ] let requestId = PrayerRequestId reqId
>=> fun next ctx -> task { match! findRequest ctx requestId with
match! findRequest ctx reqId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () do! PrayerRequests.updateExpiration { req with Expiration = Automatic; UpdatedDate = ctx.Now } true ctx.Conn
ctx.db.UpdateEntry { req with expiration = Automatic; updatedDate = DateTime.Now } addInfo ctx ctx.Strings["Successfully {0} prayer request", ctx.Strings["Restored"].Value.ToLower ()]
let! _ = ctx.db.SaveChangesAsync () return! redirectTo false "/prayer-requests" next ctx
addInfo ctx s.["Successfully {0} prayer request", s.["Restored"].Value.ToLower ()] | Result.Error e -> return! e
return! redirectTo false "/web/prayer-requests" next ctx }
| Error e -> return! e next ctx
}
open System.Threading.Tasks
/// POST /prayer-request/save /// POST /prayer-request/save
let save : HttpHandler = let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditRequest> () with match! ctx.TryBindFormAsync<EditRequest> () with
| Ok m -> | Ok model ->
let! req = let group = ctx.Session.CurrentGroup.Value
match m.isNew () with let! req =
| true -> Task.FromResult (Some { PrayerRequest.empty with prayerRequestId = Guid.NewGuid () }) if model.IsNew then
| false -> ctx.db.TryRequestById m.requestId { PrayerRequest.empty with
match req with Id = (Guid.NewGuid >> PrayerRequestId) ()
| Some pr -> SmallGroupId = group.Id
let upd8 = UserId = ctx.User.UserId.Value
{ 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 |> (Some >> Task.FromResult)
let now = grp.localDateNow (ctx.GetService<IClock> ()) else PrayerRequests.tryById (idFromShort PrayerRequestId model.RequestId) ctx.Conn
match m.isNew () with match req with
| true -> | Some pr when pr.SmallGroupId = group.Id ->
let dt = match m.enteredDate with Some x -> x | None -> now let now = SmallGroup.localDateNow ctx.Clock group
{ upd8 with let updated =
smallGroupId = grp.smallGroupId { pr with
userId = (currentUser ctx).userId RequestType = PrayerRequestType.fromCode model.RequestType
enteredDate = dt Requestor = match model.Requestor with Some x when x.Trim () = "" -> None | x -> x
updatedDate = dt Text = ckEditorToText model.Text
} Expiration = Expiration.fromCode model.Expiration
| false when Option.isSome m.skipDateUpdate && Option.get m.skipDateUpdate -> upd8 }
| false -> { upd8 with updatedDate = now } |> function
|> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry) | it when model.IsNew ->
let! _ = ctx.db.SaveChangesAsync () let dt =
let s = Views.I18N.localizer.Force () (defaultArg (parseListDate model.EnteredDate) now)
let act = match m.isNew () with true -> "Added" | false -> "Updated" .AtStartOfDayInZone(SmallGroup.timeZone group)
addInfo ctx s.["Successfully {0} prayer request", s.[act].Value.ToLower ()] .ToInstant()
return! redirectTo false "/web/prayer-requests" next ctx { it with EnteredDate = dt; UpdatedDate = dt }
| None -> return! fourOhFour next ctx | it when defaultArg model.SkipDateUpdate false -> it
| Error e -> return! bindError e next ctx | it -> { it with UpdatedDate = ctx.Now }
} do! PrayerRequests.save updated ctx.Conn
let act = if model.IsNew then "Added" else "Updated"
addInfo ctx ctx.Strings["Successfully {0} prayer request", ctx.Strings[act].Value.ToLower ()]
return! redirectTo false "/prayer-requests" next ctx
| Some _
| None -> return! fourOhFour ctx
| Result.Error e -> return! bindError e next ctx
}
/// GET /prayer-request/view/[date?] /// GET /prayer-request/view/[date?]
let view date : HttpHandler = let view date : HttpHandler = requireAccess [ User; Group ] >=> fun next ctx -> task {
requireAccess [ User; Group ] let! list = generateRequestList ctx (parseListDate date)
>=> fun next ctx -> return!
let startTicks = DateTime.Now.Ticks viewInfo ctx
let list = parseListDate date |> generateRequestList ctx |> Views.PrayerRequest.view { list with ShowHeader = false }
viewInfo ctx startTicks |> renderHtml next ctx
|> Views.PrayerRequest.view { list with showHeader = false } }
|> renderHtml next ctx

12
src/PrayerTracker/PrayerTracker.fsproj
View File

@ -1,7 +1,9 @@
<Project Sdk="Microsoft.NET.Sdk.Web"> <Project Sdk="Microsoft.NET.Sdk.Web">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net6.0</TargetFramework> <OutputType>Exe</OutputType>
<PublishSingleFile>True</PublishSingleFile>
<SelfContained>False</SelfContained>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
@ -11,7 +13,6 @@
<ItemGroup> <ItemGroup>
<None Include="appsettings.json" /> <None Include="appsettings.json" />
<Compile Include="Extensions.fs" /> <Compile Include="Extensions.fs" />
<Compile Include="Cookies.fs" />
<Compile Include="Email.fs" /> <Compile Include="Email.fs" />
<Compile Include="CommonFunctions.fs" /> <Compile Include="CommonFunctions.fs" />
<Compile Include="Church.fs" /> <Compile Include="Church.fs" />
@ -23,9 +24,10 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Giraffe" Version="5.0.0" /> <PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Microsoft.VisualStudio.Web.CodeGeneration.Design" Version="3.1.1" /> <PackageReference Include="Giraffe.Htmx" Version="1.8.0" />
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="5.0.10" /> <PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

583
src/PrayerTracker/SmallGroup.fs
View File

@ -1,385 +1,312 @@
module PrayerTracker.Handlers.SmallGroup module PrayerTracker.Handlers.SmallGroup
open System
open Giraffe open Giraffe
open Giraffe.ViewEngine
open Microsoft.AspNetCore.Http
open NodaTime
open PrayerTracker open PrayerTracker
open PrayerTracker.Cookies open PrayerTracker.Data
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open PrayerTracker.Views.CommonFunctions
open System
open System.Threading.Tasks
/// Set a small group "Remember Me" cookie
let private setGroupCookie (ctx : HttpContext) pwHash =
ctx.Response.Cookies.Append
(Key.Cookie.group, { GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (), autoRefresh)
/// GET /small-group/announcement /// GET /small-group/announcement
let announcement : HttpHandler = let announcement : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
requireAccess [ User ] { viewInfo ctx with HelpLink = Some Help.sendAnnouncement }
>=> fun next ctx -> |> Views.SmallGroup.announcement ctx.Session.CurrentUser.Value.IsAdmin ctx
let startTicks = DateTime.Now.Ticks
{ viewInfo ctx startTicks with helpLink = Some Help.sendAnnouncement; script = [ "ckeditor/ckeditor" ] }
|> Views.SmallGroup.announcement (currentUser ctx).isAdmin ctx
|> renderHtml next ctx |> renderHtml next ctx
/// POST /small-group/[group-id]/delete /// POST /small-group/[group-id]/delete
let delete groupId : HttpHandler = let delete grpId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ Admin ] let groupId = SmallGroupId grpId
>=> validateCSRF let conn = ctx.Conn
>=> fun next ctx -> task { match! SmallGroups.tryById groupId conn with
let s = Views.I18N.localizer.Force ()
match! ctx.db.TryGroupById groupId with
| Some grp -> | Some grp ->
let! reqs = ctx.db.CountRequestsBySmallGroup groupId let! reqs = PrayerRequests.countByGroup groupId conn
let! usrs = ctx.db.CountUsersBySmallGroup groupId let! users = Users.countByGroup groupId conn
ctx.db.RemoveEntry grp do! SmallGroups.deleteById groupId conn
let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx addInfo ctx
s.["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)", ctx.Strings["The group “{0}” and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
grp.name, reqs, usrs] grp.Name, reqs, users]
return! redirectTo false "/web/small-groups" next ctx return! redirectTo false "/small-groups" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour ctx
} }
/// POST /small-group/member/[member-id]/delete /// POST /small-group/member/[member-id]/delete
let deleteMember memberId : HttpHandler = let deleteMember mbrId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ User ] let group = ctx.Session.CurrentGroup.Value
>=> validateCSRF let memberId = MemberId mbrId
>=> fun next ctx -> task { match! Members.tryById memberId ctx.Conn with
let s = Views.I18N.localizer.Force () | Some mbr when mbr.SmallGroupId = group.Id ->
match! ctx.db.TryMemberById memberId with do! Members.deleteById memberId ctx.Conn
| Some mbr when mbr.smallGroupId = (currentGroup ctx).smallGroupId -> addHtmlInfo ctx ctx.Strings["The group member &ldquo;{0}&rdquo; was deleted successfully", mbr.Name]
ctx.db.RemoveEntry mbr return! redirectTo false "/small-group/members" next ctx
let! _ = ctx.db.SaveChangesAsync ()
addHtmlInfo ctx s.["The group member &ldquo;{0}&rdquo; was deleted successfully", mbr.memberName]
return! redirectTo false "/web/small-group/members" next ctx
| Some _ | Some _
| None -> return! fourOhFour next ctx | None -> return! fourOhFour ctx
} }
/// GET /small-group/[group-id]/edit /// GET /small-group/[group-id]/edit
let edit (groupId : SmallGroupId) : HttpHandler = let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
requireAccess [ Admin ] let! churches = Churches.all ctx.Conn
>=> fun next ctx -> task { let groupId = SmallGroupId grpId
let startTicks = DateTime.Now.Ticks if groupId.Value = Guid.Empty then
let! churches = ctx.db.AllChurches ()
match groupId = Guid.Empty with
| true ->
return! return!
viewInfo ctx startTicks viewInfo ctx
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx |> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> else
match! ctx.db.TryGroupById groupId with match! SmallGroups.tryById groupId ctx.Conn with
| Some grp -> | Some grp ->
return! return!
viewInfo ctx startTicks viewInfo ctx
|> Views.SmallGroup.edit (EditSmallGroup.fromGroup grp) churches ctx |> Views.SmallGroup.edit (EditSmallGroup.fromGroup grp) churches ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour ctx
} }
/// GET /small-group/member/[member-id]/edit /// GET /small-group/member/[member-id]/edit
let editMember (memberId : MemberId) : HttpHandler = let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ] let group = ctx.Session.CurrentGroup.Value
>=> fun next ctx -> let types = ReferenceList.emailTypeList group.Preferences.DefaultEmailType ctx.Strings
let startTicks = DateTime.Now.Ticks let memberId = MemberId mbrId
let s = Views.I18N.localizer.Force () if memberId.Value = Guid.Empty then
let grp = currentGroup ctx return!
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s viewInfo ctx
task { |> Views.SmallGroup.editMember EditMember.empty types ctx
match memberId = Guid.Empty with
| true ->
return!
viewInfo ctx startTicks
|> Views.SmallGroup.editMember EditMember.empty typs ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> else
match! ctx.db.TryMemberById memberId with match! Members.tryById memberId ctx.Conn with
| Some mbr when mbr.smallGroupId = grp.smallGroupId -> | Some mbr when mbr.SmallGroupId = group.Id ->
return! return!
viewInfo ctx startTicks viewInfo ctx
|> Views.SmallGroup.editMember (EditMember.fromMember mbr) typs ctx |> Views.SmallGroup.editMember (EditMember.fromMember mbr) types ctx
|> renderHtml next ctx |> renderHtml next ctx
| Some _ | Some _
| None -> return! fourOhFour next ctx | None -> return! fourOhFour ctx
} }
/// GET /small-group/log-on/[group-id?] /// GET /small-group/log-on/[group-id?]
let logOn (groupId : SmallGroupId option) : HttpHandler = let logOn grpId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
requireAccess [ AccessLevel.Public ] let! groups = SmallGroups.listProtected ctx.Conn
>=> fun next ctx -> let groupId = match grpId with Some gid -> shortGuid gid | None -> ""
let startTicks = DateTime.Now.Ticks return!
task { { viewInfo ctx with HelpLink = Some Help.logOn }
let! grps = ctx.db.ProtectedGroups () |> Views.SmallGroup.logOn groups groupId ctx
let grpId = match groupId with Some gid -> flatGuid gid | None -> ""
return!
{ viewInfo ctx startTicks with helpLink = Some Help.logOn }
|> Views.SmallGroup.logOn grps grpId ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
open System.Security.Claims
open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies
/// POST /small-group/log-on/submit /// POST /small-group/log-on/submit
let logOnSubmit : HttpHandler = let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ AccessLevel.Public ] match! ctx.TryBindFormAsync<GroupLogOn> () with
>=> validateCSRF | Ok model ->
>=> fun next ctx -> match! SmallGroups.logOn (idFromShort SmallGroupId model.SmallGroupId) model.Password ctx.Conn with
task { | Some group ->
match! ctx.TryBindFormAsync<GroupLogOn> () with ctx.Session.CurrentGroup <- Some group
| Ok m -> let identity = ClaimsIdentity (
let s = Views.I18N.localizer.Force () Seq.singleton (Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value)),
match! ctx.db.TryGroupLogOnByPassword m.smallGroupId m.password with CookieAuthenticationDefaults.AuthenticationScheme)
| Some grp -> do! ctx.SignInAsync (
ctx.Session.smallGroup <- Some grp identity.AuthenticationType, ClaimsPrincipal identity,
match m.rememberMe with AuthenticationProperties (
| Some x when x -> (setGroupCookie ctx << sha1Hash) m.password IssuedUtc = DateTimeOffset.UtcNow,
| _ -> () IsPersistent = defaultArg model.RememberMe false))
addInfo ctx s.["Log On Successful • Welcome to {0}", s.["PrayerTracker"]] addInfo ctx ctx.Strings["Log On Successful • Welcome to {0}", ctx.Strings["PrayerTracker"]]
return! redirectTo false "/web/prayer-requests/view" next ctx return! redirectTo false "/prayer-requests/view" next ctx
| None -> | None ->
addError ctx s.["Password incorrect - login unsuccessful"] addError ctx ctx.Strings["Password incorrect - login unsuccessful"]
return! redirectTo false $"/web/small-group/log-on/{flatGuid m.smallGroupId}" next ctx return! redirectTo false $"/small-group/log-on/{model.SmallGroupId}" next ctx
| Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
} }
/// GET /small-groups /// GET /small-groups
let maintain : HttpHandler = let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
requireAccess [ Admin ] let! groups = SmallGroups.infoForAll ctx.Conn
>=> fun next ctx -> return!
let startTicks = DateTime.Now.Ticks viewInfo ctx
task { |> Views.SmallGroup.maintain groups ctx
let! grps = ctx.db.AllGroups ()
return!
viewInfo ctx startTicks
|> Views.SmallGroup.maintain grps ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
/// GET /small-group/members /// GET /small-group/members
let members : HttpHandler = let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ] let group = ctx.Session.CurrentGroup.Value
>=> fun next ctx -> let! members = Members.forGroup group.Id ctx.Conn
let startTicks = DateTime.Now.Ticks let types = ReferenceList.emailTypeList group.Preferences.DefaultEmailType ctx.Strings |> Map.ofSeq
let grp = currentGroup ctx return!
let s = Views.I18N.localizer.Force () { viewInfo ctx with HelpLink = Some Help.maintainGroupMembers }
task { |> Views.SmallGroup.members members types ctx
let! mbrs = ctx.db.AllMembersForSmallGroup grp.smallGroupId
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s |> Map.ofSeq
return!
{ viewInfo ctx startTicks with helpLink = Some Help.maintainGroupMembers }
|> Views.SmallGroup.members mbrs typs ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
/// GET /small-group /// GET /small-group
let overview : HttpHandler = let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ] let group = ctx.Session.CurrentGroup.Value
>=> fun next ctx -> let conn = ctx.Conn
let startTicks = DateTime.Now.Ticks let! reqs = PrayerRequests.forGroup
let clock = ctx.GetService<IClock> () { SmallGroup = group
task { Clock = ctx.Clock
let reqs = ctx.db.AllRequestsForSmallGroup (currentGroup ctx) clock None true 0 |> List.ofSeq ListDate = None
let! reqCount = ctx.db.CountRequestsBySmallGroup (currentGroup ctx).smallGroupId ActiveOnly = true
let! mbrCount = ctx.db.CountMembersForSmallGroup (currentGroup ctx).smallGroupId PageNumber = 0
let m = } conn
{ totalActiveReqs = List.length reqs let! reqCount = PrayerRequests.countByGroup group.Id conn
allReqs = reqCount let! mbrCount = Members.countByGroup group.Id conn
totalMbrs = mbrCount let! admins = Users.listByGroupId group.Id conn
activeReqsByCat = let model =
(reqs { TotalActiveReqs = List.length reqs
|> Seq.ofList AllReqs = reqCount
|> Seq.map (fun req -> req.requestType) TotalMembers = mbrCount
|> Seq.distinct ActiveReqsByType = (
|> Seq.map (fun reqType -> reqType, reqs |> List.filter (fun r -> r.requestType = reqType) |> List.length) reqs
|> Map.ofSeq) |> Seq.ofList
} |> Seq.map (fun req -> req.RequestType)
return! |> Seq.distinct
viewInfo ctx startTicks |> Seq.map (fun reqType ->
|> Views.SmallGroup.overview m reqType, reqs |> List.filter (fun r -> r.RequestType = reqType) |> List.length)
|> Map.ofSeq)
Admins = admins
}
return!
viewInfo ctx
|> Views.SmallGroup.overview model
|> renderHtml next ctx |> renderHtml next ctx
} }
/// GET /small-group/preferences /// GET /small-group/preferences
let preferences : HttpHandler = let preferences : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ] return!
>=> fun next ctx -> { viewInfo ctx with HelpLink = Some Help.groupPreferences }
let startTicks = DateTime.Now.Ticks |> Views.SmallGroup.preferences (EditPreferences.fromPreferences ctx.Session.CurrentGroup.Value.Preferences) ctx
task {
let! tzs = ctx.db.AllTimeZones ()
return!
{ viewInfo ctx startTicks with helpLink = Some Help.groupPreferences }
|> Views.SmallGroup.preferences (EditPreferences.fromPreferences (currentGroup ctx).preferences) tzs ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
open System.Threading.Tasks
/// POST /small-group/save /// POST /small-group/save
let save : HttpHandler = let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ Admin ] match! ctx.TryBindFormAsync<EditSmallGroup> () with
>=> validateCSRF | Ok model ->
>=> fun next ctx -> let! tryGroup =
let s = Views.I18N.localizer.Force () if model.IsNew then Task.FromResult (Some { SmallGroup.empty with Id = (Guid.NewGuid >> SmallGroupId) () })
task { else SmallGroups.tryById (idFromShort SmallGroupId model.SmallGroupId) ctx.Conn
match! ctx.TryBindFormAsync<EditSmallGroup> () with match tryGroup with
| Ok m -> | Some group ->
let! group = do! SmallGroups.save (model.populateGroup group) model.IsNew ctx.Conn
match m.isNew () with let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
| true -> Task.FromResult<SmallGroup option>(Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () }) addHtmlInfo ctx ctx.Strings["Successfully {0} group “{1}”", act, model.Name]
| false -> ctx.db.TryGroupById m.smallGroupId return! redirectTo false "/small-groups" next ctx
match group with | None -> return! fourOhFour ctx
| Some grp -> | Result.Error e -> return! bindError e next ctx
m.populateGroup grp }
|> function
| grp when m.isNew () ->
ctx.db.AddEntry grp
ctx.db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId }
| grp -> ctx.db.UpdateEntry grp
let! _ = ctx.db.SaveChangesAsync ()
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
addHtmlInfo ctx s.["Successfully {0} group “{1}”", act, m.name]
return! redirectTo false "/web/small-groups" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
/// POST /small-group/member/save /// POST /small-group/member/save
let saveMember : HttpHandler = let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ User ] match! ctx.TryBindFormAsync<EditMember> () with
>=> validateCSRF | Ok model ->
>=> fun next ctx -> let group = ctx.Session.CurrentGroup.Value
task { let! tryMbr =
match! ctx.TryBindFormAsync<EditMember> () with if model.IsNew then
| Ok m -> Task.FromResult (Some { Member.empty with Id = (Guid.NewGuid >> MemberId) (); SmallGroupId = group.Id })
let grp = currentGroup ctx else Members.tryById (idFromShort MemberId model.MemberId) ctx.Conn
let! mMbr = match tryMbr with
match m.isNew () with | Some mbr when mbr.SmallGroupId = group.Id ->
| true -> do! Members.save
Task.FromResult<Member option> { mbr with
(Some Name = model.Name
{ Member.empty with Email = model.Email
memberId = Guid.NewGuid () Format = String.noneIfBlank model.Format |> Option.map EmailFormat.fromCode
smallGroupId = grp.smallGroupId } ctx.Conn
}) let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
| false -> ctx.db.TryMemberById m.memberId addInfo ctx ctx.Strings["Successfully {0} group member", act]
match mMbr with return! redirectTo false "/small-group/members" next ctx
| Some mbr when mbr.smallGroupId = grp.smallGroupId -> | Some _
{ mbr with | None -> return! fourOhFour ctx
memberName = m.memberName | Result.Error e -> return! bindError e next ctx
email = m.emailAddress }
format = match m.emailType with "" | null -> None | _ -> Some m.emailType
}
|> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry)
let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
addInfo ctx s.["Successfully {0} group member", act]
return! redirectTo false "/web/small-group/members" next ctx
| Some _
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
/// POST /small-group/preferences/save /// POST /small-group/preferences/save
let savePreferences : HttpHandler = let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ User ] match! ctx.TryBindFormAsync<EditPreferences> () with
>=> validateCSRF | Ok model ->
>=> fun next ctx -> // Since the class is stored in the session, we'll use an intermediate instance to persist it; once that works,
task { // we can repopulate the session instance. That way, if the update fails, the page should still show the
match! ctx.TryBindFormAsync<EditPreferences> () with // database values, not the then out-of-sync session ones.
| Ok m -> let group = ctx.Session.CurrentGroup.Value
// Since the class is stored in the session, we'll use an intermediate instance to persist it; once that match! SmallGroups.tryByIdWithPreferences group.Id ctx.Conn with
// works, we can repopulate the session instance. That way, if the update fails, the page should still show | Some group ->
// the database values, not the then out-of-sync session ones. let pref = model.PopulatePreferences group.Preferences
match! ctx.db.TryGroupById (currentGroup ctx).smallGroupId with do! SmallGroups.savePreferences pref ctx.Conn
| Some grp -> // Refresh session instance
let prefs = m.populatePreferences grp.preferences ctx.Session.CurrentGroup <- Some { group with Preferences = pref }
ctx.db.UpdateEntry prefs addInfo ctx ctx.Strings["Group preferences updated successfully"]
let! _ = ctx.db.SaveChangesAsync () return! redirectTo false "/small-group/preferences" next ctx
// Refresh session instance | None -> return! fourOhFour ctx
ctx.Session.smallGroup <- Some { grp with preferences = prefs } | Result.Error e -> return! bindError e next ctx
let s = Views.I18N.localizer.Force () }
addInfo ctx s.["Group preferences updated successfully"]
return! redirectTo false "/web/small-group/preferences" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
open Giraffe.ViewEngine
open PrayerTracker.Views.CommonFunctions
/// POST /small-group/announcement/send /// POST /small-group/announcement/send
let sendAnnouncement : HttpHandler = let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ User ] match! ctx.TryBindFormAsync<Announcement> () with
>=> validateCSRF | Ok model ->
>=> fun next ctx -> let group = ctx.Session.CurrentGroup.Value
let startTicks = DateTime.Now.Ticks let pref = group.Preferences
task { let usr = ctx.Session.CurrentUser.Value
match! ctx.TryBindFormAsync<Announcement> () with let now = SmallGroup.localTimeNow ctx.Clock group
| Ok m -> let s = ctx.Strings
let grp = currentGroup ctx // Reformat the text to use the class's font stylings
let usr = currentUser ctx let requestText = ckEditorToText model.Text
let now = grp.localTimeNow (ctx.GetService<IClock> ()) let htmlText =
let s = Views.I18N.localizer.Force () p [ _style $"font-family:{pref.FontStack};font-size:%d{pref.TextFontSize}pt;" ] [ rawText requestText ]
// Reformat the text to use the class's font stylings
let requestText = ckEditorToText m.text
let htmlText =
p [ _style $"font-family:{grp.preferences.listFonts};font-size:%d{grp.preferences.textFontSize}pt;" ]
[ 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 = task {
match m.sendToClass with if model.SendToClass = "N" && usr.IsAdmin then
| "N" when usr.isAdmin -> ctx.db.AllUsersAsMembers () let! users = Users.all ctx.Conn
| _ -> ctx.db.AllMembersForSmallGroup grp.smallGroupId return users |> List.map (fun u -> { Member.empty with Name = u.Name; Email = u.Email })
use! client = Email.getConnection () else return! Members.forGroup group.Id ctx.Conn
do! Email.sendEmails client recipients grp }
s.["Announcement for {0} - {1:MMMM d, yyyy} {2}", use! client = Email.getConnection ()
grp.name, now.Date, (now.ToString "h:mm tt").ToLower ()].Value do! Email.sendEmails
htmlText plainText s { Client = client
// Add to the request list if desired Recipients = recipients
match m.sendToClass, m.addToRequestList with Group = group
| "N", _ Subject = s["Announcement for {0} - {1:MMMM d, yyyy} {2}", group.Name, now.Date,
| _, None -> () (now.ToString ("h:mm tt", null)).ToLower ()].Value
| _, Some x when not x -> () HtmlBody = htmlText
| _, _ -> PlainTextBody = plainText
{ PrayerRequest.empty with Strings = s
prayerRequestId = Guid.NewGuid ()
smallGroupId = grp.smallGroupId
userId = usr.userId
requestType = (Option.get >> PrayerRequestType.fromCode) m.requestType
text = requestText
enteredDate = now
updatedDate = now
} }
|> ctx.db.AddEntry // Add to the request list if desired
let! _ = ctx.db.SaveChangesAsync () match model.SendToClass, model.AddToRequestList with
() | "N", _
// Tell 'em what they've won, Johnny! | _, None -> ()
let toWhom = | _, Some x when not x -> ()
match m.sendToClass with | _, _ ->
| "N" -> s.["{0} users", s.["PrayerTracker"]].Value let zone = SmallGroup.timeZone group
| _ -> s.["Group Members"].Value.ToLower () do! PrayerRequests.save
let andAdded = match m.addToRequestList with Some x when x -> "and added it to the request list" | _ -> "" { PrayerRequest.empty with
addInfo ctx s.["Successfully sent announcement to all {0} {1}", toWhom, s.[andAdded]] Id = (Guid.NewGuid >> PrayerRequestId) ()
return! SmallGroupId = group.Id
viewInfo ctx startTicks UserId = usr.Id
|> Views.SmallGroup.announcementSent { m with text = htmlText } RequestType = (Option.get >> PrayerRequestType.fromCode) model.RequestType
Text = requestText
EnteredDate = now.Date.AtStartOfDayInZone(zone).ToInstant()
UpdatedDate = now.InZoneLeniently(zone).ToInstant()
} ctx.Conn
// Tell 'em what they've won, Johnny!
let toWhom =
if model.SendToClass = "N" then s["{0} users", s["PrayerTracker"]].Value
else s["Group Members"].Value.ToLower ()
let andAdded = match model.AddToRequestList with Some x when x -> "and added it to the request list" | _ -> ""
addInfo ctx s["Successfully sent announcement to all {0} {1}", toWhom, s[andAdded]]
return!
viewInfo ctx
|> Views.SmallGroup.announcementSent { model with Text = htmlText }
|> renderHtml next ctx |> renderHtml next ctx
| Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
} }

469
src/PrayerTracker/User.fs
View File

@ -1,311 +1,276 @@
module PrayerTracker.Handlers.User module PrayerTracker.Handlers.User
open System
open Giraffe open Giraffe
open Microsoft.AspNetCore.Html
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Identity
open PrayerTracker open PrayerTracker
open PrayerTracker.Cookies open PrayerTracker.Data
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open PrayerTracker.Views.CommonFunctions
open System
open System.Collections.Generic
open System.Net
open System.Threading.Tasks
/// Set the user's "remember me" cookie /// Password hashing implementation extending ASP.NET Core's identity implementation
let private setUserCookie (ctx : HttpContext) pwHash = [<AutoOpen>]
ctx.Response.Cookies.Append ( module Hashing =
Key.Cookie.user,
{ Id = (currentUser ctx).userId; GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (), open System.Security.Cryptography
autoRefresh) open System.Text
/// Custom password hasher used to verify and upgrade old password hashes
type PrayerTrackerPasswordHasher () =
inherit PasswordHasher<User> ()
override this.VerifyHashedPassword (user, hashedPassword, providedPassword) =
if isNull hashedPassword then nullArg (nameof hashedPassword)
if isNull providedPassword then nullArg (nameof providedPassword)
let hashBytes = Convert.FromBase64String hashedPassword
match hashBytes[0] with
| 255uy ->
// v2 hashes - PBKDF2 (RFC 2898), 1,024 rounds
if hashBytes.Length < 49 then PasswordVerificationResult.Failed
else
let v2Hash =
use alg = new Rfc2898DeriveBytes (
providedPassword, Encoding.UTF8.GetBytes ((Guid hashBytes[1..16]).ToString "N"), 1024)
(alg.GetBytes >> Convert.ToBase64String) 64
if Encoding.UTF8.GetString hashBytes[17..] = v2Hash then
PasswordVerificationResult.SuccessRehashNeeded
else PasswordVerificationResult.Failed
| 254uy ->
// v1 hashes - SHA-1
let v1Hash =
use alg = SHA1.Create ()
alg.ComputeHash (Encoding.ASCII.GetBytes providedPassword)
|> Seq.map (fun byt -> byt.ToString "x2")
|> String.concat ""
if Encoding.UTF8.GetString hashBytes[1..] = v1Hash then
PasswordVerificationResult.SuccessRehashNeeded
else
PasswordVerificationResult.Failed
| _ -> base.VerifyHashedPassword (user, hashedPassword, providedPassword)
/// 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 /// Retrieve a user from the database by password, upgrading password hashes if required
let private findUserByPassword m (db : AppDbContext) = task { let private findUserByPassword model conn = task {
match! db.TryUserByEmailAndGroup m.emailAddress m.smallGroupId with match! Users.tryByEmailAndGroup model.Email (idFromShort SmallGroupId model.SmallGroupId) conn with
| Some u when Option.isSome u.salt -> | Some user ->
// Already upgraded; match = success let hasher = PrayerTrackerPasswordHasher ()
let pwHash = pbkdf2Hash (Option.get u.salt) m.password match hasher.VerifyHashedPassword (user, user.PasswordHash, model.Password) with
match u.passwordHash = pwHash with | PasswordVerificationResult.Success -> return Some user
| true -> return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash | PasswordVerificationResult.SuccessRehashNeeded ->
| _ -> return None, "" let upgraded = { user with PasswordHash = hasher.HashPassword (user, model.Password) }
| Some u when u.passwordHash = sha1Hash m.password -> do! Users.updatePassword upgraded conn
// Not upgraded, but password is good; upgrade 'em! return Some upgraded
// Upgrade 'em! | _ -> return None
let salt = Guid.NewGuid () | None -> return None
let pwHash = pbkdf2Hash salt m.password }
let upgraded = { u with salt = Some salt; passwordHash = pwHash }
db.UpdateEntry upgraded
let! _ = db.SaveChangesAsync ()
return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
| _ -> return None, ""
}
/// Return a default URL if the given URL is non-local or otherwise questionable
let sanitizeUrl providedUrl defaultUrl =
let url = match defaultArg providedUrl "" with "" -> defaultUrl | it -> it
if url.IndexOf "\\" >= 0 || url.IndexOf "//" >= 0 then defaultUrl
elif Seq.exists Char.IsControl url then defaultUrl
else url
/// POST /user/password/change /// POST /user/password/change
let changePassword : HttpHandler = let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<ChangePassword> () with match! ctx.TryBindFormAsync<ChangePassword> () with
| Ok m -> | Ok model ->
let s = Views.I18N.localizer.Force () let curUsr = ctx.Session.CurrentUser.Value
let curUsr = currentUser ctx let hasher = PrayerTrackerPasswordHasher ()
let! dbUsr = ctx.db.TryUserById curUsr.userId let! user = task {
let! user = match! Users.tryById curUsr.Id ctx.Conn with
match dbUsr with
| Some usr ->
// Check the old password against a possibly non-salted hash
(match usr.salt with | Some salt -> pbkdf2Hash salt | _ -> sha1Hash) m.oldPassword
|> ctx.db.TryUserLogOnByCookie curUsr.userId (currentGroup ctx).smallGroupId
| _ -> Task.FromResult None
match user with
| Some _ when m.newPassword = m.newPasswordConfirm ->
match dbUsr with
| Some usr -> | Some usr ->
// Generate salt if it has not been already if hasher.VerifyHashedPassword (usr, usr.PasswordHash, model.OldPassword)
let salt = match usr.salt with Some s -> s | _ -> Guid.NewGuid () = PasswordVerificationResult.Success then
ctx.db.UpdateEntry { usr with passwordHash = pbkdf2Hash salt m.newPassword; salt = Some salt } return Some usr
let! _ = ctx.db.SaveChangesAsync () else return None
// If the user is remembered, update the cookie with the new hash | _ -> return None
match ctx.Request.Cookies.Keys.Contains Key.Cookie.user with }
| true -> setUserCookie ctx usr.passwordHash match user with
| _ -> () | Some usr when model.NewPassword = model.NewPasswordConfirm ->
addInfo ctx s.["Your password was changed successfully"] do! Users.updatePassword { usr with PasswordHash = hasher.HashPassword (usr, model.NewPassword) } ctx.Conn
| None -> addError ctx s.["Unable to change password"] addInfo ctx ctx.Strings["Your password was changed successfully"]
return! redirectTo false "/web/" next ctx return! redirectTo false "/" next ctx
| Some _ -> | Some _ ->
addError ctx s.["The new passwords did not match - your password was NOT changed"] addError ctx ctx.Strings["The new passwords did not match - your password was NOT changed"]
return! redirectTo false "/web/user/password" next ctx return! redirectTo false "/user/password" next ctx
| None -> | None ->
addError ctx s.["The old password was incorrect - your password was NOT changed"] addError ctx ctx.Strings["The old password was incorrect - your password was NOT changed"]
return! redirectTo false "/web/user/password" next ctx return! redirectTo false "/user/password" next ctx
| Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
} }
/// POST /user/[user-id]/delete /// POST /user/[user-id]/delete
let delete userId : HttpHandler = let delete usrId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ Admin ] let userId = UserId usrId
>=> validateCSRF match! Users.tryById userId ctx.Conn with
>=> fun next ctx -> task {
match! ctx.db.TryUserById userId with
| Some user -> | Some user ->
ctx.db.RemoveEntry user do! Users.deleteById userId ctx.Conn
let! _ = ctx.db.SaveChangesAsync () addInfo ctx ctx.Strings["Successfully deleted user {0}", user.Name]
let s = Views.I18N.localizer.Force () return! redirectTo false "/users" next ctx
addInfo ctx s.["Successfully deleted user {0}", user.fullName] | _ -> return! fourOhFour ctx
return! redirectTo false "/web/users" next ctx }
| _ -> return! fourOhFour next ctx
}
open System.Net
open System.Security.Claims
open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Html
/// POST /user/log-on /// POST /user/log-on
let doLogOn : HttpHandler = let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ AccessLevel.Public ]
>=> validateCSRF
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<UserLogOn> () with match! ctx.TryBindFormAsync<UserLogOn> () with
| Ok m -> | Ok model ->
let s = Views.I18N.localizer.Force () let s = ctx.Strings
let! usr, pwHash = findUserByPassword m ctx.db match! findUserByPassword model ctx.Conn with
let! grp = ctx.db.TryGroupById m.smallGroupId | Some user ->
let nextUrl = match! SmallGroups.tryByIdWithPreferences (idFromShort SmallGroupId model.SmallGroupId) ctx.Conn with
match usr with | Some group ->
| Some _ -> ctx.Session.CurrentUser <- Some user
ctx.Session.user <- usr ctx.Session.CurrentGroup <- Some group
ctx.Session.smallGroup <- grp let identity = ClaimsIdentity (
match m.rememberMe with Some x when x -> setUserCookie ctx pwHash | _ -> () seq {
addHtmlInfo ctx s.["Log On Successful • Welcome to {0}", s.["PrayerTracker"]] Claim (ClaimTypes.NameIdentifier, shortGuid user.Id.Value)
match m.redirectUrl with Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value)
| None -> "/web/small-group" }, CookieAuthenticationDefaults.AuthenticationScheme)
| Some x when x = "" -> "/web/small-group" do! ctx.SignInAsync (
| Some x -> x identity.AuthenticationType, ClaimsPrincipal identity,
| _ -> AuthenticationProperties (
let grpName = match grp with Some g -> g.name | _ -> "N/A" IssuedUtc = DateTimeOffset.UtcNow,
{ UserMessage.error with IsPersistent = defaultArg model.RememberMe false))
text = htmlLocString s.["Invalid credentials - log on unsuccessful"] do! Users.updateLastSeen user.Id ctx.Now ctx.Conn
description = addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
[ s.["This is likely due to one of the following reasons"].Value return! redirectTo false (sanitizeUrl model.RedirectUrl "/small-group") next ctx
":<ul><li>" | None -> return! fourOhFour ctx
s.["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode m.emailAddress].Value | None ->
"</li><li>" { UserMessage.error with
s.["The password entered does not match the password for the given e-mail address."].Value Text = htmlLocString s["Invalid credentials - log on unsuccessful"]
"</li><li>" Description =
s.["You are not authorized to administer the group “{0}”.", WebUtility.HtmlEncode grpName].Value let detail =
"</li></ul>" [ "This is likely due to one of the following reasons:<ul>"
] "<li>The e-mail address “{0}” is invalid.</li>"
|> String.concat "" "<li>The password entered does not match the password for the given e-mail address.</li>"
|> (HtmlString >> Some) "<li>You are not authorized to administer the selected group.</li></ul>"
} ]
|> addUserMessage ctx |> String.concat ""
"/web/user/log-on" Some (HtmlString (s[detail, WebUtility.HtmlEncode model.Email].Value))
return! redirectTo false nextUrl next ctx }
| Error e -> return! bindError e next ctx |> addUserMessage ctx
} return! redirectTo false "/user/log-on" next ctx
| Result.Error e -> return! bindError e next ctx
}
/// GET /user/[user-id]/edit /// GET /user/[user-id]/edit
let edit (userId : UserId) : HttpHandler = let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
requireAccess [ Admin ] let userId = UserId usrId
>=> fun next ctx -> task { if userId.Value = Guid.Empty then
let startTicks = DateTime.Now.Ticks
match userId = Guid.Empty with
| true ->
return! return!
viewInfo ctx startTicks viewInfo ctx
|> Views.User.edit EditUser.empty ctx |> Views.User.edit EditUser.empty ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> else
match! ctx.db.TryUserById userId with match! Users.tryById userId ctx.Conn with
| Some user -> | Some user ->
return! return!
viewInfo ctx startTicks viewInfo ctx
|> Views.User.edit (EditUser.fromUser user) ctx |> Views.User.edit (EditUser.fromUser user) ctx
|> renderHtml next ctx |> renderHtml next ctx
| _ -> return! fourOhFour next ctx | _ -> return! fourOhFour ctx
} }
/// GET /user/log-on /// GET /user/log-on
let logOn : HttpHandler = let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
requireAccess [ AccessLevel.Public ] let! groups = SmallGroups.listAll ctx.Conn
>=> fun next ctx -> task { let url = Option.ofObj <| ctx.Session.GetString Key.Session.redirectUrl
let startTicks = DateTime.Now.Ticks
let s = Views.I18N.localizer.Force ()
let! groups = ctx.db.GroupList ()
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 ctx.Strings["The page you requested requires authentication; please log on below."]
| None -> () | None -> ()
return! return!
{ viewInfo ctx startTicks with helpLink = Some Help.logOn } { viewInfo ctx 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 ] >=> fun next ctx -> task {
requireAccess [ Admin ] let! users = Users.all ctx.Conn
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let! users = ctx.db.AllUsers ()
return! return!
viewInfo ctx startTicks viewInfo ctx
|> Views.User.maintain users ctx |> Views.User.maintain users ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
/// GET /user/password /// GET /user/password
let password : HttpHandler = let password : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
requireAccess [ User ] { viewInfo ctx with HelpLink = Some Help.changePassword }
>=> fun next ctx ->
{ viewInfo ctx DateTime.Now.Ticks with helpLink = Some Help.changePassword }
|> Views.User.changePassword ctx |> Views.User.changePassword ctx
|> renderHtml next ctx |> renderHtml next ctx
open System.Threading.Tasks
/// POST /user/save /// POST /user/save
let save : HttpHandler = let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditUser> () with match! ctx.TryBindFormAsync<EditUser> () with
| Ok m -> | Ok model ->
let! user = let! user =
match m.isNew () with if model.IsNew then Task.FromResult (Some { User.empty with Id = (Guid.NewGuid >> UserId) () })
| true -> Task.FromResult (Some { User.empty with userId = Guid.NewGuid () }) else Users.tryById (idFromShort UserId model.UserId) ctx.Conn
| false -> ctx.db.TryUserById m.userId match user with
let saltedUser = | Some usr ->
match user with let hasher = PrayerTrackerPasswordHasher ()
| Some u -> let updatedUser = model.PopulateUser usr (fun pw -> hasher.HashPassword (usr, pw))
match u.salt with do! Users.save updatedUser ctx.Conn
| None when m.password <> "" -> let s = ctx.Strings
// Generate salt so that a new password hash can be generated if model.IsNew then
Some { u with salt = Some (Guid.NewGuid ()) }
| _ ->
// Leave the user with no salt, so prior hash can be validated/upgraded
user
| _ -> user
match saltedUser with
| Some u ->
let updatedUser = m.populateUser u (pbkdf2Hash (Option.get u.salt))
updatedUser |> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry)
let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
match m.isNew () with
| true ->
let h = CommonFunctions.htmlString let h = CommonFunctions.htmlString
{ UserMessage.info with { UserMessage.info with
text = h s.["Successfully {0} user", s.["Added"].Value.ToLower ()] Text = h s["Successfully {0} user", s["Added"].Value.ToLower ()]
description = Description =
h s.["Please select at least one group for which this user ({0}) is authorized", h s["Please select at least one group for which this user ({0}) is authorized",
updatedUser.fullName] updatedUser.Name]
|> Some |> Some
} }
|> addUserMessage ctx |> addUserMessage ctx
return! redirectTo false $"/web/user/{flatGuid u.userId}/small-groups" next ctx return! redirectTo false $"/user/{shortGuid usr.Id.Value}/small-groups" next ctx
| false -> else
addInfo ctx s.["Successfully {0} user", s.["Updated"].Value.ToLower ()] addInfo ctx s["Successfully {0} user", s["Updated"].Value.ToLower ()]
return! redirectTo false "/web/users" next ctx return! redirectTo false "/users" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour ctx
| Error e -> return! bindError e next ctx | Result.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 ] >=> validateCsrf >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<AssignGroups> () with match! ctx.TryBindFormAsync<AssignGroups> () with
| Ok m -> | Ok model ->
let s = Views.I18N.localizer.Force () match Seq.length model.SmallGroups with
match Seq.length m.smallGroups with
| 0 -> | 0 ->
addError ctx s.["You must select at least one group to assign"] addError ctx ctx.Strings["You must select at least one group to assign"]
return! redirectTo false $"/web/user/{flatGuid m.userId}/small-groups" next ctx return! redirectTo false $"/user/{model.UserId}/small-groups" next ctx
| _ -> | _ ->
match! ctx.db.TryUserByIdWithGroups m.userId with do! Users.updateSmallGroups (idFromShort UserId model.UserId)
| Some user -> (model.SmallGroups.Split ',' |> Array.map (idFromShort SmallGroupId) |> List.ofArray) ctx.Conn
let grps = addInfo ctx ctx.Strings["Successfully updated group permissions for {0}", model.UserName]
m.smallGroups.Split ',' return! redirectTo false "/users" next ctx
|> Array.map Guid.Parse | Result.Error e -> return! bindError e next ctx
|> List.ofArray }
user.smallGroups
|> Seq.filter (fun x -> not (grps |> List.exists (fun y -> y = x.smallGroupId)))
|> ctx.db.UserGroupXref.RemoveRange
grps
|> Seq.ofList
|> Seq.filter (fun x -> not (user.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x)))
|> Seq.map (fun x -> { UserSmallGroup.empty with userId = user.userId; smallGroupId = x })
|> List.ofSeq
|> List.iter ctx.db.AddEntry
let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s.["Successfully updated group permissions for {0}", m.userName]
return! redirectTo false "/web/users" next ctx
| _ -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
/// GET /user/[user-id]/small-groups /// GET /user/[user-id]/small-groups
let smallGroups userId : HttpHandler = let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
requireAccess [ Admin ] let userId = UserId usrId
>=> fun next ctx -> task { match! Users.tryById userId ctx.Conn with
let startTicks = DateTime.Now.Ticks
match! ctx.db.TryUserByIdWithGroups userId with
| Some user -> | Some user ->
let! grps = ctx.db.GroupList () let! groups = SmallGroups.listAll ctx.Conn
let curGroups = user.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq let! groupIds = Users.groupIdsByUserId userId ctx.Conn
let curGroups = groupIds |> List.map (fun g -> shortGuid g.Value)
return! return!
viewInfo ctx startTicks viewInfo ctx
|> Views.User.assignGroups (AssignGroups.fromUser user) grps curGroups ctx |> Views.User.assignGroups (AssignGroups.fromUser user) groups curGroups ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour ctx
} }

184
src/PrayerTracker/wwwroot/css/app.css
View File

@ -1,11 +1,20 @@
/** /**
* This is the main stylesheet for the PrayerTracker application. * This is the main stylesheet for the PrayerTracker application.
*/ */
:root {
--dark-blue-hue: 240;
--dark-blue-sat: 100%;
--darkest: hsl(var(--dark-blue-hue), var(--dark-blue-sat), 6%);
--dark: hsl(var(--dark-blue-hue), var(--dark-blue-sat), 13%);
--lighter-dark: hsl(var(--dark-blue-hue), var(--dark-blue-sat), 25%);
--inverse-backgroud: hsl(0, 0%, 95%);
--background: hsla(0, 0%, 0%, .01);
--native-fonts: system-ui,-apple-system,"Segoe UI",Roboto,Ubuntu,"Liberation Sans",Cantarell,"Helvetica Neue",sans-serif;
}
body { body {
background-color: #222; background-color: var(--background);
margin: 0; margin: 0;
margin-bottom: 25px; font-family: var(--native-fonts);
font-family: -apple-system,BlinkMacSystemFont,"Segoe UI",Roboto,Oxygen-Sans,Ubuntu,Cantarell,"Helvetica Neue",sans-serif;
font-size: 1rem; font-size: 1rem;
} }
acronym { acronym {
@ -18,10 +27,10 @@ a,
a:link, a:link,
a:visited { a:visited {
text-decoration: none; text-decoration: none;
color: navy; color: var(--dark);
} }
a:hover { a:hover {
border-bottom: dotted 1px navy; border-bottom: dotted 1px var(--darkest);
} }
a > img { a > img {
border: 0; border: 0;
@ -32,7 +41,7 @@ a > img {
justify-content: space-between; justify-content: space-between;
overflow: hidden; overflow: hidden;
width: 100%; width: 100%;
background-image: linear-gradient(to bottom, #222, #444); background-image: linear-gradient(to bottom, var(--darkest), var(--dark));
margin-bottom: 0; margin-bottom: 0;
} }
.pt-title-bar-left, .pt-title-bar-left,
@ -46,7 +55,7 @@ a > img {
float: left; float: left;
font-size: 1.25rem; font-size: 1.25rem;
font-weight: bold; font-weight: bold;
padding: .5rem 1rem 0 1rem; padding: .5rem 1rem 0 .75rem;
} }
.pt-title-bar-home a:link, .pt-title-bar-home a:link,
.pt-title-bar-home a:visited { .pt-title-bar-home a:visited {
@ -65,7 +74,7 @@ a > img {
float: left; float: left;
} }
.pt-title-bar li a, .pt-title-bar li a,
.pt-title-bar .dropbtn, .pt-title-bar .dropdown-btn,
.pt-title-bar .home-link { .pt-title-bar .home-link {
display: inline-block; display: inline-block;
color: #9d9d9d; color: #9d9d9d;
@ -77,7 +86,7 @@ a > img {
font-size: 1.1rem; font-size: 1.1rem;
} }
.pt-title-bar li a:hover, .pt-title-bar li a:hover,
.pt-title-bar .dropdown:hover .dropbtn { .pt-title-bar .dropdown:hover .dropdown-btn {
color: white; color: white;
border-bottom: none; border-bottom: none;
} }
@ -87,7 +96,7 @@ a > img {
.pt-title-bar .dropdown-content { .pt-title-bar .dropdown-content {
display: none; display: none;
position: absolute; position: absolute;
background-image: linear-gradient(to bottom, #444, #888); background-image: linear-gradient(to bottom, var(--dark), var(--lighter-dark));
min-width: 160px; min-width: 160px;
box-shadow: 0 8px 16px 0 rgba(0,0,0,0.2); box-shadow: 0 8px 16px 0 rgba(0,0,0,0.2);
z-index: 1; z-index: 1;
@ -100,14 +109,14 @@ a > img {
text-align: left; text-align: left;
} }
.pt-title-bar .dropdown-content a:hover { .pt-title-bar .dropdown-content a:hover {
background-color: #222; background-color: var(--inverse-backgroud);
color: var(--lighter-dark);
} }
.pt-title-bar .dropdown:hover .dropdown-content { .pt-title-bar .dropdown:hover .dropdown-content {
display: block; display: block;
} }
#pt-body { #pt-body {
background-color: #fcfcfc; padding-bottom: 1rem;
padding-bottom: 10px;
} }
#pt-language { #pt-language {
background-color: lightgray; background-color: lightgray;
@ -116,74 +125,84 @@ a > img {
justify-content: space-between; justify-content: space-between;
border-bottom: solid 1px darkgray; border-bottom: solid 1px darkgray;
border-top: solid 1px darkgray; border-top: solid 1px darkgray;
padding: 0 .75rem;
} }
#pt-page-title { #pt-page-title {
text-align: center; text-align: center;
border-bottom: dotted 1px lightgray; border-bottom: dotted 1px lightgray;
} }
.pt-content { .pt-content {
margin: auto; margin: auto auto 1.5rem auto;
max-width: 60rem; max-width: 60rem;
} }
.pt-content.pt-full-width { .pt-content.pt-full-width {
max-width: unset; max-width: unset;
margin-left: .5%; margin-left: .75rem;
margin-right: .5%; margin-right: .75rem;
} }
@media screen and (max-width: 60rem) { @media screen and (max-width: 60rem) {
.pt-content { .pt-content {
margin-left: .5%; margin-left: .75rem;
margin-right: .5%; margin-right: .75rem;
} }
} }
fieldset { fieldset {
margin: auto; margin: auto auto 1rem auto;
border: solid 1px #ccc; border: solid 1px #ccc;
border-radius: 1rem; border-radius: 1rem;
margin-bottom: 1rem;
} }
input[type=email], input[type=email],
input[type=text], input[type=text],
input[type=password], input[type=password],
input[type=date], input[type=date],
input[type=number], input[type=number],
input[type=url],
select { select {
border-radius: 5px; border-radius: .2rem;
border-color: var(--lighter-dark);
font-size: 1rem; font-size: 1rem;
padding: .2rem; padding: .25rem;
font-family: -apple-system,BlinkMacSystemFont,"Segoe UI",Roboto,Oxygen-Sans,Ubuntu,Cantarell,"Helvetica Neue",sans-serif; font-family: var(--native-fonts);
} border-width: 1px;
input:nth-of-type(2) {
margin-left: 2rem;
} }
button[type=submit] { button[type=submit] {
border-radius: 10px; border-radius: .6rem;
padding: .2rem 1rem; padding: .2rem 1rem;
margin-top: .5rem; margin-top: .5rem;
background-color: #444; background-color: var(--lighter-dark);
border: none; border: solid 1px var(--lighter-dark);
color: white; color: white;
} }
button[type=submit]:hover { button[type=submit]:hover {
background-color: #222; color: var(--lighter-dark);
cursor:pointer; background-color: var(--inverse-backgroud);
cursor: pointer;
} }
footer { footer.pt-footer {
position: fixed; position: fixed;
bottom: 0; bottom: 0;
width: 100%; width: 100%;
border-bottom: solid 10px #222; padding-top: .5rem;
background-image: linear-gradient(to bottom, var(--background), var(--darkest));
display: flex;
flex-flow: row wrap;
justify-content: space-between;
align-items: end;
} }
#pt-legal { #pt-legal {
background-color: #222; padding-left: .75rem;
margin: 0 0 -30px 0;
padding-left: 10px;
} }
#pt-legal a:link, #pt-legal a:link,
#pt-legal a:visited { #pt-legal a:visited {
color: lightgray; color: white;
color: rgba(255, 255, 255, .5);
font-size: 10pt; font-size: 10pt;
background-color: var(--darkest);
padding: 0 .5rem;
border-top-left-radius: .5rem;
border-top-right-radius: .5rem;
}
#pt-legal a:hover {
background-color: var(--lighter-dark);
} }
#pt-footer { #pt-footer {
border: solid 2px navy; border: solid 2px navy;
@ -191,15 +210,18 @@ footer {
border-top-left-radius: 7px; border-top-left-radius: 7px;
border-top-right-radius: 7px; border-top-right-radius: 7px;
padding: 2px 5px 0 5px; padding: 2px 5px 0 5px;
margin: 0 10px -11px auto; margin-right: .75rem;
font-size: 70%; font-size: 70%;
color: navy; color: navy;
background-color: #eee; background-color: #eee;
float:right; }
#pt-footer img,
#pt-footer span,
#pt-footer i {
vertical-align: bottom; vertical-align: bottom;
} }
#pt-footer img { #pt-version {
vertical-align: bottom; padding-left: .25rem;
} }
footer a:hover { footer a:hover {
border-bottom: 0; border-bottom: 0;
@ -214,6 +236,7 @@ footer a:hover {
flex-flow: row wrap; flex-flow: row wrap;
align-items: center; align-items: center;
justify-content: center; justify-content: center;
gap: 2rem;
} }
.pt-field { .pt-field {
display: flex; display: flex;
@ -231,8 +254,11 @@ footer a:hover {
text-transform: uppercase; text-transform: uppercase;
color: #777; color: #777;
} }
.pt-field ~ .pt-field { .pt-group {
margin-left: 3rem; display: flex;
flex-flow: row;
gap: 1.5rem;
align-items: baseline;
} }
.pt-center-text { .pt-center-text {
text-align: center; text-align: center;
@ -240,37 +266,49 @@ footer a:hover {
.pt-right-text { .pt-right-text {
text-align: right; text-align: right;
} }
.pt-table { .pt-table {
margin: auto; display: grid;
border-collapse: collapse; justify-content: center;
} }
.pt-table tr:hover { .pt-table .row.head,
.pt-table .row {
display: contents;
}
.pt-table .row:hover > * {
background-color: #eee; background-color: #eee;
} }
.pt-table tr th, .pt-table .row.head .cell {
.pt-table tr td { background-image: linear-gradient(to bottom, var(--dark), var(--lighter-dark));
font-weight: bold;
color: white;
text-align: center;
font-size: .85rem;
}
.pt-table .row.head .cell:first-of-type {
border-top-left-radius: .5rem;
}
.pt-table .row.head .cell:last-of-type {
border-top-right-radius: .5rem;
}
.pt-table .cell {
padding: .25rem .5rem; padding: .25rem .5rem;
border-bottom: dotted 1px var(--lighter-dark);
} }
.pt-table tr td { .pt-table .cell.actions {
border-bottom: dotted 1px #444; border-bottom-color: var(--background);
} }
.pt-action-table tr td:first-child { .pt-table .cell.actions a {
white-space: nowrap; background-color: gray;
border-bottom: 0;
}
.pt-action-table tr td:first-child a {
background-color: lightgray;
color: white; color: white;
border-radius: .5rem; border-radius: .5rem;
padding: .125rem .5rem .5rem .5rem; padding: 0 .5rem .25rem;
margin: 0 .125rem; margin: 0 .125rem;
} }
.pt-action-table tr:hover td:first-child a { .pt-table .row:hover .cell.actions a {
background-color: navy; background-color: var(--dark);
}
.pt-action-table tr td:first-child a:hover {
border-bottom: 0;
} }
/* TODO: Figure out nice CSS transitions for these; these don't work */ /* TODO: Figure out nice CSS transitions for these; these don't work */
.pt-fadeable { .pt-fadeable {
height: 0; height: 0;
@ -300,7 +338,7 @@ article.pt-overview section header {
text-align: center; text-align: center;
border-top-left-radius: 1rem; border-top-left-radius: 1rem;
border-top-right-radius: 1rem; border-top-right-radius: 1rem;
background-image: linear-gradient(to bottom, #444, #888); background-image: linear-gradient(to bottom, var(--dark), var(--lighter-dark));
padding: .5rem 1rem; padding: .5rem 1rem;
color: white; color: white;
} }
@ -308,7 +346,7 @@ article.pt-overview section div {
padding: .5rem; padding: .5rem;
} }
article.pt-overview section div hr { article.pt-overview section div hr {
color: #444; color: var(--dark);
margin: .5rem -.5rem; margin: .5rem -.5rem;
} }
article.pt-overview section div p { article.pt-overview section div p {
@ -317,6 +355,12 @@ article.pt-overview section div p {
.pt-editor { .pt-editor {
width: 100%; width: 100%;
} }
.pt-messages {
display: flex;
flex-flow: column;
justify-content: center;
align-items: center;
}
.pt-msg { .pt-msg {
margin: .5rem auto; margin: .5rem auto;
border-top-right-radius: .5rem; border-top-right-radius: .5rem;
@ -324,15 +368,12 @@ article.pt-overview section div p {
border-width: 2px; border-width: 2px;
border-style: solid; border-style: solid;
border-collapse: inherit; border-collapse: inherit;
padding: 5px 30px;
text-align: center;
} }
.pt-msg ul { .pt-msg ul {
text-align: left; text-align: left;
} }
.pt-msg td {
padding: 5px 30px;
margin-bottom: 2px;
text-align: center;
}
.pt-msg.error { .pt-msg.error {
background-color: #ffb6c1; background-color: #ffb6c1;
border-color: #ff0000; border-color: #ff0000;
@ -399,6 +440,9 @@ article.pt-overview section div p {
.material-icons { .material-icons {
vertical-align: middle; vertical-align: middle;
} }
.pt-help-link {
padding-right: .25rem;
}
#pt-help { #pt-help {
background-color: #fcfcfc; background-color: #fcfcfc;
} }

155
src/PrayerTracker/wwwroot/js/app.js
View File

@ -2,28 +2,14 @@
* This file contains a library of common functions used throughout the PrayerTracker website, as well as specific * This file contains a library of common functions used throughout the PrayerTracker website, as well as specific
* functions used on pages throughout the site. * functions used on pages throughout the site.
*/ */
const PT = { this.PT = {
/** /**
* Open a window with help * Open a window with help
* @param {string} url The URL for the help page. * @param {string} url The URL for the help page.
*/ */
showHelp(url) { showHelp(url) {
window.open(url, 'helpWindow', 'height=600px,width=450px,toolbar=0,menubar=0,scrollbars=1') window.open(url, "helpWindow", "height=600px,width=450px,toolbar=0,menubar=0,scrollbars=1")
return false
},
/**
* Confirm, then submit a delete action
* @param {string} action The URL for the action attribute of the delete form.
* @param {string} prompt The localized prompt for confirmation.
*/
confirmDelete(action, prompt) {
if (confirm(prompt)) {
let form = document.querySelector('#DeleteForm')
form.setAttribute('action', action)
form.submit()
}
return false return false
}, },
@ -36,14 +22,6 @@ const PT = {
.forEach(f => document.getElementById(f).required = true) .forEach(f => document.getElementById(f).required = true)
}, },
/**
* Queue an action to occur when the DOM content is loaded
* @param {Function} func The function to run once the DOM content is loaded
*/
onLoad(func) {
document.addEventListener('DOMContentLoaded', func)
},
/** /**
* Validation that compares the values of 2 fields and fails if they do not match * Validation that compares the values of 2 fields and fails if they do not match
* @param {string} field1 The ID of the first field * @param {string} field1 The ID of the first field
@ -55,7 +33,7 @@ const PT = {
const field1Value = document.getElementById(field1).value const field1Value = document.getElementById(field1).value
const field2Element = document.getElementById(field2) const field2Element = document.getElementById(field2)
if (field1Value === field2Element.value) { if (field1Value === field2Element.value) {
field2Element.setCustomValidity('') field2Element.setCustomValidity("")
return true return true
} }
field2Element.setCustomValidity(errorMsg) field2Element.setCustomValidity(errorMsg)
@ -67,8 +45,8 @@ const PT = {
* @param {HTMLElement} div The div to be shown * @param {HTMLElement} div The div to be shown
*/ */
showDiv(div) { showDiv(div) {
if (div.className.indexOf(' pt-shown') === -1) { if (div.className.indexOf(" pt-shown") === -1) {
div.className += ' pt-shown' div.className += " pt-shown"
} }
}, },
@ -77,7 +55,7 @@ const PT = {
* @param {HTMLElement} div The div to be hidden * @param {HTMLElement} div The div to be hidden
*/ */
hideDiv(div) { hideDiv(div) {
div.className = div.className.replace(' pt-shown', '') div.className = div.className.replace(" pt-shown", "")
}, },
/** /**
@ -85,10 +63,18 @@ const PT = {
*/ */
initCKEditor() { initCKEditor() {
ClassicEditor ClassicEditor
.create(document.querySelector('#text')) .create(document.querySelector("#Text"))
.then(editor => window.ckEditor = editor)
.catch(console.error) .catch(console.error)
}, },
/**
* Instruct the current CKEditor element to update its source (needed as htmx does not fire the submit event)
*/
updateCKEditor() {
window.ckEditor.updateElement()
},
/** /**
* Scripts for pages served by the Church controller * Scripts for pages served by the Church controller
*/ */
@ -101,9 +87,9 @@ const PT = {
* If the interface box is checked, show and require the interface URL field (if not, well... don't) * If the interface box is checked, show and require the interface URL field (if not, well... don't)
*/ */
checkInterface() { checkInterface() {
const div = document.getElementById('divInterfaceAddress') const div = document.getElementById("divInterfaceAddress")
const addr = document.getElementById('interfaceAddress') const addr = document.getElementById("InterfaceAddress")
if (document.getElementById('hasInterface').checked) { if (document.getElementById("HasInterface").checked) {
PT.showDiv(div) PT.showDiv(div)
addr.required = true addr.required = true
} }
@ -117,30 +103,12 @@ const PT = {
*/ */
onPageLoad() { onPageLoad() {
PT.church.edit.checkInterface() PT.church.edit.checkInterface()
document.getElementById('hasInterface') document.getElementById("HasInterface")
.addEventListener('click', PT.church.edit.checkInterface) .addEventListener("click", PT.church.edit.checkInterface)
} }
} }
}, },
/**
* Scripts for pages served by the Requests controller
*/
requests: {
/**
* Script for the request view page
*/
view: {
/**
* Prompt the user to remind them that they are about to e-mail their class
* @param {string} confirmationPrompt The text to display to the user
*/
promptBeforeEmail(confirmationPrompt) {
return confirm(confirmationPrompt)
},
},
},
/** /**
* Scripts for pages served by the SmallGroup controller * Scripts for pages served by the SmallGroup controller
*/ */
@ -154,23 +122,23 @@ const PT = {
*/ */
onPageLoad() { onPageLoad() {
PT.initCKEditor() PT.initCKEditor()
const sendNo = document.getElementById('sendN') const sendNo = document.getElementById("SendToClass_N")
const catDiv = document.getElementById('divCategory') const catDiv = document.getElementById("divCategory")
const catSel = document.getElementById('requestType') const catSel = document.getElementById("RequestType")
const addChk = document.getElementById('addToRequestList') const addChk = document.getElementById("AddToRequestList")
if (sendNo !== 'undefined') { if (sendNo !== "undefined") {
const addDiv = document.getElementById('divAddToList') const addDiv = document.getElementById("divAddToList")
sendNo.addEventListener('click', () => { sendNo.addEventListener("click", () => {
PT.hideDiv(addDiv) PT.hideDiv(addDiv)
PT.hideDiv(catDiv) PT.hideDiv(catDiv)
catSel.required = false catSel.required = false
addChk.checked = false addChk.checked = false
}) })
document.getElementById('sendY').addEventListener('click', () => { document.getElementById("SendToClass_Y").addEventListener("click", () => {
PT.showDiv(addDiv) PT.showDiv(addDiv)
}) })
} }
addChk.addEventListener('click', () => { addChk.addEventListener("click", () => {
if (addChk.checked) { if (addChk.checked) {
PT.showDiv(catDiv) PT.showDiv(catDiv)
catSel.required = true catSel.required = true
@ -190,11 +158,11 @@ const PT = {
* Determine which field should have the focus * Determine which field should have the focus
*/ */
onPageLoad() { onPageLoad() {
const grp = document.getElementById('SmallGroupId') const grp = document.getElementById("SmallGroupId")
if (grp.options[grp.selectedIndex].value === '') { if (grp.options[grp.selectedIndex].value === '') {
grp.focus() grp.focus()
} else { } else {
document.getElementById('Password').focus() document.getElementById("Password").focus()
} }
} }
}, },
@ -210,8 +178,8 @@ const PT = {
*/ */
toggleType(name) { toggleType(name) {
const isNamed = document.getElementById(`${name}Type_Name`) const isNamed = document.getElementById(`${name}Type_Name`)
const named = document.getElementById(`${name}Color_Select`) const named = document.getElementById(`${name}_Select`)
const custom = document.getElementById(`${name}Color_Color`) const custom = document.getElementById(`${name}_Color`)
if (isNamed.checked) { if (isNamed.checked) {
custom.disabled = true custom.disabled = true
named.disabled = false named.disabled = false
@ -225,9 +193,9 @@ const PT = {
* Show or hide the class password based on the visibility. * Show or hide the class password based on the visibility.
*/ */
checkVisibility() { checkVisibility() {
const divPw = document.getElementById('divClassPassword') const divPw = document.getElementById("divClassPassword")
if (document.getElementById('viz_Public').checked if (document.getElementById("Visibility_Public").checked
|| document.getElementById('viz_Private').checked) { || document.getElementById("Visibility_Private").checked) {
// Disable password // Disable password
PT.hideDiv(divPw) PT.hideDiv(divPw)
} else { } else {
@ -235,24 +203,37 @@ const PT = {
} }
}, },
/**
* Enable or disable the font list based on whether the native font stack is selected or not
*/
checkFonts() {
document.getElementById("Fonts").disabled = document.getElementById("IsNative_Y").checked
},
/** /**
* Bind the event handlers * Bind the event handlers
*/ */
onPageLoad() { onPageLoad() {
['Public', 'Private', 'Password'].map(typ => { ["Public", "Private", "Password"].map(typ => {
document.getElementById(`viz_${typ}`).addEventListener('click', document.getElementById(`Visibility_${typ}`).addEventListener("click",
PT.smallGroup.preferences.checkVisibility) PT.smallGroup.preferences.checkVisibility)
}) })
PT.smallGroup.preferences.checkVisibility() PT.smallGroup.preferences.checkVisibility()
;['headingLine', 'headingText'].map(name => { ;["LineColor", "HeadingColor"].map(name => {
document.getElementById(`${name}Type_Name`).addEventListener('click', () => { document.getElementById(`${name}Type_Name`).addEventListener("click", () => {
PT.smallGroup.preferences.toggleType(name) PT.smallGroup.preferences.toggleType(name)
}) })
document.getElementById(`${name}Type_RGB`).addEventListener('click', () => { document.getElementById(`${name}Type_RGB`).addEventListener("click", () => {
PT.smallGroup.preferences.toggleType(name) PT.smallGroup.preferences.toggleType(name)
}) })
PT.smallGroup.preferences.toggleType(name) PT.smallGroup.preferences.toggleType(name)
}) })
;["Y", "N"].map(name => {
document.getElementById(`IsNative_${name}`).addEventListener("click", () => {
PT.smallGroup.preferences.checkFonts()
})
})
PT.smallGroup.preferences.checkFonts()
}, },
}, },
}, },
@ -270,9 +251,33 @@ const PT = {
*/ */
onPageLoad(isNew) { onPageLoad(isNew) {
if (isNew) { if (isNew) {
PT.requireFields(['password', 'passwordConfirm']) PT.requireFields(["Password", "PasswordConfirm"])
} }
} }
} }
}, },
} }
htmx.on("htmx:configRequest", function (e) {
e.detail.headers["X-Target"] = e.detail.target
})
htmx.on("htmx:responseError", function (e) {
/** @type {XMLHttpRequest} */
const xhr = e.detail.xhr
const detail = document.createElement("div")
detail.className = "description"
detail.innerHTML = `<em>(Status code ${xhr.status}: ${xhr.statusText})</em>`
const msg = document.createElement("div")
msg.className = "pt-msg error"
msg.innerHTML = `<strong>ERROR</strong> &#xbb; ${xhr.responseText}<br>`
msg.appendChild(detail)
const messages = document.createElement("div")
messages.className = "pt-messages"
messages.appendChild(msg)
const title = document.getElementById("pt-page-title")
title.parentNode.insertBefore(messages, title.nextSibling)
})

110
src/names-to-lower.sql Normal file
View File

@ -0,0 +1,110 @@
-- Church
ALTER TABLE pt."Church" RENAME COLUMN "ChurchId" TO id;
ALTER TABLE pt."Church" RENAME COLUMN "Name" TO church_name;
ALTER TABLE pt."Church" RENAME COLUMN "City" TO city;
ALTER TABLE pt."Church" RENAME COLUMN "ST" TO state;
ALTER TABLE pt."Church" RENAME COLUMN "HasVirtualPrayerRoomInterface" TO has_vps_interface;
ALTER TABLE pt."Church" RENAME COLUMN "InterfaceAddress" TO interface_address;
ALTER TABLE pt."Church" RENAME CONSTRAINT "PK_Church" TO pk_church;
ALTER TABLE pt."Church" RENAME TO church;
-- List Preference
ALTER TABLE pt."ListPreference" RENAME COLUMN "SmallGroupId" TO small_group_id;
ALTER TABLE pt."ListPreference" RENAME COLUMN "DaysToExpire" TO days_to_expire;
ALTER TABLE pt."ListPreference" RENAME COLUMN "DaysToKeepNew" TO days_to_keep_new;
ALTER TABLE pt."ListPreference" RENAME COLUMN "LongTermUpdateWeeks" TO long_term_update_weeks;
ALTER TABLE pt."ListPreference" RENAME COLUMN "EmailFromName" TO email_from_name;
ALTER TABLE pt."ListPreference" RENAME COLUMN "EmailFromAddress" TO email_from_address;
ALTER TABLE pt."ListPreference" RENAME COLUMN "ListFonts" TO fonts;
ALTER TABLE pt."ListPreference" RENAME COLUMN "HeadingColor" TO heading_color;
ALTER TABLE pt."ListPreference" RENAME COLUMN "LineColor" TO line_color;
ALTER TABLE pt."ListPreference" RENAME COLUMN "HeadingFontSize" TO heading_font_size;
ALTER TABLE pt."ListPreference" RENAME COLUMN "TextFontSize" TO text_font_size;
ALTER TABLE pt."ListPreference" RENAME COLUMN "RequestSort" TO request_sort;
ALTER TABLE pt."ListPreference" RENAME COLUMN "GroupPassword" TO group_password;
ALTER TABLE pt."ListPreference" RENAME COLUMN "DefaultEmailType" TO default_email_type;
ALTER TABLE pt."ListPreference" RENAME COLUMN "IsPublic" TO is_public;
ALTER TABLE pt."ListPreference" RENAME COLUMN "TimeZoneId" TO time_zone_id;
ALTER TABLE pt."ListPreference" RENAME COLUMN "PageSize" TO page_size;
ALTER TABLE pt."ListPreference" RENAME COLUMN "AsOfDateDisplay" TO as_of_date_display;
ALTER TABLE pt."ListPreference" RENAME CONSTRAINT "PK_ListPreference" TO pk_list_preference;
ALTER TABLE pt."ListPreference" RENAME CONSTRAINT "FK_ListPreference_SmallGroup_SmallGroupId" TO fk_list_preference_small_group_id;
ALTER TABLE pt."ListPreference" DROP CONSTRAINT "FK_ListPreference_TimeZone_TimeZoneId";
ALTER TABLE pt."ListPreference" RENAME TO list_preference;
ALTER INDEX pt."IX_ListPreference_TimeZoneId" RENAME TO ix_list_preference_time_zone_id;
ALTER TABLE pt.list_preference ALTER COLUMN email_from_address SET DEFAULT 'prayer@bitbadger.solutions';
ALTER TABLE pt.list_preference ALTER COLUMN fonts SET DEFAULT 'native';
-- Small Group Member
ALTER TABLE pt."Member" RENAME COLUMN "MemberId" TO id;
ALTER TABLE pt."Member" RENAME COLUMN "SmallGroupId" TO small_group_id;
ALTER TABLE pt."Member" RENAME COLUMN "MemberName" TO member_name;
ALTER TABLE pt."Member" RENAME COLUMN "Email" TO email;
ALTER TABLE pt."Member" RENAME COLUMN "Format" TO email_format;
ALTER TABLE pt."Member" RENAME CONSTRAINT "PK_Member" TO pk_member;
ALTER TABLE pt."Member" RENAME CONSTRAINT "FK_Member_SmallGroup_SmallGroupId" TO fk_member_small_group_id;
ALTER TABLE pt."Member" RENAME TO member;
ALTER INDEX pt."IX_Member_SmallGroupId" RENAME TO ix_member_small_group_id;
-- Prayer Request
ALTER TABLE pt."PrayerRequest" RENAME COLUMN "PrayerRequestId" TO id;
ALTER TABLE pt."PrayerRequest" RENAME COLUMN "RequestType" TO request_type;
ALTER TABLE pt."PrayerRequest" RENAME COLUMN "UserId" TO user_id;
ALTER TABLE pt."PrayerRequest" RENAME COLUMN "SmallGroupId" TO small_group_id;
ALTER TABLE pt."PrayerRequest" RENAME COLUMN "EnteredDate" TO entered_date;
ALTER TABLE pt."PrayerRequest" RENAME COLUMN "UpdatedDate" TO updated_date;
ALTER TABLE pt."PrayerRequest" RENAME COLUMN "Requestor" TO requestor;
ALTER TABLE pt."PrayerRequest" RENAME COLUMN "Text" TO request_text;
ALTER TABLE pt."PrayerRequest" RENAME COLUMN "NotifyChaplain" TO notify_chaplain;
ALTER TABLE pt."PrayerRequest" RENAME COLUMN "Expiration" TO expiration;
ALTER TABLE pt."PrayerRequest" RENAME CONSTRAINT "PK_PrayerRequest" TO pk_prayer_request;
ALTER TABLE pt."PrayerRequest" RENAME CONSTRAINT "FK_PrayerRequest_User_UserId" TO fk_prayer_request_user_id;
ALTER TABLE pt."PrayerRequest" RENAME CONSTRAINT "FK_PrayerRequest_SmallGroup_SmallGroupId" TO fk_prayer_request_small_group_id;
ALTER TABLE pt."PrayerRequest" RENAME TO prayer_request;
ALTER INDEX pt."IX_PrayerRequest_UserId" RENAME TO ix_prayer_request_user_id;
ALTER INDEX pt."IX_PrayerRequest_SmallGroupId" RENAME TO ix_prayer_request_small_group_id;
ALTER INDEX pt."IX_PrayerRequest_Requestor_TRGM" RENAME TO ix_prayer_request_trgm_requestor;
ALTER INDEX pt."IX_PrayerRequest_Text_TRGM" RENAME TO ix_prayer_request_trgm_request_text;
-- Small Group
ALTER TABLE pt."SmallGroup" RENAME COLUMN "SmallGroupId" TO id;
ALTER TABLE pt."SmallGroup" RENAME COLUMN "ChurchId" TO church_id;
ALTER TABLE pt."SmallGroup" RENAME COLUMN "Name" TO group_name;
ALTER TABLE pt."SmallGroup" RENAME CONSTRAINT "PK_SmallGroup" TO pk_small_group;
ALTER TABLE pt."SmallGroup" RENAME CONSTRAINT "FK_SmallGroup_Church_ChurchId" TO fk_small_group_church_id;
ALTER TABLE pt."SmallGroup" RENAME TO small_group;
ALTER INDEX pt."IX_SmallGroup_ChurchId" RENAME TO ix_small_group_church_id;
-- Time Zone (goes away)
DROP TABLE pt."TimeZone";
-- User
ALTER TABLE pt."User" RENAME COLUMN "UserId" TO id;
ALTER TABLE pt."User" RENAME COLUMN "FirstName" TO first_name;
ALTER TABLE pt."User" RENAME COLUMN "LastName" TO last_name;
ALTER TABLE pt."User" RENAME COLUMN "EmailAddress" TO email;
ALTER TABLE pt."User" RENAME COLUMN "IsSystemAdmin" TO is_admin;
ALTER TABLE pt."User" RENAME COLUMN "PasswordHash" TO password_hash;
ALTER TABLE pt."User" RENAME COLUMN "Salt" TO salt;
ALTER TABLE pt."User" RENAME CONSTRAINT "PK_User" TO pk_pt_user;
ALTER TABLE pt."User" RENAME TO pt_user;
ALTER TABLE pt.pt_user ADD COLUMN last_seen timestamptz;
-- User / Small Group
ALTER TABLE pt."User_SmallGroup" RENAME COLUMN "UserId" TO user_id;
ALTER TABLE pt."User_SmallGroup" RENAME COLUMN "SmallGroupId" TO small_group_id;
ALTER TABLE pt."User_SmallGroup" RENAME CONSTRAINT "PK_User_SmallGroup" TO pk_user_small_group;
ALTER TABLE pt."User_SmallGroup" RENAME CONSTRAINT "FK_User_SmallGroup_User_UserId" TO fk_user_small_group_user_id;
ALTER TABLE pt."User_SmallGroup" RENAME CONSTRAINT "FK_User_SmallGroup_SmallGroup_SmallGroupId" TO fk_user_small_group_small_group_id;
ALTER TABLE pt."User_SmallGroup" RENAME TO user_small_group;
ALTER INDEX pt."IX_User_SmallGroup_SmallGroupId" RENAME TO ix_user_small_group_small_group_id;
-- #41 - change to timestamptz
SET TimeZone = 'UTC';
ALTER TABLE pt.prayer_request ALTER COLUMN entered_date TYPE timestamptz;
ALTER TABLE pt.prayer_request ALTER COLUMN updated_date TYPE timestamptz;