From 13ace6ca615e06a8d20ae671e6276052ed2ce70e Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Fri, 19 Aug 2022 15:08:30 -0400 Subject: [PATCH] Version 8 (#43) * Use htmx for front end (#36) * Use short GUIDs in URLs and forms (#1) * Refresh theme (#38) * Use ASP.NET Core for log on/off (#39) * Fix date/time / time zone issues (#41) * Update help for v8 (#42) * Add FAKE build script (#37) --- .config/dotnet-tools.json | 12 + .gitignore | 1 + build.fsx | 44 + build.fsx.lock | 233 +++ docs/en/requests/maintain.md | 4 +- docs/en/small-group/members.md | 4 +- docs/en/small-group/preferences.md | 25 +- docs/en/user/password.md | 2 +- docs/es/requests/maintain.md | 4 +- docs/es/small-group/members.md | 4 +- docs/es/small-group/preferences.md | 25 +- docs/es/user/password.md | 2 +- fake.cmd | 2 + fake.sh | 7 + src/Directory.Build.props | 8 +- src/PrayerTracker.Data/Access.fs | 724 +++++++++ src/PrayerTracker.Data/AppDbContext.fs | 86 -- src/PrayerTracker.Data/DataAccess.fs | 373 ----- src/PrayerTracker.Data/DistributedCache.fs | 218 +++ src/PrayerTracker.Data/Entities.fs | 1149 ++++++--------- .../20161217153124_InitialDatabase.fs | 514 ------- .../Migrations/AppDbContextModelSnapshot.fs | 200 --- .../PrayerTracker.Data.fsproj | 15 +- src/PrayerTracker.Tests/Data/EntitiesTests.fs | 615 ++++---- .../PrayerTracker.Tests.fsproj | 4 +- src/PrayerTracker.Tests/Program.fs | 2 +- .../UI/CommonFunctionsTests.fs | 307 ++-- src/PrayerTracker.Tests/UI/UtilsTests.fs | 313 ++-- src/PrayerTracker.Tests/UI/ViewModelsTests.fs | 1272 ++++++++-------- src/PrayerTracker.UI/Church.fs | 199 +-- src/PrayerTracker.UI/CommonFunctions.fs | 248 ++-- src/PrayerTracker.UI/Home.fs | 457 +++--- src/PrayerTracker.UI/I18N.fs | 6 +- src/PrayerTracker.UI/Layout.fs | 554 ++++--- src/PrayerTracker.UI/PrayerRequest.fs | 635 ++++---- src/PrayerTracker.UI/PrayerTracker.UI.fsproj | 6 +- src/PrayerTracker.UI/Resources/Common.es.resx | 70 +- .../Views/Home/PrivacyPolicy.es.resx | 2 +- .../Views/SmallGroup/Preferences.es.resx | 12 +- src/PrayerTracker.UI/SmallGroup.fs | 1050 +++++++------ src/PrayerTracker.UI/User.fs | 405 +++--- src/PrayerTracker.UI/Utils.fs | 299 ++-- src/PrayerTracker.UI/ViewModels.fs | 1295 ++++++++++------- src/PrayerTracker.sln | 1 - src/PrayerTracker/App.fs | 430 +++--- src/PrayerTracker/Church.fs | 122 +- src/PrayerTracker/CommonFunctions.fs | 291 ++-- src/PrayerTracker/Cookies.fs | 129 -- src/PrayerTracker/Email.fs | 127 +- src/PrayerTracker/Extensions.fs | 138 +- src/PrayerTracker/Home.fs | 80 +- src/PrayerTracker/PrayerRequest.fs | 446 +++--- src/PrayerTracker/PrayerTracker.fsproj | 12 +- src/PrayerTracker/SmallGroup.fs | 583 ++++---- src/PrayerTracker/User.fs | 469 +++--- src/PrayerTracker/wwwroot/css/app.css | 184 ++- src/PrayerTracker/wwwroot/js/app.js | 155 +- src/names-to-lower.sql | 110 ++ 58 files changed, 7525 insertions(+), 7159 deletions(-) create mode 100644 .config/dotnet-tools.json create mode 100644 build.fsx create mode 100644 build.fsx.lock create mode 100644 fake.cmd create mode 100755 fake.sh create mode 100644 src/PrayerTracker.Data/Access.fs delete mode 100644 src/PrayerTracker.Data/AppDbContext.fs delete mode 100644 src/PrayerTracker.Data/DataAccess.fs create mode 100644 src/PrayerTracker.Data/DistributedCache.fs delete mode 100644 src/PrayerTracker.Data/Migrations/20161217153124_InitialDatabase.fs delete mode 100644 src/PrayerTracker.Data/Migrations/AppDbContextModelSnapshot.fs delete mode 100644 src/PrayerTracker/Cookies.fs create mode 100644 src/names-to-lower.sql diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json new file mode 100644 index 0000000..429547e --- /dev/null +++ b/.config/dotnet-tools.json @@ -0,0 +1,12 @@ +{ + "version": 1, + "isRoot": true, + "tools": { + "fake-cli": { + "version": "5.23.0", + "commands": [ + "fake" + ] + } + } +} \ No newline at end of file diff --git a/.gitignore b/.gitignore index 72d666f..09c26fe 100644 --- a/.gitignore +++ b/.gitignore @@ -332,5 +332,6 @@ ASALocalRun/ ### --- ### src/PrayerTracker/appsettings.json docs/_site +**/*.db* .ionide \ No newline at end of file diff --git a/build.fsx b/build.fsx new file mode 100644 index 0000000..50b9aa1 --- /dev/null +++ b/build.fsx @@ -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" diff --git a/build.fsx.lock b/build.fsx.lock new file mode 100644 index 0000000..1d92727 --- /dev/null +++ b/build.fsx.lock @@ -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)) diff --git a/docs/en/requests/maintain.md b/docs/en/requests/maintain.md index b8e8509..8d99872 100644 --- a/docs/en/requests/maintain.md +++ b/docs/en/requests/maintain.md @@ -14,7 +14,7 @@ If you are looking for a particular requests, enter some text in the search box ## 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 @@ -26,4 +26,4 @@ When the page is first displayed, it does not display inactive requests. However ## 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. diff --git a/docs/en/small-group/members.md b/docs/en/small-group/members.md index c387215..99fb20d 100644 --- a/docs/en/small-group/members.md +++ b/docs/en/small-group/members.md @@ -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 -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 -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.) diff --git a/docs/en/small-group/preferences.md b/docs/en/small-group/preferences.md index 1c3b137..54c68cd 100644 --- a/docs/en/small-group/preferences.md +++ b/docs/en/small-group/preferences.md @@ -34,7 +34,10 @@ You can customize the colors that are used for the headings and lines in your re ## 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 @@ -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: -> _Fonts_
-> — 'Times New Roman',serif +> **Fonts**
+> Named Fonts: "Times New Roman",serif > -> _Heading Text Size_
-> — 18pt +> **Heading Text Size**
+> 18pt > -> _List Text Size_
-> — 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. +> **List Text Size**
+> 16pt ## 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.) +## 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 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. diff --git a/docs/en/user/password.md b/docs/en/user/password.md index 3b5f2df..6261f3f 100644 --- a/docs/en/user/password.md +++ b/docs/en/user/password.md @@ -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. -"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). diff --git a/docs/es/requests/maintain.md b/docs/es/requests/maintain.md index 470cc9f..9e78471 100644 --- a/docs/es/requests/maintain.md +++ b/docs/es/requests/maintain.md @@ -14,7 +14,7 @@ Si está buscando una solicitud en particular, ingrese un texto en el cuadro de ## 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 @@ -26,4 +26,4 @@ Cuando la página se muestra por primera vez, que no muestra peticiones inactivo ## 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. \ No newline at end of file +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. \ No newline at end of file diff --git a/docs/es/small-group/members.md b/docs/es/small-group/members.md index e7fe766..50b1fca 100644 --- a/docs/es/small-group/members.md +++ b/docs/es/small-group/members.md @@ -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 -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 -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.) diff --git a/docs/es/small-group/preferences.md b/docs/es/small-group/preferences.md index 3a46129..ac3e12a 100644 --- a/docs/es/small-group/preferences.md +++ b/docs/es/small-group/preferences.md @@ -34,7 +34,10 @@ Usted puede personalizar los colores que se utilizan para las partidas y líneas ## 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 @@ -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”: -> _Fuentes_
-> — 'Times New Roman',serif +> **Fuentes**
+> Fuentes con Nombre: "Times New Roman",serif > -> _Partida el Tamaño del Texto_
-> — 18pt +> **Partida el Tamaño del Texto**
+> 18pt > -> _Lista el Tamaño del Texto_
-> — 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. +> **Lista el Tamaño del Texto**
+> 16pt ## 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.) +## 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 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. diff --git a/docs/es/user/password.md b/docs/es/user/password.md index 19d2350..71f7eeb 100644 --- a/docs/es/user/password.md +++ b/docs/es/user/password.md @@ -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. -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). diff --git a/fake.cmd b/fake.cmd new file mode 100644 index 0000000..72bbc3e --- /dev/null +++ b/fake.cmd @@ -0,0 +1,2 @@ +dotnet tool restore +dotnet fake %* \ No newline at end of file diff --git a/fake.sh b/fake.sh new file mode 100755 index 0000000..bc92bc9 --- /dev/null +++ b/fake.sh @@ -0,0 +1,7 @@ +#!/usr/bin/env bash + +set -eu +set -o pipefail + +dotnet tool restore +dotnet fake "$@" \ No newline at end of file diff --git a/src/Directory.Build.props b/src/Directory.Build.props index 27de438..d54687e 100644 --- a/src/Directory.Build.props +++ b/src/Directory.Build.props @@ -1,9 +1,11 @@ - 7.6.1.0 - 7.6.1.0 + net6.0 + 8.0.0.0 + 8.0.0.0 danieljsummers Bit Badger Solutions - 7.6.1 + 8.0.0 + Embedded diff --git a/src/PrayerTracker.Data/Access.fs b/src/PrayerTracker.Data/Access.fs new file mode 100644 index 0000000..28c2167 --- /dev/null +++ b/src/PrayerTracker.Data/Access.fs @@ -0,0 +1,724 @@ +namespace PrayerTracker.Data + +open NodaTime +open Npgsql +open Npgsql.FSharp +open PrayerTracker.Entities + +/// Helper functions for the PostgreSQL data implementation +[] +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 "entered_date" + UpdatedDate = row.fieldValue "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 "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) + () + } diff --git a/src/PrayerTracker.Data/AppDbContext.fs b/src/PrayerTracker.Data/AppDbContext.fs deleted file mode 100644 index c4199c2..0000000 --- a/src/PrayerTracker.Data/AppDbContext.fs +++ /dev/null @@ -1,86 +0,0 @@ -namespace PrayerTracker - -open Microsoft.EntityFrameworkCore -open PrayerTracker.Entities - -/// EF Core data context for PrayerTracker -[] -type AppDbContext (options : DbContextOptions) = - inherit DbContext (options) - - [] - val mutable private churches : DbSet - [] - val mutable private members : DbSet - [] - val mutable private prayerRequests : DbSet - [] - val mutable private preferences : DbSet - [] - val mutable private smallGroups : DbSet - [] - val mutable private timeZones : DbSet - [] - val mutable private users : DbSet - [] - val mutable private userGroupXref : DbSet - - /// 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) diff --git a/src/PrayerTracker.Data/DataAccess.fs b/src/PrayerTracker.Data/DataAccess.fs deleted file mode 100644 index c8bf97f..0000000 --- a/src/PrayerTracker.Data/DataAccess.fs +++ /dev/null @@ -1,373 +0,0 @@ -[] -module PrayerTracker.DataAccess - -open Microsoft.EntityFrameworkCore -open PrayerTracker.Entities -open System.Collections.Generic -open System.Linq - -[] -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) = - 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(usr).State <- EntityState.Detached - return Some { usr with passwordHash = ""; salt = None; smallGroups = List() } - | _ -> 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)) diff --git a/src/PrayerTracker.Data/DistributedCache.fs b/src/PrayerTracker.Data/DistributedCache.fs new file mode 100644 index 0000000..8abf8c8 --- /dev/null +++ b/src/PrayerTracker.Data/DistributedCache.fs @@ -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 +[] +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 "expire_at" + SlidingExpiration = row.fieldValueOrNone "sliding_expiration" + AbsoluteExpiration = row.fieldValueOrNone "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 + diff --git a/src/PrayerTracker.Data/Entities.fs b/src/PrayerTracker.Data/Entities.fs index 1780d11..29bcfd1 100644 --- a/src/PrayerTracker.Data/Entities.fs +++ b/src/PrayerTracker.Data/Entities.fs @@ -1,758 +1,557 @@ namespace PrayerTracker.Entities -open FSharp.EFCore.OptionConverter -open Microsoft.EntityFrameworkCore -open NodaTime -open System -open System.Collections.Generic - -// fsharplint:disable RecordFieldNames MemberNames - (*-- SUPPORT TYPES --*) /// How as-of dates should (or should not) be displayed with requests type AsOfDateDisplay = - /// No as-of date should be displayed - | NoDisplay - /// The as-of date should be displayed in the culture's short date format - | ShortDate - /// The as-of date should be displayed in the culture's long date format - | LongDate -with - /// Convert to a DU case from a single-character string - static member fromCode code = - match code with - | "N" -> NoDisplay - | "S" -> ShortDate - | "L" -> LongDate - | _ -> invalidArg "code" (sprintf "Unknown code %s" code) - /// Convert this DU case to a single-character string - member this.code = - match this with - | NoDisplay -> "N" - | ShortDate -> "S" - | LongDate -> "L" + /// No as-of date should be displayed + | NoDisplay + /// The as-of date should be displayed in the culture's short date format + | ShortDate + /// The as-of date should be displayed in the culture's long date format + | LongDate + +/// Functions to support as-of date display options +module AsOfDateDisplay = + + /// Convert to a DU case from a single-character string + let fromCode code = + match code with + | "N" -> NoDisplay + | "S" -> ShortDate + | "L" -> LongDate + | _ -> invalidArg "code" $"Unknown code {code}" + + /// Convert this DU case to a single-character string + let toCode = function NoDisplay -> "N" | ShortDate -> "S" | LongDate -> "L" /// Acceptable e-mail formats type EmailFormat = - /// HTML e-mail - | HtmlFormat - /// Plain-text e-mail - | PlainTextFormat -with - /// Convert to a DU case from a single-character string - static member fromCode code = - match code with - | "H" -> HtmlFormat - | "P" -> PlainTextFormat - | _ -> invalidArg "code" (sprintf "Unknown code %s" code) - /// Convert this DU case to a single-character string - member this.code = - match this with - | HtmlFormat -> "H" - | PlainTextFormat -> "P" + /// HTML e-mail + | HtmlFormat + /// Plain-text e-mail + | PlainTextFormat + +/// Functions to support e-mail formats +module EmailFormat = + + /// Convert to a DU case from a single-character string + let fromCode code = + match code with + | "H" -> HtmlFormat + | "P" -> PlainTextFormat + | _ -> invalidArg "code" $"Unknown code {code}" + + /// Convert this DU case to a single-character string + let toCode = function HtmlFormat -> "H" | PlainTextFormat -> "P" /// Expiration for requests type Expiration = - /// Follow the rules for normal expiration - | Automatic - /// Do not expire via rules - | Manual - /// Force immediate expiration - | Forced -with - /// Convert to a DU case from a single-character string - static member fromCode code = - match code with - | "A" -> Automatic - | "M" -> Manual - | "F" -> Forced - | _ -> invalidArg "code" (sprintf "Unknown code %s" code) - /// Convert this DU case to a single-character string - member this.code = - match this with - | Automatic -> "A" - | Manual -> "M" - | Forced -> "F" + /// Follow the rules for normal expiration + | Automatic + /// Do not expire via rules + | Manual + /// Force immediate expiration + | Forced + +/// Functions to support expirations +module Expiration = + + /// Convert to a DU case from a single-character string + let fromCode code = + match code with + | "A" -> Automatic + | "M" -> Manual + | "F" -> Forced + | _ -> invalidArg "code" $"Unknown code {code}" + + /// Convert this DU case to a single-character string + let toCode = function Automatic -> "A" | Manual -> "M" | Forced -> "F" /// Types of prayer requests type PrayerRequestType = - /// Current requests - | CurrentRequest - /// Long-term/ongoing request - | LongTermRequest - /// Expectant couples - | Expecting - /// Praise reports - | PraiseReport - /// Announcements - | Announcement -with - /// Convert to a DU case from a single-character string - static member fromCode code = - match code with - | "C" -> CurrentRequest - | "L" -> LongTermRequest - | "E" -> Expecting - | "P" -> PraiseReport - | "A" -> Announcement - | _ -> invalidArg "code" (sprintf "Unknown code %s" code) - /// Convert this DU case to a single-character string - member this.code = - match this with - | CurrentRequest -> "C" - | LongTermRequest -> "L" - | Expecting -> "E" - | PraiseReport -> "P" - | Announcement -> "A" + /// Current requests + | CurrentRequest + /// Long-term/ongoing request + | LongTermRequest + /// Expectant couples + | Expecting + /// Praise reports + | PraiseReport + /// Announcements + | Announcement + +/// Functions to support prayer request types +module PrayerRequestType = + + /// Convert to a DU case from a single-character string + let fromCode code = + match code with + | "C" -> CurrentRequest + | "L" -> LongTermRequest + | "E" -> Expecting + | "P" -> PraiseReport + | "A" -> Announcement + | _ -> invalidArg "code" $"Unknown code {code}" + + /// Convert this DU case to a single-character string + let toCode = + function + | CurrentRequest -> "C" + | LongTermRequest -> "L" + | Expecting -> "E" + | PraiseReport -> "P" + | Announcement -> "A" /// How requests should be sorted type RequestSort = - /// Sort by date, then by requestor/subject - | SortByDate - /// Sort by requestor/subject, then by date - | SortByRequestor + /// Sort by date, then by requestor/subject + | SortByDate + /// Sort by requestor/subject, then by date + | SortByRequestor + +/// Functions to support request sorts +module RequestSort = + + /// Convert to a DU case from a single-character string + let fromCode code = + match code with + | "D" -> SortByDate + | "R" -> SortByRequestor + | _ -> invalidArg "code" $"Unknown code {code}" + + /// Convert this DU case to a single-character string + let toCode = function SortByDate -> "D" | SortByRequestor -> "R" + + +open System + +/// PK type for the Church entity +type ChurchId = + | ChurchId of Guid with - /// Convert to a DU case from a single-character string - static member fromCode code = - match code with - | "D" -> SortByDate - | "R" -> SortByRequestor - | _ -> invalidArg "code" (sprintf "Unknown code %s" code) - /// Convert this DU case to a single-character string - member this.code = - match this with - | SortByDate -> "D" - | SortByRequestor -> "R" + /// The GUID value of the church ID + member this.Value = this |> function ChurchId guid -> guid -module Converters = - open Microsoft.EntityFrameworkCore.Storage.ValueConversion - open Microsoft.FSharp.Linq.RuntimeHelpers - open System.Linq.Expressions +/// PK type for the Member entity +type MemberId = + | MemberId of Guid +with + /// The GUID value of the member ID + member this.Value = this |> function MemberId guid -> guid - let private asOfFromDU = - <@ Func(fun (x : AsOfDateDisplay) -> x.code) @> - |> LeafExpressionConverter.QuotationToExpression - |> unbox>> - let private asOfToDU = - <@ Func(AsOfDateDisplay.fromCode) @> - |> LeafExpressionConverter.QuotationToExpression - |> unbox>> - - let private emailFromDU = - <@ Func(fun (x : EmailFormat) -> x.code) @> - |> LeafExpressionConverter.QuotationToExpression - |> unbox>> +/// PK type for the PrayerRequest entity +type PrayerRequestId = + | PrayerRequestId of Guid +with + /// The GUID value of the prayer request ID + member this.Value = this |> function PrayerRequestId guid -> guid - let private emailToDU = - <@ Func(EmailFormat.fromCode) @> - |> LeafExpressionConverter.QuotationToExpression - |> unbox>> - - let private expFromDU = - <@ Func(fun (x : Expiration) -> x.code) @> - |> LeafExpressionConverter.QuotationToExpression - |> unbox>> - let private expToDU = - <@ Func(Expiration.fromCode) @> - |> LeafExpressionConverter.QuotationToExpression - |> unbox>> - - let private sortFromDU = - <@ Func(fun (x : RequestSort) -> x.code) @> - |> LeafExpressionConverter.QuotationToExpression - |> unbox>> +/// PK type for the SmallGroup entity +type SmallGroupId = + | SmallGroupId of Guid +with + /// The GUID value of the small group ID + member this.Value = this |> function SmallGroupId guid -> guid - let private sortToDU = - <@ Func(RequestSort.fromCode) @> - |> LeafExpressionConverter.QuotationToExpression - |> unbox>> - - let private typFromDU = - <@ Func(fun (x : PrayerRequestType) -> x.code) @> - |> LeafExpressionConverter.QuotationToExpression - |> unbox>> - let private typToDU = - <@ Func(PrayerRequestType.fromCode) @> - |> LeafExpressionConverter.QuotationToExpression - |> unbox>> - - /// Conversion between a string and an AsOfDateDisplay DU value - type AsOfDateDisplayConverter () = - inherit ValueConverter (asOfFromDU, asOfToDU) +/// PK type for the TimeZone entity +type TimeZoneId = TimeZoneId of string - /// Conversion between a string and an EmailFormat DU value - type EmailFormatConverter () = - inherit ValueConverter (emailFromDU, emailToDU) +/// Functions to support time zone IDs +module TimeZoneId = + + /// Convert a time zone ID to its string value + let toString = function TimeZoneId it -> it - /// Conversion between a string and an Expiration DU value - type ExpirationConverter () = - inherit ValueConverter (expFromDU, expToDU) - /// Conversion between a string and an AsOfDateDisplay DU value - type PrayerRequestTypeConverter () = - inherit ValueConverter (typFromDU, typToDU) - - /// Conversion between a string and a RequestSort DU value - type RequestSortConverter () = - inherit ValueConverter (sortFromDU, sortToDU) +/// PK type for the User entity +type UserId = + | UserId of Guid +with + /// The GUID value of the user ID + member this.Value = this |> function UserId guid -> guid +(*-- SPECIFIC VIEW TYPES --*) /// Statistics for churches [] type ChurchStats = - { /// The number of small groups in the church - smallGroups : int - /// The number of prayer requests in the church - prayerRequests : int - /// The number of users who can access small groups in the church - users : int + { /// The number of small groups in the church + SmallGroups : int + + /// The number of prayer requests in the church + PrayerRequests : int + + /// The number of users who can access small groups in the church + Users : int } -/// PK type for the Church entity -type ChurchId = Guid -/// PK type for the Member entity -type MemberId = Guid - -/// PK type for the PrayerRequest entity -type PrayerRequestId = Guid - -/// PK type for the SmallGroup entity -type SmallGroupId = Guid - -/// PK type for the TimeZone entity -type TimeZoneId = string - -/// PK type for the User entity -type UserId = Guid - -/// PK for User/SmallGroup cross-reference table -type UserSmallGroupKey = - { userId : UserId - smallGroupId : SmallGroupId - } +/// Information needed to display the public/protected request list and small group maintenance pages +[] +type SmallGroupInfo = + { /// The ID of the small group + Id : string + + /// The name of the small group + Name : string + + /// The name of the church to which the small group belongs + ChurchName : string + + /// The ID of the time zone for the small group + TimeZoneId : TimeZoneId + + /// Whether the small group has a publicly-available request list + IsPublic : bool + } (*-- ENTITIES --*) +open NodaTime + /// This represents a church -type [] Church = - { /// The Id of this church - churchId : ChurchId - /// The name of the church - name : string - /// The city where the church is - city : string - /// The state where the church is - st : string - /// Does this church have an active interface with Virtual Prayer Room? - hasInterface : bool - /// The address for the interface - interfaceAddress : string option - - /// Small groups for this church - smallGroups : ICollection +[] +type Church = + { /// The ID of this church + Id : ChurchId + + /// The name of the church + Name : string + + /// The city where the church is + City : string + + /// The 2-letter state or province code for the church's location + State : string + + /// Does this church have an active interface with Virtual Prayer Space? + HasVpsInterface : bool + + /// The address for the interface + InterfaceAddress : string option } - with + +/// Functions to support churches +module Church = + /// An empty church // aww... how sad :( - static member empty = - { churchId = Guid.Empty - name = "" - city = "" - st = "" - hasInterface = false - interfaceAddress = None - smallGroups = List () + let empty = + { Id = ChurchId Guid.Empty + Name = "" + City = "" + State = "" + HasVpsInterface = false + InterfaceAddress = None } - /// Configure EF for this entity - static member internal configureEF (mb : ModelBuilder) = - mb.Entity ( - fun m -> - m.ToTable "Church" |> ignore - m.Property(fun e -> e.churchId).HasColumnName "ChurchId" |> ignore - m.Property(fun e -> e.name).HasColumnName("Name").IsRequired () |> ignore - m.Property(fun e -> e.city).HasColumnName("City").IsRequired () |> ignore - m.Property(fun e -> e.st).HasColumnName("ST").IsRequired().HasMaxLength 2 |> ignore - m.Property(fun e -> e.hasInterface).HasColumnName "HasVirtualPrayerRoomInterface" |> ignore - m.Property(fun e -> e.interfaceAddress).HasColumnName "InterfaceAddress" |> ignore) - |> ignore - mb.Model.FindEntityType(typeof).FindProperty("interfaceAddress") - .SetValueConverter(OptionConverter ()) - + /// Preferences for the form and format of the prayer request list -and [] ListPreferences = - { /// The Id of the small group to which these preferences belong - smallGroupId : SmallGroupId - /// The days after which regular requests expire - daysToExpire : int - /// The number of days a new or updated request is considered new - daysToKeepNew : int - /// The number of weeks after which long-term requests are flagged for follow-up - longTermUpdateWeeks : int - /// The name from which e-mails are sent - emailFromName : string - /// The e-mail address from which e-mails are sent - emailFromAddress : string - /// The fonts to use in generating the list of prayer requests - listFonts : string - /// The color for the prayer request list headings - headingColor : string - /// The color for the lines offsetting the prayer request list headings - lineColor : string - /// The font size for the headings on the prayer request list - headingFontSize : int - /// The font size for the text on the prayer request list - textFontSize : int - /// The order in which the prayer requests are sorted - requestSort : RequestSort - /// The password used for "small group login" (view-only request list) - groupPassword : string - /// The default e-mail type for this class - defaultEmailType : EmailFormat - /// Whether this class makes its request list public - isPublic : bool - /// The time zone which this class uses (use tzdata names) - timeZoneId : TimeZoneId - /// The time zone information - timeZone : TimeZone - /// The number of requests displayed per page - pageSize : int - /// How the as-of date should be automatically displayed - asOfDateDisplay : AsOfDateDisplay +[] +type ListPreferences = + { /// The Id of the small group to which these preferences belong + SmallGroupId : SmallGroupId + + /// The days after which regular requests expire + DaysToExpire : int + + /// The number of days a new or updated request is considered new + DaysToKeepNew : int + + /// The number of weeks after which long-term requests are flagged for follow-up + LongTermUpdateWeeks : int + + /// The name from which e-mails are sent + EmailFromName : string + + /// The e-mail address from which e-mails are sent + EmailFromAddress : string + + /// The fonts to use in generating the list of prayer requests + Fonts : string + + /// The color for the prayer request list headings + HeadingColor : string + + /// The color for the lines offsetting the prayer request list headings + LineColor : string + + /// The font size for the headings on the prayer request list + HeadingFontSize : int + + /// The font size for the text on the prayer request list + TextFontSize : int + + /// The order in which the prayer requests are sorted + RequestSort : RequestSort + + /// The password used for "small group login" (view-only request list) + GroupPassword : string + + /// The default e-mail type for this class + DefaultEmailType : EmailFormat + + /// Whether this class makes its request list public + IsPublic : bool + + /// The time zone which this class uses (use tzdata names) + TimeZoneId : TimeZoneId + + /// The number of requests displayed per page + PageSize : int + + /// How the as-of date should be automatically displayed + AsOfDateDisplay : AsOfDateDisplay } - with +with + + /// The list of fonts to use when displaying request lists (converts "native" to native font stack) + member this.FontStack = + if this.Fonts = "native" then + """system-ui,-apple-system,"Segoe UI",Roboto,Ubuntu,"Liberation Sans",Cantarell,"Helvetica Neue",sans-serif""" + else this.Fonts + +/// Functions to support list preferences +module ListPreferences = + /// A set of preferences with their default values - static member empty = - { smallGroupId = Guid.Empty - daysToExpire = 14 - daysToKeepNew = 7 - longTermUpdateWeeks = 4 - emailFromName = "PrayerTracker" - emailFromAddress = "prayer@djs-consulting.com" - listFonts = "Century Gothic,Tahoma,Luxi Sans,sans-serif" - headingColor = "maroon" - lineColor = "navy" - headingFontSize = 16 - textFontSize = 12 - requestSort = SortByDate - groupPassword = "" - defaultEmailType = HtmlFormat - isPublic = false - timeZoneId = "America/Denver" - timeZone = TimeZone.empty - pageSize = 100 - asOfDateDisplay = NoDisplay - } - /// Configure EF for this entity - static member internal configureEF (mb : ModelBuilder) = - mb.Entity ( - fun m -> - m.ToTable "ListPreference" |> ignore - m.HasKey (fun e -> e.smallGroupId :> obj) |> ignore - m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore - m.Property(fun e -> e.daysToKeepNew) - .HasColumnName("DaysToKeepNew") - .IsRequired() - .HasDefaultValue 7 - |> ignore - m.Property(fun e -> e.daysToExpire) - .HasColumnName("DaysToExpire") - .IsRequired() - .HasDefaultValue 14 - |> ignore - m.Property(fun e -> e.longTermUpdateWeeks) - .HasColumnName("LongTermUpdateWeeks") - .IsRequired() - .HasDefaultValue 4 - |> ignore - m.Property(fun e -> e.emailFromName) - .HasColumnName("EmailFromName") - .IsRequired() - .HasDefaultValue "PrayerTracker" - |> ignore - m.Property(fun e -> e.emailFromAddress) - .HasColumnName("EmailFromAddress") - .IsRequired() - .HasDefaultValue "prayer@djs-consulting.com" - |> ignore - m.Property(fun e -> e.listFonts) - .HasColumnName("ListFonts") - .IsRequired() - .HasDefaultValue "Century Gothic,Tahoma,Luxi Sans,sans-serif" - |> ignore - m.Property(fun e -> e.headingColor) - .HasColumnName("HeadingColor") - .IsRequired() - .HasDefaultValue "maroon" - |> ignore - m.Property(fun e -> e.lineColor) - .HasColumnName("LineColor") - .IsRequired() - .HasDefaultValue "navy" - |> ignore - m.Property(fun e -> e.headingFontSize) - .HasColumnName("HeadingFontSize") - .IsRequired() - .HasDefaultValue 16 - |> ignore - m.Property(fun e -> e.textFontSize) - .HasColumnName("TextFontSize") - .IsRequired() - .HasDefaultValue 12 - |> ignore - m.Property(fun e -> e.requestSort) - .HasColumnName("RequestSort") - .IsRequired() - .HasMaxLength(1) - .HasDefaultValue SortByDate - |> ignore - m.Property(fun e -> e.groupPassword) - .HasColumnName("GroupPassword") - .IsRequired() - .HasDefaultValue "" - |> ignore - m.Property(fun e -> e.defaultEmailType) - .HasColumnName("DefaultEmailType") - .IsRequired() - .HasDefaultValue HtmlFormat - |> ignore - m.Property(fun e -> e.isPublic) - .HasColumnName("IsPublic") - .IsRequired() - .HasDefaultValue false - |> ignore - m.Property(fun e -> e.timeZoneId) - .HasColumnName("TimeZoneId") - .IsRequired() - .HasDefaultValue "America/Denver" - |> ignore - m.Property(fun e -> e.pageSize) - .HasColumnName("PageSize") - .IsRequired() - .HasDefaultValue 100 - |> ignore - m.Property(fun e -> e.asOfDateDisplay) - .HasColumnName("AsOfDateDisplay") - .IsRequired() - .HasMaxLength(1) - .HasDefaultValue NoDisplay - |> ignore) - |> ignore - mb.Model.FindEntityType(typeof).FindProperty("requestSort") - .SetValueConverter(Converters.RequestSortConverter ()) - mb.Model.FindEntityType(typeof).FindProperty("defaultEmailType") - .SetValueConverter(Converters.EmailFormatConverter ()) - mb.Model.FindEntityType(typeof).FindProperty("asOfDateDisplay") - .SetValueConverter(Converters.AsOfDateDisplayConverter ()) + let empty = + { SmallGroupId = SmallGroupId Guid.Empty + DaysToExpire = 14 + DaysToKeepNew = 7 + LongTermUpdateWeeks = 4 + EmailFromName = "PrayerTracker" + EmailFromAddress = "prayer@bitbadger.solutions" + Fonts = "native" + HeadingColor = "maroon" + LineColor = "navy" + HeadingFontSize = 16 + TextFontSize = 12 + RequestSort = SortByDate + GroupPassword = "" + DefaultEmailType = HtmlFormat + IsPublic = false + TimeZoneId = TimeZoneId "America/Denver" + PageSize = 100 + AsOfDateDisplay = NoDisplay + } /// A member of a small group -and [] Member = - { /// The Id of the member - memberId : MemberId - /// The Id of the small group to which this member belongs - smallGroupId : SmallGroupId - /// The name of the member - memberName : string - /// The e-mail address for the member - email : string - /// The type of e-mail preferred by this member (see constants) - format : string option // TODO - do I need a custom formatter for this? - /// The small group to which this member belongs - smallGroup : SmallGroup +[] +type Member = + { /// The ID of the small group member + Id : MemberId + + /// The Id of the small group to which this member belongs + SmallGroupId : SmallGroupId + + /// The name of the member + Name : string + + /// The e-mail address for the member + Email : string + + /// The type of e-mail preferred by this member + Format : EmailFormat option } - with + +/// Functions to support small group members +module Member = + /// An empty member - static member empty = - { memberId = Guid.Empty - smallGroupId = Guid.Empty - memberName = "" - email = "" - format = None - smallGroup = SmallGroup.empty + let empty = + { Id = MemberId Guid.Empty + SmallGroupId = SmallGroupId Guid.Empty + Name = "" + Email = "" + Format = None } - /// Configure EF for this entity - static member internal configureEF (mb : ModelBuilder) = - mb.Entity ( - fun m -> - m.ToTable "Member" |> ignore - m.Property(fun e -> e.memberId).HasColumnName "MemberId" |> ignore - m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore - m.Property(fun e -> e.memberName).HasColumnName("MemberName").IsRequired() |> ignore - m.Property(fun e -> e.email).HasColumnName("Email").IsRequired() |> ignore - m.Property(fun e -> e.format).HasColumnName "Format" |> ignore) - |> ignore - mb.Model.FindEntityType(typeof).FindProperty("format").SetValueConverter(OptionConverter ()) /// This represents a single prayer request -and [] PrayerRequest = - { /// The Id of this request - prayerRequestId : PrayerRequestId - /// The type of the request - requestType : PrayerRequestType - /// The user who entered the request - userId : UserId - /// The small group to which this request belongs - smallGroupId : SmallGroupId - /// The date/time on which this request was entered - enteredDate : DateTime - /// The date/time this request was last updated - updatedDate : DateTime - /// The name of the requestor or subject, or title of announcement - requestor : string option - /// The text of the request - text : string - /// Whether the chaplain should be notified for this request - notifyChaplain : bool - /// The user who entered this request - user : User - /// The small group to which this request belongs - smallGroup : SmallGroup - /// Is this request expired? - expiration : Expiration +[] +type PrayerRequest = + { /// The ID of this request + Id : PrayerRequestId + + /// The type of the request + RequestType : PrayerRequestType + + /// The ID of the user who entered the request + UserId : UserId + + /// The small group to which this request belongs + SmallGroupId : SmallGroupId + + /// The date/time on which this request was entered + EnteredDate : Instant + + /// The date/time this request was last updated + UpdatedDate : Instant + + /// The name of the requestor or subject, or title of announcement + Requestor : string option + + /// The text of the request + Text : string + + /// Whether the chaplain should be notified for this request + NotifyChaplain : bool + + /// Is this request expired? + Expiration : Expiration } - with - /// An empty request - static member empty = - { prayerRequestId = Guid.Empty - requestType = CurrentRequest - userId = Guid.Empty - smallGroupId = Guid.Empty - enteredDate = DateTime.MinValue - updatedDate = DateTime.MinValue - requestor = None - text = "" - notifyChaplain = false - user = User.empty - smallGroup = SmallGroup.empty - expiration = Automatic - } - /// Is this request expired? - member this.isExpired (curr : DateTime) expDays = - match this.expiration with - | Forced -> true - | Manual -> false - | Automatic -> - match this.requestType with - | LongTermRequest - | Expecting -> false - | _ -> curr.AddDays(-(float expDays)).Date > this.updatedDate.Date // Automatic expiration - - /// Is an update required for this long-term request? - member this.updateRequired curr expDays updWeeks = - match this.isExpired curr expDays with - | true -> false - | false -> curr.AddDays(-(float (updWeeks * 7))).Date > this.updatedDate.Date - - /// Configure EF for this entity - static member internal configureEF (mb : ModelBuilder) = - mb.Entity ( - fun m -> - m.ToTable "PrayerRequest" |> ignore - m.Property(fun e -> e.prayerRequestId).HasColumnName "PrayerRequestId" |> ignore - m.Property(fun e -> e.requestType).HasColumnName("RequestType").IsRequired() |> ignore - m.Property(fun e -> e.userId).HasColumnName "UserId" |> ignore - m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore - m.Property(fun e -> e.enteredDate).HasColumnName "EnteredDate" |> ignore - m.Property(fun e -> e.updatedDate).HasColumnName "UpdatedDate" |> ignore - m.Property(fun e -> e.requestor).HasColumnName "Requestor" |> ignore - m.Property(fun e -> e.text).HasColumnName("Text").IsRequired() |> ignore - m.Property(fun e -> e.notifyChaplain).HasColumnName "NotifyChaplain" |> ignore - m.Property(fun e -> e.expiration).HasColumnName "Expiration" |> ignore) - |> ignore - mb.Model.FindEntityType(typeof).FindProperty("requestType") - .SetValueConverter(Converters.PrayerRequestTypeConverter ()) - mb.Model.FindEntityType(typeof).FindProperty("requestor") - .SetValueConverter(OptionConverter ()) - mb.Model.FindEntityType(typeof).FindProperty("expiration") - .SetValueConverter(Converters.ExpirationConverter ()) +// functions are below small group functions /// This represents a small group (Sunday School class, Bible study group, etc.) -and [] SmallGroup = - { /// The Id of this small group - smallGroupId : SmallGroupId - /// The church to which this group belongs - churchId : ChurchId - /// The name of the group - name : string - /// The church to which this small group belongs - church : Church - /// The preferences for the request list - preferences : ListPreferences - /// The members of the group - members : ICollection - /// Prayer requests for this small group - prayerRequests : ICollection - /// The users authorized to manage this group - users : ICollection +[] +type SmallGroup = + { /// The ID of this small group + Id : SmallGroupId + + /// The church to which this group belongs + ChurchId : ChurchId + + /// The name of the group + Name : string + + /// The preferences for the request list + Preferences : ListPreferences } - with - /// An empty small group - static member empty = - { smallGroupId = Guid.Empty - churchId = Guid.Empty - name = "" - church = Church.empty - preferences = ListPreferences.empty - members = List () - prayerRequests = List () - users = List () - } - /// Get the local date for this group - member this.localTimeNow (clock : IClock) = - match clock with null -> nullArg "clock" | _ -> () - let tz = - match DateTimeZoneProviders.Tzdb.Ids.Contains this.preferences.timeZoneId with - | true -> DateTimeZoneProviders.Tzdb.[this.preferences.timeZoneId] - | false -> DateTimeZone.Utc - clock.GetCurrentInstant().InZone(tz).ToDateTimeUnspecified() - - /// Get the local date for this group - member this.localDateNow clock = - (this.localTimeNow clock).Date +/// Functions to support small groups +module SmallGroup = - /// Configure EF for this entity - static member internal configureEF (mb : ModelBuilder) = - mb.Entity ( - fun m -> - m.ToTable "SmallGroup" |> ignore - m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore - m.Property(fun e -> e.churchId).HasColumnName "ChurchId" |> ignore - m.Property(fun e -> e.name).HasColumnName("Name").IsRequired() |> ignore - m.HasOne(fun e -> e.preferences) |> ignore) - |> ignore - - -/// This represents a time zone in which a class may reside -and [] TimeZone = - { /// The Id for this time zone (uses tzdata names) - timeZoneId : TimeZoneId - /// The description of this time zone - description : string - /// The order in which this timezone should be displayed - sortOrder : int - /// Whether this timezone is active - isActive : bool - } - with - /// An empty time zone - static member empty = - { timeZoneId = "" - description = "" - sortOrder = 0 - isActive = false + /// An empty small group + let empty = + { Id = SmallGroupId Guid.Empty + ChurchId = ChurchId Guid.Empty + Name = "" + Preferences = ListPreferences.empty } - /// Configure EF for this entity - static member internal configureEF (mb : ModelBuilder) = - mb.Entity ( - fun m -> - m.ToTable "TimeZone" |> ignore - m.Property(fun e -> e.timeZoneId).HasColumnName "TimeZoneId" |> ignore - m.Property(fun e -> e.description).HasColumnName("Description").IsRequired() |> ignore - m.Property(fun e -> e.sortOrder).HasColumnName "SortOrder" |> ignore - m.Property(fun e -> e.isActive).HasColumnName "IsActive" |> ignore) - |> ignore + + /// The DateTimeZone for the time zone ID for this small group + let timeZone group = + let tzId = TimeZoneId.toString group.Preferences.TimeZoneId + if DateTimeZoneProviders.Tzdb.Ids.Contains tzId then DateTimeZoneProviders.Tzdb[tzId] + else DateTimeZone.Utc + + /// Get the local date/time for this group + let localTimeNow (clock : IClock) group = + if isNull clock then nullArg (nameof clock) + clock.GetCurrentInstant().InZone(timeZone group).LocalDateTime + + /// Get the local date for this group + let localDateNow clock group = + (localTimeNow clock group).Date + + +/// Functions to support prayer requests +module PrayerRequest = + + /// An empty request + let empty = + { Id = PrayerRequestId Guid.Empty + RequestType = CurrentRequest + UserId = UserId Guid.Empty + SmallGroupId = SmallGroupId Guid.Empty + EnteredDate = Instant.MinValue + UpdatedDate = Instant.MinValue + Requestor = None + Text = "" + NotifyChaplain = false + Expiration = Automatic + } + + /// Is this request expired? + let isExpired (asOf : LocalDate) group req = + match req.Expiration, req.RequestType with + | Forced, _ -> true + | Manual, _ + | Automatic, LongTermRequest + | Automatic, Expecting -> false + | Automatic, _ -> + // Automatic expiration + Period.Between(req.UpdatedDate.InZone(SmallGroup.timeZone group).Date, asOf, PeriodUnits.Days).Days + >= group.Preferences.DaysToExpire + + /// Is an update required for this long-term request? + let updateRequired asOf group req = + if isExpired asOf group req then false + else asOf.PlusWeeks -group.Preferences.LongTermUpdateWeeks + >= req.UpdatedDate.InZone(SmallGroup.timeZone group).Date /// This represents a user of PrayerTracker -and [] User = - { /// The Id of this user - userId : UserId - /// The first name of this user - firstName : string - /// The last name of this user - lastName : string - /// The e-mail address of the user - emailAddress : string - /// Whether this user is a PrayerTracker system administrator - isAdmin : bool - /// The user's hashed password - passwordHash : string - /// The salt for the user's hashed password - salt : Guid option - /// The small groups which this user is authorized - smallGroups : ICollection +[] +type User = + { /// The ID of this user + Id : UserId + + /// The first name of this user + FirstName : string + + /// The last name of this user + LastName : string + + /// The e-mail address of the user + Email : string + + /// Whether this user is a PrayerTracker system administrator + IsAdmin : bool + + /// The user's hashed password + PasswordHash : string + + /// The last time the user was seen (set whenever the user is loaded into a session) + LastSeen : Instant option } - with - /// An empty user - static member empty = - { userId = Guid.Empty - firstName = "" - lastName = "" - emailAddress = "" - isAdmin = false - passwordHash = "" - salt = None - smallGroups = List () - } +with /// The full name of the user - member this.fullName = - sprintf "%s %s" this.firstName this.lastName + member this.Name = + $"{this.FirstName} {this.LastName}" - /// Configure EF for this entity - static member internal configureEF (mb : ModelBuilder) = - mb.Entity ( - fun m -> - m.ToTable "User" |> ignore - m.Ignore(fun e -> e.fullName :> obj) |> ignore - m.Property(fun e -> e.userId).HasColumnName "UserId" |> ignore - m.Property(fun e -> e.firstName).HasColumnName("FirstName").IsRequired() |> ignore - m.Property(fun e -> e.lastName).HasColumnName("LastName").IsRequired() |> ignore - m.Property(fun e -> e.emailAddress).HasColumnName("EmailAddress").IsRequired() |> ignore - m.Property(fun e -> e.isAdmin).HasColumnName "IsSystemAdmin" |> ignore - m.Property(fun e -> e.passwordHash).HasColumnName("PasswordHash").IsRequired() |> ignore - m.Property(fun e -> e.salt).HasColumnName "Salt" |> ignore) - |> ignore - mb.Model.FindEntityType(typeof).FindProperty("salt") - .SetValueConverter(OptionConverter ()) +/// Functions to support users +module User = + + /// An empty user + let empty = + { Id = UserId Guid.Empty + FirstName = "" + LastName = "" + Email = "" + IsAdmin = false + PasswordHash = "" + LastSeen = None + } /// Cross-reference between user and small group -and [] UserSmallGroup = - { /// The Id of the user who has access to the small group - userId : UserId - /// The Id of the small group to which the user has access - smallGroupId : SmallGroupId - /// The user who has access to the small group - user : User - /// The small group to which the user has access - smallGroup : SmallGroup +[] +type UserSmallGroup = + { /// The Id of the user who has access to the small group + UserId : UserId + + /// The Id of the small group to which the user has access + SmallGroupId : SmallGroupId } - with + +/// Functions to support user/small group cross-reference +module UserSmallGroup = + /// An empty user/small group xref - static member empty = - { userId = Guid.Empty - smallGroupId = Guid.Empty - user = User.empty - smallGroup = SmallGroup.empty + let empty = + { UserId = UserId Guid.Empty + SmallGroupId = SmallGroupId Guid.Empty } - /// Configure EF for this entity - static member internal configureEF (mb : ModelBuilder) = - mb.Entity ( - fun m -> - m.ToTable "User_SmallGroup" |> ignore - m.HasKey(fun e -> { userId = e.userId; smallGroupId = e.smallGroupId } :> obj) |> ignore - m.Property(fun e -> e.userId).HasColumnName "UserId" |> ignore - m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore - m.HasOne(fun e -> e.user) - .WithMany(fun e -> e.smallGroups :> IEnumerable) - .HasForeignKey(fun e -> e.userId :> obj) - |> ignore - m.HasOne(fun e -> e.smallGroup) - .WithMany(fun e -> e.users :> IEnumerable) - .HasForeignKey(fun e -> e.smallGroupId :> obj) - |> ignore) - |> ignore diff --git a/src/PrayerTracker.Data/Migrations/20161217153124_InitialDatabase.fs b/src/PrayerTracker.Data/Migrations/20161217153124_InitialDatabase.fs deleted file mode 100644 index c228771..0000000 --- a/src/PrayerTracker.Data/Migrations/20161217153124_InitialDatabase.fs +++ /dev/null @@ -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 - city : OperationBuilder - hasInterface : OperationBuilder - interfaceAddress : OperationBuilder - name : OperationBuilder - st : OperationBuilder - } - -type ListPreferencesTable = - { smallGroupId : OperationBuilder - daysToExpire : OperationBuilder - daysToKeepNew : OperationBuilder - defaultEmailType : OperationBuilder - emailFromAddress : OperationBuilder - emailFromName : OperationBuilder - groupPassword : OperationBuilder - headingColor : OperationBuilder - headingFontSize : OperationBuilder - isPublic : OperationBuilder - lineColor : OperationBuilder - listFonts : OperationBuilder - longTermUpdateWeeks : OperationBuilder - requestSort : OperationBuilder - textFontSize : OperationBuilder - timeZoneId : OperationBuilder - pageSize : OperationBuilder - asOfDateDisplay : OperationBuilder - } - -type MemberTable = - { memberId : OperationBuilder - email : OperationBuilder - format : OperationBuilder - memberName : OperationBuilder - smallGroupId : OperationBuilder - } - -type PrayerRequestTable = - { prayerRequestId : OperationBuilder - enteredDate : OperationBuilder - expiration : OperationBuilder - notifyChaplain : OperationBuilder - requestType : OperationBuilder - requestor : OperationBuilder - smallGroupId : OperationBuilder - text : OperationBuilder - updatedDate : OperationBuilder - userId : OperationBuilder - } - -type SmallGroupTable = - { smallGroupId : OperationBuilder - churchId : OperationBuilder - name : OperationBuilder - } - -type TimeZoneTable = - { timeZoneId : OperationBuilder - description : OperationBuilder - isActive : OperationBuilder - sortOrder : OperationBuilder - } - -type UserSmallGroupTable = - { userId : OperationBuilder - smallGroupId : OperationBuilder - } - -type UserTable = - { userId : OperationBuilder - emailAddress : OperationBuilder - firstName : OperationBuilder - isAdmin : OperationBuilder - lastName : OperationBuilder - passwordHash : OperationBuilder - salt : OperationBuilder - } - -[)>] -[] -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 (name = "ChurchId", nullable = false) - city = table.Column (name = "City", nullable = false) - hasInterface = table.Column (name = "HasVirtualPrayerRoomInterface", nullable = false) - interfaceAddress = table.Column (name = "InterfaceAddress", nullable = true) - name = table.Column (name = "Name", nullable = false) - st = table.Column (name = "ST", nullable = false, maxLength = Nullable 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 (name = "TimeZoneId", nullable = false) - description = table.Column (name = "Description", nullable = false) - isActive = table.Column (name = "IsActive", nullable = false) - sortOrder = table.Column (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 (name = "UserId", nullable = false) - emailAddress = table.Column (name = "EmailAddress", nullable = false) - firstName = table.Column (name = "FirstName", nullable = false) - isAdmin = table.Column (name = "IsSystemAdmin", nullable = false) - lastName = table.Column (name = "LastName", nullable = false) - passwordHash = table.Column (name = "PasswordHash", nullable = false) - salt = table.Column (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 (name = "SmallGroupId", nullable = false) - churchId = table.Column (name = "ChurchId", nullable = false) - name = table.Column (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 (name = "SmallGroupId", nullable = false) - daysToExpire = table.Column (name = "DaysToExpire", nullable = false, defaultValue = 14) - daysToKeepNew = table.Column (name = "DaysToKeepNew", nullable = false, defaultValue = 7) - defaultEmailType = table.Column (name = "DefaultEmailType", nullable = false, defaultValue = "Html") - emailFromAddress = table.Column (name = "EmailFromAddress", nullable = false, defaultValue = "prayer@djs-consulting.com") - emailFromName = table.Column (name = "EmailFromName", nullable = false, defaultValue = "PrayerTracker") - groupPassword = table.Column (name = "GroupPassword", nullable = false, defaultValue = "") - headingColor = table.Column (name = "HeadingColor", nullable = false, defaultValue = "maroon") - headingFontSize = table.Column (name = "HeadingFontSize", nullable = false, defaultValue = 16) - isPublic = table.Column (name = "IsPublic", nullable = false, defaultValue = false) - lineColor = table.Column (name = "LineColor", nullable = false, defaultValue = "navy") - listFonts = table.Column (name = "ListFonts", nullable = false, defaultValue = "Century Gothic,Tahoma,Luxi Sans,sans-serif") - longTermUpdateWeeks = table.Column (name = "LongTermUpdateWeeks", nullable = false, defaultValue = 4) - requestSort = table.Column (name = "RequestSort", nullable = false, defaultValue = "D", maxLength = Nullable 1) - textFontSize = table.Column (name = "TextFontSize", nullable = false, defaultValue = 12) - timeZoneId = table.Column (name = "TimeZoneId", nullable = false, defaultValue = "America/Denver") - pageSize = table.Column (name = "PageSize", nullable = false, defaultValue = 100) - asOfDateDisplay = table.Column (name = "AsOfDateDisplay", nullable = false, defaultValue = "N", maxLength = Nullable 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 (name = "MemberId", nullable = false) - email = table.Column (name = "Email", nullable = false) - format = table.Column (name = "Format", nullable = true) - memberName = table.Column (name = "MemberName", nullable = false) - smallGroupId = table.Column (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 (name = "PrayerRequestId", nullable = false) - expiration = table.Column (name = "Expiration", nullable = false) - enteredDate = table.Column (name = "EnteredDate", nullable = false) - notifyChaplain = table.Column (name = "NotifyChaplain", nullable = false) - requestType = table.Column (name = "RequestType", nullable = false) - requestor = table.Column (name = "Requestor", nullable = true) - smallGroupId = table.Column (name = "SmallGroupId", nullable = false) - text = table.Column (name = "Text", nullable = false) - updatedDate = table.Column (name = "UpdatedDate", nullable = false) - userId = table.Column (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 (name = "UserId", nullable = false) - smallGroupId = table.Column (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, - fun b -> - b.Property("churchId").ValueGeneratedOnAdd() |> ignore - b.Property("city").IsRequired() |> ignore - b.Property("hasInterface") |> ignore - b.Property("interfaceAddress") |> ignore - b.Property("name").IsRequired() |> ignore - b.Property("st").IsRequired().HasMaxLength(2) |> ignore - b.HasKey("churchId") |> ignore - b.ToTable("Church") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - fun b -> - b.Property("smallGroupId") |> ignore - b.Property("daysToExpire").ValueGeneratedOnAdd().HasDefaultValue(14) |> ignore - b.Property("daysToKeepNew").ValueGeneratedOnAdd().HasDefaultValue(7) |> ignore - b.Property("defaultEmailType").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("H") |> ignore - b.Property("emailFromAddress").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("prayer@djs-consulting.com") |> ignore - b.Property("emailFromName").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("PrayerTracker") |> ignore - b.Property("groupPassword").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("") |> ignore - b.Property("headingColor").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("maroon") |> ignore - b.Property("headingFontSize").ValueGeneratedOnAdd().HasDefaultValue(16) |> ignore - b.Property("isPublic").ValueGeneratedOnAdd().HasDefaultValue(false) |> ignore - b.Property("lineColor").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("navy") |> ignore - b.Property("listFonts").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("Century Gothic,Tahoma,Luxi Sans,sans-serif") |> ignore - b.Property("longTermUpdateWeeks").ValueGeneratedOnAdd().HasDefaultValue(4) |> ignore - b.Property("requestSort").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("D").HasMaxLength(1) |> ignore - b.Property("textFontSize").ValueGeneratedOnAdd().HasDefaultValue(12) |> ignore - b.Property("timeZoneId").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("America/Denver") |> ignore - b.Property("pageSize").IsRequired().ValueGeneratedOnAdd().HasDefaultValue(100) |> ignore - b.Property("asOfDateDisplay").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("N").HasMaxLength(1) |> ignore - b.HasKey("smallGroupId") |> ignore - b.HasIndex("timeZoneId") |> ignore - b.ToTable("ListPreference") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - fun b -> - b.Property("memberId").ValueGeneratedOnAdd() |> ignore - b.Property("email").IsRequired() |> ignore - b.Property("format") |> ignore - b.Property("memberName").IsRequired() |> ignore - b.Property("smallGroupId") |> ignore - b.HasKey("memberId") |> ignore - b.HasIndex("smallGroupId") |> ignore - b.ToTable("Member") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - fun b -> - b.Property("prayerRequestId").ValueGeneratedOnAdd() |> ignore - b.Property("enteredDate").IsRequired() |> ignore - b.Property("expiration").IsRequired().HasMaxLength 1 |> ignore - b.Property("notifyChaplain") |> ignore - b.Property("requestType").IsRequired().HasMaxLength 1 |> ignore - b.Property("requestor") |> ignore - b.Property("smallGroupId") |> ignore - b.Property("text").IsRequired() |> ignore - b.Property("updatedDate") |> ignore - b.Property("userId") |> ignore - b.HasKey("prayerRequestId") |> ignore - b.HasIndex("smallGroupId") |> ignore - b.HasIndex("userId") |> ignore - b.ToTable("PrayerRequest") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - fun b -> - b.Property("smallGroupId").ValueGeneratedOnAdd() |> ignore - b.Property("churchId") |> ignore - b.Property("name").IsRequired() |> ignore - b.HasKey("smallGroupId") |> ignore - b.HasIndex("churchId") |> ignore - b.ToTable("SmallGroup") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - fun b -> - b.Property("timeZoneId").ValueGeneratedOnAdd() |> ignore - b.Property("description").IsRequired() |> ignore - b.Property("isActive") |> ignore - b.Property("sortOrder") |> ignore - b.HasKey("timeZoneId") |> ignore - b.ToTable("TimeZone") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - fun b -> - b.Property("userId").ValueGeneratedOnAdd() |> ignore - b.Property("emailAddress").IsRequired() |> ignore - b.Property("firstName").IsRequired() |> ignore - b.Property("isAdmin") |> ignore - b.Property("lastName").IsRequired() |> ignore - b.Property("passwordHash").IsRequired() |> ignore - b.Property("salt") |> ignore - b.HasKey("userId") |> ignore - b.ToTable("User") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - fun b -> - b.Property("userId") |> ignore - b.Property("smallGroupId") |> ignore - b.HasKey("userId", "smallGroupId") |> ignore - b.HasIndex("smallGroupId") |> ignore - b.ToTable("User_SmallGroup") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - 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, - fun b -> - b.HasOne("PrayerTracker.Entities.SmallGroup", "smallGroup") - .WithMany("members") - .HasForeignKey("smallGroupId") - .OnDelete(DeleteBehavior.Cascade) - |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - 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, - fun b -> - b.HasOne("PrayerTracker.Entities.Church", "Church") - .WithMany("SmallGroups") - .HasForeignKey("ChurchId") - .OnDelete(DeleteBehavior.Cascade) - |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - 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 diff --git a/src/PrayerTracker.Data/Migrations/AppDbContextModelSnapshot.fs b/src/PrayerTracker.Data/Migrations/AppDbContextModelSnapshot.fs deleted file mode 100644 index 5ae5d5f..0000000 --- a/src/PrayerTracker.Data/Migrations/AppDbContextModelSnapshot.fs +++ /dev/null @@ -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 - -[)>] -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, - fun b -> - b.Property("churchId").ValueGeneratedOnAdd() |> ignore - b.Property("city").IsRequired() |> ignore - b.Property("hasInterface") |> ignore - b.Property("interfaceAddress") |> ignore - b.Property("name").IsRequired() |> ignore - b.Property("st").IsRequired().HasMaxLength(2) |> ignore - b.HasKey("churchId") |> ignore - b.ToTable("Church") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - fun b -> - b.Property("smallGroupId") |> ignore - b.Property("daysToExpire").ValueGeneratedOnAdd().HasDefaultValue(14) |> ignore - b.Property("daysToKeepNew").ValueGeneratedOnAdd().HasDefaultValue(7) |> ignore - b.Property("defaultEmailType").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("H").HasMaxLength(1) |> ignore - b.Property("emailFromAddress").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("prayer@djs-consulting.com") |> ignore - b.Property("emailFromName").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("PrayerTracker") |> ignore - b.Property("groupPassword").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("") |> ignore - b.Property("headingColor").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("maroon") |> ignore - b.Property("headingFontSize").ValueGeneratedOnAdd().HasDefaultValue(16) |> ignore - b.Property("isPublic").ValueGeneratedOnAdd().HasDefaultValue(false) |> ignore - b.Property("lineColor").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("navy") |> ignore - b.Property("listFonts").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("Century Gothic,Tahoma,Luxi Sans,sans-serif") |> ignore - b.Property("longTermUpdateWeeks").ValueGeneratedOnAdd().HasDefaultValue(4) |> ignore - b.Property("requestSort").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("D").HasMaxLength(1) |> ignore - b.Property("textFontSize").ValueGeneratedOnAdd().HasDefaultValue(12) |> ignore - b.Property("timeZoneId").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("America/Denver") |> ignore - b.Property("pageSize").IsRequired().ValueGeneratedOnAdd().HasDefaultValue(100) |> ignore - b.Property("asOfDateDisplay").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("N").HasMaxLength(1) |> ignore - b.HasKey("smallGroupId") |> ignore - b.HasIndex("timeZoneId") |> ignore - b.ToTable("ListPreference") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - fun b -> - b.Property("memberId").ValueGeneratedOnAdd() |> ignore - b.Property("email").IsRequired() |> ignore - b.Property("format") |> ignore - b.Property("memberName").IsRequired() |> ignore - b.Property("smallGroupId") |> ignore - b.HasKey("memberId") |> ignore - b.HasIndex("smallGroupId") |> ignore - b.ToTable("Member") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - fun b -> - b.Property("prayerRequestId").ValueGeneratedOnAdd() |> ignore - b.Property("enteredDate") |> ignore - b.Property("expiration").IsRequired().HasMaxLength(1) |> ignore - b.Property("notifyChaplain") |> ignore - b.Property("requestType").IsRequired().HasMaxLength(1) |> ignore - b.Property("requestor") |> ignore - b.Property("smallGroupId") |> ignore - b.Property("text").IsRequired() |> ignore - b.Property("updatedDate") |> ignore - b.Property("userId") |> ignore - b.HasKey("prayerRequestId") |> ignore - b.HasIndex("smallGroupId") |> ignore - b.HasIndex("userId") |> ignore - b.ToTable("PrayerRequest") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - fun b -> - b.Property("smallGroupId").ValueGeneratedOnAdd() |> ignore - b.Property("churchId") |> ignore - b.Property("name").IsRequired() |> ignore - b.HasKey("smallGroupId") |> ignore - b.HasIndex("churchId") |> ignore - b.ToTable("SmallGroup") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - fun b -> - b.Property("timeZoneId").ValueGeneratedOnAdd() |> ignore - b.Property("description").IsRequired() |> ignore - b.Property("isActive") |> ignore - b.Property("sortOrder") |> ignore - b.HasKey("timeZoneId") |> ignore - b.ToTable("TimeZone") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - fun b -> - b.Property("userId").ValueGeneratedOnAdd() |> ignore - b.Property("emailAddress").IsRequired() |> ignore - b.Property("firstName").IsRequired() |> ignore - b.Property("isAdmin") |> ignore - b.Property("lastName").IsRequired() |> ignore - b.Property("passwordHash").IsRequired() |> ignore - b.Property("salt") |> ignore - b.HasKey("userId") |> ignore - b.ToTable("User") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - fun b -> - b.Property("userId") |> ignore - b.Property("smallGroupId") |> ignore - b.HasKey("userId", "smallGroupId") |> ignore - b.HasIndex("smallGroupId") |> ignore - b.ToTable("User_SmallGroup") |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - 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, - fun b -> - b.HasOne("PrayerTracker.Entities.SmallGroup", "smallGroup") - .WithMany("members") - .HasForeignKey("smallGroupId") - .OnDelete(DeleteBehavior.Cascade) - |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - 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, - fun b -> - b.HasOne("PrayerTracker.Entities.Church", "Church") - .WithMany("SmallGroups") - .HasForeignKey("ChurchId") - .OnDelete(DeleteBehavior.Cascade) - |> ignore) - |> ignore - - modelBuilder.Entity ( - typeof, - 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 diff --git a/src/PrayerTracker.Data/PrayerTracker.Data.fsproj b/src/PrayerTracker.Data/PrayerTracker.Data.fsproj index b7eeb49..40cae83 100644 --- a/src/PrayerTracker.Data/PrayerTracker.Data.fsproj +++ b/src/PrayerTracker.Data/PrayerTracker.Data.fsproj @@ -6,17 +6,16 @@ - - - - + + - - - - + + + + + diff --git a/src/PrayerTracker.Tests/Data/EntitiesTests.fs b/src/PrayerTracker.Tests/Data/EntitiesTests.fs index 28f6185..e9a59c4 100644 --- a/src/PrayerTracker.Tests/Data/EntitiesTests.fs +++ b/src/PrayerTracker.Tests/Data/EntitiesTests.fs @@ -7,356 +7,355 @@ open System [] let asOfDateDisplayTests = - testList "AsOfDateDisplay" [ - test "NoDisplay code is correct" { - Expect.equal NoDisplay.code "N" "The code for NoDisplay should have been \"N\"" - } - test "ShortDate code is correct" { - Expect.equal ShortDate.code "S" "The code for ShortDate should have been \"S\"" - } - test "LongDate code is correct" { - Expect.equal LongDate.code "L" "The code for LongDate should have been \"N\"" - } - test "fromCode N should return NoDisplay" { - Expect.equal (AsOfDateDisplay.fromCode "N") NoDisplay "\"N\" should have been converted to NoDisplay" - } - test "fromCode S should return ShortDate" { - Expect.equal (AsOfDateDisplay.fromCode "S") ShortDate "\"S\" should have been converted to ShortDate" - } - test "fromCode L should return LongDate" { - Expect.equal (AsOfDateDisplay.fromCode "L") LongDate "\"L\" should have been converted to LongDate" - } - test "fromCode X should raise" { - Expect.throws (fun () -> AsOfDateDisplay.fromCode "X" |> ignore) - "An unknown code should have raised an exception" - } + testList "AsOfDateDisplay" [ + test "NoDisplay code is correct" { + Expect.equal (AsOfDateDisplay.toCode NoDisplay) "N" "The code for NoDisplay should have been \"N\"" + } + test "ShortDate code is correct" { + Expect.equal (AsOfDateDisplay.toCode ShortDate) "S" "The code for ShortDate should have been \"S\"" + } + test "LongDate code is correct" { + Expect.equal (AsOfDateDisplay.toCode LongDate) "L" "The code for LongDate should have been \"N\"" + } + test "fromCode N should return NoDisplay" { + Expect.equal (AsOfDateDisplay.fromCode "N") NoDisplay "\"N\" should have been converted to NoDisplay" + } + test "fromCode S should return ShortDate" { + Expect.equal (AsOfDateDisplay.fromCode "S") ShortDate "\"S\" should have been converted to ShortDate" + } + test "fromCode L should return LongDate" { + Expect.equal (AsOfDateDisplay.fromCode "L") LongDate "\"L\" should have been converted to LongDate" + } + test "fromCode X should raise" { + Expect.throws (fun () -> AsOfDateDisplay.fromCode "X" |> ignore) + "An unknown code should have raised an exception" + } ] [] let churchTests = - testList "Church" [ - test "empty is as expected" { - let mt = Church.empty - Expect.equal mt.churchId Guid.Empty "The church ID should have been an empty GUID" - Expect.equal mt.name "" "The name 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.isFalse mt.hasInterface "The church should not show that it has an interface" - 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" - } + testList "Church" [ + test "empty is as expected" { + let mt = Church.empty + 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.City "" "The city should have been blank" + Expect.equal mt.State "" "The state should have been blank" + Expect.isFalse mt.HasVpsInterface "The church should not show that it has an interface" + Expect.isNone mt.InterfaceAddress "The interface address should not exist" + } ] [] let emailFormatTests = - testList "EmailFormat" [ - test "HtmlFormat code is correct" { - Expect.equal HtmlFormat.code "H" "The code for HtmlFormat should have been \"H\"" - } - test "PlainTextFormat code is correct" { - Expect.equal PlainTextFormat.code "P" "The code for PlainTextFormat should have been \"P\"" - } - test "fromCode H should return HtmlFormat" { - Expect.equal (EmailFormat.fromCode "H") HtmlFormat "\"H\" should have been converted to HtmlFormat" - } - test "fromCode P should return ShortDate" { - 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" - } + testList "EmailFormat" [ + test "HtmlFormat code is correct" { + Expect.equal (EmailFormat.toCode HtmlFormat) "H" "The code for HtmlFormat should have been \"H\"" + } + test "PlainTextFormat code is correct" { + Expect.equal (EmailFormat.toCode PlainTextFormat) "P" "The code for PlainTextFormat should have been \"P\"" + } + test "fromCode H should return HtmlFormat" { + Expect.equal (EmailFormat.fromCode "H") HtmlFormat "\"H\" should have been converted to HtmlFormat" + } + test "fromCode P should return ShortDate" { + 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" + } ] [] let expirationTests = - testList "Expiration" [ - test "Automatic code is correct" { - Expect.equal Automatic.code "A" "The code for Automatic should have been \"A\"" - } - test "Manual code is correct" { - Expect.equal Manual.code "M" "The code for Manual should have been \"M\"" - } - test "Forced code is correct" { - Expect.equal Forced.code "F" "The code for Forced should have been \"F\"" - } - test "fromCode A should return Automatic" { - Expect.equal (Expiration.fromCode "A") Automatic "\"A\" should have been converted to Automatic" - } - test "fromCode M should return Manual" { - Expect.equal (Expiration.fromCode "M") Manual "\"M\" should have been converted to Manual" - } - test "fromCode F should return Forced" { - Expect.equal (Expiration.fromCode "F") Forced "\"F\" should have been converted to Forced" - } - test "fromCode V should raise" { - Expect.throws (fun () -> Expiration.fromCode "V" |> ignore) "An unknown code should have raised an exception" - } + testList "Expiration" [ + test "Automatic code is correct" { + Expect.equal (Expiration.toCode Automatic) "A" "The code for Automatic should have been \"A\"" + } + test "Manual code is correct" { + Expect.equal (Expiration.toCode Manual) "M" "The code for Manual should have been \"M\"" + } + test "Forced code is correct" { + Expect.equal (Expiration.toCode Forced) "F" "The code for Forced should have been \"F\"" + } + test "fromCode A should return Automatic" { + Expect.equal (Expiration.fromCode "A") Automatic "\"A\" should have been converted to Automatic" + } + test "fromCode M should return Manual" { + Expect.equal (Expiration.fromCode "M") Manual "\"M\" should have been converted to Manual" + } + test "fromCode F should return Forced" { + Expect.equal (Expiration.fromCode "F") Forced "\"F\" should have been converted to Forced" + } + test "fromCode V should raise" { + Expect.throws (fun () -> Expiration.fromCode "V" |> ignore) + "An unknown code should have raised an exception" + } ] [] let listPreferencesTests = - testList "ListPreferences" [ - test "empty is as expected" { - let mt = ListPreferences.empty - Expect.equal mt.smallGroupId Guid.Empty "The small group ID should have been an empty GUID" - Expect.equal mt.daysToExpire 14 "The default days to expire should have been 14" - 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" - Expect.equal mt.emailFromName "PrayerTracker" "The default e-mail from name should have been PrayerTracker" - Expect.equal mt.emailFromAddress "prayer@djs-consulting.com" - "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" - Expect.equal mt.headingColor "maroon" "The default heading text color should have been maroon" - Expect.equal mt.lineColor "navy" "The default heding line color should have been navy" - 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 mt.timeZoneId "America/Denver" "The default time zone should have been America/Denver" - Expect.equal mt.timeZone.timeZoneId "" "The default preferences should have included an empty time zone" - 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" - } + testList "ListPreferences" [ + test "FontStack is correct for native fonts" { + Expect.equal ListPreferences.empty.FontStack + """system-ui,-apple-system,"Segoe UI",Roboto,Ubuntu,"Liberation Sans",Cantarell,"Helvetica Neue",sans-serif""" + "The expected native font stack was incorrect" + } + test "FontStack is correct for specific fonts" { + Expect.equal { ListPreferences.empty with Fonts = "Arial,sans-serif" }.FontStack "Arial,sans-serif" + "The specified fonts were not returned correctly" + } + test "empty is as expected" { + let mt = ListPreferences.empty + Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID" + Expect.equal mt.DaysToExpire 14 "The default days to expire should have been 14" + 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" + Expect.equal mt.EmailFromName "PrayerTracker" "The default e-mail from name should have been PrayerTracker" + Expect.equal mt.EmailFromAddress "prayer@bitbadger.solutions" + "The default e-mail from address should have been prayer@bitbadger.solutions" + Expect.equal mt.Fonts "native" "The default list fonts were incorrect" + Expect.equal mt.HeadingColor "maroon" "The default heading text color should have been maroon" + Expect.equal mt.LineColor "navy" "The default heading line color should have been navy" + 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" + } ] [] let memberTests = - testList "Member" [ - test "empty is as expected" { - let mt = Member.empty - Expect.equal mt.memberId 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.memberName "" "The member name 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.equal mt.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one" - } + testList "Member" [ + test "empty is as expected" { + let mt = Member.empty + Expect.equal mt.Id.Value Guid.Empty "The member 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.Name "" "The member name 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" + } ] [] let prayerRequestTests = - testList "PrayerRequest" [ - test "empty is as expected" { - let mt = PrayerRequest.empty - Expect.equal mt.prayerRequestId Guid.Empty "The request ID should have been an empty GUID" - Expect.equal mt.requestType CurrentRequest "The request type should have been Current" - Expect.equal mt.userId 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.enteredDate DateTime.MinValue "The entered date should have been the minimum" - Expect.equal mt.updatedDate DateTime.MinValue "The updated date should have been the minimum" - Expect.isNone mt.requestor "The requestor should not exist" - Expect.equal mt.text "" "The request text should have been blank" - Expect.isFalse mt.notifyChaplain "The notify chaplain flag should not have been set" - Expect.equal mt.expiration Automatic "The expiration should have been Automatic" - 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" - } - test "isExpired always returns false for expecting requests" { - let req = { PrayerRequest.empty with requestType = Expecting } - Expect.isFalse (req.isExpired DateTime.Now 0) "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 } - Expect.isFalse (req.isExpired DateTime.Now 4) "A never-expired request should never be considered expired" - } - test "isExpired always returns false for long term/recurring requests" { - 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 true for force-expired requests" { - let req = { PrayerRequest.empty with updatedDate = DateTime.Now; expiration = Forced } - Expect.isTrue (req.isExpired DateTime.Now 5) "A force-expired request should always be considered expired" - } - test "isExpired returns false for non-expired requests" { - let now = DateTime.Now - let req = { PrayerRequest.empty with updatedDate = now.AddDays -5. } - Expect.isFalse (req.isExpired now 7) "A request updated 5 days ago should not be considered expired" - } - test "isExpired returns true for expired requests" { - let now = DateTime.Now - let req = { PrayerRequest.empty with updatedDate = now.AddDays -8. } - Expect.isTrue (req.isExpired now 7) "A request updated 8 days ago should be considered expired" - } - test "isExpired returns true for same-day expired requests" { - let now = DateTime.Now - let req = { PrayerRequest.empty with updatedDate = now.Date.AddDays(-7.).AddSeconds -1. } - Expect.isTrue (req.isExpired now 7) "A request entered a second before midnight should be considered expired" - } - test "updateRequired returns false for expired requests" { - let req = { PrayerRequest.empty with expiration = Forced } - Expect.isFalse (req.updateRequired DateTime.Now 7 4) "An expired request should not require an update" - } - test "updateRequired returns false when an update is not required for an active request" { - let now = DateTime.Now - let req = - { PrayerRequest.empty with - requestType = LongTermRequest - updatedDate = now.AddDays -14. - } - Expect.isFalse (req.updateRequired now 7 4) - "An active request updated 14 days ago should not require an update until 28 days" - } - test "updateRequired returns true when an update is required for an active request" { - let now = DateTime.Now - let req = - { PrayerRequest.empty with - requestType = LongTermRequest - updatedDate = now.AddDays -34. - } - Expect.isTrue (req.updateRequired now 7 4) - "An active request updated 34 days ago should require an update (past 28 days)" - } + let instantNow = SystemClock.Instance.GetCurrentInstant + let localDateNow () = (instantNow ()).InUtc().Date + testList "PrayerRequest" [ + test "empty is as expected" { + let mt = PrayerRequest.empty + Expect.equal mt.Id.Value Guid.Empty "The request ID should have been an empty GUID" + Expect.equal mt.RequestType CurrentRequest "The request type should have been Current" + Expect.equal mt.UserId.Value Guid.Empty "The user 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.EnteredDate Instant.MinValue "The entered date should have been the minimum" + Expect.equal mt.UpdatedDate Instant.MinValue "The updated date should have been the minimum" + Expect.isNone mt.Requestor "The requestor should not exist" + Expect.equal mt.Text "" "The request text should have been blank" + Expect.isFalse mt.NotifyChaplain "The notify chaplain flag should not have been set" + Expect.equal mt.Expiration Automatic "The expiration should have been Automatic" + } + test "isExpired always returns false for expecting requests" { + PrayerRequest.isExpired (localDateNow ()) SmallGroup.empty + { 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" { + PrayerRequest.isExpired (localDateNow ()) SmallGroup.empty + { PrayerRequest.empty with UpdatedDate = (instantNow ()) - Duration.FromDays 1; Expiration = Manual } + |> Flip.Expect.isFalse "A never-expired request should never be considered expired" + } + test "isExpired always returns false for long term/recurring requests" { + PrayerRequest.isExpired (localDateNow ()) SmallGroup.empty + { PrayerRequest.empty with RequestType = LongTermRequest } + |> Flip.Expect.isFalse "A recurring/long-term request should never be considered expired" + } + test "isExpired always returns true for force-expired requests" { + PrayerRequest.isExpired (localDateNow ()) SmallGroup.empty + { PrayerRequest.empty with UpdatedDate = (instantNow ()); Expiration = Forced } + |> Flip.Expect.isTrue "A force-expired request should always be considered expired" + } + test "isExpired returns false for non-expired requests" { + let now = instantNow () + PrayerRequest.isExpired (now.InUtc().Date) SmallGroup.empty + { PrayerRequest.empty with UpdatedDate = now - Duration.FromDays 5 } + |> Flip.Expect.isFalse "A request updated 5 days ago should not be considered expired" + } + test "isExpired returns true for expired requests" { + let now = instantNow () + PrayerRequest.isExpired (now.InUtc().Date) SmallGroup.empty + { PrayerRequest.empty with UpdatedDate = now - Duration.FromDays 15 } + |> Flip.Expect.isTrue "A request updated 15 days ago should be considered expired" + } + test "isExpired returns true for same-day expired requests" { + let now = instantNow () + PrayerRequest.isExpired (now.InUtc().Date) SmallGroup.empty + { PrayerRequest.empty with UpdatedDate = now - (Duration.FromDays 14) - (Duration.FromSeconds 1L) } + |> Flip.Expect.isTrue "A request entered a second before midnight should be considered expired" + } + test "updateRequired returns false for expired requests" { + PrayerRequest.updateRequired (localDateNow ()) SmallGroup.empty + { PrayerRequest.empty with Expiration = Forced } + |> Flip.Expect.isFalse "An expired request should not require an update" + } + test "updateRequired returns false when an update is not required for an active request" { + let now = instantNow () + PrayerRequest.updateRequired (localDateNow ()) SmallGroup.empty + { PrayerRequest.empty with RequestType = LongTermRequest; UpdatedDate = now - Duration.FromDays 14 } + |> Flip.Expect.isFalse "An active request updated 14 days ago should not require an update until 28 days" + } + test "UpdateRequired returns true when an update is required for an active request" { + let now = instantNow () + PrayerRequest.updateRequired (localDateNow ()) SmallGroup.empty + { PrayerRequest.empty with RequestType = LongTermRequest; UpdatedDate = now - Duration.FromDays 34 } + |> Flip.Expect.isTrue "An active request updated 34 days ago should require an update (past 28 days)" + } ] [] let prayerRequestTypeTests = - testList "PrayerRequestType" [ - test "CurrentRequest code is correct" { - Expect.equal CurrentRequest.code "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 "PraiseReport code is correct" { - Expect.equal PraiseReport.code "P" "The code for PraiseReport should have been \"P\"" - } - test "Expecting code is correct" { - Expect.equal Expecting.code "E" "The code for Expecting should have been \"E\"" - } - test "Announcement code is correct" { - Expect.equal Announcement.code "A" "The code for Announcement should have been \"A\"" - } - test "fromCode C should return CurrentRequest" { - Expect.equal (PrayerRequestType.fromCode "C") CurrentRequest - "\"C\" should have been converted to CurrentRequest" - } - test "fromCode L should return LongTermRequest" { - Expect.equal (PrayerRequestType.fromCode "L") LongTermRequest - "\"L\" should have been converted to LongTermRequest" - } - test "fromCode P should return PraiseReport" { - Expect.equal (PrayerRequestType.fromCode "P") PraiseReport "\"P\" should have been converted to PraiseReport" - } - test "fromCode E should return Expecting" { - Expect.equal (PrayerRequestType.fromCode "E") Expecting "\"E\" should have been converted to Expecting" - } - test "fromCode A should return Announcement" { - Expect.equal (PrayerRequestType.fromCode "A") Announcement "\"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" - } + testList "PrayerRequestType" [ + test "CurrentRequest code is correct" { + Expect.equal (PrayerRequestType.toCode CurrentRequest) "C" + "The code for CurrentRequest should have been \"C\"" + } + test "LongTermRequest code is correct" { + Expect.equal (PrayerRequestType.toCode LongTermRequest) "L" + "The code for LongTermRequest should have been \"L\"" + } + test "PraiseReport code is correct" { + Expect.equal (PrayerRequestType.toCode PraiseReport) "P" "The code for PraiseReport should have been \"P\"" + } + test "Expecting code is correct" { + Expect.equal (PrayerRequestType.toCode Expecting) "E" "The code for Expecting should have been \"E\"" + } + test "Announcement code is correct" { + Expect.equal (PrayerRequestType.toCode Announcement) "A" "The code for Announcement should have been \"A\"" + } + test "fromCode C should return CurrentRequest" { + Expect.equal (PrayerRequestType.fromCode "C") CurrentRequest + "\"C\" should have been converted to CurrentRequest" + } + test "fromCode L should return LongTermRequest" { + Expect.equal (PrayerRequestType.fromCode "L") LongTermRequest + "\"L\" should have been converted to LongTermRequest" + } + test "fromCode P should return PraiseReport" { + Expect.equal (PrayerRequestType.fromCode "P") PraiseReport + "\"P\" should have been converted to PraiseReport" + } + test "fromCode E should return Expecting" { + Expect.equal (PrayerRequestType.fromCode "E") Expecting "\"E\" should have been converted to Expecting" + } + test "fromCode A should return Announcement" { + Expect.equal (PrayerRequestType.fromCode "A") Announcement + "\"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" + } ] [] let requestSortTests = - testList "RequestSort" [ - test "SortByDate code is correct" { - Expect.equal SortByDate.code "D" "The code for SortByDate should have been \"D\"" - } - test "SortByRequestor code is correct" { - Expect.equal SortByRequestor.code "R" "The code for SortByRequestor should have been \"R\"" - } - test "fromCode D should return SortByDate" { - Expect.equal (RequestSort.fromCode "D") SortByDate "\"D\" should have been converted to SortByDate" - } - test "fromCode R should return 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" - } + testList "RequestSort" [ + test "SortByDate code is correct" { + Expect.equal (RequestSort.toCode SortByDate) "D" "The code for SortByDate should have been \"D\"" + } + test "SortByRequestor code is correct" { + Expect.equal (RequestSort.toCode SortByRequestor) "R" "The code for SortByRequestor should have been \"R\"" + } + test "fromCode D should return SortByDate" { + Expect.equal (RequestSort.fromCode "D") SortByDate "\"D\" should have been converted to SortByDate" + } + test "fromCode R should return 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" + } ] [] let smallGroupTests = - testList "SmallGroup" [ - let now = DateTime (2017, 5, 12, 12, 15, 0, DateTimeKind.Utc) - let withFakeClock f () = - FakeClock (Instant.FromDateTimeUtc now) |> f - yield test "empty is as expected" { - let mt = SmallGroup.empty - Expect.equal mt.smallGroupId 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.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" - Expect.isEmpty mt.members "There should be no members for an empty small group" - Expect.isNotNull mt.prayerRequests "The prayer requests navigation property should not be null" - Expect.isEmpty mt.prayerRequests "There should be no prayer requests for an empty small group" - Expect.isNotNull mt.users "The users navigation property should not be null" - Expect.isEmpty mt.users "There should be no users for an empty small group" - } - yield! testFixture withFakeClock [ - "localTimeNow adjusts the time ahead of UTC", - fun clock -> - let grp = { SmallGroup.empty with preferences = { ListPreferences.empty with timeZoneId = "Europe/Berlin" } } - Expect.isGreaterThan (grp.localTimeNow clock) now "UTC to Europe/Berlin should have added hours" - "localTimeNow adjusts the time behind UTC", - fun clock -> - Expect.isLessThan (SmallGroup.empty.localTimeNow clock) now - "UTC to America/Denver should have subtracted hours" - "localTimeNow returns UTC when the time zone is invalid", - fun clock -> - 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" - ] - yield test "localTimeNow fails when clock is not passed" { - Expect.throws (fun () -> (SmallGroup.empty.localTimeNow >> ignore) null) - "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) - let clock = FakeClock (Instant.FromDateTimeUtc now') - Expect.isLessThan (SmallGroup.empty.localDateNow clock) now.Date "The date should have been a day earlier" - } - ] - -[] -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" - } + testList "SmallGroup" [ + let now = Instant.FromDateTimeUtc (DateTime (2017, 5, 12, 12, 15, 0, DateTimeKind.Utc)) + let withFakeClock f () = + FakeClock now |> f + yield test "empty is as expected" { + let mt = SmallGroup.empty + Expect.equal mt.Id.Value Guid.Empty "The small group 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" + } + yield! testFixture withFakeClock [ + "LocalTimeNow adjusts the time ahead of UTC", + fun clock -> + let grp = + { SmallGroup.empty with + Preferences = { ListPreferences.empty with TimeZoneId = TimeZoneId "Europe/Berlin" } + } + Expect.isGreaterThan (SmallGroup.localTimeNow clock grp) (now.InUtc().LocalDateTime) + "UTC to Europe/Berlin should have added hours" + "LocalTimeNow adjusts the time behind UTC", + fun clock -> + Expect.isLessThan (SmallGroup.localTimeNow clock SmallGroup.empty) (now.InUtc().LocalDateTime) + "UTC to America/Denver should have subtracted hours" + "LocalTimeNow returns UTC when the time zone is invalid", + fun clock -> + let grp = + { SmallGroup.empty with + Preferences = { ListPreferences.empty with TimeZoneId = TimeZoneId "garbage" } + } + 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.localTimeNow null SmallGroup.empty |> ignore)) + "Should have raised an exception for null clock" + } + yield test "LocalDateNow returns the date portion" { + let clock = FakeClock (Instant.FromDateTimeUtc (DateTime (2017, 5, 12, 1, 15, 0, DateTimeKind.Utc))) + Expect.isLessThan (SmallGroup.localDateNow clock SmallGroup.empty) (now.InUtc().Date) + "The date should have been a day earlier" + } ] [] let userTests = - testList "User" [ - test "empty is as expected" { - let mt = User.empty - Expect.equal mt.userId 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.lastName "" "The last name should have been blank" - Expect.equal mt.emailAddress "" "The e-mail address should have been blank" - 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.isNone mt.salt "The password salt should not exist" - Expect.isNotNull mt.smallGroups "The small groups navigation property should not have been null" - Expect.isEmpty mt.smallGroups "There should be no small groups for an empty user" - } - 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" - } + testList "User" [ + test "empty is as expected" { + let mt = User.empty + 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.LastName "" "The last name 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.equal mt.PasswordHash "" "The password hash should have been blank" + } + test "Name concatenates first and last names" { + 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" + } ] [] let userSmallGroupTests = - testList "UserSmallGroup" [ - test "empty is as expected" { - let mt = UserSmallGroup.empty - Expect.equal mt.userId 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.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" - } + testList "UserSmallGroup" [ + test "empty is as expected" { + let mt = UserSmallGroup.empty + Expect.equal mt.UserId.Value Guid.Empty "The user ID should have been an empty GUID" + Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID" + } ] diff --git a/src/PrayerTracker.Tests/PrayerTracker.Tests.fsproj b/src/PrayerTracker.Tests/PrayerTracker.Tests.fsproj index 14f1306..e98224a 100644 --- a/src/PrayerTracker.Tests/PrayerTracker.Tests.fsproj +++ b/src/PrayerTracker.Tests/PrayerTracker.Tests.fsproj @@ -16,8 +16,8 @@ - - + + diff --git a/src/PrayerTracker.Tests/Program.fs b/src/PrayerTracker.Tests/Program.fs index c3e7e04..fbce67e 100644 --- a/src/PrayerTracker.Tests/Program.fs +++ b/src/PrayerTracker.Tests/Program.fs @@ -2,4 +2,4 @@ [] let main argv = - runTestsInAssembly defaultConfig argv + runTestsInAssembly defaultConfig argv diff --git a/src/PrayerTracker.Tests/UI/CommonFunctionsTests.fs b/src/PrayerTracker.Tests/UI/CommonFunctionsTests.fs index 437feed..19f4cb3 100644 --- a/src/PrayerTracker.Tests/UI/CommonFunctionsTests.fs +++ b/src/PrayerTracker.Tests/UI/CommonFunctionsTests.fs @@ -1,208 +1,215 @@ module PrayerTracker.UI.CommonFunctionsTests +open System.IO open Expecto open Giraffe.ViewEngine open Microsoft.AspNetCore.Mvc.Localization open Microsoft.Extensions.Localization open PrayerTracker.Tests.TestLocalization open PrayerTracker.Views -open System.IO [] let iconSizedTests = - testList "iconSized" [ - test "succeeds" { - let ico = iconSized 18 "tom-&-jerry" |> renderHtmlNode - Expect.equal ico "tom-&-jerry" "icon HTML not correct" - } + testList "iconSized" [ + test "succeeds" { + let ico = iconSized 18 "tom-&-jerry" |> renderHtmlNode + Expect.equal ico """tom-&-jerry""" "icon HTML not correct" + } ] [] let iconTests = - testList "icon" [ - test "succeeds" { - let ico = icon "bob-&-tom" |> renderHtmlNode - Expect.equal ico "bob-&-tom" "icon HTML not correct" - } + testList "icon" [ + test "succeeds" { + let ico = icon "bob-&-tom" |> renderHtmlNode + Expect.equal ico """bob-&-tom""" "icon HTML not correct" + } ] [] let locStrTests = - testList "locStr" [ - test "succeeds" { - let enc = locStr (LocalizedString ("test", "test&")) |> renderHtmlNode - Expect.equal enc "test&" "string not encoded correctly" - } + testList "locStr" [ + test "succeeds" { + let enc = locStr (LocalizedString ("test", "test&")) |> renderHtmlNode + Expect.equal enc "test&" "string not encoded correctly" + } ] [] let namedColorListTests = - testList "namedColorList" [ - test "succeeds with default values" { - let expected = - [ "" - ] - |> String.concat "" - let selectList = namedColorList "the-name" "" [] _s |> renderHtmlNode - Expect.equal expected selectList "The default select list was not generated correctly" - } - test "succeeds with a selected value" { - let selectList = namedColorList "the-name" "white" [] _s |> renderHtmlNode - Expect.stringContains selectList " selected>white" "Selected option not generated correctly" - } - test "succeeds with extra attributes" { - let selectList = namedColorList "the-name" "" [ _id "myId" ] _s |> renderHtmlNode - Expect.stringStarts selectList """" + """""" + """""" + """""" + """""" + """""" + """""" + """""" + """""" + """""" + """""" + """""" + """""" + """""" + """""" + """""" + """""" + "" + ] + |> String.concat "" + let selectList = namedColorList "the-name" "" [] _s |> renderHtmlNode + Expect.equal expected selectList "The default select list was not generated correctly" + } + test "succeeds with a selected value" { + let selectList = namedColorList "the-name" "white" [] _s |> renderHtmlNode + Expect.stringContains selectList " selected>white" "Selected option not generated correctly" + } + test "succeeds with extra attributes" { + let selectList = namedColorList "the-name" "" [ _id "myId" ] _s |> renderHtmlNode + Expect.stringStarts selectList """" - "Unselected radio button not generated correctly" - } - test "succeeds when selected" { - let rad = radio "a-name" "anId" "unit" "unit" |> renderHtmlNode - Expect.equal rad "" - "Selected radio button not generated correctly" - } + testList "radio" [ + test "succeeds when not selected" { + let rad = radio "a-name" "anId" "test" "unit" |> renderHtmlNode + Expect.equal rad """""" + "Unselected radio button not generated correctly" + } + test "succeeds when selected" { + let rad = radio "a-name" "anId" "unit" "unit" |> renderHtmlNode + Expect.equal rad """""" + "Selected radio button not generated correctly" + } ] [] let rawLocTextTests = - testList "rawLocText" [ - test "succeeds" { - use sw = new StringWriter () - let raw = rawLocText sw (LocalizedHtmlString ("test", "test&")) |> renderHtmlNode - Expect.equal raw "test&" "string not written correctly" - } + testList "rawLocText" [ + test "succeeds" { + use sw = new StringWriter () + let raw = rawLocText sw (LocalizedHtmlString ("test", "test&")) |> renderHtmlNode + Expect.equal raw "test&" "string not written correctly" + } ] [] let selectDefaultTests = - testList "selectDefault" [ - test "succeeds" { - Expect.equal (selectDefault "a&b") "— a&b —" "Default selection not generated correctly" - } + testList "selectDefault" [ + test "succeeds" { + Expect.equal (selectDefault "a&b") "— a&b —" "Default selection not generated correctly" + } ] [] let selectListTests = - testList "selectList" [ - test "succeeds with minimum options" { - let theList = selectList "a-list" "" [] [] |> renderHtmlNode - Expect.equal theList "" "Empty select list not generated correctly" - } - test "succeeds with all options" { - let theList = - [ "tom", "Tom&" - "bob", "Bob" - "jan", "Jan" - ] - |> selectList "the-list" "bob" [ _style "ugly" ] - |> renderHtmlNode - let expected = - [ "" - ] - |> String.concat "" - Expect.equal theList expected "Filled select list not generated correctly" - } + testList "selectList" [ + test "succeeds with minimum options" { + let theList = selectList "a-list" "" [] [] |> renderHtmlNode + Expect.equal theList """""" + "Empty select list not generated correctly" + } + test "succeeds with all options" { + let theList = + [ "tom", "Tom&" + "bob", "Bob" + "jan", "Jan" + ] + |> selectList "the-list" "bob" [ _style "ugly" ] + |> renderHtmlNode + let expected = + [ """""" + ] + |> String.concat "" + Expect.equal theList expected "Filled select list not generated correctly" + } ] [] let spaceTests = - testList "space" [ - test "succeeds" { - Expect.equal (renderHtmlNode space) " " "space literal not correct" - } + testList "space" [ + test "succeeds" { + Expect.equal (renderHtmlNode space) " " "space literal not correct" + } ] [] let submitTests = - testList "submit" [ - test "succeeds" { - let btn = submit [ _class "slick" ] "file-ico" _s.["a&b"] |> renderHtmlNode - Expect.equal - btn - "" - "Submit button not generated correctly" - } + testList "submit" [ + test "succeeds" { + let btn = submit [ _class "slick" ] "file-ico" _s["a&b"] |> renderHtmlNode + Expect.equal + btn + """""" + "Submit button not generated correctly" + } ] [] let tableSummaryTests = - testList "tableSummary" [ - test "succeeds for no entries" { - let sum = tableSummary 0 _s |> renderHtmlNode - Expect.equal sum "
No Entries to Display
" - "Summary for no items is incorrect" - } - test "succeeds for one entry" { - let sum = tableSummary 1 _s |> renderHtmlNode - Expect.equal sum "
Displaying 1 Entry
" - "Summary for one item is incorrect" - } - test "succeeds for many entries" { - let sum = tableSummary 5 _s |> renderHtmlNode - Expect.equal sum "
Displaying 5 Entries
" - "Summary for many items is incorrect" - } + testList "tableSummary" [ + test "succeeds for no entries" { + let sum = tableSummary 0 _s |> renderHtmlNode + Expect.equal sum """
No Entries to Display
""" + "Summary for no items is incorrect" + } + test "succeeds for one entry" { + let sum = tableSummary 1 _s |> renderHtmlNode + Expect.equal sum """
Displaying 1 Entry
""" + "Summary for one item is incorrect" + } + test "succeeds for many entries" { + let sum = tableSummary 5 _s |> renderHtmlNode + Expect.equal sum """
Displaying 5 Entries
""" + "Summary for many items is incorrect" + } ] module TimeZones = - open PrayerTracker.Views.CommonFunctions.TimeZones + open PrayerTracker.Entities + open PrayerTracker.Views.CommonFunctions.TimeZones - [] - let nameTests = - testList "TimeZones.name" [ - test "succeeds for US Eastern time" { - Expect.equal (name "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 Mountain time" { - Expect.equal (name "America/Denver" _s |> string) "Mountain" "US Mountain time zone not returned correctly" - } - test "succeeds for US Mountain (AZ) time" { - Expect.equal (name "America/Phoenix" _s |> string) "Mountain (Arizona)" - "US Mountain (AZ) time zone not returned correctly" - } - test "succeeds for US Pacific time" { - Expect.equal (name "America/Los_Angeles" _s |> string) "Pacific" "US Pacific time zone not returned correctly" - } - test "succeeds for Central European time" { - Expect.equal (name "Europe/Berlin" _s |> string) "Central European" - "Central European time zone not returned correctly" - } - test "fails for unexpected time zone" { - Expect.equal (name "Wakanda" _s |> string) "Wakanda" "Unexpected time zone should have returned the original ID" - } - ] + [] + let nameTests = + testList "TimeZones.name" [ + test "succeeds for US Eastern time" { + 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 (TimeZoneId "America/Chicago") _s |> string) "Central" + "US Central time zone not returned correctly" + } + test "succeeds for US Mountain time" { + Expect.equal (name (TimeZoneId "America/Denver") _s |> string) "Mountain" + "US Mountain time zone not returned correctly" + } + test "succeeds for US Mountain (AZ) time" { + Expect.equal (name (TimeZoneId "America/Phoenix") _s |> string) "Mountain (Arizona)" + "US Mountain (AZ) time zone not returned correctly" + } + test "succeeds for US Pacific time" { + Expect.equal (name (TimeZoneId "America/Los_Angeles") _s |> string) "Pacific" + "US Pacific time zone not returned correctly" + } + test "succeeds for Central European time" { + 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" + } + ] diff --git a/src/PrayerTracker.Tests/UI/UtilsTests.fs b/src/PrayerTracker.Tests/UI/UtilsTests.fs index 7fc94c4..0b3c232 100644 --- a/src/PrayerTracker.Tests/UI/UtilsTests.fs +++ b/src/PrayerTracker.Tests/UI/UtilsTests.fs @@ -5,189 +5,192 @@ open PrayerTracker [] let ckEditorToTextTests = - testList "ckEditorToText" [ - test "replaces newline/tab sequence with nothing" { - Expect.equal (ckEditorToText "Here is some \n\ttext") "Here is some text" - "Newline/tab sequence should have been removed" - } - test "replaces   with a space" { - Expect.equal (ckEditorToText "Test text") "Test text" "  should have been replaced with a space" - } - test "replaces double space with one non-breaking space and one regular space" { - Expect.equal (ckEditorToText "Test text") "Test  text" - "double space should have been replaced with one non-breaking space and one regular space" - } - test "replaces paragraph break with two line breaks" { - Expect.equal (ckEditorToText "some

text") "some

text" - "paragraph break should have been replaced with two line breaks" - } - test "removes start and end paragraph tags" { - Expect.equal (ckEditorToText "

something something

") "something something" - "start/end paragraph tags should have been removed" - } - test "trims the result" { - Expect.equal (ckEditorToText " abc ") "abc" "Should have trimmed the resulting text" - } - test "does all the replacements and removals at one time" { - Expect.equal (ckEditorToText "

Paragraph 1\n\t line two

Paragraph 2 x

") - "Paragraph 1 line two

Paragraph 2  x" - "all replacements and removals were not made correctly" - } + testList "ckEditorToText" [ + test "replaces newline/tab sequence with nothing" { + Expect.equal (ckEditorToText "Here is some \n\ttext") "Here is some text" + "Newline/tab sequence should have been removed" + } + test "replaces   with a space" { + Expect.equal (ckEditorToText "Test text") "Test text" "  should have been replaced with a space" + } + test "replaces double space with one non-breaking space and one regular space" { + Expect.equal (ckEditorToText "Test text") "Test  text" + "double space should have been replaced with one non-breaking space and one regular space" + } + test "replaces paragraph break with two line breaks" { + Expect.equal (ckEditorToText "some

text") "some

text" + "paragraph break should have been replaced with two line breaks" + } + test "removes start and end paragraph tags" { + Expect.equal (ckEditorToText "

something something

") "something something" + "start/end paragraph tags should have been removed" + } + test "trims the result" { + Expect.equal (ckEditorToText " abc ") "abc" "Should have trimmed the resulting text" + } + test "does all the replacements and removals at one time" { + Expect.equal (ckEditorToText "

Paragraph 1\n\t line two

Paragraph 2 x

") + "Paragraph 1 line two

Paragraph 2  x" + "all replacements and removals were not made correctly" + } ] [] let htmlToPlainTextTests = - testList "htmlToPlainText" [ - test "decodes HTML-encoded entities" { - Expect.equal (htmlToPlainText "1 > 0") "1 > 0" "HTML-encoded entities should have been decoded" - } - test "trims the input HTML" { - Expect.equal (htmlToPlainText " howdy ") "howdy" "HTML input string should have been trimmed" - } - test "replaces line breaks with new lines" { - Expect.equal (htmlToPlainText "Lots
of
new
lines") "Lots\nof\nnew\nlines" - "Break tags should have been converted to newline characters" - } - test "replaces non-breaking spaces with spaces" { - Expect.equal (htmlToPlainText "Here is some more text") "Here is some more text" - "Non-breaking spaces should have been replaced with spaces" - } - test "does all replacements at one time" { - Expect.equal (htmlToPlainText " < <
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 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" - Expect.equal (htmlToPlainText "Paragraph 1

Paragraph 2

...and paragraph 3") - expected "Blank lines not preserved for consecutive line breaks" - } + testList "htmlToPlainText" [ + test "decodes HTML-encoded entities" { + Expect.equal (htmlToPlainText "1 > 0") "1 > 0" "HTML-encoded entities should have been decoded" + } + test "trims the input HTML" { + Expect.equal (htmlToPlainText " howdy ") "howdy" "HTML input string should have been trimmed" + } + test "replaces line breaks with new lines" { + Expect.equal (htmlToPlainText "Lots
of
new
lines") "Lots\nof\nnew\nlines" + "Break tags should have been converted to newline characters" + } + test "replaces non-breaking spaces with spaces" { + Expect.equal (htmlToPlainText "Here is some more text") "Here is some more text" + "Non-breaking spaces should have been replaced with spaces" + } + test "does all replacements at one time" { + Expect.equal (htmlToPlainText " < <
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 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" + Expect.equal + (htmlToPlainText "Paragraph 1

Paragraph 2

...and paragraph 3") + expected "Blank lines not preserved for consecutive line breaks" + } ] [] let makeUrlTests = - testList "makeUrl" [ - 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" - } - test "returns the URL with one query string parameter" { - 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" { - let url = makeUrl "/test" [ "space", "a space"; "turkey", "=" ] - Expect.equal url "/test?space=a+space&turkey=%3D" "The URL was not constructed properly" - } + testList "makeUrl" [ + 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" + } + test "returns the URL with one query string parameter" { + 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" { + let url = makeUrl "/test" [ "space", "a space"; "turkey", "=" ] + Expect.equal url "/test?space=a+space&turkey=%3D" "The URL was not constructed properly" + } ] [] let sndAsStringTests = - testList "sndAsString" [ - 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" - } + testList "sndAsString" [ + 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" + } ] module StringTests = - open PrayerTracker.Utils.String + open PrayerTracker.Utils.String - [] - let replaceFirstTests = - testList "String.replaceFirst" [ - test "replaces the first occurrence when it is found at the beginning of the string" { - let testString = "unit 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" - } - test "replaces the first occurrence when it is found in the center of the string" { - let testString = "test unit 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" - } - test "returns the original string if the replacement isn't found" { - let testString = "unit tests" - Expect.equal (replaceFirst "tested" "testing" testString) "unit tests" - "String which did not have the target substring was not returned properly" - } - ] + [] + let replaceFirstTests = + testList "String.replaceFirst" [ + test "replaces the first occurrence when it is found at the beginning of the string" { + let testString = "unit 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" + } + test "replaces the first occurrence when it is found in the center of the string" { + let testString = "test unit 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" + } + test "returns the original string if the replacement isn't found" { + let testString = "unit tests" + Expect.equal (replaceFirst "tested" "testing" testString) "unit tests" + "String which did not have the target substring was not returned properly" + } + ] - [] - let replaceTests = - testList "String.replace" [ - test "succeeds" { - Expect.equal (replace "a" "b" "abacab") "bbbcbb" "String did not replace properly" - } - ] + [] + let replaceTests = + testList "String.replace" [ + test "succeeds" { + Expect.equal (replace "a" "b" "abacab") "bbbcbb" "String did not replace properly" + } + ] - [] - let trimTests = - testList "String.trim" [ - test "succeeds" { - Expect.equal (trim " abc ") "abc" "Space not trimmed from string properly" - } - ] + [] + let trimTests = + testList "String.trim" [ + test "succeeds" { + Expect.equal (trim " abc ") "abc" "Space not trimmed from string properly" + } + ] [] let stripTagsTests = - let testString = "

Here is some text

and some more

" - testList "stripTags" [ - test "does nothing if all tags are allowed" { - Expect.equal (stripTags [ "p"; "br" ] testString) testString - "There should have been no replacements in the target string" - } - test "strips the start/end tag for non allowed tag" { - Expect.equal (stripTags [ "br" ] testString) "Here is some text

and some more" - "There should have been no \"p\" tag, but all \"br\" tags, in the returned string" - } - test "strips void/self-closing tags" { - 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" - } + let testString = """

Here is some text

and some more

""" + testList "stripTags" [ + test "does nothing if all tags are allowed" { + Expect.equal (stripTags [ "p"; "br" ] testString) testString + "There should have been no replacements in the target string" + } + test "strips the start/end tag for non allowed tag" { + Expect.equal (stripTags [ "br" ] testString) "Here is some text

and some more" + "There should have been no \"p\" tag, but all \"br\" tags, in the returned string" + } + test "strips void/self-closing tags" { + 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" + } ] [] let wordWrapTests = - testList "wordWrap" [ - test "breaks where it is supposed to" { - 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" - "Line not broken correctly" - } - test "wraps long line without a space" { - let testString = "Asamatteroffact, the dog does too" - Expect.equal (wordWrap 10 testString) "Asamattero\nffact, the\ndog does\ntoo\n" - "Longer line not broken correctly" - } - test "preserves blank lines" { - let testString = "Here is\n\na string with blank lines" - Expect.equal (wordWrap 80 testString) testString "Blank lines were not preserved" - } + testList "wordWrap" [ + test "breaks where it is supposed to" { + 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" + "Line not broken correctly" + } + test "wraps long line without a space" { + let testString = "Asamatteroffact, the dog does too" + Expect.equal (wordWrap 10 testString) "Asamattero\nffact, the\ndog does\ntoo\n" + "Longer line not broken correctly" + } + test "preserves blank lines" { + let testString = "Here is\n\na string with blank lines" + Expect.equal (wordWrap 80 testString) testString "Blank lines were not preserved" + } ] [] let wordWrapBTests = - testList "wordWrapB" [ - test "breaks where it is supposed to" { - 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" - "Line not broken correctly" - } - test "wraps long line without a space and a line with exact length" { - let testString = "Asamatteroffact, the dog does too" - Expect.equal (wordWrap 10 testString) "Asamattero\nffact, the\ndog does\ntoo\n" - "Longer line not broken correctly" - } - test "wraps long line without a space and a line with non-exact length" { - let testString = "Asamatteroffact, that dog does too" - Expect.equal (wordWrap 10 testString) "Asamattero\nffact,\nthat dog\ndoes too\n" - "Longer line not broken correctly" - } - test "preserves blank lines" { - let testString = "Here is\n\na string with blank lines" - Expect.equal (wordWrap 80 testString) testString "Blank lines were not preserved" - } + testList "wordWrapB" [ + test "breaks where it is supposed to" { + 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" + "Line not broken correctly" + } + test "wraps long line without a space and a line with exact length" { + let testString = "Asamatteroffact, the dog does too" + Expect.equal (wordWrap 10 testString) "Asamattero\nffact, the\ndog does\ntoo\n" + "Longer line not broken correctly" + } + test "wraps long line without a space and a line with non-exact length" { + let testString = "Asamatteroffact, that dog does too" + Expect.equal (wordWrap 10 testString) "Asamattero\nffact,\nthat dog\ndoes too\n" + "Longer line not broken correctly" + } + test "preserves blank lines" { + let testString = "Here is\n\na string with blank lines" + Expect.equal (wordWrap 80 testString) testString "Blank lines were not preserved" + } ] diff --git a/src/PrayerTracker.Tests/UI/ViewModelsTests.fs b/src/PrayerTracker.Tests/UI/ViewModelsTests.fs index 46d4ddc..5b08c81 100644 --- a/src/PrayerTracker.Tests/UI/ViewModelsTests.fs +++ b/src/PrayerTracker.Tests/UI/ViewModelsTests.fs @@ -1,12 +1,13 @@ module PrayerTracker.UI.ViewModelsTests +open System open Expecto open Microsoft.AspNetCore.Html +open NodaTime open PrayerTracker.Entities open PrayerTracker.Tests.TestLocalization open PrayerTracker.Utils open PrayerTracker.ViewModels -open System /// Filter function that filters nothing @@ -15,666 +16,729 @@ let countAll _ = true module ReferenceListTests = - [] - let asOfDateListTests = - testList "ReferenceList.asOfDateList" [ - test "has all three options listed" { - let asOf = ReferenceList.asOfDateList _s - Expect.hasCountOf asOf 3u countAll "There should have been 3 as-of choices returned" - Expect.exists asOf (fun (x, _) -> x = NoDisplay.code) "The option for no display was not found" - Expect.exists asOf (fun (x, _) -> x = ShortDate.code) "The option for a short date was not found" - Expect.exists asOf (fun (x, _) -> x = LongDate.code) "The option for a full date was not found" - } - ] - - [] - let emailTypeListTests = - testList "ReferenceList.emailTypeList" [ - test "includes default type" { - let typs = ReferenceList.emailTypeList HtmlFormat _s - Expect.hasCountOf typs 3u countAll "There should have been 3 e-mail type options returned" - let top = Seq.head typs - Expect.equal (fst top) "" "The default option should have been blank" - Expect.equal (snd top).Value "Group Default (HTML Format)" "The default option label was incorrect" - let nxt = typs |> Seq.skip 1 |> Seq.head - Expect.equal (fst nxt) HtmlFormat.code "The 2nd option should have been HTML" - let lst = typs |> Seq.last - Expect.equal (fst lst) PlainTextFormat.code "The 3rd option should have been plain text" - } - ] - - [] - let expirationListTests = - testList "ReferenceList.expirationList" [ - test "excludes immediate expiration if not required" { - let exps = ReferenceList.expirationList _s false - Expect.hasCountOf exps 2u countAll "There should have been 2 expiration types returned" - Expect.exists exps (fun (exp, _) -> exp = Automatic.code) "The option for automatic expiration was not found" - Expect.exists exps (fun (exp, _) -> exp = Manual.code) "The option for manual expiration was not found" - } - test "includes immediate expiration if required" { - let exps = ReferenceList.expirationList _s true - Expect.hasCountOf exps 3u countAll "There should have been 3 expiration types returned" - Expect.exists exps (fun (exp, _) -> exp = Automatic.code) "The option for automatic expiration was not found" - Expect.exists exps (fun (exp, _) -> exp = Manual.code) "The option for manual expiration was not found" - Expect.exists exps (fun (exp, _) -> exp = Forced.code) "The option for immediate expiration was not found" - } - ] - - [] - let requestTypeListTests = - testList "ReferenceList.requestTypeList" [ - let withList f () = - (ReferenceList.requestTypeList >> f) _s - yield! testFixture withList [ - yield "returns 5 types", - fun typs -> Expect.hasCountOf typs 5u countAll "There should have been 5 request types returned" - yield! [ CurrentRequest; LongTermRequest; PraiseReport; Expecting; Announcement ] - |> List.map (fun typ -> - sprintf "contains \"%O\"" typ, - fun typs -> - Expect.isSome (typs |> List.tryFind (fun x -> fst x = typ)) - (sprintf "The \"%O\" option was not found" typ)) + [] + let asOfDateListTests = + testList "ReferenceList.asOfDateList" [ + test "has all three options listed" { + let asOf = ReferenceList.asOfDateList _s + Expect.hasCountOf asOf 3u countAll "There should have been 3 as-of choices returned" + Expect.exists asOf (fun (x, _) -> x = AsOfDateDisplay.toCode NoDisplay) + "The option for no display was not found" + Expect.exists asOf (fun (x, _) -> x = AsOfDateDisplay.toCode ShortDate) + "The option for a short date was not found" + Expect.exists asOf (fun (x, _) -> x = AsOfDateDisplay.toCode LongDate) + "The option for a full date was not found" + } + ] + + [] + let emailTypeListTests = + testList "ReferenceList.emailTypeList" [ + test "includes default type" { + let typs = ReferenceList.emailTypeList HtmlFormat _s + Expect.hasCountOf typs 3u countAll "There should have been 3 e-mail type options returned" + let top = Seq.head typs + Expect.equal (fst top) "" "The default option should have been blank" + Expect.equal (snd top).Value "Group Default (HTML Format)" "The default option label was incorrect" + let nxt = typs |> Seq.skip 1 |> Seq.head + Expect.equal (fst nxt) (EmailFormat.toCode HtmlFormat) "The 2nd option should have been HTML" + let lst = typs |> Seq.last + Expect.equal (fst lst) (EmailFormat.toCode PlainTextFormat) "The 3rd option should have been plain text" + } + ] + + [] + let expirationListTests = + testList "ReferenceList.expirationList" [ + test "excludes immediate expiration if not required" { + let exps = ReferenceList.expirationList _s false + Expect.hasCountOf exps 2u countAll "There should have been 2 expiration types returned" + Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Automatic) + "The option for automatic expiration was not found" + Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Manual) + "The option for manual expiration was not found" + } + test "includes immediate expiration if required" { + let exps = ReferenceList.expirationList _s true + Expect.hasCountOf exps 3u countAll "There should have been 3 expiration types returned" + Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Automatic) + "The option for automatic expiration was not found" + Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Manual) + "The option for manual expiration was not found" + Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Forced) + "The option for immediate expiration was not found" + } + ] + + [] + let requestTypeListTests = + testList "ReferenceList.requestTypeList" [ + let withList f () = + (ReferenceList.requestTypeList >> f) _s + yield! testFixture withList [ + yield "returns 5 types", + fun typs -> Expect.hasCountOf typs 5u countAll "There should have been 5 request types returned" + yield! + [ CurrentRequest; LongTermRequest; PraiseReport; Expecting; Announcement ] + |> List.map (fun typ -> + $"contains \"%O{typ}\"", + fun typs -> + Expect.isSome (typs |> List.tryFind (fun x -> fst x = typ)) + $"""The "%O{typ}" option was not found""") + ] ] - ] [] let announcementTests = - let empty = { sendToClass = "N"; text = "

unit testing

"; addToRequestList = None; requestType = None } - testList "Announcement" [ - test "plainText strips HTML" { - let ann = { empty with text = "

unit testing

" } - Expect.equal (ann.plainText ()) "unit testing" "Plain text should have stripped HTML" - } - test "plainText wraps at 74 characters" { - let ann = { empty with text = String.replicate 80 "x" } - let txt = (ann.plainText ()).Split "\n" - Expect.hasCountOf txt 3u countAll "There should have been two lines of plain text returned" - Expect.stringHasLength txt.[0] 74 "The first line should have been wrapped at 74 characters" - Expect.stringHasLength txt.[1] 6 "The second line should have had the remaining 6 characters" - Expect.stringHasLength txt.[2] 0 "The third line should have been blank" - } - test "plainText wraps at 74 characters and strips HTML" { - let ann = { empty with text = sprintf "%s" (String.replicate 80 "z") } - let txt = ann.plainText () - Expect.stringStarts txt "zzz" "HTML should have been stripped from the front of the plain text" - Expect.equal (txt.ToCharArray ()).[74] '\n' "The text should have been broken at 74 characters" - } + let empty = { SendToClass = "N"; Text = "

unit testing

"; AddToRequestList = None; RequestType = None } + testList "Announcement" [ + test "plainText strips HTML" { + let ann = { empty with Text = "

unit testing

" } + Expect.equal ann.PlainText "unit testing" "Plain text should have stripped HTML" + } + test "plainText wraps at 74 characters" { + let ann = { empty with Text = String.replicate 80 "x" } + let txt = ann.PlainText.Split "\n" + Expect.hasCountOf txt 3u countAll "There should have been two lines of plain text returned" + Expect.stringHasLength txt[0] 74 "The first line should have been wrapped at 74 characters" + Expect.stringHasLength txt[1] 6 "The second line should have had the remaining 6 characters" + Expect.stringHasLength txt[2] 0 "The third line should have been blank" + } + test "plainText wraps at 74 characters and strips HTML" { + let ann = { empty with Text = sprintf "%s" (String.replicate 80 "z") } + let txt = ann.PlainText + Expect.stringStarts txt "zzz" "HTML should have been stripped from the front of the plain text" + Expect.equal (txt.ToCharArray ()).[74] '\n' "The text should have been broken at 74 characters" + } ] [] let appViewInfoTests = - testList "AppViewInfo" [ - test "fresh is constructed properly" { - let vi = AppViewInfo.fresh - Expect.isEmpty vi.style "There should have been no styles set" - Expect.isEmpty vi.script "There should have been no scripts set" - Expect.isNone vi.helpLink "The help link should have been set to none" - Expect.isEmpty vi.messages "There should have been no messages set" - Expect.equal vi.version "" "The version should have been blank" - Expect.isGreaterThan vi.requestStart DateTime.MinValue.Ticks "The request start time should have been set" - Expect.isNone vi.user "There should not have been a user" - Expect.isNone vi.group "There should not have been a small group" - } + testList "AppViewInfo" [ + test "fresh is constructed properly" { + let vi = AppViewInfo.fresh + Expect.isEmpty vi.Style "There should have been no styles set" + Expect.isNone vi.HelpLink "The help link should have been set to none" + Expect.isEmpty vi.Messages "There should have been no messages set" + Expect.equal vi.Version "" "The version should have been blank" + Expect.equal vi.RequestStart Instant.MinValue "The request start time should have been the minimum value" + Expect.isNone vi.User "There should not have been a user" + Expect.isNone vi.Group "There should not have been a small group" + } ] [] let assignGroupsTests = - testList "AssignGroups" [ - test "fromUser populates correctly" { - let usr = { User.empty with userId = Guid.NewGuid (); firstName = "Alice"; lastName = "Bob" } - let asg = AssignGroups.fromUser usr - Expect.equal asg.userId usr.userId "The user ID was not filled correctly" - Expect.equal asg.userName usr.fullName "The user name was not filled correctly" - Expect.equal asg.smallGroups "" "The small group string was not filled correctly" - } + testList "AssignGroups" [ + test "fromUser populates correctly" { + let usr = { User.empty with Id = (Guid.NewGuid >> UserId) (); FirstName = "Alice"; LastName = "Bob" } + let asg = AssignGroups.fromUser usr + Expect.equal asg.UserId (shortGuid usr.Id.Value) "The user ID was not filled correctly" + Expect.equal asg.UserName usr.Name "The user's name was not filled correctly" + Expect.equal asg.SmallGroups "" "The small group string was not filled correctly" + } ] [] let editChurchTests = - testList "EditChurch" [ - test "fromChurch populates correctly when interface exists" { - let church = - { Church.empty with - churchId = Guid.NewGuid () - name = "Unit Test" - city = "Testlandia" - st = "UT" - hasInterface = true - interfaceAddress = Some "https://test-dem-units.test" - } - let edit = EditChurch.fromChurch church - Expect.equal edit.churchId church.churchId "The church ID was not filled correctly" - Expect.equal edit.name church.name "The church name was not filled correctly" - Expect.equal edit.city church.city "The church's city was not filled correctly" - Expect.equal edit.st church.st "The church's state was not filled correctly" - Expect.isSome edit.hasInterface "The church should show that it has an interface" - Expect.equal edit.hasInterface (Some true) "The hasInterface flag should be true" - Expect.isSome edit.interfaceAddress "The interface address should exist" - Expect.equal edit.interfaceAddress church.interfaceAddress "The interface address was not filled correctly" - } - test "fromChurch populates correctly when interface does not exist" { - let edit = - EditChurch.fromChurch - { Church.empty with - churchId = Guid.NewGuid () - name = "Unit Test" - city = "Testlandia" - st = "UT" - } - Expect.isNone edit.hasInterface "The church should not show that it has an interface" - Expect.isNone edit.interfaceAddress "The interface address should not exist" - } - test "empty is as expected" { - let edit = EditChurch.empty - Expect.equal edit.churchId Guid.Empty "The church ID should be the empty GUID" - Expect.equal edit.name "" "The church name should be blank" - Expect.equal edit.city "" "The church's city should be blank" - Expect.equal edit.st "" "The church's state should be blank" - Expect.isNone edit.hasInterface "The church should not show that it has an interface" - Expect.isNone edit.interfaceAddress "The interface address should not exist" - } - test "isNew works on a new church" { - Expect.isTrue (EditChurch.empty.isNew ()) "An empty GUID should be flagged as a new church" - } - test "isNew works on an existing church" { - Expect.isFalse ({ EditChurch.empty with churchId = Guid.NewGuid () }.isNew ()) - "A non-empty GUID should not be flagged as a new church" - } - test "populateChurch works correctly when an interface exists" { - let edit = - { EditChurch.empty with - churchId = Guid.NewGuid () - name = "Test Baptist Church" - city = "Testerville" - st = "TE" - hasInterface = Some true - interfaceAddress = Some "https://test.units" - } - let church = edit.populateChurch Church.empty - Expect.notEqual church.churchId edit.churchId "The church ID should not have been modified" - Expect.equal church.name edit.name "The church name was not updated correctly" - Expect.equal church.city edit.city "The church's city was not updated correctly" - Expect.equal church.st edit.st "The church's state was not updated correctly" - Expect.isTrue church.hasInterface "The church should show that it has an interface" - Expect.isSome church.interfaceAddress "The interface address should exist" - Expect.equal church.interfaceAddress edit.interfaceAddress "The interface address was not updated correctly" - } - test "populateChurch works correctly when an interface does not exist" { - let church = - { EditChurch.empty with - name = "Test Baptist Church" - city = "Testerville" - st = "TE" - }.populateChurch Church.empty - Expect.isFalse church.hasInterface "The church should show that it has an interface" - Expect.isNone church.interfaceAddress "The interface address should exist" - } + testList "EditChurch" [ + test "fromChurch populates correctly when interface exists" { + let church = + { Church.empty with + Id = (Guid.NewGuid >> ChurchId) () + Name = "Unit Test" + City = "Testlandia" + State = "UT" + HasVpsInterface = true + InterfaceAddress = Some "https://test-dem-units.test" + } + let edit = EditChurch.fromChurch church + Expect.equal edit.ChurchId (shortGuid church.Id.Value) "The church ID was not filled correctly" + Expect.equal edit.Name church.Name "The church name was not filled correctly" + Expect.equal edit.City church.City "The church's city was not filled correctly" + Expect.equal edit.State church.State "The church's state was not filled correctly" + Expect.isSome edit.HasInterface "The church should show that it has an interface" + Expect.equal edit.HasInterface (Some true) "The HasVpsInterface flag should be true" + Expect.isSome edit.InterfaceAddress "The interface address should exist" + Expect.equal edit.InterfaceAddress church.InterfaceAddress "The interface address was not filled correctly" + } + test "fromChurch populates correctly when interface does not exist" { + let edit = + EditChurch.fromChurch + { Church.empty with + Id = (Guid.NewGuid >> ChurchId) () + Name = "Unit Test" + City = "Testlandia" + State = "UT" + } + Expect.isNone edit.HasInterface "The church should not show that it has an interface" + Expect.isNone edit.InterfaceAddress "The interface address should not exist" + } + test "empty is as expected" { + let edit = EditChurch.empty + Expect.equal edit.ChurchId emptyGuid "The church ID should be the empty GUID" + Expect.equal edit.Name "" "The church name should be blank" + Expect.equal edit.City "" "The church's city should be blank" + Expect.equal edit.State "" "The church's state should be blank" + Expect.isNone edit.HasInterface "The church should not show that it has an interface" + Expect.isNone edit.InterfaceAddress "The interface address should not exist" + } + test "isNew works on a new church" { + Expect.isTrue EditChurch.empty.IsNew "An empty GUID should be flagged as a new church" + } + test "isNew works on an existing church" { + Expect.isFalse { EditChurch.empty with ChurchId = (Guid.NewGuid >> shortGuid) () }.IsNew + "A non-empty GUID should not be flagged as a new church" + } + test "populateChurch works correctly when an interface exists" { + let edit = + { EditChurch.empty with + ChurchId = (Guid.NewGuid >> shortGuid) () + Name = "Test Baptist Church" + City = "Testerville" + State = "TE" + HasInterface = Some true + InterfaceAddress = Some "https://test.units" + } + let church = edit.PopulateChurch Church.empty + Expect.notEqual (shortGuid church.Id.Value) edit.ChurchId "The church ID should not have been modified" + Expect.equal church.Name edit.Name "The church name was not updated correctly" + Expect.equal church.City edit.City "The church's city was not updated correctly" + Expect.equal church.State edit.State "The church's state was not updated correctly" + Expect.isTrue church.HasVpsInterface "The church should show that it has an interface" + Expect.isSome church.InterfaceAddress "The interface address should exist" + Expect.equal church.InterfaceAddress edit.InterfaceAddress "The interface address was not updated correctly" + } + test "populateChurch works correctly when an interface does not exist" { + let church = + { EditChurch.empty with + Name = "Test Baptist Church" + City = "Testerville" + State = "TE" + }.PopulateChurch Church.empty + Expect.isFalse church.HasVpsInterface "The church should show that it has an interface" + Expect.isNone church.InterfaceAddress "The interface address should exist" + } ] [] let editMemberTests = - testList "EditMember" [ - test "fromMember populates with group default format" { - let mbr = - { Member.empty with - memberId = Guid.NewGuid () - memberName = "Test Name" - email = "test_units@example.com" - } - let edit = EditMember.fromMember mbr - Expect.equal edit.memberId mbr.memberId "The member ID was not filled correctly" - Expect.equal edit.memberName mbr.memberName "The member name was not filled correctly" - Expect.equal edit.emailAddress mbr.email "The e-mail address was not filled correctly" - Expect.equal edit.emailType "" "The e-mail type should have been blank for group default" - } - test "fromMember populates with specific format" { - let edit = EditMember.fromMember { Member.empty with format = Some HtmlFormat.code } - Expect.equal edit.emailType HtmlFormat.code "The e-mail type was not filled correctly" - } - test "empty is as expected" { - let edit = EditMember.empty - Expect.equal edit.memberId Guid.Empty "The member ID should have been an empty GUID" - Expect.equal edit.memberName "" "The member name should have been blank" - Expect.equal edit.emailAddress "" "The e-mail address should have been blank" - Expect.equal edit.emailType "" "The e-mail type should have been blank" - } - test "isNew works for a new member" { - Expect.isTrue (EditMember.empty.isNew ()) "An empty GUID should be flagged as a new member" - } - test "isNew works for an existing member" { - Expect.isFalse ({ EditMember.empty with memberId = Guid.NewGuid () }.isNew ()) - "A non-empty GUID should not be flagged as a new member" - } + testList "EditMember" [ + test "fromMember populates with group default format" { + let mbr = + { Member.empty with + Id = (Guid.NewGuid >> MemberId) () + Name = "Test Name" + Email = "test_units@example.com" + } + let edit = EditMember.fromMember mbr + Expect.equal edit.MemberId (shortGuid mbr.Id.Value) "The member ID was not filled correctly" + Expect.equal edit.Name mbr.Name "The member name was not filled correctly" + Expect.equal edit.Email mbr.Email "The e-mail address was not filled correctly" + Expect.equal edit.Format "" "The e-mail format should have been blank for group default" + } + test "fromMember populates with specific format" { + let edit = EditMember.fromMember { Member.empty with Format = Some HtmlFormat } + Expect.equal edit.Format (EmailFormat.toCode HtmlFormat) "The e-mail format was not filled correctly" + } + test "empty is as expected" { + let edit = EditMember.empty + Expect.equal edit.MemberId emptyGuid "The member ID should have been an empty GUID" + Expect.equal edit.Name "" "The member name should have been blank" + Expect.equal edit.Email "" "The e-mail address should have been blank" + Expect.equal edit.Format "" "The e-mail format should have been blank" + } + test "isNew works for a new member" { + Expect.isTrue EditMember.empty.IsNew "An empty GUID should be flagged as a new member" + } + test "isNew works for an existing member" { + Expect.isFalse { EditMember.empty with MemberId = (Guid.NewGuid >> shortGuid) () }.IsNew + "A non-empty GUID should not be flagged as a new member" + } ] [] let editPreferencesTests = - testList "EditPreferences" [ - test "fromPreferences succeeds for named colors and private list" { - let prefs = ListPreferences.empty - let edit = EditPreferences.fromPreferences prefs - Expect.equal edit.expireDays prefs.daysToExpire "The expiration days were not filled correctly" - Expect.equal edit.daysToKeepNew prefs.daysToKeepNew "The days to keep new were not filled correctly" - Expect.equal edit.longTermUpdateWeeks prefs.longTermUpdateWeeks "The weeks for update were not filled correctly" - Expect.equal edit.requestSort prefs.requestSort.code "The request sort was not filled correctly" - Expect.equal edit.emailFromName prefs.emailFromName "The e-mail from name was not filled correctly" - Expect.equal edit.emailFromAddress prefs.emailFromAddress "The e-mail from address was not filled correctly" - Expect.equal edit.defaultEmailType prefs.defaultEmailType.code "The default e-mail type was not filled correctly" - Expect.equal edit.headingLineType "Name" "The heading line color type was not derived correctly" - Expect.equal edit.headingLineColor prefs.lineColor "The heading line color was not filled correctly" - Expect.equal edit.headingTextType "Name" "The heading text color type was not derived correctly" - Expect.equal edit.headingTextColor prefs.headingColor "The heading text color was not filled correctly" - Expect.equal edit.listFonts prefs.listFonts "The list fonts were not filled correctly" - Expect.equal edit.headingFontSize prefs.headingFontSize "The heading font size was not filled correctly" - Expect.equal edit.listFontSize prefs.textFontSize "The list text font size was not filled correctly" - Expect.equal edit.timeZone prefs.timeZoneId "The time zone was not filled correctly" - Expect.isSome edit.groupPassword "The group password should have been set" - Expect.equal edit.groupPassword (Some prefs.groupPassword) "The group password was not filled correctly" - Expect.equal edit.listVisibility RequestVisibility.``private`` "The list visibility was not derived correctly" - } - test "fromPreferences succeeds for RGB line color and password-protected list" { - let prefs = { ListPreferences.empty with lineColor = "#ff0000"; groupPassword = "pw" } - let edit = EditPreferences.fromPreferences prefs - Expect.equal edit.headingLineType "RGB" "The heading line color type was not derived correctly" - Expect.equal edit.headingLineColor prefs.lineColor "The heading line color was not filled correctly" - Expect.isSome edit.groupPassword "The group password should have been set" - Expect.equal edit.groupPassword (Some prefs.groupPassword) "The group password was not filled correctly" - Expect.equal edit.listVisibility RequestVisibility.passwordProtected - "The list visibility was not derived correctly" - } - test "fromPreferences succeeds for RGB text color and public list" { - let prefs = { ListPreferences.empty with headingColor = "#0000ff"; isPublic = true } - let edit = EditPreferences.fromPreferences prefs - Expect.equal edit.headingTextType "RGB" "The heading text color type was not derived correctly" - Expect.equal edit.headingTextColor prefs.headingColor "The heading text color was not filled correctly" - Expect.isSome edit.groupPassword "The group password should have been set" - Expect.equal edit.groupPassword (Some "") "The group password was not filled correctly" - Expect.equal edit.listVisibility RequestVisibility.``public`` "The list visibility was not derived correctly" - } + testList "EditPreferences" [ + test "fromPreferences succeeds for native fonts, named colors, and private list" { + let prefs = ListPreferences.empty + let edit = EditPreferences.fromPreferences prefs + Expect.equal edit.ExpireDays prefs.DaysToExpire "The expiration days were not filled correctly" + Expect.equal edit.DaysToKeepNew prefs.DaysToKeepNew "The days to keep new were not filled correctly" + Expect.equal edit.LongTermUpdateWeeks prefs.LongTermUpdateWeeks + "The weeks for update were not filled correctly" + Expect.equal edit.RequestSort (RequestSort.toCode prefs.RequestSort) + "The request sort was not filled correctly" + Expect.equal edit.EmailFromName prefs.EmailFromName "The e-mail from name was not filled correctly" + Expect.equal edit.EmailFromAddress prefs.EmailFromAddress "The e-mail from address was not filled correctly" + Expect.equal edit.DefaultEmailType (EmailFormat.toCode prefs.DefaultEmailType) + "The default e-mail type was not filled correctly" + Expect.equal edit.LineColorType "Name" "The heading line color type was not derived correctly" + Expect.equal edit.LineColor prefs.LineColor "The heading line color was not filled correctly" + Expect.equal edit.HeadingColorType "Name" "The heading text color type was not derived correctly" + Expect.equal edit.HeadingColor prefs.HeadingColor "The heading text color was not filled correctly" + Expect.isTrue edit.IsNative "The IsNative flag should have been true (default value)" + Expect.isNone edit.Fonts "The list fonts should not exist for native font stack" + Expect.equal edit.HeadingFontSize prefs.HeadingFontSize "The heading font size was not filled correctly" + Expect.equal edit.ListFontSize prefs.TextFontSize "The list text font size was not filled correctly" + Expect.equal edit.TimeZone (TimeZoneId.toString prefs.TimeZoneId) "The time zone was not filled correctly" + Expect.isSome edit.GroupPassword "The group password should have been set" + Expect.equal edit.GroupPassword (Some prefs.GroupPassword) "The group password was not filled correctly" + Expect.equal edit.Visibility GroupVisibility.PrivateList + "The list visibility was not derived correctly" + Expect.equal edit.PageSize prefs.PageSize "The page size was not filled correctly" + Expect.equal edit.AsOfDate (AsOfDateDisplay.toCode prefs.AsOfDateDisplay) + "The as-of date display was not filled correctly" + } + test "fromPreferences succeeds for RGB line color and password-protected list" { + let prefs = { ListPreferences.empty with LineColor = "#ff0000"; GroupPassword = "pw" } + let edit = EditPreferences.fromPreferences prefs + Expect.equal edit.LineColorType "RGB" "The heading line color type was not derived correctly" + Expect.equal edit.LineColor prefs.LineColor "The heading line color was not filled correctly" + Expect.isSome edit.GroupPassword "The group password should have been set" + Expect.equal edit.GroupPassword (Some prefs.GroupPassword) "The group password was not filled correctly" + Expect.equal edit.Visibility GroupVisibility.HasPassword + "The list visibility was not derived correctly" + } + test "fromPreferences succeeds for RGB text color and public list" { + let prefs = { ListPreferences.empty with HeadingColor = "#0000ff"; IsPublic = true } + let edit = EditPreferences.fromPreferences prefs + Expect.equal edit.HeadingColorType "RGB" "The heading text color type was not derived correctly" + Expect.equal edit.HeadingColor prefs.HeadingColor "The heading text color was not filled correctly" + Expect.isSome edit.GroupPassword "The group password should have been set" + Expect.equal edit.GroupPassword (Some "") "The group password was not filled correctly" + Expect.equal edit.Visibility GroupVisibility.PublicList + "The list visibility was not derived correctly" + } + test "fromPreferences succeeds for non-native fonts" { + let prefs = { ListPreferences.empty with Fonts = "Arial,sans-serif" } + let edit = EditPreferences.fromPreferences prefs + Expect.isFalse edit.IsNative "The IsNative flag should have been false" + Expect.isSome edit.Fonts "The fonts should have been filled for non-native fonts" + Expect.equal edit.Fonts.Value prefs.Fonts "The fonts were not filled correctly" + } ] [] let editRequestTests = - testList "EditRequest" [ - test "empty is as expected" { - let mt = EditRequest.empty - Expect.equal mt.requestId Guid.Empty "The request ID should be an empty GUID" - Expect.equal mt.requestType CurrentRequest.code "The request type should have been \"Current\"" - Expect.isNone mt.enteredDate "The entered date should have been None" - Expect.isNone mt.skipDateUpdate "The \"skip date update\" flag should have been None" - Expect.isNone mt.requestor "The requestor should have been None" - Expect.equal mt.expiration Automatic.code "The expiration should have been \"A\" (Automatic)" - Expect.equal mt.text "" "The text should have been blank" - } - test "fromRequest succeeds" { - let req = - { PrayerRequest.empty with - prayerRequestId = Guid.NewGuid () - requestType = CurrentRequest - requestor = Some "Me" - expiration = Manual - text = "the text" - } - let edit = EditRequest.fromRequest req - Expect.equal edit.requestId req.prayerRequestId "The request ID was not filled correctly" - Expect.equal edit.requestType req.requestType.code "The request type was not filled correctly" - Expect.equal edit.requestor req.requestor "The requestor was not filled correctly" - Expect.equal edit.expiration Manual.code "The expiration was not filled correctly" - Expect.equal edit.text req.text "The text was not filled correctly" - } - test "isNew works for a new request" { - Expect.isTrue (EditRequest.empty.isNew ()) "An empty GUID should be flagged as a new request" - } - test "isNew works for an existing request" { - Expect.isFalse ({ EditRequest.empty with requestId = Guid.NewGuid () }.isNew ()) - "A non-empty GUID should not be flagged as a new request" - } + testList "EditRequest" [ + test "empty is as expected" { + let mt = EditRequest.empty + Expect.equal mt.RequestId emptyGuid "The request ID should be an empty GUID" + Expect.equal mt.RequestType (PrayerRequestType.toCode CurrentRequest) + "The request type should have been \"Current\"" + Expect.isNone mt.EnteredDate "The entered date should have been None" + Expect.isNone mt.SkipDateUpdate """The "skip date update" flag should have been None""" + Expect.isNone mt.Requestor "The requestor should have been None" + Expect.equal mt.Expiration (Expiration.toCode Automatic) + """The expiration should have been "A" (Automatic)""" + Expect.equal mt.Text "" "The text should have been blank" + } + test "fromRequest succeeds" { + let req = + { PrayerRequest.empty with + Id = (Guid.NewGuid >> PrayerRequestId) () + RequestType = CurrentRequest + Requestor = Some "Me" + Expiration = Manual + Text = "the text" + } + let edit = EditRequest.fromRequest req + Expect.equal edit.RequestId (shortGuid req.Id.Value) "The request ID was not filled correctly" + Expect.equal edit.RequestType (PrayerRequestType.toCode req.RequestType) + "The request type was not filled correctly" + Expect.equal edit.Requestor req.Requestor "The requestor was not filled correctly" + Expect.equal edit.Expiration (Expiration.toCode Manual) "The expiration was not filled correctly" + Expect.equal edit.Text req.Text "The text was not filled correctly" + } + test "isNew works for a new request" { + Expect.isTrue EditRequest.empty.IsNew "An empty GUID should be flagged as a new request" + } + test "isNew works for an existing request" { + Expect.isFalse { EditRequest.empty with RequestId = (Guid.NewGuid >> shortGuid) () }.IsNew + "A non-empty GUID should not be flagged as a new request" + } ] [] let editSmallGroupTests = - testList "EditSmallGroup" [ - test "fromGroup succeeds" { - let grp = - { SmallGroup.empty with - smallGroupId = Guid.NewGuid () - name = "test group" - churchId = Guid.NewGuid () - } - let edit = EditSmallGroup.fromGroup grp - Expect.equal edit.smallGroupId grp.smallGroupId "The small group ID was not filled correctly" - Expect.equal edit.name grp.name "The name was not filled correctly" - Expect.equal edit.churchId grp.churchId "The church ID was not filled correctly" - } - test "empty is as expected" { - let mt = EditSmallGroup.empty - Expect.equal mt.smallGroupId Guid.Empty "The small group ID should be an empty GUID" - Expect.equal mt.name "" "The name should be blank" - Expect.equal mt.churchId Guid.Empty "The church ID should be an empty GUID" - } - test "isNew works for a new small group" { - Expect.isTrue (EditSmallGroup.empty.isNew ()) "An empty GUID should be flagged as a new small group" - } - test "isNew works for an existing small group" { - Expect.isFalse ({ EditSmallGroup.empty with smallGroupId = Guid.NewGuid () }.isNew ()) - "A non-empty GUID should not be flagged as a new small group" - } - test "populateGroup succeeds" { - let edit = - { EditSmallGroup.empty with - name = "test name" - churchId = Guid.NewGuid () - } - let grp = edit.populateGroup SmallGroup.empty - Expect.equal grp.name edit.name "The name was not populated correctly" - Expect.equal grp.churchId edit.churchId "The church ID was not populated correctly" - } + testList "EditSmallGroup" [ + test "fromGroup succeeds" { + let grp = + { SmallGroup.empty with + Id = (Guid.NewGuid >> SmallGroupId) () + Name = "test group" + ChurchId = (Guid.NewGuid >> ChurchId) () + } + let edit = EditSmallGroup.fromGroup grp + Expect.equal edit.SmallGroupId (shortGuid grp.Id.Value) "The small group ID was not filled correctly" + Expect.equal edit.Name grp.Name "The name was not filled correctly" + Expect.equal edit.ChurchId (shortGuid grp.ChurchId.Value) "The church ID was not filled correctly" + } + test "empty is as expected" { + let mt = EditSmallGroup.empty + Expect.equal mt.SmallGroupId emptyGuid "The small group ID should be an empty GUID" + Expect.equal mt.Name "" "The name should be blank" + Expect.equal mt.ChurchId emptyGuid "The church ID should be an empty GUID" + } + test "isNew works for a new small group" { + Expect.isTrue EditSmallGroup.empty.IsNew "An empty GUID should be flagged as a new small group" + } + test "isNew works for an existing small group" { + Expect.isFalse { EditSmallGroup.empty with SmallGroupId = (Guid.NewGuid >> shortGuid) () }.IsNew + "A non-empty GUID should not be flagged as a new small group" + } + test "populateGroup succeeds" { + let edit = + { EditSmallGroup.empty with + Name = "test name" + ChurchId = (Guid.NewGuid >> shortGuid) () + } + let grp = edit.populateGroup SmallGroup.empty + Expect.equal grp.Name edit.Name "The name was not populated correctly" + Expect.equal grp.ChurchId (idFromShort ChurchId edit.ChurchId) "The church ID was not populated correctly" + } ] [] let editUserTests = - testList "EditUser" [ - test "empty is as expected" { - let mt = EditUser.empty - Expect.equal mt.userId Guid.Empty "The user ID should be an empty GUID" - Expect.equal mt.firstName "" "The first name should be blank" - Expect.equal mt.lastName "" "The last name should be blank" - Expect.equal mt.emailAddress "" "The e-mail address should be blank" - Expect.equal mt.password "" "The password should be blank" - Expect.equal mt.passwordConfirm "" "The confirmed password should be blank" - Expect.isNone mt.isAdmin "The isAdmin flag should be None" - } - test "fromUser succeeds" { - let usr = - { User.empty with - userId = Guid.NewGuid () - firstName = "user" - lastName = "test" - emailAddress = "a@b.c" - } - let edit = EditUser.fromUser usr - Expect.equal edit.userId usr.userId "The user ID was not filled correctly" - Expect.equal edit.firstName usr.firstName "The first name was not filled correctly" - Expect.equal edit.lastName usr.lastName "The last name was not filled correctly" - Expect.equal edit.emailAddress usr.emailAddress "The e-mail address was not filled correctly" - Expect.isNone edit.isAdmin "The isAdmin flag was not filled correctly" - } - test "isNew works for a new user" { - Expect.isTrue (EditUser.empty.isNew ()) "An empty GUID should be flagged as a new user" - } - test "isNew works for an existing user" { - Expect.isFalse ({ EditUser.empty with userId = Guid.NewGuid () }.isNew ()) - "A non-empty GUID should not be flagged as a new user" - } - test "populateUser succeeds" { - let edit = - { EditUser.empty with - firstName = "name" - lastName = "eman" - emailAddress = "n@m.e" - isAdmin = Some true - password = "testpw" - } - let hasher = fun x -> x + "+" - let usr = edit.populateUser User.empty hasher - Expect.equal usr.firstName edit.firstName "The first name was not populated correctly" - Expect.equal usr.lastName edit.lastName "The last name was not populated correctly" - Expect.equal usr.emailAddress edit.emailAddress "The e-mail address was not populated correctly" - Expect.isTrue usr.isAdmin "The isAdmin flag was not populated correctly" - Expect.equal usr.passwordHash (hasher edit.password) "The password hash was not populated correctly" - } + testList "EditUser" [ + test "empty is as expected" { + let mt = EditUser.empty + Expect.equal mt.UserId emptyGuid "The user ID should be an empty GUID" + Expect.equal mt.FirstName "" "The first name should be blank" + Expect.equal mt.LastName "" "The last name should be blank" + Expect.equal mt.Email "" "The e-mail address should be blank" + Expect.equal mt.Password "" "The password should be blank" + Expect.equal mt.PasswordConfirm "" "The confirmed password should be blank" + Expect.isNone mt.IsAdmin "The IsAdmin flag should be None" + } + test "fromUser succeeds" { + let usr = + { User.empty with + Id = (Guid.NewGuid >> UserId) () + FirstName = "user" + LastName = "test" + Email = "a@b.c" + } + let edit = EditUser.fromUser usr + Expect.equal edit.UserId (shortGuid usr.Id.Value) "The user ID was not filled correctly" + Expect.equal edit.FirstName usr.FirstName "The first name was not filled correctly" + Expect.equal edit.LastName usr.LastName "The last name was not filled correctly" + Expect.equal edit.Email usr.Email "The e-mail address was not filled correctly" + Expect.isNone edit.IsAdmin "The IsAdmin flag was not filled correctly" + } + test "isNew works for a new user" { + Expect.isTrue EditUser.empty.IsNew "An empty GUID should be flagged as a new user" + } + test "isNew works for an existing user" { + Expect.isFalse { EditUser.empty with UserId = (Guid.NewGuid >> shortGuid) () }.IsNew + "A non-empty GUID should not be flagged as a new user" + } + test "populateUser succeeds" { + let edit = + { EditUser.empty with + FirstName = "name" + LastName = "eman" + Email = "n@m.e" + IsAdmin = Some true + Password = "testpw" + } + let hasher = fun x -> x + "+" + let usr = edit.PopulateUser User.empty hasher + Expect.equal usr.FirstName edit.FirstName "The first name was not populated correctly" + Expect.equal usr.LastName edit.LastName "The last name was not populated correctly" + Expect.equal usr.Email edit.Email "The e-mail address was not populated correctly" + Expect.isTrue usr.IsAdmin "The isAdmin flag was not populated correctly" + Expect.equal usr.PasswordHash (hasher edit.Password) "The password hash was not populated correctly" + } ] [] let groupLogOnTests = - testList "GroupLogOn" [ - test "empty is as expected" { - let mt = GroupLogOn.empty - Expect.equal mt.smallGroupId Guid.Empty "The small group ID should be an empty GUID" - Expect.equal mt.password "" "The password should be blank" - Expect.isNone mt.rememberMe "Remember Me should be None" - } + testList "GroupLogOn" [ + test "empty is as expected" { + let mt = GroupLogOn.empty + Expect.equal mt.SmallGroupId emptyGuid "The small group ID should be an empty GUID" + Expect.equal mt.Password "" "The password should be blank" + Expect.isNone mt.RememberMe "Remember Me should be None" + } ] [] let maintainRequestsTests = - testList "MaintainRequests" [ - test "empty is as expected" { - let mt = MaintainRequests.empty - Expect.isEmpty mt.requests "The requests for the model should have been empty" - Expect.equal mt.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one" - Expect.isNone mt.onlyActive "The only active flag should have been None" - Expect.isNone mt.searchTerm "The search term should have been None" - Expect.isNone mt.pageNbr "The page number should have been None" - } + testList "MaintainRequests" [ + test "empty is as expected" { + let mt = MaintainRequests.empty + Expect.isEmpty mt.Requests "The requests for the model should have been empty" + Expect.equal mt.SmallGroup.Id.Value Guid.Empty "The small group should have been an empty one" + Expect.isNone mt.OnlyActive "The only active flag should have been None" + Expect.isNone mt.SearchTerm "The search term should have been None" + Expect.isNone mt.PageNbr "The page number should have been None" + } + ] + +[] +let messageLevelTests = + testList "MessageLevel" [ + test "toString for Info is as expected" { + Expect.equal (MessageLevel.toString Info) "Info" """The string value of "Info" is incorrect""" + } + test "toString for Warning is as expected" { + Expect.equal (MessageLevel.toString Warning) "WARNING" """The string value of "Warning" is incorrect""" + } + test "toString for Error is as expected" { + Expect.equal (MessageLevel.toString Error) "ERROR" """The string value of "Error" is incorrect""" + } + test "toCssClass for Info is as expected" { + Expect.equal (MessageLevel.toCssClass Info) "info" """The string value of "Info" is incorrect""" + } + test "toCssClass for Warning is as expected" { + Expect.equal (MessageLevel.toCssClass Warning) "warning" """The string value of "Warning" is incorrect""" + } + test "toCssClass for Error is as expected" { + Expect.equal (MessageLevel.toCssClass Error) "error" """The string value of "Error" is incorrect""" + } ] [] let requestListTests = - testList "RequestList" [ - let withRequestList f () = - { requests = [ - { PrayerRequest.empty with - requestType = CurrentRequest - requestor = Some "Zeb" - text = "zyx" - updatedDate = DateTime.Today - } - { PrayerRequest.empty with - requestType = CurrentRequest - requestor = Some "Aaron" - text = "abc" - updatedDate = DateTime.Today - TimeSpan.FromDays 9. - } - { PrayerRequest.empty with - requestType = PraiseReport - text = "nmo" - updatedDate = DateTime.Today + testList "RequestList" [ + let withRequestList f () = + let today = SystemClock.Instance.GetCurrentInstant () + { Requests = [ + { PrayerRequest.empty with + RequestType = CurrentRequest + Requestor = Some "Zeb" + Text = "zyx" + UpdatedDate = today + } + { PrayerRequest.empty with + RequestType = CurrentRequest + Requestor = Some "Aaron" + Text = "abc" + UpdatedDate = today - Duration.FromDays 9 + } + { PrayerRequest.empty with + RequestType = PraiseReport + Text = "nmo" + UpdatedDate = today + } + ] + Date = today.InUtc().Date + SmallGroup = SmallGroup.empty + ShowHeader = false + Recipients = [] + CanEmail = false } + |> f + yield! testFixture withRequestList [ + "AsHtml succeeds without header or as-of date", + fun reqList -> + let htmlList = { reqList with SmallGroup = { reqList.SmallGroup with Name = "Test HTML Group" } } + let html = htmlList.AsHtml _s + let fonts = reqList.SmallGroup.Preferences.FontStack.Replace ("\"", """) + Expect.equal -1 (html.IndexOf "Test HTML Group") + "The small group name should not have existed (no header)" + let curReqHeading = + [ $"""""" + "" + """
""" + "    Current Requests   
" + ] + |> String.concat "" + Expect.stringContains html curReqHeading """Heading for category "Current Requests" not found""" + let curReqHtml = + [ $"""
    """ + """
  • """ + "Zeb – zyx
    • " + """
  • """ + "Aaron – abc
" + ] + |> String.concat "" + Expect.stringContains html curReqHtml """Expected HTML for "Current Requests" requests not found""" + let praiseHeading = + [ $"""""" + "" + """
""" + "    Praise Reports   
" + ] + |> String.concat "" + Expect.stringContains html praiseHeading """Heading for category "Praise Reports" not found""" + let praiseHtml = + [ $"""
    """ + """
  • """ + "nmo
" + ] + |> String.concat "" + Expect.stringContains html praiseHtml """Expected HTML for "Praise Reports" requests not found""" + "AsHtml succeeds with header", + fun reqList -> + let htmlList = + { reqList with + SmallGroup = { reqList.SmallGroup with Name = "Test HTML Group" } + ShowHeader = true + } + let html = htmlList.AsHtml _s + let fonts = reqList.SmallGroup.Preferences.FontStack.Replace ("\"", """) + let lstHeading = + [ $"""
""" + """Prayer Requests
""" + """Test HTML Group
""" + htmlList.Date.ToString ("MMMM d, yyyy", null) + "

" + ] + |> String.concat "" + Expect.stringContains html lstHeading "Expected HTML for the list heading not found" + // spot check; without header test tests this exhaustively + Expect.stringContains html "Zeb – zyx" "Expected requests not found" + "AsHtml succeeds with short as-of date", + fun reqList -> + let htmlList = + { reqList with + SmallGroup = + { reqList.SmallGroup with + Preferences = { reqList.SmallGroup.Preferences with AsOfDateDisplay = ShortDate } + } + } + let html = htmlList.AsHtml _s + let expected = + htmlList.Requests[0].UpdatedDate.InUtc().Date.ToString ("d", null) + |> sprintf """Zeb – zyx  (as of %s)""" + // spot check; if one request has it, they all should + Expect.stringContains html expected "Expected short as-of date not found" + "AsHtml succeeds with long as-of date", + fun reqList -> + let htmlList = + { reqList with + SmallGroup = + { reqList.SmallGroup with + Preferences = { reqList.SmallGroup.Preferences with AsOfDateDisplay = LongDate } + } + } + let html = htmlList.AsHtml _s + let expected = + htmlList.Requests[0].UpdatedDate.InUtc().Date.ToString ("D", null) + |> sprintf """Zeb – zyx  (as of %s)""" + // spot check; if one request has it, they all should + Expect.stringContains html expected "Expected long as-of date not found" + "AsText succeeds with no as-of date", + fun reqList -> + let textList = { reqList with SmallGroup = { reqList.SmallGroup with Name = "Test Group" } } + let text = textList.AsText _s + Expect.stringContains text $"{textList.SmallGroup.Name}\n" "Small group name not found" + Expect.stringContains text "Prayer Requests\n" "List heading not found" + Expect.stringContains text ((textList.Date.ToString ("MMMM d, yyyy", null)) + "\n \n") + "List date not found" + Expect.stringContains text "--------------------\n CURRENT REQUESTS\n--------------------\n" + """Heading for category "Current Requests" not found""" + Expect.stringContains text " + Zeb - zyx\n" "First request not found" + Expect.stringContains text " - Aaron - abc\n \n" + "Second request not found; should have been end of category" + Expect.stringContains text "------------------\n PRAISE REPORTS\n------------------\n" + """Heading for category "Praise Reports" not found""" + Expect.stringContains text " + nmo\n \n" "Last request not found" + "AsText succeeds with short as-of date", + fun reqList -> + let textList = + { reqList with + SmallGroup = + { reqList.SmallGroup with + Preferences = { reqList.SmallGroup.Preferences with AsOfDateDisplay = ShortDate } + } + } + let text = textList.AsText _s + let expected = + textList.Requests[0].UpdatedDate.InUtc().Date.ToString ("d", null) + |> sprintf " + Zeb - zyx (as of %s)" + // spot check; if one request has it, they all should + Expect.stringContains text expected "Expected short as-of date not found" + "AsText succeeds with long as-of date", + fun reqList -> + let textList = + { reqList with + SmallGroup = + { reqList.SmallGroup with + Preferences = { reqList.SmallGroup.Preferences with AsOfDateDisplay = LongDate } + } + } + let text = textList.AsText _s + let expected = + textList.Requests[0].UpdatedDate.InUtc().Date.ToString ("D", null) + |> sprintf " + Zeb - zyx (as of %s)" + // spot check; if one request has it, they all should + Expect.stringContains text expected "Expected long as-of date not found" + "IsNew succeeds for both old and new requests", + fun reqList -> + let allReqs = reqList.RequestsByType _s + let _, _, reqs = allReqs |> List.find (fun (typ, _, _) -> typ = CurrentRequest) + Expect.hasCountOf reqs 2u countAll "There should have been two requests" + Expect.isTrue (reqList.IsNew (List.head reqs)) "The first request should have been new" + Expect.isFalse (reqList.IsNew (List.last reqs)) "The second request should not have been new" + "RequestsByType succeeds", + fun reqList -> + let allReqs = reqList.RequestsByType _s + Expect.hasLength allReqs 2 "There should have been two types of request groupings" + let maybeCurrent = allReqs |> List.tryFind (fun (typ, _, _) -> typ = CurrentRequest) + Expect.isSome maybeCurrent "There should have been current requests" + let _, _, reqs = Option.get maybeCurrent + Expect.hasCountOf reqs 2u countAll "There should have been two requests" + let first = List.head reqs + Expect.equal first.Text "zyx" "The requests should be sorted by updated date descending" + Expect.isTrue (allReqs |> List.exists (fun (typ, _, _) -> typ = PraiseReport)) + "There should have been praise reports" + Expect.isFalse (allReqs |> List.exists (fun (typ, _, _) -> typ = Announcement)) + "There should not have been announcements" + "RequestsByType succeeds and sorts by requestor", + fun reqList -> + let newList = + { reqList with + SmallGroup = + { reqList.SmallGroup with + Preferences = { reqList.SmallGroup.Preferences with RequestSort = SortByRequestor } + } + } + let allReqs = newList.RequestsByType _s + let _, _, reqs = allReqs |> List.find (fun (typ, _, _) -> typ = CurrentRequest) + Expect.hasCountOf reqs 2u countAll "There should have been two requests" + let first = List.head reqs + Expect.equal first.Text "abc" "The requests should be sorted by requestor" ] - date = DateTime.Today - listGroup = SmallGroup.empty - showHeader = false - recipients = [] - canEmail = false - } - |> f - yield! testFixture withRequestList [ - "asHtml succeeds without header or as-of date", - fun reqList -> - let htmlList = { reqList with listGroup = { reqList.listGroup with name = "Test HTML Group" } } - let html = htmlList.asHtml _s - Expect.equal -1 (html.IndexOf "Test HTML Group") "The small group name should not have existed (no header)" - let curReqHeading = - [ "" - "" - "
" - "    Current Requests   
" - ] - |> String.concat "" - Expect.stringContains html curReqHeading "Heading for category \"Current Requests\" not found" - let curReqHtml = - [ "
    " - "
  • " - "Zeb — zyx
    • " - "
  • " - "Aaron — abc
" - ] - |> String.concat "" - Expect.stringContains html curReqHtml "Expected HTML for \"Current Requests\" requests not found" - let praiseHeading = - [ "" - "" - "
" - "    Praise Reports   
" - ] - |> String.concat "" - Expect.stringContains html praiseHeading "Heading for category \"Praise Reports\" not found" - let praiseHtml = - [ "
    " - "
  • " - "nmo
" - ] - |> String.concat "" - Expect.stringContains html praiseHtml "Expected HTML for \"Praise Reports\" requests not found" - "asHtml succeeds with header", - fun reqList -> - let htmlList = - { reqList with - listGroup = { reqList.listGroup with name = "Test HTML Group" } - showHeader = true - } - let html = htmlList.asHtml _s - let lstHeading = - [ "
" - "Prayer Requests
" - "Test HTML Group
" - htmlList.date.ToString "MMMM d, yyyy" - "

" - ] - |> String.concat "" - Expect.stringContains html lstHeading "Expected HTML for the list heading not found" - // spot check; without header test tests this exhaustively - Expect.stringContains html "Zeb — zyx" "Expected requests not found" - "asHtml succeeds with short as-of date", - fun reqList -> - let htmlList = - { reqList with - listGroup = - { reqList.listGroup with - preferences = { reqList.listGroup.preferences with asOfDateDisplay = ShortDate } - } - } - let html = htmlList.asHtml _s - let expected = - htmlList.requests.[0].updatedDate.ToShortDateString () - |> sprintf "Zeb — zyx  (as of %s)" - // spot check; if one request has it, they all should - Expect.stringContains html expected "Expected short as-of date not found" - "asHtml succeeds with long as-of date", - fun reqList -> - let htmlList = - { reqList with - listGroup = - { reqList.listGroup with - preferences = { reqList.listGroup.preferences with asOfDateDisplay = LongDate } - } - } - let html = htmlList.asHtml _s - let expected = - htmlList.requests.[0].updatedDate.ToLongDateString () - |> sprintf "Zeb — zyx  (as of %s)" - // spot check; if one request has it, they all should - Expect.stringContains html expected "Expected long as-of date not found" - "asText succeeds with no as-of date", - fun reqList -> - let textList = { reqList with listGroup = { reqList.listGroup with name = "Test Group" } } - let text = textList.asText _s - Expect.stringContains text (textList.listGroup.name + "\n") "Small group name not found" - Expect.stringContains text "Prayer Requests\n" "List heading not found" - Expect.stringContains text ((textList.date.ToString "MMMM d, yyyy") + "\n \n") "List date not found" - Expect.stringContains text "--------------------\n CURRENT REQUESTS\n--------------------\n" - "Heading for category \"Current Requests\" not found" - Expect.stringContains text " + Zeb - zyx\n" "First request not found" - Expect.stringContains text " - Aaron - abc\n \n" "Second request not found; should have been end of category" - Expect.stringContains text "------------------\n PRAISE REPORTS\n------------------\n" - "Heading for category \"Praise Reports\" not found" - Expect.stringContains text " + nmo\n \n" "Last request not found" - "asText succeeds with short as-of date", - fun reqList -> - let textList = - { reqList with - listGroup = - { reqList.listGroup with - preferences = { reqList.listGroup.preferences with asOfDateDisplay = ShortDate } - } - } - let text = textList.asText _s - let expected = - textList.requests.[0].updatedDate.ToShortDateString () - |> sprintf " + Zeb - zyx (as of %s)" - // spot check; if one request has it, they all should - Expect.stringContains text expected "Expected short as-of date not found" - "asText succeeds with long as-of date", - fun reqList -> - let textList = - { reqList with - listGroup = - { reqList.listGroup with - preferences = { reqList.listGroup.preferences with asOfDateDisplay = LongDate } - } - } - let text = textList.asText _s - let expected = - textList.requests.[0].updatedDate.ToLongDateString () - |> sprintf " + Zeb - zyx (as of %s)" - // spot check; if one request has it, they all should - Expect.stringContains text expected "Expected long as-of date not found" - "isNew succeeds for both old and new requests", - fun reqList -> - let reqs = reqList.requestsInCategory CurrentRequest - Expect.hasCountOf reqs 2u countAll "There should have been two requests" - Expect.isTrue (reqList.isNew (List.head reqs)) "The first request should have been new" - Expect.isFalse (reqList.isNew (List.last reqs)) "The second request should not have been new" - "requestsInCategory succeeds when requests exist", - fun reqList -> - let reqs = reqList.requestsInCategory CurrentRequest - Expect.hasCountOf reqs 2u countAll "There should have been two requests" - let first = List.head reqs - Expect.equal first.text "zyx" "The requests should be sorted by updated date descending" - "requestsInCategory succeeds when requests do not exist", - fun reqList -> - Expect.isEmpty (reqList.requestsInCategory Announcement) "There should have been no \"Announcement\" requests" - "requestsInCategory succeeds and sorts by requestor", - fun reqList -> - let newList = - { reqList with - listGroup = - { reqList.listGroup with - preferences = { reqList.listGroup.preferences with requestSort = SortByRequestor } - } - } - let reqs = newList.requestsInCategory CurrentRequest - Expect.hasCountOf reqs 2u countAll "There should have been two requests" - let first = List.head reqs - Expect.equal first.text "abc" "The requests should be sorted by requestor" - ] ] [] let userLogOnTests = - testList "UserLogOn" [ - test "empty is as expected" { - let mt = UserLogOn.empty - Expect.equal mt.emailAddress "" "The e-mail address should be blank" - Expect.equal mt.password "" "The password should be blank" - Expect.equal mt.smallGroupId Guid.Empty "The small group ID should be an empty GUID" - Expect.isNone mt.rememberMe "Remember Me should be None" - Expect.isNone mt.redirectUrl "Redirect URL should be None" - } + testList "UserLogOn" [ + test "empty is as expected" { + let mt = UserLogOn.empty + Expect.equal mt.Email "" "The e-mail address should be blank" + Expect.equal mt.Password "" "The password should be blank" + Expect.equal mt.SmallGroupId emptyGuid "The small group ID should be an empty GUID" + Expect.isNone mt.RememberMe "Remember Me should be None" + Expect.isNone mt.RedirectUrl "Redirect URL should be None" + } ] [] let userMessageTests = - testList "UserMessage" [ - test "Error is constructed properly" { - let msg = UserMessage.error - Expect.equal msg.level "ERROR" "Incorrect message level" - Expect.equal msg.text HtmlString.Empty "Text should have been blank" - Expect.isNone msg.description "Description should have been None" - } - test "Warning is constructed properly" { - let msg = UserMessage.warning - Expect.equal msg.level "WARNING" "Incorrect message level" - Expect.equal msg.text HtmlString.Empty "Text should have been blank" - Expect.isNone msg.description "Description should have been None" - } - test "Info is constructed properly" { - let msg = UserMessage.info - Expect.equal msg.level "Info" "Incorrect message level" - Expect.equal msg.text HtmlString.Empty "Text should have been blank" - Expect.isNone msg.description "Description should have been None" - } + testList "UserMessage" [ + test "Error is constructed properly" { + let msg = UserMessage.error + Expect.equal msg.Level Error "Incorrect message level" + Expect.equal msg.Text HtmlString.Empty "Text should have been blank" + Expect.isNone msg.Description "Description should have been None" + } + test "Warning is constructed properly" { + let msg = UserMessage.warning + Expect.equal msg.Level Warning "Incorrect message level" + Expect.equal msg.Text HtmlString.Empty "Text should have been blank" + Expect.isNone msg.Description "Description should have been None" + } + test "Info is constructed properly" { + let msg = UserMessage.info + Expect.equal msg.Level Info "Incorrect message level" + Expect.equal msg.Text HtmlString.Empty "Text should have been blank" + Expect.isNone msg.Description "Description should have been None" + } ] diff --git a/src/PrayerTracker.UI/Church.fs b/src/PrayerTracker.UI/Church.fs index cdeed04..de740fc 100644 --- a/src/PrayerTracker.UI/Church.fs +++ b/src/PrayerTracker.UI/Church.fs @@ -1,109 +1,122 @@ module PrayerTracker.Views.Church open Giraffe.ViewEngine +open Giraffe.ViewEngine.Accessibility +open Giraffe.ViewEngine.Htmx +open PrayerTracker open PrayerTracker.Entities open PrayerTracker.ViewModels /// View for the church edit page -let edit (m : EditChurch) ctx vi = - let pageTitle = match m.isNew () with true -> "Add a New Church" | false -> "Edit Church" - let s = I18N.localizer.Force () - [ form [ _action "/web/church/save"; _method "post"; _class "pt-center-columns" ] [ - style [ _scoped ] - [ rawText "#name { width: 20rem; } #city { width: 10rem; } #st { width: 3rem; } #interfaceAddress { width: 30rem; }" ] - csrfToken ctx - input [ _type "hidden"; _name "churchId"; _value (flatGuid m.churchId) ] - div [ _class "pt-field-row" ] [ - div [ _class "pt-field" ] [ - 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 ] - ] +let edit (model : EditChurch) ctx viewInfo = + let pageTitle = if model.IsNew then "Add a New Church" else "Edit Church" + let s = I18N.localizer.Force () + let vi = + viewInfo + |> AppViewInfo.withScopedStyles [ + $"#{nameof model.Name} {{ width: 20rem; }}" + $"#{nameof model.City} {{ width: 10rem; }}" + $"#{nameof model.State} {{ width: 3rem; }}" + $"#{nameof model.InterfaceAddress} {{ width: 30rem; }}" ] - div [ _class "pt-field-row" ] [ - div [ _class "pt-checkbox-field" ] [ - input [ _type "checkbox" - _name "hasInterface" - _id "hasInterface" - _value "True" - match m.hasInterface with Some x when x -> _checked | _ -> () ] - label [ _for "hasInterface" ] [ locStr s.["Has an interface with Virtual Prayer Room"] ] - ] + |> AppViewInfo.withOnLoadScript "PT.church.edit.onPageLoad" + form [ _action "/church/save"; _method "post"; _class "pt-center-columns"; Target.content ] [ + csrfToken ctx + input [ _type "hidden"; _name (nameof model.ChurchId); _value model.ChurchId ] + div [ _fieldRow ] [ + div [ _inputField ] [ + label [ _for (nameof model.Name) ] [ locStr s["Church Name"] ] + 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 [ _class "pt-field" ] [ - label [ _for "interfaceAddress" ] [ locStr s.["VPR Interface URL"] ] - input [ _type "url"; _name "interfaceAddress"; _id "interfaceAddress"; - _value (match m.interfaceAddress with Some ia -> ia | None -> "") ] - ] + div [ _fieldRow ] [ + div [ _checkboxField ] [ + inputField "checkbox" (nameof model.HasInterface) "True" + [ if defaultArg model.HasInterface false then _checked ] + 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"] ] - ] - script [] [ rawText "PT.onLoad(PT.church.edit.onPageLoad)" ] + div [ _fieldRowWith [ "pt-fadeable" ]; _id "divInterfaceAddress" ] [ + div [ _inputField ] [ + 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 - |> Layout.standard vi pageTitle + |> List.singleton + |> Layout.Content.standard + |> Layout.standard vi pageTitle /// View for church maintenance page -let maintain (churches : Church list) (stats : Map) ctx vi = - let s = I18N.localizer.Force () - let chTbl = - match churches with - | [] -> space - | _ -> - table [ _class "pt-table pt-action-table" ] [ - thead [] [ - tr [] [ - th [] [ locStr s.["Actions"] ] - th [] [ locStr s.["Name"] ] - th [] [ locStr s.["Location"] ] - th [] [ locStr s.["Groups"] ] - th [] [ locStr s.["Requests"] ] - th [] [ locStr s.["Users"] ] - th [] [ locStr s.["Interface?"] ] - ] +let maintain (churches : Church list) (stats : Map) ctx viewInfo = + let s = I18N.localizer.Force () + let vi = AppViewInfo.withScopedStyles [ "#churchList { grid-template-columns: repeat(7, auto); }" ] viewInfo + let churchTable = + match churches with + | [] -> space + | _ -> + section [ _id "churchList"; _class "pt-table"; _ariaLabel "Church list" ] [ + div [ _class "row head" ] [ + header [ _class "cell" ] [ locStr s["Actions"] ] + header [ _class "cell" ] [ locStr s["Name"] ] + header [ _class "cell" ] [ locStr s["Location"] ] + header [ _class "cell" ] [ locStr s["Groups"] ] + header [ _class "cell" ] [ locStr s["Requests"] ] + header [ _class "cell" ] [ locStr s["Users"] ] + 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 - |> List.map (fun ch -> - let chId = flatGuid ch.churchId - let delAction = $"/web/church/{chId}/delete" - let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.", - $"""{s.["Church"].Value.ToLower ()} ({ch.name})"""] - tr [] [ - td [] [ - a [ _href $"/web/church/{chId}/edit"; _title s.["Edit This Church"].Value ] [ icon "edit" ] - a [ _href delAction - _title s.["Delete This Church"].Value - _onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ] - [ 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 "  "; locStr s.["Add a New Church"] ] - br [] - br [] - ] - tableSummary churches.Length s - chTbl - form [ _id "DeleteForm"; _action ""; _method "post" ] [ csrfToken ctx ] + [ div [ _class "pt-center-text" ] [ + br [] + a [ _href $"/church/{emptyGuid}/edit"; _title s["Add a New Church"].Value ] [ + icon "add_circle"; rawText "  "; locStr s["Add a New Church"] + ] + br [] + br [] + ] + tableSummary churches.Length s + form [ _method "post" ] [ + csrfToken ctx + churchTable + ] ] - |> Layout.Content.wide - |> Layout.standard vi "Maintain Churches" + |> Layout.Content.wide + |> Layout.standard vi "Maintain Churches" diff --git a/src/PrayerTracker.UI/CommonFunctions.fs b/src/PrayerTracker.UI/CommonFunctions.fs index 8d55bc8..dd192bc 100644 --- a/src/PrayerTracker.UI/CommonFunctions.fs +++ b/src/PrayerTracker.UI/CommonFunctions.fs @@ -1,26 +1,24 @@ [] module PrayerTracker.Views.CommonFunctions +open System.IO +open System.Text.Encodings.Web open Giraffe open Giraffe.ViewEngine open Microsoft.AspNetCore.Antiforgery -open Microsoft.AspNetCore.Html open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Mvc.Localization open Microsoft.Extensions.Localization -open System -open System.IO -open System.Text.Encodings.Web /// Encoded text for a localized string let locStr (text : LocalizedString) = str text.Value /// Raw text for a localized HTML string let rawLocText (writer : StringWriter) (text : LocalizedHtmlString) = - text.WriteTo (writer, HtmlEncoder.Default) - let txt = string writer - writer.GetStringBuilder().Clear () |> ignore - rawText txt + text.WriteTo (writer, HtmlEncoder.Default) + let txt = string writer + writer.GetStringBuilder().Clear () |> ignore + rawText txt /// A space (used for back-to-back localization string breaks) let space = rawText " " @@ -29,106 +27,153 @@ let space = rawText " " let icon name = i [ _class "material-icons" ] [ rawText name ] /// Generate a Material Design icon, specifying the point size (must be defined in CSS) -let iconSized size name = i [ _class $"material-icons md-{size}" ] [ rawText name ] +let iconSized size name = i [ _class $"material-icons md-%i{size}" ] [ rawText name ] /// Generate a CSRF prevention token let csrfToken (ctx : HttpContext) = - let antiForgery = ctx.GetService () - let tokenSet = antiForgery.GetAndStoreTokens ctx - input [ _type "hidden"; _name tokenSet.FormFieldName; _value tokenSet.RequestToken ] + let antiForgery = ctx.GetService () + let tokenSet = antiForgery.GetAndStoreTokens ctx + input [ _type "hidden"; _name tokenSet.FormFieldName; _value tokenSet.RequestToken ] /// Create a summary for a table of items let tableSummary itemCount (s : IStringLocalizer) = - div [ _class "pt-center-text" ] [ - small [] [ - match itemCount with - | 0 -> s.["No Entries to Display"] - | 1 -> s.["Displaying {0} Entry", itemCount] - | _ -> s.["Displaying {0} Entries", itemCount] - |> locStr - ] + div [ _class "pt-center-text" ] [ + small [] [ + match itemCount with + | 0 -> s["No Entries to Display"] + | 1 -> s["Displaying {0} Entry", itemCount] + | _ -> s["Displaying {0} Entries", itemCount] + |> locStr + ] ] /// Generate a list of named HTML colors let namedColorList name selected attrs (s : IStringLocalizer) = - /// The list of HTML named colors (name, display, text color) - seq { - ("aqua", s.["Aqua"], "black") - ("black", s.["Black"], "white") - ("blue", s.["Blue"], "white") - ("fuchsia", s.["Fuchsia"], "black") - ("gray", s.["Gray"], "white") - ("green", s.["Green"], "white") - ("lime", s.["Lime"], "black") - ("maroon", s.["Maroon"], "white") - ("navy", s.["Navy"], "white") - ("olive", s.["Olive"], "white") - ("purple", s.["Purple"], "white") - ("red", s.["Red"], "black") - ("silver", s.["Silver"], "black") - ("teal", s.["Teal"], "white") - ("white", s.["White"], "black") - ("yellow", s.["Yellow"], "black") + // The list of HTML named colors (name, display, text color) + seq { + ("aqua", s["Aqua"], "black") + ("black", s["Black"], "white") + ("blue", s["Blue"], "white") + ("fuchsia", s["Fuchsia"], "black") + ("gray", s["Gray"], "white") + ("green", s["Green"], "white") + ("lime", s["Lime"], "black") + ("maroon", s["Maroon"], "white") + ("navy", s["Navy"], "white") + ("olive", s["Olive"], "white") + ("purple", s["Purple"], "white") + ("red", s["Red"], "black") + ("silver", s["Silver"], "black") + ("teal", s["Teal"], "white") + ("white", s["White"], "black") + ("yellow", s["Yellow"], "black") } - |> Seq.map (fun color -> - let (colorName, dispText, txtColor) = color - option [ yield _value colorName - yield _style $"background-color:{colorName};color:{txtColor};" - match colorName = selected with true -> yield _selected | false -> () ] [ - encodedText (dispText.Value.ToLower ()) - ]) - |> List.ofSeq - |> select (_name name :: attrs) + |> Seq.map (fun color -> + let colorName, text, txtColor = color + option + [ _value colorName + _style $"background-color:{colorName};color:{txtColor};" + if colorName = selected then _selected + ] [ encodedText (text.Value.ToLower ()) ]) + |> List.ofSeq + |> 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 let radio name domId value current = - input [ _type "radio" - _name name - _id domId - _value value - match value = current with true -> _checked | false -> () ] + input [ _type "radio" + _name name + if domId <> "" then _id domId + _value value + if value = current then _checked ] /// Generate a select list with the current value selected let selectList name selected attrs items = - items - |> Seq.map (fun (value, text) -> - option [ _value value - match value = selected with true -> _selected | false -> () ] [ encodedText text ]) - |> List.ofSeq - |> select (List.concat [ [ _name name; _id name ]; attrs ]) + items + |> Seq.map (fun (value, text) -> + option + [ _value value + if value = selected then _selected + ] [ encodedText text ]) + |> List.ofSeq + |> select (List.concat [ [ _name name; _id name ]; attrs ]) /// Generate the text for a default entry at the top of a select list -let selectDefault text = $"— {text} —" +let selectDefault text = $"— %s{text} —" /// Generate a standard submit button with icon and text let submit attrs ico text = button (_type "submit" :: attrs) [ icon ico; rawText "  "; locStr text ] -/// Format a GUID with no dashes (used for URLs and forms) -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 +/// Create an HTML onsubmit event handler let _onsubmit = attr "onsubmit" -/// scoped flag (used for