Compare commits
	
		
			17 Commits
		
	
	
		
	
	| Author | SHA1 | Date | |
|---|---|---|---|
| 733a730591 | |||
| 0c1285eaa7 | |||
| c9ccfe8b68 | |||
| 2e5a1426f6 | |||
| 05394b4461 | |||
| 14b0a58d98 | |||
| bade89dd37 | |||
| 26f408bb54 | |||
| 9d71177352 | |||
| 2b5ec692f2 | |||
| d86249c18e | |||
| 194cd2b5cc | |||
| 42e3a58131 | |||
| facc294d66 | |||
| 5240b78487 | |||
| 7fb1eca2a3 | |||
| ae8cf9ad80 | 
| @ -3,10 +3,11 @@ | ||||
|   "isRoot": true, | ||||
|   "tools": { | ||||
|     "fake-cli": { | ||||
|       "version": "5.23.0", | ||||
|       "version": "6.1.3", | ||||
|       "commands": [ | ||||
|         "fake" | ||||
|       ] | ||||
|       ], | ||||
|       "rollForward": false | ||||
|     } | ||||
|   } | ||||
| } | ||||
| @ -1,44 +1,50 @@ | ||||
| #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/net7.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" | ||||
| open Fake.Core | ||||
| open Fake.DotNet | ||||
| open Fake.IO | ||||
| open Fake.IO.Globbing.Operators | ||||
| 
 | ||||
| let execContext = Context.FakeExecutionContext.Create false "build.fsx" [] | ||||
| Context.setExecutionContext (Context.RuntimeContext.Fake execContext) | ||||
| 
 | ||||
| /// The root path to the projects within this solution | ||||
| let projPath = "src" | ||||
| 
 | ||||
| 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" | ||||
|     Testing.Expecto.run | ||||
|         (fun opts -> { opts with WorkingDirectory = $"{testPath}/bin/Release/net9.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/PrayerTracker.fsproj") | ||||
| 
 | ||||
| Target.create "All" ignore | ||||
| 
 | ||||
| open Fake.Core.TargetOperators | ||||
| 
 | ||||
| let dependencies = [ | ||||
|     "Clean" | ||||
|         ==> "Test" | ||||
|         ==> "Publish" | ||||
|         ==> "All" | ||||
| ] | ||||
| 
 | ||||
| [<EntryPoint>] | ||||
| let main args = | ||||
|     try | ||||
|         match args with | ||||
|         | [| target |] -> Target.runOrDefault target | ||||
|         | _ -> Target.runOrDefault "All" | ||||
|         0 | ||||
|     with e -> | ||||
|         printfn "%A" e | ||||
|         1 | ||||
							
								
								
									
										19
									
								
								build.fsproj
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										19
									
								
								build.fsproj
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,19 @@ | ||||
| <Project Sdk="Microsoft.NET.Sdk"> | ||||
| 
 | ||||
|   <PropertyGroup> | ||||
|     <OutputType>Exe</OutputType> | ||||
|     <TargetFramework>net9.0</TargetFramework> | ||||
|   </PropertyGroup> | ||||
| 
 | ||||
|   <ItemGroup> | ||||
|     <Compile Include="build.fs" /> | ||||
|   </ItemGroup> | ||||
|    | ||||
|   <ItemGroup> | ||||
|     <PackageReference Include="Fake.Core.Target" Version="6.1.3" /> | ||||
|     <PackageReference Include="Fake.DotNet.Cli" Version="6.1.3" /> | ||||
|     <PackageReference Include="Fake.Dotnet.Testing.Expecto" Version="6.1.3" /> | ||||
|     <PackageReference Include="MSBuild.StructuredLogger" Version="2.2.386" /> | ||||
|   </ItemGroup> | ||||
| 
 | ||||
| </Project> | ||||
							
								
								
									
										233
									
								
								build.fsx.lock
									
									
									
									
									
								
							
							
						
						
									
										233
									
								
								build.fsx.lock
									
									
									
									
									
								
							| @ -1,233 +0,0 @@ | ||||
| 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)) | ||||
							
								
								
									
										7
									
								
								fake.sh
									
									
									
									
									
								
							
							
						
						
									
										7
									
								
								fake.sh
									
									
									
									
									
								
							| @ -1,7 +0,0 @@ | ||||
| #!/usr/bin/env bash | ||||
| 
 | ||||
| set -eu | ||||
| set -o pipefail | ||||
| 
 | ||||
| dotnet tool restore | ||||
| dotnet fake "$@" | ||||
							
								
								
									
										456
									
								
								src/Data/Access.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										456
									
								
								src/Data/Access.fs
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,456 @@ | ||||
| namespace PrayerTracker.Data | ||||
| 
 | ||||
| /// Table names | ||||
| [<RequireQualifiedAccess>] | ||||
| module Table = | ||||
| 
 | ||||
|     /// The church table | ||||
|     [<Literal>] | ||||
|     let Church = "church" | ||||
| 
 | ||||
|     /// The small group table | ||||
|     [<Literal>] | ||||
|     let Group = "small_group" | ||||
| 
 | ||||
|     /// The small group member table | ||||
|     [<Literal>] | ||||
|     let Member = "member" | ||||
| 
 | ||||
|     /// The prayer request table | ||||
|     [<Literal>] | ||||
|     let Request = "prayer_request" | ||||
| 
 | ||||
|     /// The user table | ||||
|     [<Literal>] | ||||
|     let User = "pt_user" | ||||
| 
 | ||||
| 
 | ||||
| open System | ||||
| open NodaTime | ||||
| open PrayerTracker.Entities | ||||
| 
 | ||||
| /// JSON serialization customizations | ||||
| [<RequireQualifiedAccess>] | ||||
| module Json = | ||||
| 
 | ||||
|     open System.Text.Json.Serialization | ||||
| 
 | ||||
|     /// Convert a wrapped DU to/from its string representation | ||||
|     type WrappedJsonConverter<'T>(wrap: string -> 'T, unwrap: 'T -> string) = | ||||
|         inherit JsonConverter<'T>() | ||||
|         override _.Read(reader, _, _) = wrap (reader.GetString()) | ||||
|         override _.Write(writer, value, _) = writer.WriteStringValue(unwrap value) | ||||
| 
 | ||||
|     open System.Text.Json | ||||
|     open NodaTime.Serialization.SystemTextJson | ||||
| 
 | ||||
|     /// JSON serializer options to support the target domain | ||||
|     let options = | ||||
|         let opts = JsonSerializerOptions() | ||||
| 
 | ||||
|         [ WrappedJsonConverter<AsOfDateDisplay>(AsOfDateDisplay.Parse, string) :> JsonConverter | ||||
|           WrappedJsonConverter<EmailFormat>(EmailFormat.Parse, string) | ||||
|           WrappedJsonConverter<Expiration>(Expiration.Parse, string) | ||||
|           WrappedJsonConverter<PrayerRequestType>(PrayerRequestType.Parse, string) | ||||
|           WrappedJsonConverter<RequestSort>(RequestSort.Parse, string) | ||||
|           WrappedJsonConverter<TimeZoneId>(TimeZoneId, string) | ||||
|           WrappedJsonConverter<ChurchId>(Guid.Parse >> ChurchId, string) | ||||
|           WrappedJsonConverter<MemberId>(Guid.Parse >> MemberId, string) | ||||
|           WrappedJsonConverter<PrayerRequestId>(Guid.Parse >> PrayerRequestId, string) | ||||
|           WrappedJsonConverter<SmallGroupId>(Guid.Parse >> SmallGroupId, string) | ||||
|           WrappedJsonConverter<UserId>(Guid.Parse >> UserId, string) | ||||
|           JsonFSharpConverter() ] | ||||
|         |> List.iter opts.Converters.Add | ||||
| 
 | ||||
|         let _ = opts.ConfigureForNodaTime DateTimeZoneProviders.Tzdb | ||||
|         opts.PropertyNamingPolicy <- JsonNamingPolicy.CamelCase | ||||
|         opts.DefaultIgnoreCondition <- JsonIgnoreCondition.WhenWritingNull | ||||
|         opts | ||||
| 
 | ||||
| 
 | ||||
| module private Helpers = | ||||
|     let instant (it: Instant) = | ||||
|         it.ToString() | ||||
| 
 | ||||
| open BitBadger.Documents | ||||
| open BitBadger.Documents.Sqlite | ||||
| 
 | ||||
| /// Establish the required data environment | ||||
| [<RequireQualifiedAccess>] | ||||
| module Connection = | ||||
| 
 | ||||
|     open System.Text.Json | ||||
| 
 | ||||
|     /// Ensure tables and indexes are defined | ||||
|     let setUp () = | ||||
|         backgroundTask { | ||||
|             Configuration.useIdField "id" | ||||
| 
 | ||||
|             Configuration.useSerializer | ||||
|                 { new IDocumentSerializer with | ||||
|                     member _.Serialize<'T>(it: 'T) = | ||||
|                         JsonSerializer.Serialize(it, Json.options) | ||||
| 
 | ||||
|                     member _.Deserialize<'T>(it: string) = | ||||
|                         JsonSerializer.Deserialize<'T>(it, Json.options) } | ||||
| 
 | ||||
|             let! tables = Custom.list<string> "SELECT name FROM sqlite_master WHERE type = 'table'" [] _.GetString(0) | ||||
| 
 | ||||
|             if not (List.contains Table.Church tables) then | ||||
|                 do! Definition.ensureTable Table.Church | ||||
| 
 | ||||
|             if not (List.contains Table.Group tables) then | ||||
|                 do! Definition.ensureTable Table.Group | ||||
|                 do! Definition.ensureFieldIndex Table.Group "church" [ "churchId" ] | ||||
| 
 | ||||
|             if not (List.contains Table.Member tables) then | ||||
|                 do! Definition.ensureTable Table.Member | ||||
|                 do! Definition.ensureFieldIndex Table.Member "group" [ "smallGroupId" ] | ||||
| 
 | ||||
|             if not (List.contains Table.Request tables) then | ||||
|                 do! Definition.ensureTable Table.Request | ||||
|                 do! Definition.ensureFieldIndex Table.Request "group" [ "smallGroupId" ] | ||||
| 
 | ||||
|             if not (List.contains Table.User tables) then | ||||
|                 do! Definition.ensureTable Table.User | ||||
|                 do! Definition.ensureFieldIndex Table.User "email" [ "email" ] | ||||
|         } | ||||
| 
 | ||||
| 
 | ||||
| open Microsoft.Data.Sqlite | ||||
| 
 | ||||
| /// Functions to retrieve small group information | ||||
| module SmallGroups = | ||||
| 
 | ||||
|     /// Query to retrieve data for a small group info instance | ||||
|     let private infoQuery = | ||||
|         $"SELECT g.data->>'id' AS id, g.data->>'name' AS groupName, c.data->>'name' AS churchName, | ||||
|                  g.data->'preferences'->>'timeZoneId' AS timeZoneId, g.data->'preferences'->>'isPublic' AS isPublic | ||||
|             FROM {Table.Group} g | ||||
|                  INNER JOIN {Table.Church} c ON c.data->>'id' = g.data->>'churchId'" | ||||
| 
 | ||||
|     /// Query to retrieve data for a small group select list item | ||||
|     let private itemQuery = | ||||
|         $"SELECT g.data->>'name' AS groupName, g.data->>'id' AS id, c.data->>'name' AS churchName | ||||
|             FROM {Table.Group} g | ||||
|                  INNER JOIN {Table.Church} c ON c.data->>'id' = g.data->>'churchId'" | ||||
| 
 | ||||
|     /// The ORDER BY clause for select list item queries | ||||
|     let private itemOrderBy = | ||||
|         Query.orderBy | ||||
|             [ { Field.Named "name" with Qualifier = Some "c" }; { Field.Named "name" with Qualifier = Some "g" } ] | ||||
|             SQLite | ||||
| 
 | ||||
|     /// Map a row to a Small Group list item | ||||
|     let private toSmallGroupItem (rdr: SqliteDataReader) = | ||||
|         (rdr.GetOrdinal >> rdr.GetString >> Guid.Parse >> Giraffe.ShortGuid.fromGuid) "id", | ||||
|         $"""{(rdr.GetOrdinal >> rdr.GetString) "churchName"} | {(rdr.GetOrdinal >> rdr.GetString) "groupName"}""" | ||||
| 
 | ||||
|     /// Get the group IDs for the given church | ||||
|     let internal groupIdsByChurch (churchId: ChurchId) = | ||||
|         backgroundTask { | ||||
|             let! groups = Find.byFields<SmallGroup> Table.Group All [ Field.Equal "churchId" (string churchId) ] | ||||
|             return groups |> List.map _.Id | ||||
|         } | ||||
| 
 | ||||
|     /// Count the number of small groups for a church | ||||
|     let countByChurch (churchId: ChurchId) = | ||||
|         Count.byFields Table.Group All [ Field.Equal "churchId" (string churchId) ] | ||||
| 
 | ||||
|     /// Delete a small group by its ID | ||||
|     let deleteById (groupId: SmallGroupId) = | ||||
|         backgroundTask { | ||||
|             use conn = Configuration.dbConn () | ||||
|             use! txn = conn.BeginTransactionAsync() | ||||
| 
 | ||||
|             let! users = | ||||
|                 Find.byFields<User> Table.User All [ Field.InArray "smallGroups" Table.User [ (string groupId) ] ] | ||||
| 
 | ||||
|             for user in users do | ||||
|                 do! Patch.byId Table.User user.Id {| SmallGroups = user.SmallGroups |> List.except [ groupId ] |} | ||||
| 
 | ||||
|             do! conn.deleteByFields Table.Request All [ Field.Equal "smallGroupId" (string groupId) ] | ||||
|             do! conn.deleteById Table.Group (string groupId) | ||||
| 
 | ||||
|             do! txn.CommitAsync() | ||||
|         } | ||||
| 
 | ||||
|     /// Get information for all small groups | ||||
|     let infoForAll () = | ||||
|         Custom.list $"{infoQuery} ORDER BY g.data->>'name'" [] SmallGroupInfo.FromReader | ||||
| 
 | ||||
|     /// Get a list of small group IDs along with a description that includes the church name | ||||
|     let listAll () = | ||||
|         Custom.list $"{itemQuery} {itemOrderBy}" [] toSmallGroupItem | ||||
| 
 | ||||
|     /// Get a list of small group IDs and descriptions for groups with a group password | ||||
|     let listProtected () = | ||||
|         Custom.list | ||||
|             $"{itemQuery} WHERE COALESCE(g.data->'preferences'->>'groupPassword', '') <> '' {itemOrderBy}" | ||||
|             [] | ||||
|             toSmallGroupItem | ||||
| 
 | ||||
|     /// Get a list of small group IDs and descriptions for groups that are public or have a group password | ||||
|     let listPublicAndProtected () = | ||||
|         Custom.list | ||||
|             $"{infoQuery} | ||||
|               WHERE g.data->'preferences'->>'isPublic' = TRUE | ||||
|                  OR COALESCE(g.data->'preferences'->>'groupPassword', '') <> '' | ||||
|               {itemOrderBy}" | ||||
|             [] | ||||
|             SmallGroupInfo.FromReader | ||||
| 
 | ||||
|     /// Log on for a small group (includes list preferences) | ||||
|     let logOn (groupId: SmallGroupId) (password: string) = | ||||
|         Find.firstByFields<SmallGroup> | ||||
|             Table.Group | ||||
|             All | ||||
|             [ Field.Equal "id" (string groupId); Field.Equal "preferences.groupPassword" password ] | ||||
| 
 | ||||
|     /// Save a small group | ||||
|     let save group = save<SmallGroup> Table.Group group | ||||
| 
 | ||||
|     /// Save a small group's list preferences | ||||
|     let savePreferences (groupId: SmallGroupId) (pref: ListPreferences) = | ||||
|         Patch.byId Table.Group (string groupId) {| Preferences = pref |} | ||||
| 
 | ||||
|     /// Get a small group by its ID (including list preferences) | ||||
|     let tryById groupId = | ||||
|         Find.byId<SmallGroupId, SmallGroup> Table.Group groupId | ||||
| 
 | ||||
| 
 | ||||
| /// Functions to manipulate churches | ||||
| module Churches = | ||||
| 
 | ||||
|     /// Get a list of all churches | ||||
|     let all () = Find.all<Church> Table.Church | ||||
| 
 | ||||
|     /// Delete a church by its ID | ||||
|     let deleteById churchId = | ||||
|         backgroundTask { | ||||
|             use conn = Configuration.dbConn () | ||||
|             use! txn = conn.BeginTransactionAsync() | ||||
| 
 | ||||
|             let! groupIds   = SmallGroups.groupIdsByChurch churchId | ||||
|             let  gIdStrings = groupIds |> List.map string | ||||
| 
 | ||||
|             do! Delete.byFields Table.Request All [ Field.In "smallGroupId" gIdStrings ] | ||||
| 
 | ||||
|             let! users = Find.byFields<User> Table.User All [ Field.InArray "smallGroups" Table.User gIdStrings ] | ||||
| 
 | ||||
|             for user in users do | ||||
|                 do! Patch.byId Table.User (string user.Id) {| SmallGroups = user.SmallGroups |> List.except groupIds |} | ||||
| 
 | ||||
|             do! Delete.byFields Table.Group All [ Field.Equal "churchId" (string churchId) ] | ||||
|             do! Delete.byId Table.Church (string churchId) | ||||
|             do! txn.CommitAsync() | ||||
|         } | ||||
| 
 | ||||
|     /// Save a church's information | ||||
|     let save church = save<Church> Table.Church church | ||||
| 
 | ||||
|     /// Find a church by its ID | ||||
|     let tryById churchId = | ||||
|         Find.byId<ChurchId, Church> Table.Church churchId | ||||
| 
 | ||||
| 
 | ||||
| /// Functions to manipulate small group members | ||||
| module Members = | ||||
| 
 | ||||
|     /// Count members for the given small group | ||||
|     let countByGroup (groupId: SmallGroupId) = | ||||
|         Count.byFields Table.Member All [ Field.Equal "smallGroupId" (string groupId) ] | ||||
| 
 | ||||
|     /// Delete a small group member by its ID | ||||
|     let deleteById (memberId: MemberId) = Delete.byId Table.Member (string memberId) | ||||
| 
 | ||||
|     /// Retrieve all members for a given small group | ||||
|     let forGroup (groupId: SmallGroupId) = | ||||
|         Find.byFieldsOrdered<Member> | ||||
|             Table.Member | ||||
|             All | ||||
|             [ Field.Equal "smallGroupId" (string groupId) ] | ||||
|             [ Field.Named "memberName" ] | ||||
| 
 | ||||
|     /// Save a small group member | ||||
|     let save mbr = save<Member> Table.Member mbr | ||||
| 
 | ||||
|     /// Retrieve a small group member by its ID | ||||
|     let tryById memberId = | ||||
|         Find.byId<MemberId, Member> Table.Member memberId | ||||
| 
 | ||||
| 
 | ||||
| /// 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 -> [ Field.Named "updatedDate DESC"; Field.Named "enteredDate DESC"; Field.Named "requestor" ] | ||||
|         | SortByRequestor -> [ Field.Named "requestor"; Field.Named "updatedDate DESC"; Field.Named "enteredDate DESC" ] | ||||
|         |> fun fields -> Query.orderBy fields SQLite | ||||
| 
 | ||||
|     /// 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 = | ||||
|         backgroundTask { | ||||
|             let! groupIds = SmallGroups.groupIdsByChurch churchId | ||||
|             return! Count.byFields Table.Request All [ Field.In "smallGroupId" (List.map string groupIds) ] | ||||
|         } | ||||
| 
 | ||||
|     /// Count the number of prayer requests for a small group | ||||
|     let countByGroup (groupId: SmallGroupId) = | ||||
|         Count.byFields Table.Request All [ Field.Equal "smallGroupId" (string groupId) ] | ||||
| 
 | ||||
|     /// Delete a prayer request by its ID | ||||
|     let deleteById (reqId: PrayerRequestId) = Delete.byId Table.Request (string reqId) | ||||
| 
 | ||||
|     /// Get all (or active) requests for a small group as of now or the specified date | ||||
|     let forGroup (opts: PrayerRequestOptions) = | ||||
|         let theDate = defaultArg opts.ListDate (opts.SmallGroup.LocalDateNow opts.Clock) | ||||
| 
 | ||||
|         let sql, parameters = | ||||
|             if opts.ActiveOnly then | ||||
|                 let expDate = | ||||
|                     (theDate.AtStartOfDayInZone(opts.SmallGroup.TimeZone) | ||||
|                          - Duration.FromDays opts.SmallGroup.Preferences.DaysToExpire) | ||||
|                         .ToInstant() | ||||
|                 $"""AND (   date(data->>'updatedDate')  > date(:updatedDate) | ||||
|                          OR data->>'expiration'         = :expManual | ||||
|                          OR data->>'requestType'       IN (:typLongTerm, :typExpecting)) | ||||
|                     AND data->>'expiration' <> :expForced""", | ||||
|                 [ SqliteParameter(":updatedDate", string expDate) | ||||
|                   SqliteParameter(":expManual", string Manual) | ||||
|                   SqliteParameter(":typLongTerm", string LongTermRequest) | ||||
|                   SqliteParameter(":typExpecting", string Expecting) | ||||
|                   SqliteParameter(":expForced", string Forced) ] | ||||
|             else | ||||
|                 "", [] | ||||
| 
 | ||||
|         Custom.list | ||||
|             $"SELECT data FROM {Table.Request} | ||||
|                WHERE data->>'smallGroupId' = :groupId | ||||
|                  {sql} | ||||
|                {orderBy opts.SmallGroup.Preferences.RequestSort} | ||||
|                {paginate opts.PageNumber opts.SmallGroup.Preferences.PageSize}" | ||||
|             (SqliteParameter(":groupId", string opts.SmallGroup.Id) :: parameters) | ||||
|             fromData<PrayerRequest> | ||||
| 
 | ||||
|     /// Save a prayer request | ||||
|     let save req = save<PrayerRequest> Table.Request req | ||||
| 
 | ||||
|     /// Search prayer requests for the given term | ||||
|     let searchForGroup group searchTerm pageNbr = | ||||
|         let pct = "%" | ||||
|         Custom.list | ||||
|             $"WITH results AS ( | ||||
|                 SELECT data FROM {Table.Request} | ||||
|                  WHERE data->>'smallGroupId' = :groupId | ||||
|                    AND data->>'text' LIKE :search | ||||
|               UNION | ||||
|                 SELECT data FROM {Table.Request} | ||||
|                  WHERE data->>'smallGroupId' = :groupId | ||||
|                    AND COALESCE(data->>'requestor', '') LIKE :search) | ||||
|               SELECT data FROM results | ||||
|               {orderBy group.Preferences.RequestSort} | ||||
|               {paginate pageNbr group.Preferences.PageSize}" | ||||
|             [ SqliteParameter(":groupId", string group.Id); SqliteParameter(":search", $"{pct}%s{searchTerm}{pct}") ] | ||||
|             fromData<PrayerRequest> | ||||
| 
 | ||||
|     /// Retrieve a prayer request by its ID | ||||
|     let tryById reqId = | ||||
|         Find.byId<PrayerRequestId, PrayerRequest> Table.Request reqId | ||||
| 
 | ||||
|     /// Update the expiration for the given prayer request | ||||
|     let updateExpiration (req: PrayerRequest) withTime = | ||||
|         if withTime then | ||||
|             Patch.byId | ||||
|                 Table.Request | ||||
|                 (string req.Id) | ||||
|                 {| UpdatedDate = req.UpdatedDate | ||||
|                    Expiration = req.Expiration |} | ||||
|         else | ||||
|             Patch.byId Table.Request (string req.Id) {| Expiration = req.Expiration |} | ||||
| 
 | ||||
| 
 | ||||
| /// Functions to manipulate users | ||||
| module Users = | ||||
| 
 | ||||
|     /// Retrieve all PrayerTracker users | ||||
|     let all () = | ||||
|         Find.allOrdered<User> Table.User [ Field.Named "lastName"; Field.Named "firstName" ] | ||||
| 
 | ||||
|     /// Count the number of users for a church | ||||
|     let countByChurch churchId = | ||||
|         backgroundTask { | ||||
|             let! groupIds = SmallGroups.groupIdsByChurch churchId | ||||
|             return! Count.byFields Table.User All [ Field.InArray "smallGroups" Table.User (List.map string groupIds) ] | ||||
|         } | ||||
| 
 | ||||
|     /// Count the number of users for a small group | ||||
|     let countByGroup (groupId: SmallGroupId) = | ||||
|         Count.byFields Table.User All [ Field.InArray "smallGroups" Table.User [ (string groupId) ] ] | ||||
| 
 | ||||
|     /// Delete a user by its database ID | ||||
|     let deleteById (userId: UserId) = Delete.byId Table.User (string userId) | ||||
| 
 | ||||
|     /// Get a list of users authorized to administer the given small group | ||||
|     let listByGroupId (groupId: SmallGroupId) = | ||||
|         Find.byFieldsOrdered<User> | ||||
|             Table.User | ||||
|             All | ||||
|             [ Field.InArray "smallGroups" Table.User [ (string groupId) ] ] | ||||
|             [ Field.Named "lastName"; Field.Named "firstName" ] | ||||
| 
 | ||||
|     /// Save a user's information | ||||
|     let save user = save<User> Table.User user | ||||
| 
 | ||||
|     /// Find a user by its e-mail address and authorized small group | ||||
|     let tryByEmailAndGroup (email: string) (groupId: SmallGroupId) = | ||||
|         Find.firstByFields<User> | ||||
|             Table.User | ||||
|             All | ||||
|             [ Field.Equal "email" email | ||||
|               Field.InArray "smallGroups" Table.User [ (string groupId) ] ] | ||||
| 
 | ||||
|     /// Find a user by their database ID | ||||
|     let tryById userId = | ||||
|         Find.byId<UserId, User> Table.User userId | ||||
| 
 | ||||
|     /// Update a user's last seen date/time | ||||
|     let updateLastSeen (userId: UserId) (now: Instant) = | ||||
|         Patch.byId Table.User (string userId) {| LastSeen = now |} | ||||
| 
 | ||||
|     /// Update a user's password hash | ||||
|     let updatePassword (user: User) = | ||||
|         Patch.byId Table.User (string user.Id) {| PasswordHash = user.PasswordHash |} | ||||
| 
 | ||||
|     /// Update a user's authorized small groups | ||||
|     let updateSmallGroups (userId: UserId) (groupIds: SmallGroupId list) = | ||||
|         Patch.byId Table.User (string userId) {| SmallGroups = groupIds |} | ||||
							
								
								
									
										565
									
								
								src/Data/Entities.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										565
									
								
								src/Data/Entities.fs
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,565 @@ | ||||
| namespace PrayerTracker.Entities | ||||
| 
 | ||||
| (*-- 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 | ||||
| 
 | ||||
|     /// Convert this to a single-character code | ||||
|     override this.ToString() = | ||||
|         match this with | ||||
|         | NoDisplay -> "N" | ||||
|         | ShortDate -> "S" | ||||
|         | LongDate -> "L" | ||||
| 
 | ||||
|     /// <summary>Create an <c>AsOfDateDisplay</c> from a single-character code</summary> | ||||
|     static member Parse code = | ||||
|         match code with | ||||
|         | "N" -> NoDisplay | ||||
|         | "S" -> ShortDate | ||||
|         | "L" -> LongDate | ||||
|         | _ -> invalidArg "code" $"Unknown code {code}" | ||||
| 
 | ||||
| 
 | ||||
| /// Acceptable e-mail formats | ||||
| type EmailFormat = | ||||
|     /// HTML e-mail | ||||
|     | HtmlFormat | ||||
|     /// Plain-text e-mail | ||||
|     | PlainTextFormat | ||||
| 
 | ||||
|     /// Convert this to a single-character code | ||||
|     override this.ToString() = | ||||
|         match this with | ||||
|         | HtmlFormat -> "H" | ||||
|         | PlainTextFormat -> "P" | ||||
| 
 | ||||
|     /// <summary>Create an <c>EmailFormat</c> from a single-character code</summary> | ||||
|     static member Parse code = | ||||
|         match code with | ||||
|         | "H" -> HtmlFormat | ||||
|         | "P" -> PlainTextFormat | ||||
|         | _ -> invalidArg "code" $"Unknown code {code}" | ||||
| 
 | ||||
| 
 | ||||
| /// Expiration for requests | ||||
| type Expiration = | ||||
|     /// Follow the rules for normal expiration | ||||
|     | Automatic | ||||
|     /// Do not expire via rules | ||||
|     | Manual | ||||
|     /// Force immediate expiration | ||||
|     | Forced | ||||
| 
 | ||||
|     /// Convert this to a single-character code | ||||
|     override this.ToString() = | ||||
|         match this with | ||||
|         | Automatic -> "A" | ||||
|         | Manual -> "M" | ||||
|         | Forced -> "F" | ||||
| 
 | ||||
|     /// <summary>Create an <c>Expiration</c> from a single-character code</summary> | ||||
|     static member Parse code = | ||||
|         match code with | ||||
|         | "A" -> Automatic | ||||
|         | "M" -> Manual | ||||
|         | "F" -> Forced | ||||
|         | _ -> invalidArg "code" $"Unknown code {code}" | ||||
| 
 | ||||
| 
 | ||||
| /// Types of prayer requests | ||||
| type PrayerRequestType = | ||||
|     /// Current requests | ||||
|     | CurrentRequest | ||||
|     /// Long-term/ongoing request | ||||
|     | LongTermRequest | ||||
|     /// Expectant couples | ||||
|     | Expecting | ||||
|     /// Praise reports | ||||
|     | PraiseReport | ||||
|     /// Announcements | ||||
|     | Announcement | ||||
| 
 | ||||
|     /// Convert this to a single-character code | ||||
|     override this.ToString() = | ||||
|         match this with | ||||
|         | CurrentRequest -> "C" | ||||
|         | LongTermRequest -> "L" | ||||
|         | Expecting -> "E" | ||||
|         | PraiseReport -> "P" | ||||
|         | Announcement -> "A" | ||||
| 
 | ||||
|     /// <summary>Create a <c>PrayerRequestType</c> from a single-character code</summary> | ||||
|     static member Parse code = | ||||
|         match code with | ||||
|         | "C" -> CurrentRequest | ||||
|         | "L" -> LongTermRequest | ||||
|         | "E" -> Expecting | ||||
|         | "P" -> PraiseReport | ||||
|         | "A" -> Announcement | ||||
|         | _ -> invalidArg "code" $"Unknown code {code}" | ||||
| 
 | ||||
| 
 | ||||
| /// How requests should be sorted | ||||
| type RequestSort = | ||||
|     /// Sort by date, then by requestor/subject | ||||
|     | SortByDate | ||||
|     /// Sort by requestor/subject, then by date | ||||
|     | SortByRequestor | ||||
| 
 | ||||
|     /// Convert this to a single-character code | ||||
|     override this.ToString() = | ||||
|         match this with | ||||
|         | SortByDate -> "D" | ||||
|         | SortByRequestor -> "R" | ||||
| 
 | ||||
|     /// <summary>Create a <c>RequestSort</c> from a single-character code</summary> | ||||
|     static member Parse code = | ||||
|         match code with | ||||
|         | "D" -> SortByDate | ||||
|         | "R" -> SortByRequestor | ||||
|         | _ -> invalidArg "code" $"Unknown code {code}" | ||||
| 
 | ||||
| 
 | ||||
| /// Type for a time zone ID | ||||
| type TimeZoneId = | ||||
|     | TimeZoneId of string | ||||
| 
 | ||||
|     override this.ToString() = | ||||
|         match this with | ||||
|         | TimeZoneId it -> it | ||||
| 
 | ||||
| 
 | ||||
| open System | ||||
| 
 | ||||
| /// PK type for the Church entity | ||||
| type ChurchId = | ||||
|     | ChurchId of Guid | ||||
| 
 | ||||
|     /// The GUID value of the church ID | ||||
|     member this.Value = | ||||
|         this | ||||
|         |> function | ||||
|             | ChurchId guid -> guid | ||||
| 
 | ||||
|     override this.ToString() = | ||||
|         this.Value.ToString "N" | ||||
| 
 | ||||
| 
 | ||||
| /// PK type for the Member entity | ||||
| type MemberId = | ||||
|     | MemberId of Guid | ||||
| 
 | ||||
|     /// The GUID value of the member ID | ||||
|     member this.Value = | ||||
|         this | ||||
|         |> function | ||||
|             | MemberId guid -> guid | ||||
| 
 | ||||
|     override this.ToString() = | ||||
|         this.Value.ToString "N" | ||||
| 
 | ||||
| 
 | ||||
| /// PK type for the PrayerRequest entity | ||||
| type PrayerRequestId = | ||||
|     | PrayerRequestId of Guid | ||||
| 
 | ||||
|     /// The GUID value of the prayer request ID | ||||
|     member this.Value = | ||||
|         this | ||||
|         |> function | ||||
|             | PrayerRequestId guid -> guid | ||||
| 
 | ||||
|     override this.ToString() = | ||||
|         this.Value.ToString "N" | ||||
| 
 | ||||
| 
 | ||||
| /// PK type for the SmallGroup entity | ||||
| type SmallGroupId = | ||||
|     | SmallGroupId of Guid | ||||
| 
 | ||||
|     /// The GUID value of the small group ID | ||||
|     member this.Value = | ||||
|         this | ||||
|         |> function | ||||
|             | SmallGroupId guid -> guid | ||||
| 
 | ||||
|     override this.ToString() = | ||||
|         this.Value.ToString "N" | ||||
| 
 | ||||
| 
 | ||||
| /// PK type for the User entity | ||||
| type UserId = | ||||
|     | UserId of Guid | ||||
| 
 | ||||
|     /// The GUID value of the user ID | ||||
|     member this.Value = | ||||
|         this | ||||
|         |> function | ||||
|             | UserId guid -> guid | ||||
| 
 | ||||
|     override this.ToString() = | ||||
|         this.Value.ToString "N" | ||||
| 
 | ||||
| (*-- SPECIFIC VIEW TYPES --*) | ||||
| 
 | ||||
| open Microsoft.Data.Sqlite | ||||
| 
 | ||||
| /// Statistics for churches | ||||
| [<NoComparison; NoEquality>] | ||||
| 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 | ||||
|     } | ||||
| 
 | ||||
| 
 | ||||
| /// Information needed to display the public/protected request list and small group maintenance pages | ||||
| [<CLIMutable; NoComparison; NoEquality>] | ||||
| 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 | ||||
|     } | ||||
|      | ||||
|     /// Map a row to a Small Group information set | ||||
|     static member FromReader (rdr: SqliteDataReader) = | ||||
|         { Id = Giraffe.ShortGuid.fromGuid ((rdr.GetOrdinal >> rdr.GetString >> Guid.Parse) "id") | ||||
|           Name = (rdr.GetOrdinal >> rdr.GetString) "groupName" | ||||
|           ChurchName = (rdr.GetOrdinal >> rdr.GetString) "churchName" | ||||
|           TimeZoneId = (rdr.GetOrdinal >> rdr.GetString >> TimeZoneId) "timeZoneId" | ||||
|           IsPublic = (rdr.GetOrdinal >> rdr.GetBoolean) "isPublic" } | ||||
| 
 | ||||
| 
 | ||||
| (*-- ENTITIES --*) | ||||
| 
 | ||||
| open NodaTime | ||||
| 
 | ||||
| /// This represents a church | ||||
| [<CLIMutable; NoComparison; NoEquality>] | ||||
| 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 | ||||
|     } | ||||
| 
 | ||||
|     /// An empty church | ||||
|     // aww... how sad :( | ||||
|     static member Empty = | ||||
|         { Id = ChurchId Guid.Empty | ||||
|           Name = "" | ||||
|           City = "" | ||||
|           State = "" | ||||
|           HasVpsInterface = false | ||||
|           InterfaceAddress = None } | ||||
| 
 | ||||
| 
 | ||||
| /// Preferences for the form and format of the prayer request list | ||||
| [<NoComparison; NoEquality>] | ||||
| type ListPreferences = | ||||
|     { | ||||
|         /// 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 | ||||
|     } | ||||
| 
 | ||||
|     /// 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 | ||||
| 
 | ||||
|     /// A set of preferences with their default values | ||||
|     static member 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 | ||||
| [<CLIMutable; NoComparison; NoEquality>] | ||||
| 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 | ||||
|     } | ||||
| 
 | ||||
|     /// An empty member | ||||
|     static member Empty = | ||||
|         { Id = MemberId Guid.Empty | ||||
|           SmallGroupId = SmallGroupId Guid.Empty | ||||
|           Name = "" | ||||
|           Email = "" | ||||
|           Format = None } | ||||
| 
 | ||||
| 
 | ||||
| /// This represents a small group (Sunday School class, Bible study group, etc.) | ||||
| [<CLIMutable; NoComparison; NoEquality>] | ||||
| 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 | ||||
|     } | ||||
| 
 | ||||
|     /// The DateTimeZone for the time zone ID for this small group | ||||
|     member this.TimeZone = | ||||
|         let tzId = string this.Preferences.TimeZoneId | ||||
| 
 | ||||
|         if DateTimeZoneProviders.Tzdb.Ids.Contains tzId then | ||||
|             DateTimeZoneProviders.Tzdb[tzId] | ||||
|         else | ||||
|             DateTimeZone.Utc | ||||
| 
 | ||||
|     /// Get the local date/time for this group | ||||
|     member this.LocalTimeNow(clock: IClock) = | ||||
|         if isNull clock then | ||||
|             nullArg (nameof clock) | ||||
| 
 | ||||
|         clock.GetCurrentInstant().InZone(this.TimeZone).LocalDateTime | ||||
| 
 | ||||
|     /// Get the local date for this group | ||||
|     member this.LocalDateNow clock = this.LocalTimeNow(clock).Date | ||||
| 
 | ||||
|     /// An empty small group | ||||
|     static member Empty = | ||||
|         { Id = SmallGroupId Guid.Empty | ||||
|           ChurchId = ChurchId Guid.Empty | ||||
|           Name = "" | ||||
|           Preferences = ListPreferences.Empty } | ||||
| 
 | ||||
| 
 | ||||
| /// This represents a single prayer request | ||||
| [<CLIMutable; NoComparison; NoEquality>] | ||||
| 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 | ||||
|     } | ||||
| 
 | ||||
|     /// Is this request expired? | ||||
|     member this.IsExpired (asOf: LocalDate) (group: SmallGroup) = | ||||
|         match this.Expiration, this.RequestType with | ||||
|         | Forced, _ -> true | ||||
|         | Manual, _ | ||||
|         | Automatic, LongTermRequest | ||||
|         | Automatic, Expecting -> false | ||||
|         | Automatic, _ -> | ||||
|             // Automatic expiration | ||||
|             Period | ||||
|                 .Between(this.UpdatedDate.InZone(group.TimeZone).Date, asOf, PeriodUnits.Days) | ||||
|                 .Days | ||||
|             >= group.Preferences.DaysToExpire | ||||
| 
 | ||||
|     /// Is an update required for this long-term request? | ||||
|     member this.UpdateRequired asOf group = | ||||
|         if this.IsExpired asOf group then | ||||
|             false | ||||
|         else | ||||
|             asOf.PlusWeeks -group.Preferences.LongTermUpdateWeeks | ||||
|             >= this.UpdatedDate.InZone(group.TimeZone).Date | ||||
| 
 | ||||
|     /// An empty request | ||||
|     static member 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 } | ||||
| 
 | ||||
| 
 | ||||
| /// This represents a user of PrayerTracker | ||||
| [<CLIMutable; NoComparison; NoEquality>] | ||||
| 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 | ||||
| 
 | ||||
|         /// The small groups to which this user is authorized | ||||
|         SmallGroups: SmallGroupId list | ||||
|     } | ||||
| 
 | ||||
|     /// The full name of the user | ||||
|     member this.Name = $"{this.FirstName} {this.LastName}" | ||||
| 
 | ||||
|     /// An empty user | ||||
|     static member Empty = | ||||
|         { Id = UserId Guid.Empty | ||||
|           FirstName = "" | ||||
|           LastName = "" | ||||
|           Email = "" | ||||
|           IsAdmin = false | ||||
|           PasswordHash = "" | ||||
|           LastSeen = None | ||||
|           SmallGroups = [] } | ||||
							
								
								
									
										16
									
								
								src/Data/PrayerTracker.Data.fsproj
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										16
									
								
								src/Data/PrayerTracker.Data.fsproj
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,16 @@ | ||||
| <Project Sdk="Microsoft.NET.Sdk"> | ||||
| 
 | ||||
|   <ItemGroup> | ||||
|     <Compile Include="Entities.fs" /> | ||||
|     <Compile Include="Access.fs" /> | ||||
|   </ItemGroup> | ||||
| 
 | ||||
|   <ItemGroup> | ||||
|     <PackageReference Include="BitBadger.Documents.Sqlite" Version="4.0.1" /> | ||||
|     <PackageReference Include="Giraffe" Version="7.0.2" /> | ||||
|     <PackageReference Include="NodaTime" Version="3.2.1" /> | ||||
|     <PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.3.0" /> | ||||
|     <PackageReference Update="FSharp.Core" Version="9.0.101" /> | ||||
|   </ItemGroup> | ||||
| 
 | ||||
| </Project> | ||||
| @ -1,11 +1,11 @@ | ||||
| <Project> | ||||
|   <PropertyGroup> | ||||
|     <TargetFramework>net8.0</TargetFramework> | ||||
|     <AssemblyVersion>8.4.0.0</AssemblyVersion> | ||||
|     <FileVersion>8.4.0.0</FileVersion> | ||||
|     <TargetFramework>net9.0</TargetFramework> | ||||
|     <AssemblyVersion>9.0.0.0</AssemblyVersion> | ||||
|     <FileVersion>9.0.0.0</FileVersion> | ||||
|     <Authors>danieljsummers</Authors> | ||||
|     <Company>Bit Badger Solutions</Company> | ||||
|     <Version>8.4.0</Version> | ||||
|     <Version>9.0.0</Version> | ||||
|     <DebugType>Embedded</DebugType> | ||||
|   </PropertyGroup> | ||||
| </Project> | ||||
|  | ||||
| @ -1,15 +1,15 @@ | ||||
| FROM mcr.microsoft.com/dotnet/sdk:8.0-alpine AS build | ||||
| WORKDIR /pt | ||||
| COPY ./PrayerTracker.sln                              ./ | ||||
| COPY ./Directory.Build.props                          ./ | ||||
| COPY ./PrayerTracker/PrayerTracker.fsproj             ./PrayerTracker/ | ||||
| COPY ./PrayerTracker.Data/PrayerTracker.Data.fsproj   ./PrayerTracker.Data/ | ||||
| COPY ./PrayerTracker.Tests/PrayerTracker.Tests.fsproj ./PrayerTracker.Tests/ | ||||
| COPY ./PrayerTracker.UI/PrayerTracker.UI.fsproj       ./PrayerTracker.UI/ | ||||
| COPY ./PrayerTracker.sln                  ./ | ||||
| COPY ./Directory.Build.props              ./ | ||||
| COPY ./Data/PrayerTracker.Data.fsproj     ./Data/ | ||||
| COPY ./UI/PrayerTracker.UI.fsproj         ./UI/ | ||||
| COPY ./PrayerTracker/PrayerTracker.fsproj ./PrayerTracker/ | ||||
| COPY ./Tests/PrayerTracker.Tests.fsproj   ./Tests/ | ||||
| RUN dotnet restore | ||||
| 
 | ||||
| COPY . ./ | ||||
| WORKDIR /pt/PrayerTracker.Tests | ||||
| WORKDIR /pt/Tests | ||||
| RUN dotnet run | ||||
| 
 | ||||
| WORKDIR /pt/PrayerTracker | ||||
|  | ||||
| @ -1,589 +0,0 @@ | ||||
| namespace PrayerTracker.Data | ||||
| 
 | ||||
| open NodaTime | ||||
| open Npgsql | ||||
| open Npgsql.FSharp | ||||
| open PrayerTracker.Entities | ||||
| 
 | ||||
| /// Helper functions for the PostgreSQL data implementation | ||||
| [<AutoOpen>] | ||||
| module private Helpers = | ||||
|      | ||||
|     /// Map a row to a Church instance | ||||
|     let mapToChurch (row : RowReader) = | ||||
|         {   Id               = ChurchId         (row.uuid "id") | ||||
|             Name             = row.string       "church_name" | ||||
|             City             = row.string       "city" | ||||
|             State            = row.string       "state" | ||||
|             HasVpsInterface  = row.bool         "has_vps_interface" | ||||
|             InterfaceAddress = row.stringOrNone "interface_address" | ||||
|         } | ||||
|      | ||||
|     /// Map a row to a ListPreferences instance | ||||
|     let mapToListPreferences (row : RowReader) = | ||||
|         {   SmallGroupId        = SmallGroupId (row.uuid "small_group_id") | ||||
|             DaysToKeepNew       = row.int      "days_to_keep_new" | ||||
|             DaysToExpire        = row.int      "days_to_expire" | ||||
|             LongTermUpdateWeeks = row.int      "long_term_update_weeks" | ||||
|             EmailFromName       = row.string   "email_from_name" | ||||
|             EmailFromAddress    = row.string   "email_from_address" | ||||
|             Fonts               = row.string   "fonts" | ||||
|             HeadingColor        = row.string   "heading_color" | ||||
|             LineColor           = row.string   "line_color" | ||||
|             HeadingFontSize     = row.int      "heading_font_size" | ||||
|             TextFontSize        = row.int      "text_font_size" | ||||
|             GroupPassword       = row.string   "group_password" | ||||
|             IsPublic            = row.bool     "is_public" | ||||
|             PageSize            = row.int      "page_size" | ||||
|             TimeZoneId          = TimeZoneId    (row.string "time_zone_id") | ||||
|             RequestSort         = RequestSort.fromCode     (row.string "request_sort") | ||||
|             DefaultEmailType    = EmailFormat.fromCode     (row.string "default_email_type") | ||||
|             AsOfDateDisplay     = AsOfDateDisplay.fromCode (row.string "as_of_date_display") | ||||
|         } | ||||
|      | ||||
|     /// Map a row to a Member instance | ||||
|     let mapToMember (row : RowReader) = | ||||
|         {   Id           = MemberId         (row.uuid "id") | ||||
|             SmallGroupId = SmallGroupId     (row.uuid "small_group_id") | ||||
|             Name         = row.string       "member_name" | ||||
|             Email        = row.string       "email" | ||||
|             Format       = row.stringOrNone "email_format" |> Option.map EmailFormat.fromCode | ||||
|         } | ||||
|      | ||||
|     /// Map a row to a Prayer Request instance | ||||
|     let mapToPrayerRequest (row : RowReader) = | ||||
|         {   Id             = PrayerRequestId         (row.uuid "id") | ||||
|             UserId         = UserId                  (row.uuid "user_id") | ||||
|             SmallGroupId   = SmallGroupId            (row.uuid "small_group_id") | ||||
|             EnteredDate    = row.fieldValue<Instant> "entered_date" | ||||
|             UpdatedDate    = row.fieldValue<Instant> "updated_date" | ||||
|             Requestor      = row.stringOrNone        "requestor" | ||||
|             Text           = row.string              "request_text" | ||||
|             NotifyChaplain = row.bool                "notify_chaplain" | ||||
|             RequestType    = PrayerRequestType.fromCode (row.string "request_type") | ||||
|             Expiration     = Expiration.fromCode        (row.string "expiration") | ||||
|         } | ||||
|      | ||||
|     /// Map a row to a Small Group instance | ||||
|     let mapToSmallGroup (row : RowReader) = | ||||
|         {   Id          = SmallGroupId (row.uuid "id") | ||||
|             ChurchId    = ChurchId     (row.uuid "church_id") | ||||
|             Name        = row.string   "group_name" | ||||
|             Preferences = ListPreferences.empty | ||||
|         } | ||||
|      | ||||
|     /// Map a row to a Small Group information set | ||||
|     let mapToSmallGroupInfo (row : RowReader) = | ||||
|         {   Id         = Giraffe.ShortGuid.fromGuid (row.uuid "id") | ||||
|             Name       = row.string "group_name" | ||||
|             ChurchName = row.string "church_name" | ||||
|             TimeZoneId = TimeZoneId (row.string "time_zone_id") | ||||
|             IsPublic   = row.bool   "is_public" | ||||
|         } | ||||
|      | ||||
|     /// Map a row to a Small Group list item | ||||
|     let mapToSmallGroupItem (row : RowReader) = | ||||
|         Giraffe.ShortGuid.fromGuid (row.uuid "id"), $"""{row.string "church_name"} | {row.string "group_name"}""" | ||||
|      | ||||
|     /// Map a row to a Small Group instance with populated list preferences     | ||||
|     let mapToSmallGroupWithPreferences (row : RowReader) = | ||||
|         { mapToSmallGroup row with | ||||
|             Preferences = mapToListPreferences row | ||||
|         } | ||||
|      | ||||
|     /// Map a row to a User instance | ||||
|     let mapToUser (row : RowReader) = | ||||
|         {   Id           = UserId     (row.uuid "id") | ||||
|             FirstName    = row.string "first_name" | ||||
|             LastName     = row.string "last_name" | ||||
|             Email        = row.string "email" | ||||
|             IsAdmin      = row.bool   "is_admin" | ||||
|             PasswordHash = row.string "password_hash" | ||||
|             LastSeen     = row.fieldValueOrNone<Instant> "last_seen" | ||||
|         } | ||||
| 
 | ||||
| 
 | ||||
| open BitBadger.Documents.Postgres | ||||
| 
 | ||||
| /// Functions to manipulate churches | ||||
| module Churches = | ||||
|      | ||||
|     /// Get a list of all churches | ||||
|     let all () = | ||||
|         Custom.list "SELECT * FROM pt.church ORDER BY church_name" [] mapToChurch | ||||
|      | ||||
|     /// Delete a church by its ID | ||||
|     let deleteById (churchId : ChurchId) = 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! _ = | ||||
|             Configuration.dataSource () | ||||
|             |> Sql.fromDataSource | ||||
|             |> 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 ] | ||||
|         () | ||||
|     } | ||||
|      | ||||
|     /// Save a church's information | ||||
|     let save (church : Church) = | ||||
|         Custom.nonQuery | ||||
|             "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" | ||||
|             [   "@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 ] | ||||
|      | ||||
|     /// Find a church by its ID | ||||
|     let tryById (churchId : ChurchId) = | ||||
|         Custom.single "SELECT * FROM pt.church WHERE id = @id" [ "@id", Sql.uuid churchId.Value ] mapToChurch | ||||
| 
 | ||||
| 
 | ||||
| /// Functions to manipulate small group members | ||||
| module Members = | ||||
|      | ||||
|     /// Count members for the given small group | ||||
|     let countByGroup (groupId : SmallGroupId) = | ||||
|         Custom.scalar "SELECT COUNT(id) AS mbr_count FROM pt.member WHERE small_group_id = @groupId" | ||||
|                       [ "@groupId", Sql.uuid groupId.Value ] (fun row -> row.int "mbr_count") | ||||
|      | ||||
|     /// Delete a small group member by its ID | ||||
|     let deleteById (memberId : MemberId) = | ||||
|         Custom.nonQuery "DELETE FROM pt.member WHERE id = @id" [ "@id", Sql.uuid memberId.Value ] | ||||
|      | ||||
|     /// Retrieve all members for a given small group | ||||
|     let forGroup (groupId : SmallGroupId) = | ||||
|         Custom.list "SELECT * FROM pt.member WHERE small_group_id = @groupId ORDER BY member_name" | ||||
|                     [ "@groupId", Sql.uuid groupId.Value ] mapToMember | ||||
|      | ||||
|     /// Save a small group member | ||||
|     let save (mbr : Member) = | ||||
|         Custom.nonQuery | ||||
|             "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" | ||||
|             [   "@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) ] | ||||
|      | ||||
|     /// Retrieve a small group member by its ID | ||||
|     let tryById (memberId : MemberId) = | ||||
|         Custom.single "SELECT * FROM pt.member WHERE id = @id" [ "@id", Sql.uuid memberId.Value ] mapToMember | ||||
| 
 | ||||
| 
 | ||||
| /// 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) = | ||||
|         Custom.scalar | ||||
|             "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)" | ||||
|             [ "@churchId", Sql.uuid churchId.Value ] (fun row -> row.int "req_count") | ||||
|      | ||||
|     /// Count the number of prayer requests for a small group | ||||
|     let countByGroup (groupId : SmallGroupId) = | ||||
|         Custom.scalar "SELECT COUNT(id) AS req_count FROM pt.prayer_request WHERE small_group_id = @groupId" | ||||
|                       [ "@groupId", Sql.uuid groupId.Value ] (fun row -> row.int "req_count") | ||||
|      | ||||
|     /// Delete a prayer request by its ID | ||||
|     let deleteById (reqId : PrayerRequestId) = | ||||
|         Custom.nonQuery "DELETE FROM pt.prayer_request WHERE id = @id" [ "@id", Sql.uuid reqId.Value ] | ||||
|      | ||||
|     /// Get all (or active) requests for a small group as of now or the specified date | ||||
|     let forGroup (opts : PrayerRequestOptions) = | ||||
|         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 "", [] | ||||
|         Custom.list | ||||
|             $"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}" | ||||
|             (("@groupId", Sql.uuid opts.SmallGroup.Id.Value) :: parameters) mapToPrayerRequest | ||||
|      | ||||
|     /// Save a prayer request | ||||
|     let save (req : PrayerRequest) = | ||||
|         Custom.nonQuery | ||||
|             "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" | ||||
|             [   "@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) ] | ||||
|      | ||||
|     /// Search prayer requests for the given term | ||||
|     let searchForGroup group searchTerm pageNbr = | ||||
|         Custom.list  | ||||
|             $"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}" | ||||
|             [ "@groupId", Sql.uuid group.Id.Value; "@search", Sql.string $"%%%s{searchTerm}%%" ] mapToPrayerRequest | ||||
| 
 | ||||
|     /// Retrieve a prayer request by its ID | ||||
|     let tryById (reqId : PrayerRequestId) = | ||||
|         Custom.single "SELECT * FROM pt.prayer_request WHERE id = @id" [ "@id", Sql.uuid reqId.Value ] | ||||
|                       mapToPrayerRequest | ||||
|      | ||||
|     /// Update the expiration for the given prayer request | ||||
|     let updateExpiration (req : PrayerRequest) withTime = | ||||
|         let sql, parameters = | ||||
|             if withTime then | ||||
|                 ", updated_date = @updated", | ||||
|                 [ "@updated", Sql.parameter (NpgsqlParameter ("@updated", req.UpdatedDate)) ] | ||||
|             else "", [] | ||||
|         Custom.nonQuery $"UPDATE pt.prayer_request SET expiration = @expiration{sql} WHERE id = @id" | ||||
|                         ([  "@expiration", Sql.string (Expiration.toCode req.Expiration) | ||||
|                             "@id",         Sql.uuid   req.Id.Value ] | ||||
|                         |> List.append parameters) | ||||
| 
 | ||||
| 
 | ||||
| /// Functions to retrieve small group information | ||||
| module SmallGroups = | ||||
|      | ||||
|     /// Count the number of small groups for a church | ||||
|     let countByChurch (churchId : ChurchId) = | ||||
|         Custom.scalar "SELECT COUNT(id) AS group_count FROM pt.small_group WHERE church_id = @churchId" | ||||
|                       [ "@churchId", Sql.uuid churchId.Value ] (fun row -> row.int "group_count") | ||||
|      | ||||
|     /// Delete a small group by its ID | ||||
|     let deleteById (groupId : SmallGroupId) = backgroundTask { | ||||
|         let idParam = [ [ "@groupId", Sql.uuid groupId.Value ] ] | ||||
|         let! _ = | ||||
|             Configuration.dataSource () | ||||
|             |> Sql.fromDataSource | ||||
|             |> 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 ] | ||||
|         () | ||||
|     } | ||||
|      | ||||
|     /// Get information for all small groups | ||||
|     let infoForAll () = | ||||
|         Custom.list | ||||
|             "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" | ||||
|             [] mapToSmallGroupInfo | ||||
|      | ||||
|     /// Get a list of small group IDs along with a description that includes the church name | ||||
|     let listAll () = | ||||
|         Custom.list | ||||
|             "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" | ||||
|             [] mapToSmallGroupItem | ||||
|      | ||||
|     /// Get a list of small group IDs and descriptions for groups with a group password | ||||
|     let listProtected () = | ||||
|         Custom.list | ||||
|             "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" | ||||
|             [] mapToSmallGroupItem | ||||
|      | ||||
|     /// Get a list of small group IDs and descriptions for groups that are public or have a group password | ||||
|     let listPublicAndProtected () = | ||||
|         Custom.list | ||||
|             "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" | ||||
|             [] mapToSmallGroupInfo | ||||
|      | ||||
|     /// Log on for a small group (includes list preferences) | ||||
|     let logOn (groupId : SmallGroupId) password = | ||||
|         Custom.single | ||||
|             "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" | ||||
|             [ "@id", Sql.uuid groupId.Value; "@password", Sql.string password ] mapToSmallGroupWithPreferences | ||||
|      | ||||
|     /// Save a small group | ||||
|     let save (group : SmallGroup) isNew = backgroundTask { | ||||
|         let! _ = | ||||
|             Configuration.dataSource () | ||||
|             |> Sql.fromDataSource | ||||
|             |> 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 ] ] | ||||
|             ] | ||||
|         () | ||||
|     } | ||||
|      | ||||
|     /// Save a small group's list preferences | ||||
|     let savePreferences (pref : ListPreferences) = | ||||
|         Custom.nonQuery | ||||
|             "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" | ||||
|             [   "@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) ] | ||||
|      | ||||
|     /// Get a small group by its ID | ||||
|     let tryById (groupId : SmallGroupId) = | ||||
|         Custom.single "SELECT * FROM pt.small_group WHERE id = @id" [ "@id", Sql.uuid groupId.Value ] mapToSmallGroup | ||||
|      | ||||
|     /// Get a small group by its ID with its list preferences populated | ||||
|     let tryByIdWithPreferences (groupId : SmallGroupId) = | ||||
|         Custom.single | ||||
|             "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" | ||||
|             [ "@id", Sql.uuid groupId.Value ] mapToSmallGroupWithPreferences | ||||
| 
 | ||||
| 
 | ||||
| /// Functions to manipulate users | ||||
| module Users = | ||||
|      | ||||
|     /// Retrieve all PrayerTracker users | ||||
|     let all () = | ||||
|         Custom.list "SELECT * FROM pt.pt_user ORDER BY last_name, first_name" [] mapToUser | ||||
|      | ||||
|     /// Count the number of users for a church | ||||
|     let countByChurch (churchId : ChurchId) = | ||||
|         Custom.scalar | ||||
|             "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)" | ||||
|             [ "@churchId", Sql.uuid churchId.Value ] (fun row -> row.int "user_count") | ||||
|      | ||||
|     /// Count the number of users for a small group | ||||
|     let countByGroup (groupId : SmallGroupId) = | ||||
|         Custom.scalar "SELECT COUNT(user_id) AS user_count FROM pt.user_small_group WHERE small_group_id = @groupId" | ||||
|                       [ "@groupId", Sql.uuid groupId.Value ] (fun row -> row.int "user_count") | ||||
|      | ||||
|     /// Delete a user by its database ID | ||||
|     let deleteById (userId : UserId) = | ||||
|         Custom.nonQuery "DELETE FROM pt.pt_user WHERE id = @id" [ "@id", Sql.uuid userId.Value ] | ||||
|      | ||||
|     /// Get the IDs of the small groups for which the given user is authorized | ||||
|     let groupIdsByUserId (userId : UserId) = | ||||
|         Custom.list "SELECT small_group_id FROM pt.user_small_group WHERE user_id = @id" | ||||
|                    [ "@id", Sql.uuid userId.Value ] (fun row -> SmallGroupId (row.uuid "small_group_id")) | ||||
|      | ||||
|     /// Get a list of users authorized to administer the given small group | ||||
|     let listByGroupId (groupId : SmallGroupId) = | ||||
|         Custom.list | ||||
|             "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" | ||||
|             [ "@groupId", Sql.uuid groupId.Value ] mapToUser | ||||
|      | ||||
|     /// Save a user's information | ||||
|     let save (user : User) =  | ||||
|         Custom.nonQuery | ||||
|             "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" | ||||
|             [   "@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 ] | ||||
|      | ||||
|     /// Find a user by its e-mail address and authorized small group | ||||
|     let tryByEmailAndGroup email (groupId : SmallGroupId) = | ||||
|         Custom.single | ||||
|             "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" | ||||
|             [ "@email", Sql.string email; "@groupId", Sql.uuid groupId.Value ] mapToUser | ||||
|      | ||||
|     /// Find a user by their database ID | ||||
|     let tryById (userId : UserId) = | ||||
|         Custom.single "SELECT * FROM pt.pt_user WHERE id = @id" [ "@id", Sql.uuid userId.Value ] mapToUser | ||||
|      | ||||
|     /// Update a user's last seen date/time | ||||
|     let updateLastSeen (userId : UserId) (now : Instant) = | ||||
|         Custom.nonQuery "UPDATE pt.pt_user SET last_seen = @now WHERE id = @id" | ||||
|                         [ "@id", Sql.uuid userId.Value; "@now", Sql.parameter (NpgsqlParameter ("@now", now)) ] | ||||
|      | ||||
|     /// Update a user's password hash | ||||
|     let updatePassword (user : User) = | ||||
|         Custom.nonQuery "UPDATE pt.pt_user SET password_hash = @passwordHash WHERE id = @id" | ||||
|                         [ "@id", Sql.uuid user.Id.Value; "@passwordHash", Sql.string user.PasswordHash ] | ||||
|      | ||||
|     /// Update a user's authorized small groups | ||||
|     let updateSmallGroups (userId : UserId) groupIds = backgroundTask { | ||||
|         let! existingGroupIds = groupIdsByUserId userId | ||||
|         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! _ = | ||||
|                 Configuration.dataSource () | ||||
|                 |> Sql.fromDataSource | ||||
|                 |> Sql.executeTransactionAsync (List.ofSeq queries) | ||||
|             () | ||||
|     } | ||||
| @ -1,193 +0,0 @@ | ||||
| namespace PrayerTracker.Data | ||||
| 
 | ||||
| open System.Threading | ||||
| open System.Threading.Tasks | ||||
| open Microsoft.Extensions.Caching.Distributed | ||||
| open NodaTime | ||||
| open Npgsql | ||||
| open Npgsql.FSharp | ||||
| 
 | ||||
| /// Helper types and functions for the cache | ||||
| [<AutoOpen>] | ||||
| module private CacheHelpers = | ||||
|      | ||||
|     open System | ||||
|      | ||||
|     /// The cache entry | ||||
|     type Entry = | ||||
|         {   /// The ID of the cache entry | ||||
|             Id : string | ||||
|              | ||||
|             /// The value to be cached | ||||
|             Payload : byte[] | ||||
|              | ||||
|             /// When this entry will expire | ||||
|             ExpireAt : Instant | ||||
|              | ||||
|             /// The duration by which the expiration should be pushed out when being refreshed | ||||
|             SlidingExpiration : Duration option | ||||
|              | ||||
|             /// The must-expire-by date/time for the cache entry | ||||
|             AbsoluteExpiration : Instant option | ||||
|         } | ||||
|      | ||||
|     /// Run a task synchronously | ||||
|     let sync<'T> (it : Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously) | ||||
|      | ||||
|     /// Get the current instant | ||||
|     let getNow () = SystemClock.Instance.GetCurrentInstant () | ||||
|      | ||||
|     /// Create a parameter for the expire-at time | ||||
|     let expireParam (it : Instant) = | ||||
|         "@expireAt", Sql.parameter (NpgsqlParameter ("@expireAt", it)) | ||||
|      | ||||
|     /// Create a parameter for a possibly-missing NodaTime type | ||||
|     let optParam<'T> name (it : 'T option) = | ||||
|         let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value) | ||||
|         p.ParameterName, Sql.parameter p | ||||
| 
 | ||||
| 
 | ||||
| open BitBadger.Documents.Postgres | ||||
| 
 | ||||
| /// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog | ||||
| type DistributedCache () = | ||||
|      | ||||
|     // ~~~ INITIALIZATION ~~~ | ||||
|      | ||||
|     do | ||||
|         task { | ||||
|             let! exists = | ||||
|                 Custom.scalar | ||||
|                     $"SELECT EXISTS | ||||
|                           (SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session') | ||||
|                         AS does_exist" | ||||
|                     [] (fun row -> row.bool "does_exist") | ||||
|             if not exists then | ||||
|                 do! Custom.nonQuery | ||||
|                         "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)" [] | ||||
|         } |> sync | ||||
|      | ||||
|     // ~~~ SUPPORT FUNCTIONS ~~~ | ||||
|      | ||||
|     /// Get an entry, updating it for sliding expiration | ||||
|     let getEntry key = backgroundTask { | ||||
|         let idParam = "@id", Sql.string key | ||||
|         let! tryEntry = | ||||
|             Custom.single "SELECT * FROM session WHERE id = @id" [ idParam ] | ||||
|                           (fun row -> | ||||
|                               {   Id                 = row.string                     "id" | ||||
|                                   Payload            = row.bytea                      "payload" | ||||
|                                   ExpireAt           = row.fieldValue<Instant>        "expire_at" | ||||
|                                   SlidingExpiration  = row.fieldValueOrNone<Duration> "sliding_expiration" | ||||
|                                   AbsoluteExpiration = row.fieldValueOrNone<Instant>  "absolute_expiration"   }) | ||||
|         match 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 | ||||
|                 do! Custom.nonQuery "UPDATE session SET expire_at = @expireAt WHERE id = @id" | ||||
|                                     [ expireParam item.ExpireAt; idParam ] | ||||
|             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 | ||||
|             do! Custom.nonQuery "DELETE FROM session WHERE expire_at < @expireAt" [ expireParam now ] | ||||
|             lastPurge <- now | ||||
|     } | ||||
|      | ||||
|     /// Remove a cache entry | ||||
|     let removeEntry key = | ||||
|         Custom.nonQuery "DELETE FROM session WHERE id = @id" [ "@id", Sql.string key ] | ||||
|      | ||||
|     /// Save an entry | ||||
|     let saveEntry (opts : DistributedCacheEntryOptions) key payload = | ||||
|         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 | ||||
|         Custom.nonQuery | ||||
|             "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" | ||||
|             [   "@id",      Sql.string key | ||||
|                 "@payload", Sql.bytea payload | ||||
|                 expireParam expireAt | ||||
|                 optParam "slideExp" slideExp | ||||
|                 optParam "absExp"   absExp ] | ||||
|          | ||||
|     // ~~~ 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 | ||||
| 
 | ||||
| @ -1,557 +0,0 @@ | ||||
| namespace PrayerTracker.Entities | ||||
| 
 | ||||
| (*-- 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 | ||||
| 
 | ||||
| /// 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 | ||||
| 
 | ||||
| /// 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 | ||||
| 
 | ||||
| /// 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 | ||||
| 
 | ||||
| /// 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 | ||||
| 
 | ||||
| /// 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 | ||||
|     /// The GUID value of the church ID | ||||
|     member this.Value = this |> function ChurchId guid -> guid | ||||
| 
 | ||||
| 
 | ||||
| /// 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 | ||||
| 
 | ||||
| 
 | ||||
| /// 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 | ||||
| 
 | ||||
| 
 | ||||
| /// 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 | ||||
| 
 | ||||
| 
 | ||||
| /// PK type for the TimeZone entity | ||||
| type TimeZoneId = TimeZoneId of string | ||||
| 
 | ||||
| /// Functions to support time zone IDs | ||||
| module TimeZoneId = | ||||
|      | ||||
|     /// Convert a time zone ID to its string value | ||||
|     let toString = function TimeZoneId it -> it | ||||
| 
 | ||||
| 
 | ||||
| /// 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 | ||||
| [<NoComparison; NoEquality>] | ||||
| 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 | ||||
|     } | ||||
| 
 | ||||
| 
 | ||||
| /// Information needed to display the public/protected request list and small group maintenance pages | ||||
| [<NoComparison; NoEquality>] | ||||
| 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 | ||||
| [<NoComparison; NoEquality>] | ||||
| 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 | ||||
|     } | ||||
| 
 | ||||
| /// Functions to support churches | ||||
| module Church = | ||||
|      | ||||
|     /// An empty church | ||||
|     // aww... how sad :( | ||||
|     let empty = | ||||
|         {   Id               = ChurchId Guid.Empty | ||||
|             Name             = "" | ||||
|             City             = "" | ||||
|             State            = "" | ||||
|             HasVpsInterface  = false | ||||
|             InterfaceAddress = None | ||||
|         } | ||||
|      | ||||
| 
 | ||||
| /// Preferences for the form and format of the prayer request list | ||||
| [<NoComparison; NoEquality>] | ||||
| 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 | ||||
|      | ||||
|     /// 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 | ||||
|     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 | ||||
| [<NoComparison; NoEquality>] | ||||
| 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 | ||||
|     } | ||||
| 
 | ||||
| /// Functions to support small group members | ||||
| module Member = | ||||
|      | ||||
|     /// An empty member | ||||
|     let empty = | ||||
|         {   Id           = MemberId Guid.Empty | ||||
|             SmallGroupId = SmallGroupId Guid.Empty | ||||
|             Name         = "" | ||||
|             Email        = "" | ||||
|             Format       = None | ||||
|         } | ||||
| 
 | ||||
| 
 | ||||
| /// This represents a single prayer request | ||||
| [<NoComparison; NoEquality>] | ||||
| 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 | ||||
|     } | ||||
| // functions are below small group functions | ||||
| 
 | ||||
| 
 | ||||
| /// This represents a small group (Sunday School class, Bible study group, etc.) | ||||
| [<NoComparison; NoEquality>] | ||||
| 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 | ||||
|     } | ||||
| 
 | ||||
| /// Functions to support small groups | ||||
| module SmallGroup = | ||||
|      | ||||
|     /// An empty small group | ||||
|     let empty = | ||||
|         {   Id          = SmallGroupId Guid.Empty | ||||
|             ChurchId    = ChurchId Guid.Empty | ||||
|             Name        = ""  | ||||
|             Preferences = ListPreferences.empty | ||||
|         } | ||||
| 
 | ||||
|     /// 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 | ||||
| [<NoComparison; NoEquality>] | ||||
| 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 | ||||
|     /// The full name of the user | ||||
|     member this.Name = | ||||
|         $"{this.FirstName} {this.LastName}" | ||||
| 
 | ||||
| /// 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 | ||||
| [<NoComparison; NoEquality>] | ||||
| 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 | ||||
|     } | ||||
| 
 | ||||
| /// Functions to support user/small group cross-reference | ||||
| module UserSmallGroup = | ||||
|      | ||||
|     /// An empty user/small group xref | ||||
|     let empty = | ||||
|         {   UserId       = UserId Guid.Empty | ||||
|             SmallGroupId = SmallGroupId Guid.Empty | ||||
|         } | ||||
| @ -1,18 +0,0 @@ | ||||
| <Project Sdk="Microsoft.NET.Sdk"> | ||||
| 
 | ||||
|   <ItemGroup> | ||||
|     <Compile Include="Entities.fs" /> | ||||
|     <Compile Include="Access.fs" /> | ||||
|     <Compile Include="DistributedCache.fs" /> | ||||
|   </ItemGroup> | ||||
| 
 | ||||
|   <ItemGroup> | ||||
|     <PackageReference Include="BitBadger.Documents.Postgres" Version="3.1.0" /> | ||||
|     <PackageReference Include="Giraffe" Version="6.4.0" /> | ||||
|     <PackageReference Include="NodaTime" Version="3.1.11" /> | ||||
|     <PackageReference Include="Npgsql.FSharp" Version="5.7.0" /> | ||||
|     <PackageReference Include="Npgsql.NodaTime" Version="8.0.3" /> | ||||
|     <PackageReference Update="FSharp.Core" Version="8.0.300" /> | ||||
|   </ItemGroup> | ||||
| 
 | ||||
| </Project> | ||||
							
								
								
									
										21
									
								
								src/PrayerTracker.MigrateV9/PrayerTracker.MigrateV9.fsproj
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										21
									
								
								src/PrayerTracker.MigrateV9/PrayerTracker.MigrateV9.fsproj
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,21 @@ | ||||
| <Project Sdk="Microsoft.NET.Sdk"> | ||||
| 
 | ||||
|   <PropertyGroup> | ||||
|     <OutputType>Exe</OutputType> | ||||
|     <TargetFramework>net9.0</TargetFramework> | ||||
|   </PropertyGroup> | ||||
| 
 | ||||
|   <ItemGroup> | ||||
|     <Compile Include="Program.fs" /> | ||||
|   </ItemGroup> | ||||
| 
 | ||||
|   <ItemGroup> | ||||
|     <ProjectReference Include="..\Data\PrayerTracker.Data.fsproj" /> | ||||
|   </ItemGroup> | ||||
| 
 | ||||
|   <ItemGroup> | ||||
|     <PackageReference Include="BitBadger.Documents.Postgres" Version="4.0.1" /> | ||||
|     <PackageReference Include="Npgsql.NodaTime" Version="9.0.2" /> | ||||
|   </ItemGroup> | ||||
| 
 | ||||
| </Project> | ||||
							
								
								
									
										133
									
								
								src/PrayerTracker.MigrateV9/Program.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										133
									
								
								src/PrayerTracker.MigrateV9/Program.fs
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,133 @@ | ||||
|  | ||||
| open NodaTime | ||||
| open PrayerTracker.Entities | ||||
| 
 | ||||
| module PgMappings = | ||||
|     /// 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 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.Parse } | ||||
| 
 | ||||
|     /// Map a row to a Prayer Request instance | ||||
|     let mapToPrayerRequest (row: RowReader) = | ||||
|         { Id             = PrayerRequestId         (row.uuid "id") | ||||
|           UserId         = UserId                  (row.uuid "user_id") | ||||
|           SmallGroupId   = SmallGroupId            (row.uuid "small_group_id") | ||||
|           EnteredDate    = row.fieldValue<Instant> "entered_date" | ||||
|           UpdatedDate    = row.fieldValue<Instant> "updated_date" | ||||
|           Requestor      = row.stringOrNone        "requestor" | ||||
|           Text           = row.string              "request_text" | ||||
|           NotifyChaplain = row.bool                "notify_chaplain" | ||||
|           RequestType    = PrayerRequestType.Parse (row.string "request_type") | ||||
|           Expiration     = Expiration.Parse        (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 = | ||||
|               { 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.Parse     (row.string "request_sort") | ||||
|                 DefaultEmailType    = EmailFormat.Parse     (row.string "default_email_type") | ||||
|                 AsOfDateDisplay     = AsOfDateDisplay.Parse (row.string "as_of_date_display") } } | ||||
| 
 | ||||
|     /// Map a row to a User instance | ||||
|     let mapToUser (row: RowReader) = | ||||
|         { Id           = UserId     (row.uuid "id") | ||||
|           FirstName    = row.string "first_name" | ||||
|           LastName     = row.string "last_name" | ||||
|           Email        = row.string "email" | ||||
|           IsAdmin      = row.bool   "is_admin" | ||||
|           PasswordHash = row.string "password_hash" | ||||
|           LastSeen     = row.fieldValueOrNone<Instant> "last_seen" | ||||
|           SmallGroups  = [] } | ||||
| 
 | ||||
| 
 | ||||
| open System | ||||
| open BitBadger.Documents.Sqlite | ||||
| open Npgsql | ||||
| open Npgsql.FSharp | ||||
| open PrayerTracker.Data | ||||
| 
 | ||||
| task { | ||||
| 
 | ||||
|     Configuration.useConnectionString (Environment.GetEnvironmentVariable "PT_SQLITE_CONN") | ||||
|     do! Connection.setUp () | ||||
| 
 | ||||
|     let builder = NpgsqlDataSourceBuilder(Environment.GetEnvironmentVariable "PT_PG_CONN") | ||||
|     let _ = builder.UseNodaTime() | ||||
|     use source = builder.Build() | ||||
| 
 | ||||
|     let! churches = | ||||
|         Sql.fromDataSource source | ||||
|         |> Sql.query "SELECT * FROM pt.church" | ||||
|         |> Sql.executeAsync PgMappings.mapToChurch | ||||
|     for church in churches do | ||||
|         do! Churches.save church | ||||
|     printfn "Migrated %d churches" churches.Length | ||||
| 
 | ||||
|     let! groups = | ||||
|         Sql.fromDataSource source | ||||
|         |> Sql.query "SELECT sg.*, lp.* FROM pt.small_group sg | ||||
|                         INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id" | ||||
|         |> Sql.executeAsync PgMappings.mapToSmallGroup | ||||
|     for group in groups do | ||||
|         do! SmallGroups.save group | ||||
|     printfn "Migrated %d groups" groups.Length | ||||
| 
 | ||||
|     let! members = | ||||
|         Sql.fromDataSource source | ||||
|         |> Sql.query "SELECT * from pt.member" | ||||
|         |> Sql.executeAsync PgMappings.mapToMember | ||||
|     for mbr in members do | ||||
|         do! Members.save mbr | ||||
|     printfn "Migrated %d members" members.Length | ||||
| 
 | ||||
|     let! requests = | ||||
|         Sql.fromDataSource source | ||||
|         |> Sql.query "SELECT * from pt.prayer_request" | ||||
|         |> Sql.executeAsync PgMappings.mapToPrayerRequest | ||||
|     for request in requests do | ||||
|         do! PrayerRequests.save request | ||||
|     printfn "Migrated %d requests" requests.Length | ||||
| 
 | ||||
|     let! users = | ||||
|         Sql.fromDataSource source | ||||
|         |> Sql.query "SELECT * FROM pt.pt_user" | ||||
|         |> Sql.executeAsync PgMappings.mapToUser | ||||
|     for user in users do | ||||
|         let! groups = | ||||
|             Sql.fromDataSource source | ||||
|             |> Sql.query "SELECT small_group_id FROM pt.user_small_group WHERE user_id = @user_id" | ||||
|             |> Sql.parameters [ "@user_id", Sql.uuid user.Id.Value ] | ||||
|             |> Sql.executeAsync (fun row -> (row.uuid >> SmallGroupId) "small_group_id") | ||||
|         do! Users.save { user with SmallGroups = groups } | ||||
|     printfn "Migrated %d users" users.Length | ||||
| 
 | ||||
| } |> Async.AwaitTask |> Async.RunSynchronously | ||||
| @ -1,361 +0,0 @@ | ||||
| module PrayerTracker.Entities.EntitiesTests | ||||
| 
 | ||||
| open Expecto | ||||
| open NodaTime.Testing | ||||
| open NodaTime | ||||
| open System | ||||
| 
 | ||||
| [<Tests>] | ||||
| let asOfDateDisplayTests = | ||||
|     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" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let churchTests = | ||||
|     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" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let emailFormatTests = | ||||
|     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" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let expirationTests = | ||||
|     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" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let listPreferencesTests = | ||||
|     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" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let memberTests = | ||||
|     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" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let prayerRequestTests = | ||||
|     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)" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let prayerRequestTypeTests = | ||||
|     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" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let requestSortTests = | ||||
|     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" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let smallGroupTests = | ||||
|     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" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let userTests = | ||||
|     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" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let userSmallGroupTests = | ||||
|     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" | ||||
|         } | ||||
|     ] | ||||
| @ -5,17 +5,19 @@ VisualStudioVersion = 17.2.32630.192 | ||||
| MinimumVisualStudioVersion = 10.0.40219.1 | ||||
| Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker", "PrayerTracker\PrayerTracker.fsproj", "{63780D3F-D811-4BFB-9FB0-C28A83CCE28F}" | ||||
| EndProject | ||||
| Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.UI", "PrayerTracker.UI\PrayerTracker.UI.fsproj", "{EEE04A2B-818C-4241-90C5-69097CB0BF71}" | ||||
| Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.UI", "UI\PrayerTracker.UI.fsproj", "{EEE04A2B-818C-4241-90C5-69097CB0BF71}" | ||||
| EndProject | ||||
| Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Tests", "PrayerTracker.Tests\PrayerTracker.Tests.fsproj", "{786E7BE9-9370-4117-B194-02CC2F71AA09}" | ||||
| Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Tests", "Tests\PrayerTracker.Tests.fsproj", "{786E7BE9-9370-4117-B194-02CC2F71AA09}" | ||||
| EndProject | ||||
| Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Data", "PrayerTracker.Data\PrayerTracker.Data.fsproj", "{2B5BA107-9BDA-4A1D-A9AF-AFEE6BF12270}" | ||||
| Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Data", "Data\PrayerTracker.Data.fsproj", "{2B5BA107-9BDA-4A1D-A9AF-AFEE6BF12270}" | ||||
| EndProject | ||||
| Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{B290BA27-C8B8-44F3-BF01-D103302D815F}" | ||||
| 	ProjectSection(SolutionItems) = preProject | ||||
| 		Directory.Build.props = Directory.Build.props | ||||
| 	EndProjectSection | ||||
| EndProject | ||||
| Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "PrayerTracker.MigrateV9", "PrayerTracker.MigrateV9\PrayerTracker.MigrateV9.fsproj", "{CE7C5972-AC9A-44A8-8265-771483FD87DB}" | ||||
| EndProject | ||||
| Global | ||||
| 	GlobalSection(SolutionConfigurationPlatforms) = preSolution | ||||
| 		Debug|Any CPU = Debug|Any CPU | ||||
| @ -38,6 +40,10 @@ Global | ||||
| 		{2B5BA107-9BDA-4A1D-A9AF-AFEE6BF12270}.Debug|Any CPU.Build.0 = Debug|Any CPU | ||||
| 		{2B5BA107-9BDA-4A1D-A9AF-AFEE6BF12270}.Release|Any CPU.ActiveCfg = Release|Any CPU | ||||
| 		{2B5BA107-9BDA-4A1D-A9AF-AFEE6BF12270}.Release|Any CPU.Build.0 = Release|Any CPU | ||||
| 		{CE7C5972-AC9A-44A8-8265-771483FD87DB}.Debug|Any CPU.ActiveCfg = Debug|Any CPU | ||||
| 		{CE7C5972-AC9A-44A8-8265-771483FD87DB}.Debug|Any CPU.Build.0 = Debug|Any CPU | ||||
| 		{CE7C5972-AC9A-44A8-8265-771483FD87DB}.Release|Any CPU.ActiveCfg = Release|Any CPU | ||||
| 		{CE7C5972-AC9A-44A8-8265-771483FD87DB}.Release|Any CPU.Build.0 = Release|Any CPU | ||||
| 	EndGlobalSection | ||||
| 	GlobalSection(SolutionProperties) = preSolution | ||||
| 		HideSolutionNode = FALSE | ||||
|  | ||||
| @ -3,12 +3,13 @@ namespace PrayerTracker | ||||
| open Microsoft.AspNetCore.Http | ||||
| 
 | ||||
| /// Middleware to add the starting ticks for the request | ||||
| type RequestStartMiddleware (next: RequestDelegate) = | ||||
|      | ||||
|     member this.InvokeAsync (ctx: HttpContext) = task { | ||||
|         ctx.Items[Key.startTime] <- ctx.Now | ||||
|         return! next.Invoke ctx | ||||
|     } | ||||
| type RequestStartMiddleware(next: RequestDelegate) = | ||||
| 
 | ||||
|     member this.InvokeAsync(ctx: HttpContext) = | ||||
|         task { | ||||
|             ctx.Items[Key.startTime] <- ctx.Now | ||||
|             return! next.Invoke ctx | ||||
|         } | ||||
| 
 | ||||
| 
 | ||||
| open System | ||||
| @ -19,155 +20,179 @@ open Microsoft.Extensions.Configuration | ||||
| /// Module to hold configuration for the web app | ||||
| [<RequireQualifiedAccess>] | ||||
| module Configure = | ||||
|    | ||||
| 
 | ||||
|     /// Set up the configuration for the app | ||||
|     let configuration (ctx: WebHostBuilderContext) (cfg: IConfigurationBuilder) = | ||||
|         cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath) | ||||
|         cfg | ||||
|             .SetBasePath(ctx.HostingEnvironment.ContentRootPath) | ||||
|             .AddJsonFile("appsettings.json", optional = true, reloadOnChange = true) | ||||
|             .AddJsonFile($"appsettings.{ctx.HostingEnvironment.EnvironmentName}.json", optional = true) | ||||
|             .AddEnvironmentVariables() | ||||
|         |> ignore | ||||
| 
 | ||||
|     open Microsoft.AspNetCore.Server.Kestrel.Core | ||||
|      | ||||
| 
 | ||||
|     /// Configure Kestrel from appsettings.json | ||||
|     let kestrel (ctx: WebHostBuilderContext) (opts: KestrelServerOptions) = | ||||
|         (ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel" | ||||
| 
 | ||||
|     open System.Globalization | ||||
|     open BitBadger.Documents.Postgres | ||||
|     open BitBadger.Documents.Sqlite | ||||
|     open Microsoft.AspNetCore.Authentication.Cookies | ||||
|     open Microsoft.AspNetCore.Localization | ||||
|     open Microsoft.Extensions.Caching.Distributed | ||||
|     open Microsoft.Extensions.DependencyInjection | ||||
|     open NeoSmart.Caching.Sqlite | ||||
|     open NodaTime | ||||
|     open Npgsql | ||||
|     open PrayerTracker.Data | ||||
|      | ||||
| 
 | ||||
|     /// Configure ASP.NET Core's service collection (dependency injection container) | ||||
|     let services (svc : IServiceCollection) = | ||||
|     let services (svc: IServiceCollection) = | ||||
|         let _ = svc.AddOptions() | ||||
|         let _ = svc.AddLocalization(fun options -> options.ResourcesPath <- "Resources") | ||||
| 
 | ||||
|         let _ = | ||||
|             svc.Configure<RequestLocalizationOptions>(fun (opts: RequestLocalizationOptions) -> | ||||
|                 let supportedCultures = [| | ||||
|                     CultureInfo "en-US"; CultureInfo "en-GB"; CultureInfo "en-AU"; CultureInfo "en" | ||||
|                     CultureInfo "es-MX"; CultureInfo "es-ES"; CultureInfo "es" |] | ||||
|                 let supportedCultures = | ||||
|                     [| CultureInfo "en-US" | ||||
|                        CultureInfo "en-GB" | ||||
|                        CultureInfo "en-AU" | ||||
|                        CultureInfo "en" | ||||
|                        CultureInfo "es-MX" | ||||
|                        CultureInfo "es-ES" | ||||
|                        CultureInfo "es" |] | ||||
| 
 | ||||
|                 opts.DefaultRequestCulture <- RequestCulture("en-US", "en-US") | ||||
|                 opts.SupportedCultures     <- supportedCultures | ||||
|                 opts.SupportedUICultures   <- supportedCultures) | ||||
|                 opts.SupportedCultures <- supportedCultures | ||||
|                 opts.SupportedUICultures <- supportedCultures) | ||||
| 
 | ||||
|         let _ = | ||||
|             svc.AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme) | ||||
|             svc | ||||
|                 .AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme) | ||||
|                 .AddCookie(fun opts -> | ||||
|                     opts.ExpireTimeSpan    <- TimeSpan.FromMinutes 120. | ||||
|                     opts.ExpireTimeSpan <- TimeSpan.FromMinutes 120. | ||||
|                     opts.SlidingExpiration <- true | ||||
|                     opts.AccessDeniedPath  <- "/error/403") | ||||
|                     opts.AccessDeniedPath <- "/error/403") | ||||
| 
 | ||||
|         let _ = svc.AddAuthorization() | ||||
| 
 | ||||
|         let cfg = svc.BuildServiceProvider().GetService<IConfiguration>() | ||||
|         let dsb = NpgsqlDataSourceBuilder(cfg.GetConnectionString "PrayerTracker") | ||||
|         let _   = dsb.UseNodaTime() | ||||
|         dsb.Build() |> Configuration.useDataSource  | ||||
|         Configuration.useConnectionString (cfg.GetConnectionString "PrayerTracker") | ||||
|         Connection.setUp () |> Async.AwaitTask |> Async.RunSynchronously | ||||
| 
 | ||||
|         let emailCfg = cfg.GetSection "Email" | ||||
|         if (emailCfg.GetChildren >> Seq.isEmpty >> not) () then ConfigurationBinder.Bind(emailCfg, Email.smtpOptions) | ||||
| 
 | ||||
|         let _ = svc.AddSingleton<IDistributedCache, DistributedCache>() | ||||
|         if (emailCfg.GetChildren >> Seq.isEmpty >> not) () then | ||||
|             ConfigurationBinder.Bind(emailCfg, Email.smtpOptions) | ||||
| 
 | ||||
|         let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SessionDB")) "./data/session.db" | ||||
|         let _ = svc.AddSqliteCache(fun o -> o.CachePath <- cachePath) | ||||
|         let _ = svc.AddSession() | ||||
|         let _ = svc.AddLogging() | ||||
|         let _ = svc.AddAntiforgery() | ||||
|         let _ = svc.AddRouting() | ||||
|         let _ = svc.AddSingleton<IClock> SystemClock.Instance | ||||
|          | ||||
| 
 | ||||
|         () | ||||
|      | ||||
| 
 | ||||
|     open Giraffe | ||||
|      | ||||
|     let noWeb : HttpHandler = fun next ctx -> | ||||
|         redirectTo true $"""/{string ctx.Request.RouteValues["path"]}""" next ctx | ||||
|          | ||||
| 
 | ||||
|     /// <summary>Endpoint to redirect URLs starting with <c>/web</c> to their non-web equivalent</summary> | ||||
|     let noWeb: HttpHandler = | ||||
|         fun next ctx -> redirectTo true $"""/{string ctx.Request.RouteValues["path"]}""" next ctx | ||||
| 
 | ||||
|     open Giraffe.EndpointRouting | ||||
|      | ||||
| 
 | ||||
|     /// Routes for PrayerTracker | ||||
|     let routes = [ | ||||
|         route "/web/{**path}" noWeb | ||||
|         GET_HEAD [ | ||||
|             subRoute "/church" [ | ||||
|                 route  "es"       Handlers.Church.maintain | ||||
|                 routef "/%O/edit" Handlers.Church.edit ] | ||||
|             route    "/class/logon" (redirectTo true "/small-group/log-on") | ||||
|             routef   "/error/%s"    Handlers.Home.error | ||||
|             subRoute "/help" [ | ||||
|                 route    "" Handlers.Help.index | ||||
|                 subRoute "/requests" [ | ||||
|                     route "/edit"     Handlers.Help.Requests.edit | ||||
|                     route "/maintain" Handlers.Help.Requests.maintain | ||||
|                     route "/view"     Handlers.Help.Requests.view ] | ||||
|                 subRoute "/small-group" [ | ||||
|                     route "/announcement" Handlers.Help.SmallGroup.announcement | ||||
|                     route "/members"      Handlers.Help.SmallGroup.members | ||||
|                     route "/preferences"  Handlers.Help.SmallGroup.preferences ] | ||||
|                 subRoute "/user" [ | ||||
|                     route "/log-on"   Handlers.Help.User.logOn | ||||
|                     route "/password" Handlers.Help.User.password ] ] | ||||
|             routef   "/language/%s" Handlers.Home.language | ||||
|             subRoute "/legal" [ | ||||
|                 route "/privacy-policy"   Handlers.Home.privacyPolicy | ||||
|                 route "/terms-of-service" Handlers.Home.tos ] | ||||
|             route    "/log-off" Handlers.Home.logOff | ||||
|             subRoute "/prayer-request" [ | ||||
|                 route  "s"           (Handlers.PrayerRequest.maintain true) | ||||
|                 routef "s/email/%s"  Handlers.PrayerRequest.email | ||||
|                 route  "s/inactive"  (Handlers.PrayerRequest.maintain false) | ||||
|                 route  "s/lists"     Handlers.PrayerRequest.lists | ||||
|                 routef "s/%O/list"   Handlers.PrayerRequest.list | ||||
|                 route  "s/maintain"  (redirectTo true "/prayer-requests") | ||||
|                 routef "s/print/%s"  Handlers.PrayerRequest.print | ||||
|                 route  "s/view"      (Handlers.PrayerRequest.view None) | ||||
|                 routef "s/view/%s"   (Some >> Handlers.PrayerRequest.view) | ||||
|                 routef "/%O/edit"    Handlers.PrayerRequest.edit | ||||
|                 routef "/%O/expire"  Handlers.PrayerRequest.expire | ||||
|                 routef "/%O/restore" Handlers.PrayerRequest.restore ] | ||||
|             subRoute "/small-group" [ | ||||
|                 route  ""                Handlers.SmallGroup.overview | ||||
|                 route  "s"               Handlers.SmallGroup.maintain | ||||
|                 route  "/announcement"   Handlers.SmallGroup.announcement | ||||
|                 routef "/%O/edit"        Handlers.SmallGroup.edit | ||||
|                 route  "/log-on"         (Handlers.SmallGroup.logOn None) | ||||
|                 routef "/log-on/%O"      (Some >> Handlers.SmallGroup.logOn) | ||||
|                 route  "/logon"          (redirectTo true "/small-group/log-on") | ||||
|                 routef "/member/%O/edit" Handlers.SmallGroup.editMember | ||||
|                 route  "/members"        Handlers.SmallGroup.members | ||||
|                 route  "/preferences"    Handlers.SmallGroup.preferences ] | ||||
|             route    "/unauthorized" Handlers.Home.unauthorized | ||||
|             subRoute "/user" [ | ||||
|                 route  "s"                Handlers.User.maintain | ||||
|                 routef "/%O/edit"         Handlers.User.edit | ||||
|                 routef "/%O/small-groups" Handlers.User.smallGroups | ||||
|                 route  "/log-on"          Handlers.User.logOn | ||||
|                 route  "/logon"           (redirectTo true "/user/log-on") | ||||
|                 route  "/password"        Handlers.User.password ] | ||||
|             route    "/" Handlers.Home.homePage ] | ||||
|         POST [ | ||||
|             subRoute "/church" [ | ||||
|                 routef "/%O/delete" Handlers.Church.delete | ||||
|                 route  "/save"      Handlers.Church.save ] | ||||
|             subRoute "/prayer-request" [ | ||||
|                 routef "/%O/delete" Handlers.PrayerRequest.delete | ||||
|                 route  "/save"      Handlers.PrayerRequest.save ] | ||||
|             subRoute "/small-group" [ | ||||
|                 route  "/announcement/send" Handlers.SmallGroup.sendAnnouncement | ||||
|                 routef "/%O/delete"         Handlers.SmallGroup.delete | ||||
|                 route  "/log-on/submit"     Handlers.SmallGroup.logOnSubmit | ||||
|                 routef "/member/%O/delete"  Handlers.SmallGroup.deleteMember | ||||
|                 route  "/member/save"       Handlers.SmallGroup.saveMember | ||||
|                 route  "/preferences/save"  Handlers.SmallGroup.savePreferences | ||||
|                 route  "/save"              Handlers.SmallGroup.save ] | ||||
|             subRoute "/user" [ | ||||
|                 routef "/%O/delete"         Handlers.User.delete | ||||
|                 route  "/edit/save"         Handlers.User.save | ||||
|                 route  "/log-on"            Handlers.User.doLogOn | ||||
|                 route  "/password/change"   Handlers.User.changePassword | ||||
|                 route  "/small-groups/save" Handlers.User.saveGroups ] ] ] | ||||
|     let routes = | ||||
|         [ route "/web/{**path}" noWeb | ||||
|           GET_HEAD | ||||
|               [ subRoute "/church" [ route "es" Handlers.Church.maintain; routef "/%O/edit" Handlers.Church.edit ] | ||||
|                 route "/class/logon" (redirectTo true "/small-group/log-on") | ||||
|                 routef "/error/%s" Handlers.Home.error | ||||
|                 subRoute | ||||
|                     "/help" | ||||
|                     [ route "" Handlers.Help.index | ||||
|                       subRoute | ||||
|                           "/requests" | ||||
|                           [ route "/edit" Handlers.Help.Requests.edit | ||||
|                             route "/maintain" Handlers.Help.Requests.maintain | ||||
|                             route "/view" Handlers.Help.Requests.view ] | ||||
|                       subRoute | ||||
|                           "/small-group" | ||||
|                           [ route "/announcement" Handlers.Help.SmallGroup.announcement | ||||
|                             route "/members" Handlers.Help.SmallGroup.members | ||||
|                             route "/preferences" Handlers.Help.SmallGroup.preferences ] | ||||
|                       subRoute | ||||
|                           "/user" | ||||
|                           [ route "/log-on" Handlers.Help.User.logOn | ||||
|                             route "/password" Handlers.Help.User.password ] ] | ||||
|                 routef "/language/%s" Handlers.Home.language | ||||
|                 subRoute | ||||
|                     "/legal" | ||||
|                     [ route "/privacy-policy" Handlers.Home.privacyPolicy | ||||
|                       route "/terms-of-service" Handlers.Home.tos ] | ||||
|                 route "/log-off" Handlers.Home.logOff | ||||
|                 subRoute | ||||
|                     "/prayer-request" | ||||
|                     [ route "s" (Handlers.PrayerRequest.maintain true) | ||||
|                       routef "s/email/%s" Handlers.PrayerRequest.email | ||||
|                       route "s/inactive" (Handlers.PrayerRequest.maintain false) | ||||
|                       route "s/lists" Handlers.PrayerRequest.lists | ||||
|                       routef "s/%O/list" Handlers.PrayerRequest.list | ||||
|                       route "s/maintain" (redirectTo true "/prayer-requests") | ||||
|                       routef "s/print/%s" Handlers.PrayerRequest.print | ||||
|                       route "s/view" (Handlers.PrayerRequest.view None) | ||||
|                       routef "s/view/%s" (Some >> Handlers.PrayerRequest.view) | ||||
|                       routef "/%O/edit" Handlers.PrayerRequest.edit | ||||
|                       routef "/%O/expire" Handlers.PrayerRequest.expire | ||||
|                       routef "/%O/restore" Handlers.PrayerRequest.restore ] | ||||
|                 subRoute | ||||
|                     "/small-group" | ||||
|                     [ route "" Handlers.SmallGroup.overview | ||||
|                       route "s" Handlers.SmallGroup.maintain | ||||
|                       route "/announcement" Handlers.SmallGroup.announcement | ||||
|                       routef "/%O/edit" Handlers.SmallGroup.edit | ||||
|                       route "/log-on" (Handlers.SmallGroup.logOn None) | ||||
|                       routef "/log-on/%O" (Some >> Handlers.SmallGroup.logOn) | ||||
|                       route "/logon" (redirectTo true "/small-group/log-on") | ||||
|                       routef "/member/%O/edit" Handlers.SmallGroup.editMember | ||||
|                       route "/members" Handlers.SmallGroup.members | ||||
|                       route "/preferences" Handlers.SmallGroup.preferences ] | ||||
|                 route "/unauthorized" Handlers.Home.unauthorized | ||||
|                 subRoute | ||||
|                     "/user" | ||||
|                     [ route "s" Handlers.User.maintain | ||||
|                       routef "/%O/edit" Handlers.User.edit | ||||
|                       routef "/%O/small-groups" Handlers.User.smallGroups | ||||
|                       route "/log-on" Handlers.User.logOn | ||||
|                       route "/logon" (redirectTo true "/user/log-on") | ||||
|                       route "/password" Handlers.User.password ] | ||||
|                 route "/" Handlers.Home.homePage ] | ||||
|           POST | ||||
|               [ subRoute | ||||
|                     "/church" | ||||
|                     [ routef "/%O/delete" Handlers.Church.delete | ||||
|                       route "/save" Handlers.Church.save ] | ||||
|                 subRoute | ||||
|                     "/prayer-request" | ||||
|                     [ routef "/%O/delete" Handlers.PrayerRequest.delete | ||||
|                       route "/save" Handlers.PrayerRequest.save ] | ||||
|                 subRoute | ||||
|                     "/small-group" | ||||
|                     [ route "/announcement/send" Handlers.SmallGroup.sendAnnouncement | ||||
|                       routef "/%O/delete" Handlers.SmallGroup.delete | ||||
|                       route "/log-on/submit" Handlers.SmallGroup.logOnSubmit | ||||
|                       routef "/member/%O/delete" Handlers.SmallGroup.deleteMember | ||||
|                       route "/member/save" Handlers.SmallGroup.saveMember | ||||
|                       route "/preferences/save" Handlers.SmallGroup.savePreferences | ||||
|                       route "/save" Handlers.SmallGroup.save ] | ||||
|                 subRoute | ||||
|                     "/user" | ||||
|                     [ routef "/%O/delete" Handlers.User.delete | ||||
|                       route "/edit/save" Handlers.User.save | ||||
|                       route "/log-on" Handlers.User.doLogOn | ||||
|                       route "/password/change" Handlers.User.changePassword | ||||
|                       route "/small-groups/save" Handlers.User.saveGroups ] ] ] | ||||
| 
 | ||||
|     open Microsoft.Extensions.Logging | ||||
| 
 | ||||
| @ -175,29 +200,35 @@ module Configure = | ||||
|     let errorHandler (ex: exn) (logger: ILogger) = | ||||
|         logger.LogError(EventId(), ex, "An unhandled exception has occurred while executing the request.") | ||||
|         clearResponse >=> setStatusCode 500 >=> text ex.Message | ||||
|      | ||||
| 
 | ||||
|     open Microsoft.Extensions.Hosting | ||||
|      | ||||
| 
 | ||||
|     /// Configure logging | ||||
|     let logging (log: ILoggingBuilder) = | ||||
|         let env = log.Services.BuildServiceProvider().GetService<IWebHostEnvironment>() | ||||
|         if env.IsDevelopment() then log else log.AddFilter(fun l -> l > LogLevel.Information) | ||||
|         |> function l -> l.AddConsole().AddDebug() | ||||
| 
 | ||||
|         if env.IsDevelopment() then | ||||
|             log | ||||
|         else | ||||
|             log.AddFilter(fun l -> l > LogLevel.Information) | ||||
|         |> function | ||||
|             | l -> l.AddConsole().AddDebug() | ||||
|         |> ignore | ||||
|      | ||||
| 
 | ||||
|     open BitBadger.AspNetCore.CanonicalDomains | ||||
|     open Microsoft.Extensions.Localization | ||||
|     open Microsoft.Extensions.Options | ||||
|      | ||||
| 
 | ||||
|     /// Configure the application | ||||
|     let app (app : IApplicationBuilder) = | ||||
|         let env = app.ApplicationServices.GetRequiredService<IWebHostEnvironment>() | ||||
|     let app (app: WebApplication) = | ||||
|         let env = app.Services.GetRequiredService<IWebHostEnvironment>() | ||||
| 
 | ||||
|         if env.IsDevelopment() then | ||||
|             app.UseDeveloperExceptionPage() | ||||
|         else | ||||
|             app.UseGiraffeErrorHandler errorHandler | ||||
|         |> ignore | ||||
|          | ||||
| 
 | ||||
|         let _ = app.UseForwardedHeaders() | ||||
|         let _ = app.UseCanonicalDomains() | ||||
|         let _ = app.UseStatusCodePagesWithReExecute "/error/{0}" | ||||
| @ -206,31 +237,50 @@ module Configure = | ||||
|         let _ = app.UseMiddleware<RequestStartMiddleware>() | ||||
|         let _ = app.UseRouting() | ||||
|         let _ = app.UseSession() | ||||
|         let _ = app.UseRequestLocalization( | ||||
|             app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value) | ||||
|         let _ = app.UseRequestLocalization(app.Services.GetService<IOptions<RequestLocalizationOptions>>().Value) | ||||
|         let _ = app.UseAuthentication() | ||||
|         let _ = app.UseAuthorization() | ||||
|         let _ = app.UseEndpoints(fun e -> e.MapGiraffeEndpoints routes) | ||||
|         app.ApplicationServices.GetRequiredService<IStringLocalizerFactory>() |> Views.I18N.setUpFactories  | ||||
| 
 | ||||
|         app.Services.GetRequiredService<IStringLocalizerFactory>() | ||||
|         |> Views.I18N.setUpFactories | ||||
| 
 | ||||
| open Microsoft.Extensions.DependencyInjection | ||||
| open Microsoft.Extensions.Logging | ||||
| 
 | ||||
| /// The web application | ||||
| module App = | ||||
|      | ||||
| 
 | ||||
|     open System.IO | ||||
| 
 | ||||
|     [<EntryPoint>] | ||||
|     let main args = | ||||
| 
 | ||||
|         let contentRoot = Directory.GetCurrentDirectory() | ||||
|         let app = | ||||
|             WebHostBuilder() | ||||
|                 .UseContentRoot(contentRoot) | ||||
|         let builder = | ||||
|             WebApplication.CreateBuilder( | ||||
|                 WebApplicationOptions( | ||||
|                     Args = args, | ||||
|                     ApplicationName = "PrayerTracker", | ||||
|                     ContentRootPath = contentRoot, | ||||
|                     WebRootPath = Path.Combine(contentRoot, "wwwroot"))) | ||||
|         let _ = | ||||
|             builder.WebHost | ||||
|                 .ConfigureAppConfiguration(Configure.configuration) | ||||
|                 .UseKestrel(Configure.kestrel) | ||||
|                 .UseWebRoot(Path.Combine(contentRoot, "wwwroot")) | ||||
|                 .ConfigureKestrel(Configure.kestrel) | ||||
|                 .ConfigureServices(Configure.services) | ||||
|                 .ConfigureLogging(Configure.logging) | ||||
|                 .Configure(System.Action<IApplicationBuilder> Configure.app) | ||||
|                 .Build() | ||||
|         if args.Length > 0 then printfn $"Unrecognized option {args[0]}" else app.Run() | ||||
| 
 | ||||
|         use app = builder.Build() | ||||
| 
 | ||||
|         Configure.app app | ||||
| 
 | ||||
|         let fac = app.Services.GetRequiredService<ILoggerFactory>() | ||||
|         let log = fac.CreateLogger "PrayerTracker" | ||||
|         log.LogInformation "Application Started" | ||||
| 
 | ||||
|         app.Run() | ||||
| 
 | ||||
|         log.LogInformation "Application Shutting Down" | ||||
| 
 | ||||
|         0 | ||||
|  | ||||
| @ -12,7 +12,7 @@ let private findStats churchId = task { | ||||
|     let! groups   = SmallGroups.countByChurch    churchId | ||||
|     let! requests = PrayerRequests.countByChurch churchId | ||||
|     let! users    = Users.countByChurch          churchId | ||||
|     return shortGuid churchId.Value, { SmallGroups = groups; PrayerRequests = requests; Users = users } | ||||
|     return shortGuid churchId.Value, { SmallGroups = int groups; PrayerRequests = int requests; Users = int users } | ||||
| } | ||||
| 
 | ||||
| // POST /church/[church-id]/delete | ||||
| @ -40,7 +40,7 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta | ||||
|             |> renderHtml next ctx | ||||
|     else | ||||
|         match! Churches.tryById (ChurchId churchId) with | ||||
|         | Some church ->  | ||||
|         | Some church -> | ||||
|             return! | ||||
|                 viewInfo ctx | ||||
|                 |> Views.Church.edit (EditChurch.fromChurch church) ctx | ||||
| @ -63,7 +63,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c | ||||
|     match! ctx.TryBindFormAsync<EditChurch> () with | ||||
|     | Ok model -> | ||||
|         let! church = | ||||
|             if model.IsNew then Task.FromResult(Some { Church.empty with Id = (Guid.NewGuid >> ChurchId) () }) | ||||
|             if model.IsNew then Task.FromResult(Some { Church.Empty with Id = (Guid.NewGuid >> ChurchId) () }) | ||||
|             else Churches.tryById (idFromShort ChurchId model.ChurchId) | ||||
|         match church with | ||||
|         | Some ch -> | ||||
|  | ||||
| @ -13,11 +13,11 @@ let toSelectList<'T> valFunc textFunc withDefault emptyText (items: 'T seq) = | ||||
|           SelectListItem($"""— %A{s[emptyText]} —""", "") | ||||
|       | _ -> () | ||||
|       yield! items |> Seq.map (fun x -> SelectListItem(textFunc x, valFunc x)) ] | ||||
|    | ||||
| 
 | ||||
| /// Create a select list from an enumeration | ||||
| let toSelectListWithEmpty<'T> valFunc textFunc emptyText (items: 'T seq) = | ||||
|     toSelectList valFunc textFunc true emptyText items | ||||
|      | ||||
| 
 | ||||
| /// Create a select list from an enumeration | ||||
| let toSelectListWithDefault<'T> valFunc textFunc (items: 'T seq) = | ||||
|     toSelectList valFunc textFunc true "Select" items | ||||
| @ -117,7 +117,7 @@ let addInfo ctx msg = | ||||
| /// Add an informational HTML message to the session | ||||
| let addHtmlInfo ctx msg = | ||||
|     addUserMessage ctx { UserMessage.info with Text = htmlString msg } | ||||
|    | ||||
| 
 | ||||
| /// Add a warning message to the session | ||||
| let addWarning ctx msg = | ||||
|     addUserMessage ctx { UserMessage.warning with Text = htmlLocString msg } | ||||
|  | ||||
| @ -1,34 +1,30 @@ | ||||
| [<AutoOpen>] | ||||
| module PrayerTracker.Extensions | ||||
| 
 | ||||
| open BitBadger.Documents | ||||
| open Microsoft.AspNetCore.Http | ||||
| open Newtonsoft.Json | ||||
| open NodaTime | ||||
| open NodaTime.Serialization.JsonNet | ||||
| open PrayerTracker.Data | ||||
| open PrayerTracker.Entities | ||||
| open PrayerTracker.ViewModels | ||||
| 
 | ||||
| /// JSON.NET serializer settings for NodaTime | ||||
| let private jsonSettings = JsonSerializerSettings().ConfigureForNodaTime DateTimeZoneProviders.Tzdb | ||||
| 
 | ||||
| /// Extensions on the .NET session object | ||||
| type ISession with | ||||
|      | ||||
| 
 | ||||
|     /// Set an object in the session | ||||
|     member this.SetObject<'T> key (value: 'T) = | ||||
|         this.SetString(key, JsonConvert.SerializeObject(value, jsonSettings)) | ||||
|      | ||||
|         this.SetString(key, (Configuration.serializer ()).Serialize value) | ||||
| 
 | ||||
|     /// Get an object from the session | ||||
|     member this.TryGetObject<'T> key = | ||||
|         match this.GetString key with | ||||
|         | null -> None | ||||
|         | v -> Some (JsonConvert.DeserializeObject<'T>(v, jsonSettings)) | ||||
|         | v -> Some ((Configuration.serializer ()).Deserialize<'T> v) | ||||
| 
 | ||||
|     /// The currently logged on small group | ||||
|     member this.CurrentGroup | ||||
|       with get () = this.TryGetObject<SmallGroup> Key.Session.currentGroup | ||||
|        and set (v: SmallGroup option) =  | ||||
|        and set (v: SmallGroup option) = | ||||
|           match v with | ||||
|           | Some group -> this.SetObject Key.Session.currentGroup group | ||||
|           | None -> this.Remove Key.Session.currentGroup | ||||
| @ -40,7 +36,7 @@ type ISession with | ||||
|           match v with | ||||
|           | Some user -> this.SetObject Key.Session.currentUser { user with PasswordHash = "" } | ||||
|           | None -> this.Remove Key.Session.currentUser | ||||
|      | ||||
| 
 | ||||
|     /// Current messages for the session | ||||
|     member this.Messages | ||||
|       with get () = | ||||
| @ -53,43 +49,42 @@ open System.Security.Claims | ||||
| 
 | ||||
| /// Extensions on the claims principal | ||||
| type ClaimsPrincipal with | ||||
|      | ||||
|     /// The ID of the currently logged on small group     | ||||
| 
 | ||||
|     /// The ID of the currently logged on small group | ||||
|     member this.SmallGroupId = | ||||
|         if this.HasClaim (fun c -> c.Type = ClaimTypes.GroupSid) then | ||||
|             Some (idFromShort SmallGroupId (this.FindFirst(fun c -> c.Type = ClaimTypes.GroupSid).Value)) | ||||
|         else None | ||||
|      | ||||
|     /// The ID of the currently signed in user     | ||||
|         this.FindFirstValue ClaimTypes.GroupSid | ||||
|         |> Option.ofObj | ||||
|         |> Option.map (idFromShort SmallGroupId) | ||||
| 
 | ||||
|     /// The ID of the currently signed-in user | ||||
|     member this.UserId = | ||||
|         if this.HasClaim (fun c -> c.Type = ClaimTypes.NameIdentifier) then | ||||
|             Some (idFromShort UserId (this.FindFirst(fun c -> c.Type = ClaimTypes.NameIdentifier).Value)) | ||||
|         else None | ||||
|         this.FindFirstValue ClaimTypes.NameIdentifier | ||||
|         |> Option.ofObj | ||||
|         |> Option.map (idFromShort UserId) | ||||
| 
 | ||||
| 
 | ||||
| open Giraffe | ||||
| open Npgsql | ||||
| 
 | ||||
| /// Extensions on the ASP.NET Core HTTP context | ||||
| type HttpContext with | ||||
|      | ||||
| 
 | ||||
|     /// The system clock (via DI) | ||||
|     member this.Clock = this.GetService<IClock>() | ||||
|      | ||||
| 
 | ||||
|     /// The current instant | ||||
|     member this.Now = this.Clock.GetCurrentInstant() | ||||
|      | ||||
| 
 | ||||
|     /// The common string localizer | ||||
|     member _.Strings = Views.I18N.localizer.Force() | ||||
|      | ||||
| 
 | ||||
|     /// The currently logged on small group (sets the value in the session if it is missing) | ||||
|     member this.CurrentGroup () = task { | ||||
|     member this.CurrentGroup() = task { | ||||
|         match this.Session.CurrentGroup with | ||||
|         | Some group -> return Some group | ||||
|         | None -> | ||||
|             match this.User.SmallGroupId with | ||||
|             | Some groupId -> | ||||
|                 match! SmallGroups.tryByIdWithPreferences groupId with | ||||
|                 match! SmallGroups.tryById groupId with | ||||
|                 | Some group -> | ||||
|                     this.Session.CurrentGroup <- Some group | ||||
|                     return Some group | ||||
| @ -98,7 +93,7 @@ type HttpContext with | ||||
|     } | ||||
| 
 | ||||
|     /// The currently logged on user (sets the value in the session if it is missing) | ||||
|     member this.CurrentUser () = task { | ||||
|     member this.CurrentUser() = task { | ||||
|         match this.Session.CurrentUser with | ||||
|         | Some user -> return Some user | ||||
|         | None -> | ||||
|  | ||||
| @ -20,7 +20,7 @@ let private findRequest (ctx: HttpContext) reqId = task { | ||||
| /// Generate a list of requests for the given date | ||||
| let private generateRequestList (ctx: HttpContext) date = task { | ||||
|     let  group    = ctx.Session.CurrentGroup.Value | ||||
|     let  listDate = match date with Some d -> d | None -> SmallGroup.localDateNow ctx.Clock group | ||||
|     let  listDate = defaultArg date (group.LocalDateNow ctx.Clock) | ||||
|     let! reqs     = | ||||
|         PrayerRequests.forGroup | ||||
|             { SmallGroup = group | ||||
| @ -50,7 +50,7 @@ open System | ||||
| // GET /prayer-request/[request-id]/edit | ||||
| let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { | ||||
|     let group     = ctx.Session.CurrentGroup.Value | ||||
|     let now       = SmallGroup.localDateNow ctx.Clock group | ||||
|     let now       = group.LocalDateNow ctx.Clock | ||||
|     let requestId = PrayerRequestId reqId | ||||
|     if requestId.Value = Guid.Empty then | ||||
|         return! | ||||
| @ -61,7 +61,7 @@ let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { | ||||
|         match! findRequest ctx requestId with | ||||
|         | Ok req -> | ||||
|             let s = ctx.Strings | ||||
|             if PrayerRequest.isExpired now group req then | ||||
|             if req.IsExpired now group then | ||||
|                 { UserMessage.warning with | ||||
|                     Text        = htmlLocString s["This request is expired."] | ||||
|                     Description = | ||||
| @ -126,7 +126,7 @@ let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task | ||||
| 
 | ||||
| // GET /prayer-requests/[group-id]/list | ||||
| let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { | ||||
|     match! SmallGroups.tryByIdWithPreferences (SmallGroupId groupId) with | ||||
|     match! SmallGroups.tryById (SmallGroupId groupId) with | ||||
|     | Some group when group.Preferences.IsPublic -> | ||||
|         let! reqs = | ||||
|             PrayerRequests.forGroup | ||||
| @ -139,7 +139,7 @@ let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun ne | ||||
|             viewInfo ctx | ||||
|             |> Views.PrayerRequest.list | ||||
|                 { Requests   = reqs | ||||
|                   Date       = SmallGroup.localDateNow ctx.Clock group | ||||
|                   Date       = group.LocalDateNow ctx.Clock | ||||
|                   SmallGroup = group | ||||
|                   ShowHeader = true | ||||
|                   CanEmail   = Option.isSome ctx.User.UserId | ||||
| @ -226,7 +226,7 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct | ||||
|         let  group = ctx.Session.CurrentGroup.Value | ||||
|         let! req   = | ||||
|             if model.IsNew then | ||||
|                 { PrayerRequest.empty with | ||||
|                 { PrayerRequest.Empty with | ||||
|                     Id           = (Guid.NewGuid >> PrayerRequestId) () | ||||
|                     SmallGroupId = group.Id | ||||
|                     UserId       = ctx.User.UserId.Value | ||||
| @ -235,19 +235,19 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct | ||||
|             else PrayerRequests.tryById (idFromShort PrayerRequestId model.RequestId) | ||||
|         match req with | ||||
|         | Some pr when pr.SmallGroupId = group.Id -> | ||||
|             let now  = SmallGroup.localDateNow ctx.Clock group | ||||
|             let now  = group.LocalDateNow ctx.Clock | ||||
|             let updated = | ||||
|                 { pr with | ||||
|                     RequestType = PrayerRequestType.fromCode model.RequestType | ||||
|                     RequestType = PrayerRequestType.Parse model.RequestType | ||||
|                     Requestor   = match model.Requestor with Some x when x.Trim() = "" -> None | x -> x | ||||
|                     Text        = ckEditorToText model.Text | ||||
|                     Expiration  = Expiration.fromCode model.Expiration | ||||
|                     Expiration  = Expiration.Parse model.Expiration | ||||
|                 } | ||||
|                 |> function | ||||
|                 | it when model.IsNew -> | ||||
|                     let dt = | ||||
|                         (defaultArg (parseListDate model.EnteredDate) now) | ||||
|                             .AtStartOfDayInZone(SmallGroup.timeZone group) | ||||
|                             .AtStartOfDayInZone(group.TimeZone) | ||||
|                             .ToInstant() | ||||
|                     { it with EnteredDate = dt; UpdatedDate = dt } | ||||
|                 | it when defaultArg model.SkipDateUpdate false -> it | ||||
|  | ||||
| @ -25,15 +25,15 @@ | ||||
|   </ItemGroup> | ||||
| 
 | ||||
|   <ItemGroup> | ||||
|     <PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.0.0" /> | ||||
|     <PackageReference Include="Giraffe.Htmx" Version="2.0.0" /> | ||||
|     <PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" /> | ||||
|     <PackageReference Update="FSharp.Core" Version="8.0.300" /> | ||||
|     <PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.1.0" /> | ||||
|     <PackageReference Include="Giraffe.Htmx" Version="2.0.4" /> | ||||
|     <PackageReference Include="NeoSmart.Caching.Sqlite.AspNetCore" Version="9.0.0" /> | ||||
|     <PackageReference Update="FSharp.Core" Version="9.0.101" /> | ||||
|   </ItemGroup> | ||||
| 
 | ||||
|   <ItemGroup> | ||||
|     <ProjectReference Include="..\PrayerTracker.Data\PrayerTracker.Data.fsproj" /> | ||||
|     <ProjectReference Include="..\PrayerTracker.UI\PrayerTracker.UI.fsproj" /> | ||||
|     <ProjectReference Include="..\Data\PrayerTracker.Data.fsproj" /> | ||||
|     <ProjectReference Include="..\UI\PrayerTracker.UI.fsproj" /> | ||||
|   </ItemGroup> | ||||
| 
 | ||||
| </Project> | ||||
|  | ||||
| @ -152,8 +152,8 @@ let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { | ||||
|     let! admins   = Users.listByGroupId         group.Id | ||||
|     let  model    = | ||||
|         { TotalActiveReqs  = List.length reqs | ||||
|           AllReqs          = reqCount | ||||
|           TotalMembers     = mbrCount | ||||
|           AllReqs          = int reqCount | ||||
|           TotalMembers     = int mbrCount | ||||
|           ActiveReqsByType = ( | ||||
|              reqs | ||||
|              |> Seq.ofList | ||||
| @ -183,11 +183,11 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c | ||||
|     match! ctx.TryBindFormAsync<EditSmallGroup>() with | ||||
|     | Ok model -> | ||||
|         let! tryGroup = | ||||
|             if model.IsNew then Task.FromResult(Some { SmallGroup.empty with Id = (Guid.NewGuid >> SmallGroupId) () }) | ||||
|             if model.IsNew then Task.FromResult(Some { SmallGroup.Empty with Id = (Guid.NewGuid >> SmallGroupId) () }) | ||||
|             else SmallGroups.tryById (idFromShort SmallGroupId model.SmallGroupId) | ||||
|         match tryGroup with | ||||
|         | Some group -> | ||||
|             do! SmallGroups.save (model.populateGroup group) model.IsNew | ||||
|             do! SmallGroups.save (model.populateGroup group) | ||||
|             let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower() | ||||
|             addHtmlInfo ctx ctx.Strings["Successfully {0} group “{1}”", act, model.Name] | ||||
|             return! redirectTo false "/small-groups" next ctx | ||||
| @ -202,7 +202,7 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun n | ||||
|         let  group  = ctx.Session.CurrentGroup.Value | ||||
|         let! tryMbr = | ||||
|             if model.IsNew then | ||||
|                 Task.FromResult(Some { Member.empty with Id = (Guid.NewGuid >> MemberId) (); SmallGroupId = group.Id }) | ||||
|                 Task.FromResult(Some { Member.Empty with Id = (Guid.NewGuid >> MemberId) (); SmallGroupId = group.Id }) | ||||
|             else Members.tryById (idFromShort MemberId model.MemberId) | ||||
|         match tryMbr with | ||||
|         | Some mbr when mbr.SmallGroupId = group.Id -> | ||||
| @ -210,7 +210,7 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun n | ||||
|                     { mbr with | ||||
|                         Name   = model.Name | ||||
|                         Email  = model.Email | ||||
|                         Format = String.noneIfBlank model.Format |> Option.map EmailFormat.fromCode } | ||||
|                         Format = String.noneIfBlank model.Format |> Option.map EmailFormat.Parse } | ||||
|             let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower() | ||||
|             addInfo ctx ctx.Strings["Successfully {0} group member", act] | ||||
|             return! redirectTo false "/small-group/members" next ctx | ||||
| @ -227,10 +227,10 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> | ||||
|         // we can repopulate the session instance. That way, if the update fails, the page should still show the | ||||
|         // database values, not the then out-of-sync session ones. | ||||
|         let group = ctx.Session.CurrentGroup.Value | ||||
|         match! SmallGroups.tryByIdWithPreferences group.Id with | ||||
|         match! SmallGroups.tryById group.Id with | ||||
|         | Some group -> | ||||
|             let pref = model.PopulatePreferences group.Preferences | ||||
|             do! SmallGroups.savePreferences pref | ||||
|             do! SmallGroups.savePreferences group.Id pref | ||||
|             // Refresh session instance | ||||
|             ctx.Session.CurrentGroup <- Some { group with Preferences = pref } | ||||
|             addInfo ctx ctx.Strings["Group preferences updated successfully"] | ||||
| @ -241,7 +241,6 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> | ||||
| 
 | ||||
| open Giraffe.ViewEngine | ||||
| open PrayerTracker.Views.CommonFunctions | ||||
| open Microsoft.Extensions.Configuration | ||||
| 
 | ||||
| // POST /small-group/announcement/send | ||||
| let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { | ||||
| @ -250,7 +249,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> | ||||
|         let group = ctx.Session.CurrentGroup.Value | ||||
|         let pref  = group.Preferences | ||||
|         let usr   = ctx.Session.CurrentUser.Value | ||||
|         let now   = SmallGroup.localTimeNow ctx.Clock group | ||||
|         let now   = group.LocalTimeNow ctx.Clock | ||||
|         let s     = ctx.Strings | ||||
|         // Reformat the text to use the class's font stylings | ||||
|         let requestText = ckEditorToText model.Text | ||||
| @ -262,7 +261,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> | ||||
|         let! recipients = task { | ||||
|             if model.SendToClass = "N" && usr.IsAdmin then | ||||
|                 let! users = Users.all () | ||||
|                 return users |> List.map (fun u -> { Member.empty with Name = u.Name; Email = u.Email }) | ||||
|                 return users |> List.map (fun u -> { Member.Empty with Name = u.Name; Email = u.Email }) | ||||
|             else return! Members.forGroup group.Id | ||||
|         } | ||||
|         use! client = Email.getConnection () | ||||
| @ -282,13 +281,13 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> | ||||
|         | _, None  -> () | ||||
|         | _, Some x when not x -> () | ||||
|         | _, _ -> | ||||
|             let zone = SmallGroup.timeZone group | ||||
|             let zone = group.TimeZone | ||||
|             do! PrayerRequests.save | ||||
|                     { PrayerRequest.empty with | ||||
|                     { PrayerRequest.Empty with | ||||
|                         Id           = (Guid.NewGuid >> PrayerRequestId) () | ||||
|                         SmallGroupId = group.Id | ||||
|                         UserId       = usr.Id | ||||
|                         RequestType  = (Option.get >> PrayerRequestType.fromCode) model.RequestType | ||||
|                         RequestType  = (Option.get >> PrayerRequestType.Parse) model.RequestType | ||||
|                         Text         = requestText | ||||
|                         EnteredDate  = now.Date.AtStartOfDayInZone(zone).ToInstant() | ||||
|                         UpdatedDate  = now.InZoneLeniently(zone).ToInstant() } | ||||
|  | ||||
| @ -14,20 +14,20 @@ open PrayerTracker.ViewModels | ||||
| /// Password hashing implementation extending ASP.NET Core's identity implementation | ||||
| [<AutoOpen>] | ||||
| module Hashing = | ||||
|      | ||||
| 
 | ||||
|     open System.Security.Cryptography | ||||
|     open System.Text | ||||
|      | ||||
| 
 | ||||
|     /// Custom password hasher used to verify and upgrade old password hashes | ||||
|     type PrayerTrackerPasswordHasher() = | ||||
|         inherit PasswordHasher<User>() | ||||
|          | ||||
| 
 | ||||
|         override this.VerifyHashedPassword(user, hashedPassword, providedPassword) = | ||||
|             if isNull hashedPassword   then nullArg (nameof hashedPassword) | ||||
|             if isNull providedPassword then nullArg (nameof providedPassword) | ||||
|              | ||||
| 
 | ||||
|             let hashBytes = Convert.FromBase64String hashedPassword | ||||
|              | ||||
| 
 | ||||
|             match hashBytes[0] with | ||||
|             | 255uy -> | ||||
|                 // v2 hashes - PBKDF2 (RFC 2898), 1,024 rounds | ||||
| @ -53,7 +53,7 @@ module Hashing = | ||||
|                     PasswordVerificationResult.Failed | ||||
|             | _ -> base.VerifyHashedPassword(user, hashedPassword, providedPassword) | ||||
| 
 | ||||
|      | ||||
| 
 | ||||
| /// Retrieve a user from the database by password, upgrading password hashes if required | ||||
| let private findUserByPassword model = task { | ||||
|     match! Users.tryByEmailAndGroup model.Email (idFromShort SmallGroupId model.SmallGroupId) with | ||||
| @ -125,11 +125,11 @@ open Microsoft.AspNetCore.Html | ||||
| // POST /user/log-on | ||||
| let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task { | ||||
|     match! ctx.TryBindFormAsync<UserLogOn>() with | ||||
|     | Ok model ->  | ||||
|     | Ok model -> | ||||
|         let s = ctx.Strings | ||||
|         match! findUserByPassword model with | ||||
|         | Some user -> | ||||
|             match! SmallGroups.tryByIdWithPreferences (idFromShort SmallGroupId model.SmallGroupId) with | ||||
|             match! SmallGroups.tryById (idFromShort SmallGroupId model.SmallGroupId) with | ||||
|             | Some group -> | ||||
|                 ctx.Session.CurrentUser  <- Some user | ||||
|                 ctx.Session.CurrentGroup <- Some group | ||||
| @ -218,7 +218,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c | ||||
|     match! ctx.TryBindFormAsync<EditUser>() with | ||||
|     | Ok model -> | ||||
|         let! user = | ||||
|             if model.IsNew then Task.FromResult(Some { User.empty with Id = (Guid.NewGuid >> UserId) () }) | ||||
|             if model.IsNew then Task.FromResult(Some { User.Empty with Id = (Guid.NewGuid >> UserId) () }) | ||||
|             else Users.tryById (idFromShort UserId model.UserId) | ||||
|         match user with | ||||
|         | Some usr -> | ||||
| @ -230,7 +230,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c | ||||
|                 let h = CommonFunctions.htmlString | ||||
|                 { UserMessage.info with | ||||
|                     Text        = h s["Successfully {0} user", s["Added"].Value.ToLower ()] | ||||
|                     Description =  | ||||
|                     Description = | ||||
|                         h s["Please select at least one group for which this user ({0}) is authorized", | ||||
|                             updatedUser.Name] | ||||
|                         |> Some } | ||||
| @ -265,9 +265,9 @@ let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx - | ||||
|     match! Users.tryById userId with | ||||
|     | Some user -> | ||||
|         let! groups    = SmallGroups.listAll () | ||||
|         let! groupIds  = Users.groupIdsByUserId userId | ||||
|         let  groupIds  = user.SmallGroups | ||||
|         let  curGroups = groupIds |> List.map (fun g -> shortGuid g.Value) | ||||
|         return!  | ||||
|         return! | ||||
|             viewInfo ctx | ||||
|             |> Views.User.assignGroups (AssignGroups.fromUser user) groups curGroups ctx | ||||
|             |> renderHtml next ctx | ||||
|  | ||||
							
								
								
									
										0
									
								
								src/PrayerTracker/data/.gitkeep
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										0
									
								
								src/PrayerTracker/data/.gitkeep
									
									
									
									
									
										Normal file
									
								
							
							
								
								
									
										87
									
								
								src/PrayerTracker/wwwroot/_/fixi-0.5.7.js
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										87
									
								
								src/PrayerTracker/wwwroot/_/fixi-0.5.7.js
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,87 @@ | ||||
| (()=>{ | ||||
| 	let send = (elt, type, detail, bub)=>elt.dispatchEvent(new CustomEvent("fx:" + type, {detail, cancelable:true, bubbles:bub !== false, composed:true})) | ||||
| 	let attr = (elt, name, defaultVal)=>elt.getAttribute(name) || defaultVal | ||||
| 	let ignore = (elt)=>elt.matches("[fx-ignore]") || elt.closest("[fx-ignore]") != null | ||||
| 	let init = (elt)=>{ | ||||
| 		let options = {} | ||||
| 		if (elt.__fixi || ignore(elt) || !send(elt, "init", {options})) return | ||||
| 		elt.__fixi = async(evt)=>{ | ||||
| 			let reqs = elt.__fixi.requests ||= new Set() | ||||
| 			let form = elt.form || elt.closest("form") | ||||
| 			let body = new FormData(form ?? undefined, evt.submitter) | ||||
| 			if (!form && elt.name) body.append(elt.name, elt.value) | ||||
| 			let ac = new AbortController() | ||||
| 			let cfg = { | ||||
| 				trigger:evt, | ||||
| 				action:attr(elt, "fx-action"), | ||||
| 				method:attr(elt, "fx-method", "GET").toUpperCase(), | ||||
| 				target: document.querySelector(attr(elt, "fx-target")) ?? elt, | ||||
| 				swap:attr(elt, "fx-swap", "outerHTML"), | ||||
| 				body, | ||||
| 				drop:reqs.size, | ||||
| 				headers:{"FX-Request":"true"}, | ||||
| 				abort:ac.abort.bind(ac), | ||||
| 				signal:ac.signal, | ||||
| 				preventTrigger:true, | ||||
| 				transition:document.startViewTransition?.bind(document), | ||||
| 				fetch:fetch.bind(window) | ||||
| 			} | ||||
| 			let go = send(elt, "config", {cfg, requests:reqs}) | ||||
| 			if (cfg.preventTrigger) evt.preventDefault() | ||||
| 			if (!go || cfg.drop) return | ||||
| 			if (/GET|DELETE/.test(cfg.method)){ | ||||
| 				let params = new URLSearchParams(cfg.body) | ||||
| 				if (params.size) | ||||
| 					cfg.action += (/\?/.test(cfg.action) ? "&" : "?") + params | ||||
| 				cfg.body = null | ||||
| 			} | ||||
| 			reqs.add(cfg) | ||||
| 			try { | ||||
| 				if (cfg.confirm){ | ||||
| 					let result = await cfg.confirm() | ||||
| 					if (!result) return | ||||
| 				} | ||||
| 				if (!send(elt, "before", {cfg, requests:reqs})) return | ||||
| 				cfg.response = await cfg.fetch(cfg.action, cfg) | ||||
| 				cfg.text = await cfg.response.text() | ||||
| 				if (!send(elt, "after", {cfg})) return | ||||
| 			} catch(error) { | ||||
| 				send(elt, "error", {cfg, error}) | ||||
| 				return | ||||
| 			} finally { | ||||
| 				reqs.delete(cfg) | ||||
| 				send(elt, "finally", {cfg}) | ||||
| 			} | ||||
| 			let doSwap = ()=>{ | ||||
| 				if (cfg.swap instanceof Function) | ||||
| 					return cfg.swap(cfg) | ||||
| 				else if (/(before|after)(start|end)/.test(cfg.swap)) | ||||
| 					cfg.target.insertAdjacentHTML(cfg.swap, cfg.text) | ||||
| 				else if(cfg.swap in cfg.target) | ||||
| 					cfg.target[cfg.swap] = cfg.text | ||||
| 				else throw cfg.swap | ||||
| 			} | ||||
| 			if (cfg.transition) | ||||
| 				await cfg.transition(doSwap).finished | ||||
| 			else | ||||
| 				await doSwap() | ||||
| 			send(elt, "swapped", {cfg}) | ||||
| 		} | ||||
| 		elt.__fixi.evt = attr(elt, "fx-trigger", elt.matches("form") ? "submit" : elt.matches("input:not([type=button]),select,textarea") ? "change" : "click") | ||||
| 		elt.addEventListener(elt.__fixi.evt, elt.__fixi, options) | ||||
| 		send(elt, "inited", {}, false) | ||||
| 	} | ||||
| 	let process = (elt)=>{ | ||||
| 		if (elt instanceof Element){ | ||||
| 			if (ignore(elt)) return | ||||
| 			if (elt.matches("[fx-action]")) init(elt) | ||||
| 			elt.querySelectorAll("[fx-action]").forEach(init) | ||||
| 		} | ||||
| 	} | ||||
| 	document.addEventListener("fx:process", (evt)=>process(evt.target)) | ||||
| 	document.addEventListener("DOMContentLoaded", ()=>{ | ||||
| 		document.__fixi_mo = new MutationObserver((recs)=>recs.forEach((r)=>r.type === "childList" && r.addedNodes.forEach((n)=>process(n)))) | ||||
| 		document.__fixi_mo.observe(document.body, {childList:true, subtree:true}) | ||||
| 		process(document.body) | ||||
| 	}) | ||||
| })() | ||||
							
								
								
									
										368
									
								
								src/Tests/Data/EntitiesTests.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										368
									
								
								src/Tests/Data/EntitiesTests.fs
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,368 @@ | ||||
| module PrayerTracker.Entities.EntitiesTests | ||||
| 
 | ||||
| open Expecto | ||||
| open NodaTime.Testing | ||||
| open NodaTime | ||||
| open System | ||||
| 
 | ||||
| [<Tests>] | ||||
| let asOfDateDisplayTests = | ||||
|     testList "AsOfDateDisplay" [ | ||||
|         testList "ToString" [ | ||||
|             test "NoDisplay code is correct" { | ||||
|                 Expect.equal (string NoDisplay) "N" "The code for NoDisplay should have been \"N\"" | ||||
|             } | ||||
|             test "ShortDate code is correct" { | ||||
|                 Expect.equal (string ShortDate) "S" "The code for ShortDate should have been \"S\"" | ||||
|             } | ||||
|             test "LongDate code is correct" { | ||||
|                 Expect.equal (string LongDate) "L" "The code for LongDate should have been \"N\"" | ||||
|             } | ||||
|         ] | ||||
|         testList "Parse" [ | ||||
|             test "N should return NoDisplay" { | ||||
|                 Expect.equal (AsOfDateDisplay.Parse "N") NoDisplay "\"N\" should have been parsed to NoDisplay" | ||||
|             } | ||||
|             test "S should return ShortDate" { | ||||
|                 Expect.equal (AsOfDateDisplay.Parse "S") ShortDate "\"S\" should have been parsed to ShortDate" | ||||
|             } | ||||
|             test "L should return LongDate" { | ||||
|                 Expect.equal (AsOfDateDisplay.Parse "L") LongDate "\"L\" should have been parsed to LongDate" | ||||
|             } | ||||
|             test "X should raise" { | ||||
|                 Expect.throws (fun () -> AsOfDateDisplay.Parse "X" |> ignore) | ||||
|                     "An unknown code should have raised an exception" | ||||
|             } | ||||
|         ] | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let churchTests = | ||||
|     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" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let emailFormatTests = | ||||
|     testList "EmailFormat" [ | ||||
|         testList "ToString" [ | ||||
|             test "HtmlFormat code is correct" { | ||||
|                 Expect.equal (string HtmlFormat) "H" "The code for HtmlFormat should have been \"H\"" | ||||
|             } | ||||
|             test "PlainTextFormat code is correct" { | ||||
|                 Expect.equal (string PlainTextFormat) "P" "The code for PlainTextFormat should have been \"P\"" | ||||
|             } | ||||
|         ] | ||||
|         testList "Parse" [ | ||||
|             test "H should return HtmlFormat" { | ||||
|                 Expect.equal (EmailFormat.Parse "H") HtmlFormat "\"H\" should have been converted to HtmlFormat" | ||||
|             } | ||||
|             test "P should return ShortDate" { | ||||
|                 Expect.equal (EmailFormat.Parse "P") PlainTextFormat | ||||
|                     "\"P\" should have been converted to PlainTextFormat" | ||||
|             } | ||||
|             test "Z should raise" { | ||||
|                 Expect.throws (fun () -> EmailFormat.Parse "Z" |> ignore) | ||||
|                     "An unknown code should have raised an exception" | ||||
|             } | ||||
|         ] | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let expirationTests = | ||||
|     testList "Expiration" [ | ||||
|         testList "ToString" [ | ||||
|             test "Automatic code is correct" { | ||||
|                 Expect.equal (string Automatic) "A" "The code for Automatic should have been \"A\"" | ||||
|             } | ||||
|             test "Manual code is correct" { | ||||
|                 Expect.equal (string Manual) "M" "The code for Manual should have been \"M\"" | ||||
|             } | ||||
|             test "Forced code is correct" { | ||||
|                 Expect.equal (string Forced) "F" "The code for Forced should have been \"F\"" | ||||
|             } | ||||
|         ] | ||||
|         testList "Parse" [ | ||||
|             test "A should return Automatic" { | ||||
|                 Expect.equal (Expiration.Parse "A") Automatic "\"A\" should have been converted to Automatic" | ||||
|             } | ||||
|             test "M should return Manual" { | ||||
|                 Expect.equal (Expiration.Parse "M") Manual "\"M\" should have been converted to Manual" | ||||
|             } | ||||
|             test "F should return Forced" { | ||||
|                 Expect.equal (Expiration.Parse "F") Forced "\"F\" should have been converted to Forced" | ||||
|             } | ||||
|             test "fromCode V should raise" { | ||||
|                 Expect.throws (fun () -> Expiration.Parse "V" |> ignore) | ||||
|                     "An unknown code should have raised an exception" | ||||
|             } | ||||
|         ] | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let listPreferencesTests = | ||||
|     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.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 (string mt.TimeZoneId) "America/Denver" "The default time zone should have been America/Denver" | ||||
|             Expect.equal mt.PageSize 100 "The default page size should have been 100" | ||||
|             Expect.equal mt.AsOfDateDisplay NoDisplay "The as-of date display should have been No Display" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let memberTests = | ||||
|     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" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let prayerRequestTests = | ||||
|     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.Empty with RequestType = Expecting }.IsExpired (localDateNow ()) SmallGroup.Empty | ||||
|             |> Flip.Expect.isFalse "An expecting request should never be considered expired" | ||||
|         } | ||||
|         test "IsExpired always returns false for manually-expired requests" { | ||||
|             { PrayerRequest.Empty with | ||||
|                 UpdatedDate = (instantNow ()) - Duration.FromDays 1 | ||||
|                 Expiration = Manual }.IsExpired (localDateNow ()) SmallGroup.Empty | ||||
|             |> Flip.Expect.isFalse "A never-expired request should never be considered expired" | ||||
|         } | ||||
|         test "IsExpired always returns false for long term/recurring requests" { | ||||
|             { PrayerRequest.Empty with RequestType = LongTermRequest }.IsExpired (localDateNow ()) SmallGroup.Empty | ||||
|             |> Flip.Expect.isFalse "A recurring/long-term request should never be considered expired" | ||||
|         } | ||||
|         test "IsExpired always returns true for force-expired requests" { | ||||
|             { PrayerRequest.Empty with UpdatedDate = (instantNow ()); Expiration = Forced }.IsExpired | ||||
|                 (localDateNow ()) SmallGroup.Empty | ||||
|             |> Flip.Expect.isTrue "A force-expired request should always be considered expired" | ||||
|         } | ||||
|         test "IsExpired returns false for non-expired requests" { | ||||
|             let now = instantNow () | ||||
|             { PrayerRequest.Empty with UpdatedDate = now - Duration.FromDays 5 }.IsExpired | ||||
|                 (now.InUtc().Date) SmallGroup.Empty | ||||
|             |> 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.Empty with UpdatedDate = now - Duration.FromDays 15 }.IsExpired | ||||
|                 (now.InUtc().Date) SmallGroup.Empty | ||||
|             |> 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.Empty with | ||||
|                 UpdatedDate = now - (Duration.FromDays 14) - (Duration.FromSeconds 1L) }.IsExpired | ||||
|                     (now.InUtc().Date) SmallGroup.Empty | ||||
|             |> Flip.Expect.isTrue  "A request entered a second before midnight should be considered expired" | ||||
|         } | ||||
|         test "UpdateRequired returns false for expired requests" { | ||||
|             { PrayerRequest.Empty with Expiration = Forced }.UpdateRequired (localDateNow ()) SmallGroup.Empty | ||||
|             |> 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.Empty with | ||||
|                 RequestType = LongTermRequest | ||||
|                 UpdatedDate = now - Duration.FromDays 14 }.UpdateRequired (localDateNow ()) SmallGroup.Empty | ||||
|             |> 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.Empty with | ||||
|                 RequestType = LongTermRequest | ||||
|                 UpdatedDate = now - Duration.FromDays 34 }.UpdateRequired (localDateNow ()) SmallGroup.Empty | ||||
|             |> Flip.Expect.isTrue "An active request updated 34 days ago should require an update (past 28 days)" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let prayerRequestTypeTests = | ||||
|     testList "PrayerRequestType" [ | ||||
|         testList "ToString" [ | ||||
|             test "CurrentRequest code is correct" { | ||||
|                 Expect.equal (string CurrentRequest) "C" "The code for CurrentRequest should have been \"C\"" | ||||
|             } | ||||
|             test "LongTermRequest code is correct" { | ||||
|                 Expect.equal (string LongTermRequest) "L" "The code for LongTermRequest should have been \"L\"" | ||||
|             } | ||||
|             test "PraiseReport code is correct" { | ||||
|                 Expect.equal (string PraiseReport) "P" "The code for PraiseReport should have been \"P\"" | ||||
|             } | ||||
|             test "Expecting code is correct" { | ||||
|                 Expect.equal (string Expecting) "E" "The code for Expecting should have been \"E\"" | ||||
|             } | ||||
|             test "Announcement code is correct" { | ||||
|                 Expect.equal (string Announcement) "A" "The code for Announcement should have been \"A\"" | ||||
|             } | ||||
|         ] | ||||
|         testList "Parse" [ | ||||
|             test "C should return CurrentRequest" { | ||||
|                 Expect.equal (PrayerRequestType.Parse "C") CurrentRequest | ||||
|                     "\"C\" should have been converted to CurrentRequest" | ||||
|             } | ||||
|             test "L should return LongTermRequest" { | ||||
|                 Expect.equal (PrayerRequestType.Parse "L") LongTermRequest | ||||
|                     "\"L\" should have been converted to LongTermRequest" | ||||
|             } | ||||
|             test "P should return PraiseReport" { | ||||
|                 Expect.equal (PrayerRequestType.Parse "P") PraiseReport | ||||
|                     "\"P\" should have been converted to PraiseReport" | ||||
|             } | ||||
|             test "E should return Expecting" { | ||||
|                 Expect.equal (PrayerRequestType.Parse "E") Expecting "\"E\" should have been converted to Expecting" | ||||
|             } | ||||
|             test "A should return Announcement" { | ||||
|                 Expect.equal (PrayerRequestType.Parse "A") Announcement | ||||
|                     "\"A\" should have been converted to Announcement" | ||||
|             } | ||||
|             test "R should raise" { | ||||
|                 Expect.throws (fun () -> PrayerRequestType.Parse "R" |> ignore) | ||||
|                     "An unknown code should have raised an exception" | ||||
|             } | ||||
|         ] | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let requestSortTests = | ||||
|     testList "RequestSort" [ | ||||
|         testList "ToString" [ | ||||
|             test "SortByDate code is correct" { | ||||
|                 Expect.equal (string SortByDate) "D" "The code for SortByDate should have been \"D\"" | ||||
|             } | ||||
|             test "SortByRequestor code is correct" { | ||||
|                 Expect.equal (string SortByRequestor) "R" "The code for SortByRequestor should have been \"R\"" | ||||
|             } | ||||
|         ] | ||||
|         testList "Parse" [ | ||||
|             test "D should return SortByDate" { | ||||
|                 Expect.equal (RequestSort.Parse "D") SortByDate "\"D\" should have been converted to SortByDate" | ||||
|             } | ||||
|             test "R should return SortByRequestor" { | ||||
|                 Expect.equal (RequestSort.Parse "R") SortByRequestor | ||||
|                     "\"R\" should have been converted to SortByRequestor" | ||||
|             } | ||||
|             test "Q should raise" { | ||||
|                 Expect.throws (fun () -> RequestSort.Parse "Q" |> ignore) | ||||
|                     "An unknown code should have raised an exception" | ||||
|             } | ||||
|         ] | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let smallGroupTests = | ||||
|     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 (grp.LocalTimeNow clock) (now.InUtc().LocalDateTime) | ||||
|                     "UTC to Europe/Berlin should have added hours" | ||||
|             "LocalTimeNow adjusts the time behind UTC", | ||||
|             fun clock -> | ||||
|                 Expect.isLessThan (SmallGroup.Empty.LocalTimeNow clock) (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 (grp.LocalTimeNow clock) (now.InUtc().LocalDateTime) | ||||
|                     "UTC should have been returned for an invalid time zone" | ||||
|         ] | ||||
|         yield test "localTimeNow fails when clock is not passed" { | ||||
|             Expect.throws (fun () -> SmallGroup.Empty.LocalTimeNow null |> 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.Empty.LocalDateNow clock) (now.InUtc().Date) | ||||
|                 "The date should have been a day earlier" | ||||
|         } | ||||
|     ] | ||||
| 
 | ||||
| [<Tests>] | ||||
| let userTests = | ||||
|     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" | ||||
|         } | ||||
|     ] | ||||
| @ -15,13 +15,11 @@ | ||||
| 
 | ||||
|   <ItemGroup> | ||||
|     <PackageReference Include="Expecto" Version="10.2.1" /> | ||||
|     <PackageReference Include="NodaTime.Testing" Version="3.1.11" /> | ||||
|     <PackageReference Update="FSharp.Core" Version="8.0.300" /> | ||||
|     <PackageReference Include="NodaTime.Testing" Version="3.2.1" /> | ||||
|     <PackageReference Update="FSharp.Core" Version="9.0.101" /> | ||||
|   </ItemGroup> | ||||
| 
 | ||||
|   <ItemGroup> | ||||
|     <ProjectReference Include="..\PrayerTracker.Data\PrayerTracker.Data.fsproj" /> | ||||
|     <ProjectReference Include="..\PrayerTracker.UI\PrayerTracker.UI.fsproj" /> | ||||
|     <ProjectReference Include="..\PrayerTracker\PrayerTracker.fsproj" /> | ||||
|   </ItemGroup> | ||||
| 
 | ||||
| @ -15,19 +15,16 @@ let countAll _ = true | ||||
| 
 | ||||
| 
 | ||||
| module ReferenceListTests = | ||||
|    | ||||
| 
 | ||||
|     [<Tests>] | ||||
|     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" | ||||
|                 Expect.exists asOf (fun (x, _) -> x = string NoDisplay) "The option for no display was not found" | ||||
|                 Expect.exists asOf (fun (x, _) -> x = string ShortDate) "The option for a short date was not found" | ||||
|                 Expect.exists asOf (fun (x, _) -> x = string LongDate) "The option for a full date was not found" | ||||
|             } | ||||
|         ] | ||||
| 
 | ||||
| @ -41,35 +38,35 @@ module ReferenceListTests = | ||||
|                 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" | ||||
|                 Expect.equal (fst nxt) (string 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" | ||||
|                 Expect.equal (fst lst) (string PlainTextFormat) "The 3rd option should have been plain text" | ||||
|             } | ||||
|         ] | ||||
|      | ||||
| 
 | ||||
|     [<Tests>] | ||||
|     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) | ||||
|                 Expect.exists exps (fun (exp, _) -> exp = string Automatic) | ||||
|                     "The option for automatic expiration was not found" | ||||
|                 Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Manual) | ||||
|                 Expect.exists exps (fun (exp, _) -> exp = string 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) | ||||
|                 Expect.exists exps (fun (exp, _) -> exp = string Automatic) | ||||
|                     "The option for automatic expiration was not found" | ||||
|                 Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Manual) | ||||
|                 Expect.exists exps (fun (exp, _) -> exp = string Manual) | ||||
|                     "The option for manual expiration was not found" | ||||
|                 Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Forced) | ||||
|                 Expect.exists exps (fun (exp, _) -> exp = string Forced) | ||||
|                     "The option for immediate expiration was not found" | ||||
|             } | ||||
|         ] | ||||
|      | ||||
| 
 | ||||
|     [<Tests>] | ||||
|     let requestTypeListTests = | ||||
|         testList "ReferenceList.requestTypeList" [ | ||||
| @ -132,7 +129,7 @@ let appViewInfoTests = | ||||
| let assignGroupsTests = | ||||
|     testList "AssignGroups" [ | ||||
|         test "fromUser populates correctly" { | ||||
|             let usr = { User.empty with Id = (Guid.NewGuid >> UserId) (); FirstName = "Alice"; LastName = "Bob" } | ||||
|             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" | ||||
| @ -145,7 +142,7 @@ let editChurchTests = | ||||
|     testList "EditChurch" [ | ||||
|         test "fromChurch populates correctly when interface exists" { | ||||
|             let church = | ||||
|                 { Church.empty with | ||||
|                 { Church.Empty with | ||||
|                     Id               = (Guid.NewGuid >> ChurchId) () | ||||
|                     Name             = "Unit Test" | ||||
|                     City             = "Testlandia" | ||||
| @ -166,7 +163,7 @@ let editChurchTests = | ||||
|         test "fromChurch populates correctly when interface does not exist" { | ||||
|             let edit = | ||||
|                 EditChurch.fromChurch | ||||
|                     { Church.empty with | ||||
|                     { Church.Empty with | ||||
|                         Id    = (Guid.NewGuid >> ChurchId) () | ||||
|                         Name  = "Unit Test" | ||||
|                         City  = "Testlandia" | ||||
| @ -201,7 +198,7 @@ let editChurchTests = | ||||
|                     HasInterface     = Some true | ||||
|                     InterfaceAddress = Some "https://test.units" | ||||
|                   } | ||||
|             let church = edit.PopulateChurch Church.empty | ||||
|             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" | ||||
| @ -216,7 +213,7 @@ let editChurchTests = | ||||
|                     Name  = "Test Baptist Church" | ||||
|                     City  = "Testerville" | ||||
|                     State = "TE" | ||||
|                   }.PopulateChurch Church.empty | ||||
|                   }.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" | ||||
|         } | ||||
| @ -227,7 +224,7 @@ let editMemberTests = | ||||
|     testList "EditMember" [ | ||||
|         test "fromMember populates with group default format" { | ||||
|             let mbr  = | ||||
|                 { Member.empty with | ||||
|                 { Member.Empty with | ||||
|                     Id    = (Guid.NewGuid >> MemberId) () | ||||
|                     Name  = "Test Name" | ||||
|                     Email = "test_units@example.com" | ||||
| @ -239,8 +236,8 @@ let editMemberTests = | ||||
|             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" | ||||
|             let edit = EditMember.fromMember { Member.Empty with Format = Some HtmlFormat } | ||||
|             Expect.equal edit.Format (string HtmlFormat) "The e-mail format was not filled correctly" | ||||
|         } | ||||
|         test "empty is as expected" { | ||||
|             let edit = EditMember.empty | ||||
| @ -262,17 +259,16 @@ let editMemberTests = | ||||
| let editPreferencesTests = | ||||
|     testList "EditPreferences" [ | ||||
|         test "fromPreferences succeeds for native fonts, named colors, and private list" { | ||||
|             let prefs = ListPreferences.empty | ||||
|             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.RequestSort (string 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) | ||||
|             Expect.equal edit.DefaultEmailType (string 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" | ||||
| @ -282,17 +278,16 @@ let editPreferencesTests = | ||||
|             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.equal edit.TimeZone (string 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" | ||||
|             Expect.equal edit.AsOfDate (string 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 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" | ||||
| @ -302,7 +297,7 @@ let editPreferencesTests = | ||||
|                 "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 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" | ||||
| @ -312,7 +307,7 @@ let editPreferencesTests = | ||||
|                 "The list visibility was not derived correctly" | ||||
|         } | ||||
|         test "fromPreferences succeeds for non-native fonts" { | ||||
|             let prefs = { ListPreferences.empty with Fonts = "Arial,sans-serif" } | ||||
|             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" | ||||
| @ -326,18 +321,16 @@ let editRequestTests = | ||||
|         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.equal mt.RequestType (string 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.Expiration (string 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 | ||||
|                 { PrayerRequest.Empty with | ||||
|                     Id          = (Guid.NewGuid >> PrayerRequestId) () | ||||
|                     RequestType = CurrentRequest | ||||
|                     Requestor   = Some "Me" | ||||
| @ -346,10 +339,9 @@ let editRequestTests = | ||||
|                 } | ||||
|             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.RequestType (string 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.Expiration (string 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" { | ||||
| @ -366,7 +358,7 @@ let editSmallGroupTests = | ||||
|     testList "EditSmallGroup" [ | ||||
|         test "fromGroup succeeds" { | ||||
|             let grp = | ||||
|                 { SmallGroup.empty with | ||||
|                 { SmallGroup.Empty with | ||||
|                     Id       = (Guid.NewGuid >> SmallGroupId) () | ||||
|                     Name     = "test group" | ||||
|                     ChurchId = (Guid.NewGuid >> ChurchId) () | ||||
| @ -395,7 +387,7 @@ let editSmallGroupTests = | ||||
|                     Name     = "test name" | ||||
|                     ChurchId = (Guid.NewGuid >> shortGuid) () | ||||
|                   } | ||||
|             let grp = edit.populateGroup SmallGroup.empty | ||||
|             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" | ||||
|         } | ||||
| @ -416,7 +408,7 @@ let editUserTests = | ||||
|         } | ||||
|         test "fromUser succeeds" { | ||||
|             let usr = | ||||
|                 { User.empty with | ||||
|                 { User.Empty with | ||||
|                     Id        = (Guid.NewGuid >> UserId) () | ||||
|                     FirstName = "user" | ||||
|                     LastName  = "test" | ||||
| @ -446,7 +438,7 @@ let editUserTests = | ||||
|                     Password  = "testpw" | ||||
|                   } | ||||
|             let hasher = fun x -> x + "+" | ||||
|             let usr = edit.PopulateUser User.empty hasher | ||||
|             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" | ||||
| @ -508,26 +500,26 @@ let requestListTests = | ||||
|         let withRequestList f () = | ||||
|             let today = SystemClock.Instance.GetCurrentInstant () | ||||
|             {   Requests   = [ | ||||
|                     { PrayerRequest.empty with | ||||
|                     { PrayerRequest.Empty with | ||||
|                         RequestType = CurrentRequest | ||||
|                         Requestor   = Some "Zeb" | ||||
|                         Text        = "zyx" | ||||
|                         UpdatedDate = today | ||||
|                     } | ||||
|                     { PrayerRequest.empty with | ||||
|                     { PrayerRequest.Empty with | ||||
|                         RequestType = CurrentRequest | ||||
|                         Requestor   = Some "Aaron" | ||||
|                         Text        = "abc" | ||||
|                         UpdatedDate = today - Duration.FromDays 9 | ||||
|                     } | ||||
|                     { PrayerRequest.empty with | ||||
|                     { PrayerRequest.Empty with | ||||
|                         RequestType = PraiseReport | ||||
|                         Text        = "nmo" | ||||
|                         UpdatedDate = today | ||||
|                     } | ||||
|                 ] | ||||
|                 Date       = today.InUtc().Date | ||||
|                 SmallGroup = SmallGroup.empty | ||||
|                 SmallGroup = SmallGroup.Empty | ||||
|                 ShowHeader = false | ||||
|                 Recipients = [] | ||||
|                 CanEmail   = false | ||||
| @ -604,10 +596,10 @@ let requestListTests = | ||||
|                     } | ||||
|                 let html     = htmlList.AsHtml _s | ||||
|                 let expected = | ||||
|                     htmlList.Requests[0].UpdatedDate.InZone(SmallGroup.timeZone reqList.SmallGroup).Date.ToString ("d", null) | ||||
|                     htmlList.Requests[0].UpdatedDate.InZone(reqList.SmallGroup.TimeZone).Date.ToString ("d", null) | ||||
|                     |> sprintf """<strong>Zeb</strong> – zyx<i style="font-size:9.60pt">  (as of %s)</i>""" | ||||
|                 // spot check; if one request has it, they all should | ||||
|                 Expect.stringContains html expected "Expected short as-of date not found"     | ||||
|                 Expect.stringContains html expected "Expected short as-of date not found" | ||||
|             "AsHtml succeeds with long as-of date", | ||||
|             fun reqList -> | ||||
|                 let htmlList = | ||||
| @ -619,10 +611,10 @@ let requestListTests = | ||||
|                     } | ||||
|                 let html     = htmlList.AsHtml _s | ||||
|                 let expected = | ||||
|                     htmlList.Requests[0].UpdatedDate.InZone(SmallGroup.timeZone reqList.SmallGroup).Date.ToString ("D", null) | ||||
|                     htmlList.Requests[0].UpdatedDate.InZone(reqList.SmallGroup.TimeZone).Date.ToString ("D", null) | ||||
|                     |> sprintf """<strong>Zeb</strong> – zyx<i style="font-size:9.60pt">  (as of %s)</i>""" | ||||
|                 // spot check; if one request has it, they all should | ||||
|                 Expect.stringContains html expected "Expected long as-of date not found"     | ||||
|                 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" } } | ||||
| @ -650,10 +642,10 @@ let requestListTests = | ||||
|                     } | ||||
|                 let text     = textList.AsText _s | ||||
|                 let expected = | ||||
|                     textList.Requests[0].UpdatedDate.InZone(SmallGroup.timeZone reqList.SmallGroup).Date.ToString ("d", null) | ||||
|                     textList.Requests[0].UpdatedDate.InZone(reqList.SmallGroup.TimeZone).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"     | ||||
|                 Expect.stringContains text expected "Expected short as-of date not found" | ||||
|             "AsText succeeds with long as-of date", | ||||
|             fun reqList -> | ||||
|                 let textList = | ||||
| @ -665,10 +657,10 @@ let requestListTests = | ||||
|                     } | ||||
|                 let text     = textList.AsText _s | ||||
|                 let expected = | ||||
|                     textList.Requests[0].UpdatedDate.InZone(SmallGroup.timeZone reqList.SmallGroup).Date.ToString ("D", null) | ||||
|                     textList.Requests[0].UpdatedDate.InZone(reqList.SmallGroup.TimeZone).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"     | ||||
|                 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 | ||||
| @ -3,40 +3,45 @@ module PrayerTracker.Views.CommonFunctions | ||||
| 
 | ||||
| open System.IO | ||||
| open System.Text.Encodings.Web | ||||
| open Giraffe | ||||
| open Giraffe.ViewEngine | ||||
| open Microsoft.AspNetCore.Antiforgery | ||||
| open Microsoft.AspNetCore.Http | ||||
| open Microsoft.AspNetCore.Mvc.Localization | ||||
| open Microsoft.Extensions.Localization | ||||
| 
 | ||||
| /// Encoded text for a localized string | ||||
| let locStr (text : LocalizedString) = str text.Value | ||||
| let locStr (text: LocalizedString) = | ||||
|     str text.Value | ||||
| 
 | ||||
| /// Raw text for a localized HTML string | ||||
| let rawLocText (writer : StringWriter) (text : LocalizedHtmlString) = | ||||
|     text.WriteTo (writer, HtmlEncoder.Default) | ||||
| let rawLocText (writer: StringWriter) (text: LocalizedHtmlString) = | ||||
|     text.WriteTo(writer, HtmlEncoder.Default) | ||||
|     let txt = string writer | ||||
|     writer.GetStringBuilder().Clear () |> ignore | ||||
|     writer.GetStringBuilder().Clear() |> ignore | ||||
|     rawText txt | ||||
| 
 | ||||
| /// A space (used for back-to-back localization string breaks) | ||||
| let space = rawText " " | ||||
| 
 | ||||
| /// Generate a Material Design icon | ||||
| let icon name = i [ _class "material-icons" ] [ rawText name ] | ||||
| let icon name = | ||||
|     i [ _class "material-icons" ] [ rawText name ] | ||||
| 
 | ||||
| /// Generate a Material Design icon, specifying the point size (must be defined in CSS) | ||||
| let iconSized size name = i [ _class $"material-icons md-%i{size}" ] [ rawText name ] | ||||
| let iconSized size name = | ||||
|     i [ _class $"material-icons md-%i{size}" ] [ rawText name ] | ||||
| 
 | ||||
| 
 | ||||
| open Giraffe | ||||
| open Microsoft.AspNetCore.Antiforgery | ||||
| open Microsoft.AspNetCore.Http | ||||
| 
 | ||||
| /// Generate a CSRF prevention token | ||||
| let csrfToken (ctx : HttpContext) = | ||||
|     let antiForgery = ctx.GetService<IAntiforgery> () | ||||
| let csrfToken (ctx: HttpContext) = | ||||
|     let antiForgery = ctx.GetService<IAntiforgery>() | ||||
|     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) = | ||||
| let tableSummary itemCount (s: IStringLocalizer) = | ||||
|     div [ _class "pt-center-text" ] [ | ||||
|         small [] [ | ||||
|             match itemCount with | ||||
| @ -46,9 +51,9 @@ let tableSummary itemCount (s : IStringLocalizer) = | ||||
|             |> locStr | ||||
|         ] | ||||
|     ] | ||||
|       | ||||
| 
 | ||||
| /// Generate a list of named HTML colors | ||||
| let namedColorList name selected attrs (s : IStringLocalizer) = | ||||
| let namedColorList name selected attrs (s: IStringLocalizer) = | ||||
|     // The list of HTML named colors (name, display, text color) | ||||
|     seq { | ||||
|         ("aqua",    s["Aqua"],    "black") | ||||
| @ -79,7 +84,7 @@ let namedColorList name selected attrs (s : IStringLocalizer) = | ||||
|     |> select (_name name :: attrs) | ||||
| 
 | ||||
| /// Convert a named color to its hex notation | ||||
| let colorToHex (color : string) = | ||||
| let colorToHex (color: string) = | ||||
|     match color with | ||||
|     | it when it.StartsWith "#" -> color | ||||
|     | "aqua"    -> "#00ffff" | ||||
| @ -99,8 +104,8 @@ let colorToHex (color : string) = | ||||
|     | "white"   -> "#ffffff" | ||||
|     | "yellow"  -> "#ffff00" | ||||
|     | it        -> it | ||||
|      | ||||
| /// Generate an input[type=radio] that is selected if its value is the current value | ||||
| 
 | ||||
| /// <summary>Generate an <c>input type=radio</c> that is selected if its value is the current value</summary> | ||||
| let radio name domId value current = | ||||
|     input [ _type "radio" | ||||
|             _name name | ||||
| @ -108,7 +113,7 @@ let radio name domId value current = | ||||
|             _value value | ||||
|             if value = current then _checked ] | ||||
| 
 | ||||
| /// Generate a select list with the current value selected | ||||
| /// <summary>Generate a <c>select</c> list with the current value selected</summary> | ||||
| let selectList name selected attrs items = | ||||
|     items | ||||
|     |> Seq.map (fun (value, text) -> | ||||
| @ -119,16 +124,18 @@ let selectList name selected attrs items = | ||||
|     |> 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 = $"— %s{text} —" | ||||
| /// <summary>Generate the text for a default entry at the top of a <c>select</c> list</summary> | ||||
| 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 ] | ||||
| /// <summary>Generate a standard <c>button type=submit</c> with icon and text</summary> | ||||
| let submit attrs ico text = | ||||
|     button (_type "submit" :: attrs) [ icon ico; rawText "  "; locStr text ] | ||||
| 
 | ||||
| /// Create an HTML onsubmit event handler | ||||
| let _onsubmit = attr "onsubmit" | ||||
| 
 | ||||
| /// A "rel='noopener'" attribute | ||||
| /// <summary>A <c>rel="noopener"</c> attribute</summary> | ||||
| let _relNoOpener = _rel "noopener" | ||||
| 
 | ||||
| /// A class attribute that designates a row of fields, with the additional classes passed | ||||
| @ -153,12 +160,14 @@ let _checkboxField = _class "pt-checkbox-field" | ||||
| /// A group of related fields, inputs, links, etc., displayed in a row | ||||
| let _group = _class "pt-group" | ||||
| 
 | ||||
| /// Create an input field of the given type, with matching name and ID and the given value | ||||
| /// <summary> | ||||
| /// Create an <c>input</c> field of the given <c>type</c>, with matching name and ID and the given value | ||||
| /// </summary> | ||||
| let inputField typ name value attrs = | ||||
|     List.concat [ [ _type typ; _name name; _id name; if value <> "" then _value value ]; attrs ] |> input | ||||
| 
 | ||||
| /// Generate a table heading with the given localized column names | ||||
| let tableHeadings (s : IStringLocalizer) (headings : string list) = | ||||
| let tableHeadings (s: IStringLocalizer) (headings: string list) = | ||||
|     headings | ||||
|     |> List.map (fun heading -> th [ _scope "col" ] [ locStr s[heading] ]) | ||||
|     |> tr [] | ||||
| @ -166,7 +175,8 @@ let tableHeadings (s : IStringLocalizer) (headings : string list) = | ||||
|     |> thead [] | ||||
| 
 | ||||
| /// For a list of strings, prepend a pound sign and string them together with commas (CSS selector by ID) | ||||
| let toHtmlIds it = it |> List.map (fun x -> $"#%s{x}") |> String.concat ", " | ||||
| let toHtmlIds it = | ||||
|     it |> List.map (fun x -> $"#%s{x}") |> String.concat ", " | ||||
| 
 | ||||
| /// The name this function used to have when the view engine was part of Giraffe | ||||
| let renderHtmlNode = RenderView.AsString.htmlNode | ||||
| @ -180,7 +190,7 @@ let renderHtmlString = renderHtmlNode >> HtmlString | ||||
| 
 | ||||
| /// Utility methods to help with time zones (and localization of their names) | ||||
| module TimeZones = | ||||
|    | ||||
| 
 | ||||
|     open PrayerTracker.Entities | ||||
| 
 | ||||
|     /// Cross-reference between time zone Ids and their English names | ||||
| @ -194,24 +204,28 @@ module TimeZones = | ||||
|     ] | ||||
| 
 | ||||
|     /// Get the name of a time zone, given its Id | ||||
|     let name timeZoneId (s : IStringLocalizer) = | ||||
|     let name timeZoneId (s: IStringLocalizer) = | ||||
|         match xref |> List.tryFind (fun it -> fst it = timeZoneId) with | ||||
|         | Some tz -> s[snd tz] | ||||
|         | None -> | ||||
|             let tzId = TimeZoneId.toString timeZoneId | ||||
|             let tzId = string timeZoneId | ||||
|             LocalizedString (tzId, tzId) | ||||
|      | ||||
| 
 | ||||
|     /// All known time zones in their defined order | ||||
|     let all = xref |> List.map fst | ||||
| 
 | ||||
| 
 | ||||
| open Giraffe.ViewEngine.Htmx | ||||
| 
 | ||||
| /// Create a page link that will make the request with fixi | ||||
| let pageLink href attrs content = | ||||
|     a (List.append [ _href href; _hxGet href ] attrs) content | ||||
| 
 | ||||
| /// Known htmx targets | ||||
| module Target = | ||||
|      | ||||
| 
 | ||||
|     /// htmx links target the body element | ||||
|     let body = _hxTarget "body" | ||||
|      | ||||
| 
 | ||||
|     /// htmx links target the #pt-body element | ||||
|     let content = _hxTarget "#pt-body" | ||||
| @ -12,11 +12,11 @@ let private resAsmName = typeof<Common>.Assembly.GetName().Name | ||||
| /// Set up the string and HTML localizer factories | ||||
| let setUpFactories fac = | ||||
|     stringLocFactory <- fac | ||||
|     htmlLocFactory <- HtmlLocalizerFactory stringLocFactory | ||||
|     htmlLocFactory   <- HtmlLocalizerFactory stringLocFactory | ||||
| 
 | ||||
| /// An instance of the common string localizer | ||||
| let localizer = lazy (stringLocFactory.Create ("Common", resAsmName)) | ||||
| let localizer = lazy stringLocFactory.Create("Common", resAsmName) | ||||
|    | ||||
| /// Get a view localizer | ||||
| let forView (view : string) = | ||||
|     htmlLocFactory.Create ($"Views.{view.Replace ('/', '.')}", resAsmName) | ||||
| let forView (view: string) = | ||||
|     htmlLocFactory.Create($"Views.{view.Replace('/', '.')}", resAsmName) | ||||
| @ -12,7 +12,7 @@ let langCode () = if CultureInfo.CurrentCulture.Name.StartsWith "es" then "es" e | ||||
| 
 | ||||
| /// Navigation items | ||||
| module Navigation = | ||||
|    | ||||
| 
 | ||||
|     /// Top navigation bar | ||||
|     let top m = | ||||
|         let s          = I18N.localizer.Force() | ||||
| @ -25,20 +25,25 @@ module Navigation = | ||||
|                     a [ _dropdown; _ariaLabel s["Requests"].Value; _title s["Requests"].Value; _roleButton ] [ | ||||
|                         icon "question_answer"; space; locStr s["Requests"]; space; icon "keyboard_arrow_down" ] | ||||
|                     div [ _class "dropdown-content"; _roleMenuBar ] [ | ||||
|                         a [ _href "/prayer-requests"; _roleMenuItem ] [ | ||||
|                             icon "compare_arrows"; menuSpacer; locStr s["Maintain"] ] | ||||
|                         a [ _href "/prayer-requests/view"; _roleMenuItem ] [ | ||||
|                             icon "list"; menuSpacer; locStr s["View List"] ] ] ] | ||||
|                         pageLink "/prayer-requests" | ||||
|                             [ _roleMenuItem ] | ||||
|                             [ icon "compare_arrows"; menuSpacer; locStr s["Maintain"] ] | ||||
|                         pageLink "/prayer-requests/view" | ||||
|                             [ _roleMenuItem ] | ||||
|                             [ icon "list"; menuSpacer; locStr s["View List"] ] ] ] | ||||
|                 li [ _class "dropdown" ] [ | ||||
|                     a [ _dropdown; _ariaLabel s["Group"].Value; _title s["Group"].Value; _roleButton ] [ | ||||
|                         icon "group"; space; locStr s["Group"]; space; icon "keyboard_arrow_down" ] | ||||
|                     div [ _class "dropdown-content"; _roleMenuBar ] [ | ||||
|                         a [ _href "/small-group/members"; _roleMenuItem ] [ | ||||
|                             icon "email"; menuSpacer; locStr s["Maintain Group Members"] ] | ||||
|                         a [ _href "/small-group/announcement"; _roleMenuItem ] [ | ||||
|                             icon "send";  menuSpacer; locStr s["Send Announcement"] ] | ||||
|                         a [ _href "/small-group/preferences"; _roleMenuItem ] [ | ||||
|                             icon "build"; menuSpacer; locStr s["Change Preferences"] ] ] ] | ||||
|                         pageLink "/small-group/members" | ||||
|                             [ _roleMenuItem ] | ||||
|                             [ icon "email"; menuSpacer; locStr s["Maintain Group Members"] ] | ||||
|                         pageLink "/small-group/announcement" | ||||
|                             [ _roleMenuItem ] | ||||
|                             [ icon "send";  menuSpacer; locStr s["Send Announcement"] ] | ||||
|                         pageLink "/small-group/preferences" | ||||
|                             [ _roleMenuItem ] | ||||
|                             [ icon "build"; menuSpacer; locStr s["Change Preferences"] ] ] ] | ||||
|                 if u.IsAdmin then | ||||
|                     li [ _class "dropdown" ] [ | ||||
|                         a [ _dropdown | ||||
| @ -47,31 +52,31 @@ module Navigation = | ||||
|                             _roleButton ] [ | ||||
|                             icon "settings"; space; locStr s["Administration"]; space; icon "keyboard_arrow_down" ] | ||||
|                         div [ _class "dropdown-content"; _roleMenuBar ] [ | ||||
|                             a [ _href "/churches"; _roleMenuItem ] [ icon "home";  menuSpacer; locStr s["Churches"] ] | ||||
|                             a [ _href "/small-groups"; _roleMenuItem ] [ | ||||
|                                 icon "send";  menuSpacer; locStr s["Groups"] ] | ||||
|                             a [ _href "/users"; _roleMenuItem ] [ icon "build"; menuSpacer; locStr s["Users"] ] ] ] | ||||
|                             pageLink "/churches" [ _roleMenuItem ] [ icon "home";  menuSpacer; locStr s["Churches"] ] | ||||
|                             pageLink "/small-groups" | ||||
|                                 [ _roleMenuItem ] | ||||
|                                 [ icon "send";  menuSpacer; locStr s["Groups"] ] | ||||
|                             pageLink "/users" [ _roleMenuItem ] [ icon "build"; menuSpacer; locStr s["Users"] ] ] ] | ||||
|             | None -> | ||||
|                 match m.Group with | ||||
|                 | Some _ -> | ||||
|                     li [] [ | ||||
|                         a [ _href      "/prayer-requests/view" | ||||
|                             _ariaLabel s["View Request List"].Value | ||||
|                             _title     s["View Request List"].Value ] [ | ||||
|                             icon "list"; space; locStr s["View Request List"] ] ] | ||||
|                         pageLink "/prayer-requests/view" | ||||
|                             [ _ariaLabel s["View Request List"].Value; _title s["View Request List"].Value ] | ||||
|                             [ icon "list"; space; locStr s["View Request List"] ] ] | ||||
|                 | None -> | ||||
|                     li [ _class "dropdown" ] [ | ||||
|                         a [ _dropdown; _ariaLabel s["Log On"].Value; _title s["Log On"].Value; _roleButton ] [ | ||||
|                             icon "security"; space; locStr s["Log On"]; space; icon "keyboard_arrow_down" ] | ||||
|                         div [ _class "dropdown-content"; _roleMenuBar ] [ | ||||
|                             a [ _href "/user/log-on"; _roleMenuItem ] [ icon "person"; menuSpacer; locStr s["User"] ] | ||||
|                             a [ _href "/small-group/log-on"; _roleMenuItem ] [ | ||||
|                                 icon "group";  menuSpacer; locStr s["Group"] ] ] ] | ||||
|                             pageLink "/user/log-on" [ _roleMenuItem ] [ icon "person"; menuSpacer; locStr s["User"] ] | ||||
|                             pageLink "/small-group/log-on" | ||||
|                                 [ _roleMenuItem ] | ||||
|                                 [ icon "group";  menuSpacer; locStr s["Group"] ] ] ] | ||||
|                     li [] [ | ||||
|                         a [ _href      "/prayer-requests/lists" | ||||
|                             _ariaLabel s["View Request List"].Value | ||||
|                             _title     s["View Request List"].Value ] [ | ||||
|                             icon "list"; space; locStr s["View Request List"] ] ] | ||||
|                         pageLink "/prayer-requests/lists" | ||||
|                             [ _ariaLabel s["View Request List"].Value; _title s["View Request List"].Value ] | ||||
|                             [ icon "list"; space; locStr s["View Request List"] ] ] | ||||
|             li [] [ | ||||
|                 a [ _href "/help"; _ariaLabel s["Help"].Value; _title s["View Help"].Value; _target "_blank" ] [ | ||||
|                     icon "help"; space; locStr s["Help"] ] ] ] | ||||
| @ -81,24 +86,24 @@ module Navigation = | ||||
|                 match m.User with | ||||
|                 | Some _ -> | ||||
|                     li [] [ | ||||
|                         a [ _href      "/user/password" | ||||
|                             _ariaLabel s["Change Your Password"].Value | ||||
|                             _title     s["Change Your Password"].Value ] [ | ||||
|                             icon "lock"; space; locStr s["Change Your Password"] ] ] | ||||
|                         pageLink "/user/password" | ||||
|                             [ _ariaLabel s["Change Your Password"].Value; _title s["Change Your Password"].Value ] | ||||
|                             [ icon "lock"; space; locStr s["Change Your Password"] ] ] | ||||
|                 | None -> () | ||||
|                 li [] [ | ||||
|                     a [ _href "/log-off"; _ariaLabel s["Log Off"].Value; _title s["Log Off"].Value; Target.body ] [ | ||||
|                         icon "power_settings_new"; space; locStr s["Log Off"] ] ] ] | ||||
|                     pageLink "/log-off" | ||||
|                         [ _ariaLabel s["Log Off"].Value; _title s["Log Off"].Value; Target.body ] | ||||
|                         [ icon "power_settings_new"; space; locStr s["Log Off"] ] ] ] | ||||
|             | None -> [] | ||||
|         header [ _class "pt-title-bar"; Target.content ] [ | ||||
|             section [ _class "pt-title-bar-left"; _ariaLabel "Left side of top menu" ] [ | ||||
|                 span [ _class "pt-title-bar-home" ] [ | ||||
|                     a [ _href "/"; _title s["Home"].Value ] [ locStr s["PrayerTracker"] ] ] | ||||
|                     pageLink "/" [ _title s["Home"].Value ] [ locStr s["PrayerTracker"] ] ] | ||||
|                 ul [] leftLinks ] | ||||
|             section [ _class "pt-title-bar-center"; _ariaLabel "Empty center space in top menu" ] [] | ||||
|             section [ _class "pt-title-bar-right"; _roleToolBar; _ariaLabel "Right side of top menu" ] [ | ||||
|                 ul [] rightLinks ] ] | ||||
|      | ||||
| 
 | ||||
|     /// Identity bar (below top nav) | ||||
|     let identity m = | ||||
|         let s = I18N.localizer.Force() | ||||
| @ -106,14 +111,14 @@ module Navigation = | ||||
|             div [] [ | ||||
|                 span [ _title s["Language"].Value ] [ icon "record_voice_over"; space ] | ||||
|                 match langCode () with | ||||
|                 | "es" ->  | ||||
|                 | "es" -> | ||||
|                     strong [] [ locStr s["Spanish"] ] | ||||
|                     rawText "     " | ||||
|                     a [ _href "/language/en" ] [ locStr s["Change to English"] ] | ||||
|                     pageLink "/language/en" [] [ locStr s["Change to English"] ] | ||||
|                 | _ -> | ||||
|                     strong [] [ locStr s["English"] ] | ||||
|                     rawText "     " | ||||
|                     a [ _href "/language/es" ] [ locStr s["Cambie a Español"] ] ] | ||||
|                     pageLink "/language/es" [] [ locStr s["Cambie a Español"] ] ] | ||||
|             match m.Group with | ||||
|             | Some g -> | ||||
|                 [ match m.User with | ||||
| @ -129,7 +134,7 @@ module Navigation = | ||||
|                   icon "group" | ||||
|                   space | ||||
|                   match m.User with | ||||
|                   | Some _ -> a [ _href "/small-group"; Target.content ] [ strong [] [ str g.Name ] ] | ||||
|                   | Some _ -> pageLink "/small-group" [] [ strong [] [ str g.Name ] ] | ||||
|                   | None -> strong [] [ str g.Name ] ] | ||||
|             | None -> [] | ||||
|             |> div [] ] | ||||
| @ -137,14 +142,14 @@ module Navigation = | ||||
| 
 | ||||
| /// Content layouts | ||||
| module Content = | ||||
|    | ||||
| 
 | ||||
|     /// Content layout that tops at 60rem | ||||
|     let standard = div [ _class "pt-content" ] | ||||
| 
 | ||||
|     /// Content layout that uses the full width of the browser window | ||||
|     let wide = div [ _class "pt-content pt-full-width" ] | ||||
| 
 | ||||
|    | ||||
| 
 | ||||
| /// Separator for parts of the title | ||||
| let private titleSep = rawText " « " | ||||
| 
 | ||||
| @ -153,7 +158,7 @@ let private commonHead = [ | ||||
|     meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ] | ||||
|     meta [ _name "generator"; _content "Giraffe" ] | ||||
|     link [ _rel "stylesheet"; _href "https://fonts.googleapis.com/icon?family=Material+Icons" ] | ||||
|     link [ _rel "stylesheet"; _href "/css/app.css" ] ] | ||||
|     link [ _rel "stylesheet"; _href "/_/app.css" ] ] | ||||
| 
 | ||||
| /// Render the <head> portion of the page | ||||
| let private htmlHead viewInfo pgTitle = | ||||
| @ -163,19 +168,16 @@ let private htmlHead viewInfo pgTitle = | ||||
|         title [] [ locStr pgTitle; titleSep; locStr s["PrayerTracker"] ] | ||||
|         yield! commonHead | ||||
|         for cssFile in viewInfo.Style do | ||||
|             link [ _rel "stylesheet"; _href $"/css/{cssFile}.css"; _type "text/css" ] ] | ||||
|             link [ _rel "stylesheet"; _href $"/_/{cssFile}.css"; _type "text/css" ] ] | ||||
| 
 | ||||
| 
 | ||||
| open Giraffe.ViewEngine.Htmx | ||||
| 
 | ||||
| /// Render a link to the help page for the current page | ||||
| let private helpLink link = | ||||
|     let s = I18N.localizer.Force() | ||||
|     sup [ _class "pt-help-link" ] [ | ||||
|         a [ _href    link | ||||
|             _title   s["Click for Help on This Page"].Value | ||||
|             _onclick $"return PT.showHelp('{link}')" | ||||
|             _hxNoBoost ] [ iconSized 18 "help_outline" ] ] | ||||
|             _onclick $"return PT.showHelp('{link}')" ] [ iconSized 18 "help_outline" ] ] | ||||
| 
 | ||||
| /// Render the page title, and optionally a help link | ||||
| let private renderPageTitle viewInfo pgTitle = | ||||
| @ -217,9 +219,9 @@ let private htmlFooter viewInfo = | ||||
|     let resultTime = (SystemClock.Instance.GetCurrentInstant() - viewInfo.RequestStart).TotalSeconds | ||||
|     footer [ _class "pt-footer" ] [ | ||||
|         div [ _id "pt-legal" ] [ | ||||
|             a [ _href "/legal/privacy-policy" ] [ locStr s["Privacy Policy"] ] | ||||
|             pageLink "/legal/privacy-policy" [] [ locStr s["Privacy Policy"] ] | ||||
|             rawText "   " | ||||
|             a [ _href "/legal/terms-of-service" ] [ locStr s["Terms of Service"] ] | ||||
|             pageLink "/legal/terms-of-service" [] [ locStr s["Terms of Service"] ] | ||||
|             rawText "   " | ||||
|             a [ _href   "https://git.bitbadger.solutions/bit-badger/PrayerTracker" | ||||
|                 _title  s["View source code and get technical support"].Value | ||||
| @ -227,7 +229,7 @@ let private htmlFooter viewInfo = | ||||
|                 _relNoOpener ] [ | ||||
|                 locStr s["Source & Support"] ] ] | ||||
|         div [ _id "pt-footer" ] [ | ||||
|             a [ _href "/"; _style "line-height:28px;" ] [ | ||||
|             pageLink "/" [ _style "line-height:28px;" ] [ | ||||
|                 img [ _src   $"""/img/%O{s["footer_en"]}.png""" | ||||
|                       _alt   imgText | ||||
|                       _title imgText | ||||
| @ -268,21 +270,18 @@ let private partialHead pgTitle = | ||||
|         meta [ _charset "UTF-8" ] | ||||
|         title [] [ locStr pgTitle; titleSep; locStr s["PrayerTracker"] ] ] | ||||
| 
 | ||||
| open Giraffe.Htmx.Common | ||||
| 
 | ||||
| /// The body of the PrayerTracker layout | ||||
| let private pageLayout viewInfo pgTitle content = | ||||
|     body [ _hxBoost ] [ | ||||
|     body [] [ | ||||
|         Navigation.top viewInfo | ||||
|         div [ _id "pt-body"; Target.content; _hxSwap $"{HxSwap.InnerHtml} show:window:top" ] | ||||
|             (contentSection viewInfo pgTitle content) | ||||
|         div [ _id "pt-body"; Target.content ] (contentSection viewInfo pgTitle content) | ||||
|         match viewInfo.Layout with | ||||
|         | FullPage -> | ||||
|             Script.minified | ||||
|             script [ _src "/js/ckeditor/ckeditor.js" ] [] | ||||
|             script [ _src "/js/app.js" ] [] | ||||
|             Htmx.Script.minified | ||||
|             script [ _src "/_/app.js" ] [] | ||||
|         | _ -> () ] | ||||
|      | ||||
| 
 | ||||
| /// The standard layout(s) for PrayerTracker | ||||
| let standard viewInfo pageTitle content = | ||||
|     let s       = I18N.localizer.Force() | ||||
| @ -316,8 +315,8 @@ let help pageTitle isHome content = | ||||
|             meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ] | ||||
|             title [] [ locStr pgTitle; titleSep; locStr s["PrayerTracker Help"] ] | ||||
|             link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ] | ||||
|             link [ _href "/css/app.css"; _rel "stylesheet" ] | ||||
|             link [ _href "/css/help.css"; _rel "stylesheet" ] ] | ||||
|             link [ _href "/_/app.css"; _rel "stylesheet" ] | ||||
|             link [ _href "/_/help.css"; _rel "stylesheet" ] ] | ||||
|         body [] [ | ||||
|             header [ _class "pt-title-bar" ] [ | ||||
|                 section [ _class "pt-title-bar-left" ] [ | ||||
| @ -329,7 +328,7 @@ let help pageTitle isHome content = | ||||
|                     div [] [ | ||||
|                         locStr s["Language"]; rawText ": " | ||||
|                         match langCode () with | ||||
|                         | "es" ->  | ||||
|                         | "es" -> | ||||
|                             locStr s["Spanish"]; rawText " • " | ||||
|                             a [ _href "/language/en" ] [ locStr s["Change to English"] ] | ||||
|                         | _ -> | ||||
| @ -349,4 +348,3 @@ let help pageTitle isHome content = | ||||
|                             p [ _class "pt-center-text" ] [ | ||||
|                                 a [ _href "/help"; _title s["Help Index"].Value ] [ | ||||
|                                     rawText "« "; locStr s["Back to Help Index"] ] ] ] ] ] ] ] | ||||
|      | ||||
| @ -29,7 +29,7 @@ let edit (model : EditRequest) today ctx viewInfo = | ||||
|                 label [ _for (nameof model.RequestType) ] [ locStr s["Request Type"] ] | ||||
|                 ReferenceList.requestTypeList s | ||||
|                 |> Seq.ofList | ||||
|                 |> Seq.map (fun (typ, desc) -> PrayerRequestType.toCode typ, desc.Value) | ||||
|                 |> Seq.map (fun (typ, desc) -> string typ, desc.Value) | ||||
|                 |> selectList (nameof model.RequestType) model.RequestType [ _required; _autofocus ] | ||||
|             ] | ||||
|             div [ _inputField ] [ | ||||
| @ -98,7 +98,7 @@ let email model viewInfo = | ||||
| /// View for a small group's public prayer request list | ||||
| let list (model : RequestList) viewInfo = | ||||
|     [   br [] | ||||
|         I18N.localizer.Force () |> (model.AsHtml >> rawText)  | ||||
|         I18N.localizer.Force () |> (model.AsHtml >> rawText) | ||||
|     ] | ||||
|     |> Layout.Content.standard | ||||
|     |> Layout.standard viewInfo "View Request List" | ||||
| @ -156,7 +156,7 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo = | ||||
|     use sw    = new StringWriter () | ||||
|     let raw   = rawLocText sw | ||||
|     let group = model.SmallGroup | ||||
|     let now   = SmallGroup.localDateNow (ctx.GetService<IClock> ()) group | ||||
|     let now   = group.LocalDateNow (ctx.GetService<IClock>()) | ||||
|     let types = ReferenceList.requestTypeList s |> Map.ofList | ||||
|     let vi    = AppViewInfo.withScopedStyles [ "#requestList { grid-template-columns: repeat(5, auto); }" ] viewInfo | ||||
|     /// Iterate the sequence once, before we render, so we can get the count of it at the top of the table | ||||
| @ -164,8 +164,8 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo = | ||||
|         model.Requests | ||||
|         |> List.map (fun req -> | ||||
|             let updateClass  = | ||||
|                 _class (if PrayerRequest.updateRequired now group req then "cell pt-request-update" else "cell") | ||||
|             let isExpired    = PrayerRequest.isExpired now group req | ||||
|                 _class (if req.UpdateRequired now group then "cell pt-request-update" else "cell") | ||||
|             let isExpired    = req.IsExpired now group | ||||
|             let expiredClass = _class (if isExpired then "cell pt-request-expired" else "cell") | ||||
|             let reqId        = shortGuid req.Id.Value | ||||
|             let reqText      = htmlToPlainText req.Text | ||||
| @ -16,18 +16,13 @@ | ||||
| 
 | ||||
|   <ItemGroup> | ||||
|     <PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" /> | ||||
|     <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.0" /> | ||||
|     <PackageReference Include="MailKit" Version="4.6.0" /> | ||||
|     <PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.2.0" /> | ||||
|     <PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" /> | ||||
|     <PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" /> | ||||
|     <PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" /> | ||||
|     <PackageReference Include="Newtonsoft.Json" Version="13.0.3" /> | ||||
|     <PackageReference Update="FSharp.Core" Version="8.0.300" /> | ||||
|     <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.4" /> | ||||
|     <PackageReference Include="MailKit" Version="4.10.0" /> | ||||
|     <PackageReference Update="FSharp.Core" Version="9.0.101" /> | ||||
|   </ItemGroup> | ||||
| 
 | ||||
|   <ItemGroup> | ||||
|     <ProjectReference Include="..\PrayerTracker.Data\PrayerTracker.Data.fsproj" /> | ||||
|     <ProjectReference Include="..\Data\PrayerTracker.Data.fsproj" /> | ||||
|   </ItemGroup> | ||||
| 
 | ||||
|   <ItemGroup> | ||||
| @ -54,8 +54,8 @@ let announcement isAdmin ctx viewInfo = | ||||
|                 label [ _for (nameof model.RequestType) ] [ locStr s["Request Type"] ] | ||||
|                 reqTypes | ||||
|                 |> Seq.ofList | ||||
|                 |> Seq.map (fun (typ, desc) -> PrayerRequestType.toCode typ, desc.Value) | ||||
|                 |> selectList (nameof model.RequestType) (PrayerRequestType.toCode Announcement) [] | ||||
|                 |> Seq.map (fun (typ, desc) -> string typ, desc.Value) | ||||
|                 |> selectList (nameof model.RequestType) (string Announcement) [] | ||||
|             ] | ||||
|         ] | ||||
|         div [ _fieldRow ] [ submit [] "send" s["Send Announcement"] ] | ||||
| @ -99,7 +99,7 @@ let edit (model : EditSmallGroup) (churches : Church list) ctx viewInfo = | ||||
|                     "", selectDefault s["Select Church"].Value | ||||
|                     yield! churches |> List.map (fun c -> shortGuid c.Id.Value, c.Name) | ||||
|                 } | ||||
|                 |> selectList (nameof model.ChurchId) model.ChurchId [ _required ]  | ||||
|                 |> selectList (nameof model.ChurchId) model.ChurchId [ _required ] | ||||
|             ] | ||||
|         ] | ||||
|         div [ _fieldRow ] [ submit [] "save" s["Save Group"] ] | ||||
| @ -273,7 +273,7 @@ let members (members : Member list) (emailTypes : Map<string, LocalizedString>) | ||||
|                         div [ _class "cell" ] [ str mbr.Name ] | ||||
|                         div [ _class "cell" ] [ str mbr.Email ] | ||||
|                         div [ _class "cell" ] [ | ||||
|                             locStr emailTypes[defaultArg (mbr.Format |> Option.map EmailFormat.toCode) ""] | ||||
|                             locStr emailTypes[defaultArg (mbr.Format |> Option.map string) ""] | ||||
|                         ] | ||||
|                     ] | ||||
|             ] | ||||
| @ -476,7 +476,7 @@ let preferences (model : EditPreferences) ctx viewInfo = | ||||
|                                     locStr s["Custom Color"] | ||||
|                                 ] | ||||
|                                 space | ||||
|                                 input [ _type  "color"  | ||||
|                                 input [ _type  "color" | ||||
|                                         _name  (nameof model.LineColor) | ||||
|                                         _id    $"{nameof model.LineColor}_Color" | ||||
|                                         _value (colorToHex model.LineColor) | ||||
| @ -589,7 +589,7 @@ let preferences (model : EditPreferences) ctx viewInfo = | ||||
|                             "", selectDefault s["Select"].Value | ||||
|                             yield! | ||||
|                                 TimeZones.all | ||||
|                                 |> List.map (fun tz -> TimeZoneId.toString tz, (TimeZones.name tz s).Value) | ||||
|                                 |> List.map (fun tz -> string tz, (TimeZones.name tz s).Value) | ||||
|                         } | ||||
|                         |> selectList (nameof model.TimeZone) model.TimeZone [ _required ] | ||||
|                     ] | ||||
| @ -19,10 +19,12 @@ let emptyGuid = shortGuid Guid.Empty | ||||
| module String = | ||||
|    | ||||
|     /// string.Trim() | ||||
|     let trim (str: string) = str.Trim() | ||||
|     let trim (str: string) = | ||||
|         str.Trim() | ||||
| 
 | ||||
|     /// string.Replace() | ||||
|     let replace (find: string) repl (str: string) = str.Replace(find, repl) | ||||
|     let replace (find: string) repl (str: string) = | ||||
|         str.Replace(find, repl) | ||||
| 
 | ||||
|     /// Replace the first occurrence of a string with a second string within a given string | ||||
|     let replaceFirst (needle: string) replacement (haystack: string) = | ||||
| @ -51,7 +53,7 @@ let stripTags allowedTags input = | ||||
|             allowedTags | ||||
|             |> List.fold (fun acc t -> | ||||
|                    acc | ||||
|                 || htmlTag.IndexOf $"<{t}>" = 0 | ||||
|                 || htmlTag.IndexOf $"<%s{t}>" = 0 | ||||
|                 || htmlTag.IndexOf $"<{t} " = 0 | ||||
|                 || htmlTag.IndexOf $"</{t}" = 0) false | ||||
|             |> not | ||||
| @ -60,7 +62,7 @@ let stripTags allowedTags input = | ||||
| 
 | ||||
| 
 | ||||
| /// Wrap a string at the specified number of characters | ||||
| let wordWrap charPerLine (input : string) = | ||||
| let wordWrap charPerLine (input: string) = | ||||
|     match input.Length with | ||||
|     | len when len <= charPerLine -> input | ||||
|     | _ -> | ||||
| @ -92,7 +94,7 @@ let wordWrap charPerLine (input : string) = | ||||
|         |> String.concat "\n" | ||||
| 
 | ||||
| /// Modify the text returned by CKEditor into the format we need for request and announcement text | ||||
| let ckEditorToText (text : string) = | ||||
| let ckEditorToText (text: string) = | ||||
|     [ "\n\t",    "" | ||||
|       " ",  " " | ||||
|       "  ",      "  " | ||||
| @ -119,8 +121,8 @@ let htmlToPlainText html = | ||||
|         |> String.replace "\u00a0" " " | ||||
| 
 | ||||
| /// Get the second portion of a tuple as a string | ||||
| let sndAsString x = (snd >> string) x | ||||
| 
 | ||||
| let sndAsString x = | ||||
|     (snd >> string) x | ||||
| 
 | ||||
| /// Make a URL with query string parameters | ||||
| let makeUrl url qs = | ||||
| @ -10,32 +10,31 @@ open PrayerTracker.Entities | ||||
| module ReferenceList = | ||||
| 
 | ||||
|     /// A localized list of the AsOfDateDisplay DU cases | ||||
|     let asOfDateList (s : IStringLocalizer) = [ | ||||
|         AsOfDateDisplay.toCode NoDisplay, s["Do not display the “as of” date"] | ||||
|         AsOfDateDisplay.toCode ShortDate, s["Display a short “as of” date"] | ||||
|         AsOfDateDisplay.toCode LongDate,  s["Display a full “as of” date"] | ||||
|     let asOfDateList (s: IStringLocalizer) = [ | ||||
|         string NoDisplay, s["Do not display the “as of” date"] | ||||
|         string ShortDate, s["Display a short “as of” date"] | ||||
|         string LongDate,  s["Display a full “as of” date"] | ||||
|     ] | ||||
| 
 | ||||
|     /// A list of e-mail type options | ||||
|     let emailTypeList def (s : IStringLocalizer) = | ||||
|     let emailTypeList def (s: IStringLocalizer) = | ||||
|         // Localize the default type | ||||
|         let defaultType = | ||||
|             s[match def with HtmlFormat -> "HTML Format" | PlainTextFormat -> "Plain-Text Format"].Value | ||||
|         seq { | ||||
|             "", LocalizedString ("", $"""{s["Group Default"].Value} ({defaultType})""") | ||||
|             EmailFormat.toCode HtmlFormat,      s["HTML Format"] | ||||
|             EmailFormat.toCode PlainTextFormat, s["Plain-Text Format"] | ||||
|             string HtmlFormat,      s["HTML Format"] | ||||
|             string PlainTextFormat, s["Plain-Text Format"] | ||||
|           } | ||||
| 
 | ||||
|     /// A list of expiration options | ||||
|     let expirationList (s : IStringLocalizer) includeExpireNow = [ | ||||
|         Expiration.toCode Automatic, s["Expire Normally"] | ||||
|         Expiration.toCode Manual,    s["Request Never Expires"] | ||||
|         if includeExpireNow then Expiration.toCode Forced, s["Expire Immediately"] | ||||
|     ] | ||||
|     let expirationList (s: IStringLocalizer) includeExpireNow = | ||||
|         [ string Automatic, s["Expire Normally"] | ||||
|           string Manual,    s["Request Never Expires"] | ||||
|           if includeExpireNow then string Forced, s["Expire Immediately"] ] | ||||
| 
 | ||||
|     /// A list of request types | ||||
|     let requestTypeList (s : IStringLocalizer) = [ | ||||
|     let requestTypeList (s: IStringLocalizer) = [ | ||||
|         CurrentRequest,  s["Current Requests"] | ||||
|         LongTermRequest, s["Long-Term Requests"] | ||||
|         PraiseReport,    s["Praise Reports"] | ||||
| @ -55,15 +54,15 @@ type MessageLevel = | ||||
| 
 | ||||
| /// Support for the MessageLevel type | ||||
| module MessageLevel = | ||||
|      | ||||
| 
 | ||||
|     /// Convert a message level to its string representation | ||||
|     let toString = | ||||
|         function | ||||
|         | Info -> "Info" | ||||
|         | Warning -> "WARNING" | ||||
|         | Error -> "ERROR" | ||||
|      | ||||
|     let toCssClass level = (toString level).ToLowerInvariant () | ||||
| 
 | ||||
|     let toCssClass level = (toString level).ToLowerInvariant() | ||||
| 
 | ||||
| 
 | ||||
| /// This is used to create a message that is displayed to the user | ||||
| @ -71,31 +70,31 @@ module MessageLevel = | ||||
| type UserMessage = | ||||
|     {   /// The type | ||||
|         Level : MessageLevel | ||||
|          | ||||
| 
 | ||||
|         /// The actual message | ||||
|         Text : HtmlString | ||||
|          | ||||
| 
 | ||||
|         /// The description (further information) | ||||
|         Description : HtmlString option | ||||
|     } | ||||
| 
 | ||||
| /// Support for the UserMessage type | ||||
| module UserMessage = | ||||
|    | ||||
| 
 | ||||
|     /// Error message template | ||||
|     let error = | ||||
|         { Level       = Error | ||||
|           Text        = HtmlString.Empty | ||||
|           Description = None | ||||
|         } | ||||
|      | ||||
| 
 | ||||
|     /// Warning message template | ||||
|     let warning = | ||||
|         { Level       = Warning | ||||
|           Text        = HtmlString.Empty | ||||
|           Description = None | ||||
|         } | ||||
|      | ||||
| 
 | ||||
|     /// Info message template | ||||
|     let info = | ||||
|         { Level       = Info | ||||
| @ -105,13 +104,13 @@ module UserMessage = | ||||
| 
 | ||||
| /// The template with which the content will be rendered | ||||
| type LayoutType = | ||||
|      | ||||
| 
 | ||||
|     /// A full page load | ||||
|     | FullPage | ||||
|      | ||||
|     /// A response that will provide a new body tag  | ||||
| 
 | ||||
|     /// A response that will provide a new body tag | ||||
|     | PartialPage | ||||
|      | ||||
| 
 | ||||
|     /// A response that will replace the page content | ||||
|     | ContentOnly | ||||
| 
 | ||||
| @ -123,38 +122,38 @@ open NodaTime | ||||
| type AppViewInfo = | ||||
|     {   /// CSS files for the page | ||||
|         Style : string list | ||||
|          | ||||
| 
 | ||||
|         /// The link for help on this page | ||||
|         HelpLink : string option | ||||
|          | ||||
| 
 | ||||
|         /// Messages to be displayed to the user | ||||
|         Messages : UserMessage list | ||||
|          | ||||
| 
 | ||||
|         /// The current version of PrayerTracker | ||||
|         Version : string | ||||
|          | ||||
| 
 | ||||
|         /// The ticks when the request started | ||||
|         RequestStart : Instant | ||||
|          | ||||
| 
 | ||||
|         /// The currently logged on user, if there is one | ||||
|         User : User option | ||||
|          | ||||
| 
 | ||||
|         /// The currently logged on small group, if there is one | ||||
|         Group : SmallGroup option | ||||
|          | ||||
| 
 | ||||
|         /// The layout with which the content will be rendered | ||||
|         Layout : LayoutType | ||||
|          | ||||
| 
 | ||||
|         /// Scoped styles for this view | ||||
|         ScopedStyle : string list | ||||
|          | ||||
| 
 | ||||
|         /// A JavaScript function to run on page load | ||||
|         OnLoadScript : string option | ||||
|     } | ||||
| 
 | ||||
| /// Support for the AppViewInfo type | ||||
| module AppViewInfo = | ||||
|      | ||||
| 
 | ||||
|     /// A fresh version that can be populated to process the current request | ||||
|     let fresh = | ||||
|         {   Style        = [] | ||||
| @ -168,11 +167,11 @@ module AppViewInfo = | ||||
|             ScopedStyle  = [] | ||||
|             OnLoadScript = None | ||||
|         } | ||||
|      | ||||
| 
 | ||||
|     /// Add scoped styles to the given view info object | ||||
|     let withScopedStyles styles viewInfo = | ||||
|         { viewInfo with ScopedStyle = styles } | ||||
|      | ||||
| 
 | ||||
|     /// Add an onload action to the given view info object | ||||
|     let withOnLoadScript script viewInfo = | ||||
|         { viewInfo with OnLoadScript = Some script } | ||||
| @ -183,18 +182,18 @@ module AppViewInfo = | ||||
| type Announcement = | ||||
|     {   /// Whether the announcement should be sent to the class or to PrayerTracker users | ||||
|         SendToClass  : string | ||||
|          | ||||
| 
 | ||||
|         /// The text of the announcement | ||||
|         Text : string | ||||
|          | ||||
| 
 | ||||
|         /// Whether this announcement should be added to the "Announcements" of the prayer list | ||||
|         AddToRequestList : bool option | ||||
|          | ||||
| 
 | ||||
|         /// The ID of the request type to which this announcement should be added | ||||
|         RequestType : string option | ||||
|     } | ||||
| with | ||||
|      | ||||
| 
 | ||||
|     /// The text of the announcement, in plain text | ||||
|     member this.PlainText | ||||
|       with get () = (htmlToPlainText >> wordWrap 74) this.Text | ||||
| @ -205,19 +204,19 @@ with | ||||
| type AssignGroups = | ||||
|     {   /// The Id of the user being assigned | ||||
|         UserId : string | ||||
|          | ||||
| 
 | ||||
|         /// The full name of the user being assigned | ||||
|         UserName : string | ||||
|          | ||||
| 
 | ||||
|         /// The Ids of the small groups to which the user is authorized | ||||
|         SmallGroups : string | ||||
|     } | ||||
| 
 | ||||
| /// Support for the AssignGroups type | ||||
| module AssignGroups = | ||||
|      | ||||
| 
 | ||||
|     /// Create an instance of this form from an existing user | ||||
|     let fromUser (user : User) = | ||||
|     let fromUser (user: User) = | ||||
|         {   UserId      = shortGuid user.Id.Value | ||||
|             UserName    = user.Name | ||||
|             SmallGroups = "" | ||||
| @ -229,10 +228,10 @@ module AssignGroups = | ||||
| type ChangePassword = | ||||
|     {   /// The user's current password | ||||
|         OldPassword : string | ||||
|          | ||||
| 
 | ||||
|         /// The user's new password | ||||
|         NewPassword : string | ||||
|          | ||||
| 
 | ||||
|         /// The user's new password, confirmed | ||||
|         NewPasswordConfirm : string | ||||
|     } | ||||
| @ -243,29 +242,29 @@ type ChangePassword = | ||||
| type EditChurch = | ||||
|     {   /// The ID of the church | ||||
|         ChurchId : string | ||||
|          | ||||
| 
 | ||||
|         /// The name of the church | ||||
|         Name : string | ||||
|          | ||||
| 
 | ||||
|         /// The city for the church | ||||
|         City : string | ||||
|          | ||||
| 
 | ||||
|         /// The state or province for the church | ||||
|         State : string | ||||
|          | ||||
| 
 | ||||
|         /// Whether the church has an active Virtual Prayer Room interface | ||||
|         HasInterface : bool option | ||||
|          | ||||
| 
 | ||||
|         /// The address for the interface | ||||
|         InterfaceAddress : string option | ||||
|     } | ||||
| with | ||||
|    | ||||
| 
 | ||||
|     /// Is this a new church? | ||||
|     member this.IsNew = emptyGuid = this.ChurchId | ||||
|      | ||||
| 
 | ||||
|     /// Populate a church from this form | ||||
|     member this.PopulateChurch (church : Church) = | ||||
|     member this.PopulateChurch (church: Church) = | ||||
|         { church with | ||||
|             Name             = this.Name | ||||
|             City             = this.City | ||||
| @ -276,9 +275,9 @@ with | ||||
| 
 | ||||
| /// Support for the EditChurch type | ||||
| module EditChurch = | ||||
|      | ||||
| 
 | ||||
|     /// Create an instance from an existing church | ||||
|     let fromChurch (church : Church) = | ||||
|     let fromChurch (church: Church) = | ||||
|         {   ChurchId         = shortGuid church.Id.Value | ||||
|             Name             = church.Name | ||||
|             City             = church.City | ||||
| @ -286,7 +285,7 @@ module EditChurch = | ||||
|             HasInterface     = match church.HasVpsInterface with true -> Some true | false -> None | ||||
|             InterfaceAddress = church.InterfaceAddress | ||||
|         } | ||||
|      | ||||
| 
 | ||||
|     /// An instance to use for adding churches | ||||
|     let empty = | ||||
|         {   ChurchId         = emptyGuid | ||||
| @ -297,38 +296,38 @@ module EditChurch = | ||||
|             InterfaceAddress = None | ||||
|         } | ||||
| 
 | ||||
|    | ||||
| 
 | ||||
| /// Form for adding/editing small group members | ||||
| [<CLIMutable; NoComparison; NoEquality>] | ||||
| type EditMember = | ||||
|     {   /// The Id for this small group member (not user-entered) | ||||
|         MemberId : string | ||||
|          | ||||
| 
 | ||||
|         /// The name of the member | ||||
|         Name : string | ||||
|          | ||||
| 
 | ||||
|         /// The e-mail address | ||||
|         Email : string | ||||
|          | ||||
| 
 | ||||
|         /// The e-mail format | ||||
|         Format : string | ||||
|     } | ||||
| with | ||||
|    | ||||
| 
 | ||||
|     /// Is this a new member? | ||||
|     member this.IsNew = emptyGuid = this.MemberId | ||||
| 
 | ||||
| /// Support for the EditMember type | ||||
| module EditMember = | ||||
|      | ||||
| 
 | ||||
|     /// Create an instance from an existing member | ||||
|     let fromMember (mbr : Member) = | ||||
|     let fromMember (mbr: Member) = | ||||
|         {   MemberId = shortGuid mbr.Id.Value | ||||
|             Name     = mbr.Name | ||||
|             Email    = mbr.Email | ||||
|             Format   = match mbr.Format with Some fmt -> EmailFormat.toCode fmt | None -> "" | ||||
|             Format   = mbr.Format |> Option.map string |> Option.defaultValue "" | ||||
|         } | ||||
|      | ||||
| 
 | ||||
|     /// An empty instance | ||||
|     let empty = | ||||
|         {   MemberId = emptyGuid | ||||
| @ -343,68 +342,68 @@ module EditMember = | ||||
| type EditPreferences = | ||||
|     {   /// The number of days after which requests are automatically expired | ||||
|         ExpireDays : int | ||||
|          | ||||
| 
 | ||||
|         /// The number of days requests are considered "new" | ||||
|         DaysToKeepNew : int | ||||
|          | ||||
| 
 | ||||
|         /// The number of weeks after which a long-term requests is flagged as requiring an update | ||||
|         LongTermUpdateWeeks : int | ||||
|          | ||||
| 
 | ||||
|         /// Whether to sort by updated date or requestor/subject | ||||
|         RequestSort : string | ||||
|          | ||||
| 
 | ||||
|         /// The name from which e-mail will be sent | ||||
|         EmailFromName : string | ||||
|          | ||||
| 
 | ||||
|         /// The e-mail address from which e-mail will be sent | ||||
|         EmailFromAddress : string | ||||
|          | ||||
| 
 | ||||
|         /// The default e-mail type for this group | ||||
|         DefaultEmailType : string | ||||
|          | ||||
| 
 | ||||
|         /// Whether the heading line color uses named colors or R/G/B | ||||
|         LineColorType : string | ||||
|          | ||||
| 
 | ||||
|         /// The named color for the heading lines | ||||
|         LineColor : string | ||||
|          | ||||
| 
 | ||||
|         /// Whether the heading text color uses named colors or R/G/B | ||||
|         HeadingColorType : string | ||||
|          | ||||
| 
 | ||||
|         /// The named color for the heading text | ||||
|         HeadingColor : string | ||||
|          | ||||
| 
 | ||||
|         /// Whether the class uses the native font stack | ||||
|         IsNative : bool | ||||
|          | ||||
| 
 | ||||
|         /// The fonts to use for the list | ||||
|         Fonts : string option | ||||
|          | ||||
| 
 | ||||
|         /// The font size for the heading text | ||||
|         HeadingFontSize : int | ||||
|          | ||||
| 
 | ||||
|         /// The font size for the list text | ||||
|         ListFontSize : int | ||||
|          | ||||
| 
 | ||||
|         /// The time zone for the class | ||||
|         TimeZone : string | ||||
|          | ||||
| 
 | ||||
|         /// The list visibility | ||||
|         Visibility : int | ||||
|          | ||||
| 
 | ||||
|         /// The small group password | ||||
|         GroupPassword : string option | ||||
|          | ||||
| 
 | ||||
|         /// The page size for search / inactive requests | ||||
|         PageSize : int | ||||
|          | ||||
| 
 | ||||
|         /// How the as-of date should be displayed | ||||
|         AsOfDate : string | ||||
|     } | ||||
| with | ||||
|    | ||||
| 
 | ||||
|     /// Set the properties of a small group based on the form's properties | ||||
|     member this.PopulatePreferences (prefs : ListPreferences) = | ||||
|     member this.PopulatePreferences (prefs: ListPreferences) = | ||||
|         let isPublic, grpPw = | ||||
|             if   this.Visibility = GroupVisibility.PublicList  then true, "" | ||||
|             elif this.Visibility = GroupVisibility.HasPassword then false, (defaultArg this.GroupPassword "") | ||||
| @ -413,10 +412,10 @@ with | ||||
|             DaysToExpire        = this.ExpireDays | ||||
|             DaysToKeepNew       = this.DaysToKeepNew | ||||
|             LongTermUpdateWeeks = this.LongTermUpdateWeeks | ||||
|             RequestSort         = RequestSort.fromCode this.RequestSort | ||||
|             RequestSort         = RequestSort.Parse this.RequestSort | ||||
|             EmailFromName       = this.EmailFromName | ||||
|             EmailFromAddress    = this.EmailFromAddress | ||||
|             DefaultEmailType    = EmailFormat.fromCode this.DefaultEmailType | ||||
|             DefaultEmailType    = EmailFormat.Parse this.DefaultEmailType | ||||
|             LineColor           = this.LineColor | ||||
|             HeadingColor        = this.HeadingColor | ||||
|             Fonts               = if this.IsNative || Option.isNone this.Fonts then "native" else this.Fonts.Value | ||||
| @ -426,21 +425,21 @@ with | ||||
|             IsPublic            = isPublic | ||||
|             GroupPassword       = grpPw | ||||
|             PageSize            = this.PageSize | ||||
|             AsOfDateDisplay     = AsOfDateDisplay.fromCode this.AsOfDate | ||||
|             AsOfDateDisplay     = AsOfDateDisplay.Parse this.AsOfDate | ||||
|         } | ||||
| 
 | ||||
| /// Support for the EditPreferences type | ||||
| module EditPreferences = | ||||
|     /// Populate an edit form from existing preferences | ||||
|     let fromPreferences (prefs : ListPreferences) = | ||||
|     let fromPreferences (prefs: ListPreferences) = | ||||
|         let setType (x : string) = match x.StartsWith "#" with true -> "RGB" | false -> "Name" | ||||
|         {   ExpireDays          = prefs.DaysToExpire | ||||
|             DaysToKeepNew       = prefs.DaysToKeepNew | ||||
|             LongTermUpdateWeeks = prefs.LongTermUpdateWeeks | ||||
|             RequestSort         = RequestSort.toCode prefs.RequestSort | ||||
|             RequestSort         = string prefs.RequestSort | ||||
|             EmailFromName       = prefs.EmailFromName | ||||
|             EmailFromAddress    = prefs.EmailFromAddress | ||||
|             DefaultEmailType    = EmailFormat.toCode prefs.DefaultEmailType | ||||
|             DefaultEmailType    = string prefs.DefaultEmailType | ||||
|             LineColorType       = setType prefs.LineColor | ||||
|             LineColor           = prefs.LineColor | ||||
|             HeadingColorType    = setType prefs.HeadingColor | ||||
| @ -449,10 +448,10 @@ module EditPreferences = | ||||
|             Fonts               = if prefs.Fonts = "native" then None else Some prefs.Fonts | ||||
|             HeadingFontSize     = prefs.HeadingFontSize | ||||
|             ListFontSize        = prefs.TextFontSize | ||||
|             TimeZone            = TimeZoneId.toString prefs.TimeZoneId | ||||
|             TimeZone            = string prefs.TimeZoneId | ||||
|             GroupPassword       = Some prefs.GroupPassword | ||||
|             PageSize            = prefs.PageSize | ||||
|             AsOfDate            = AsOfDateDisplay.toCode prefs.AsOfDateDisplay | ||||
|             AsOfDate            = string prefs.AsOfDateDisplay | ||||
|             Visibility          = | ||||
|                 if   prefs.IsPublic           then GroupVisibility.PublicList | ||||
|                 elif prefs.GroupPassword = "" then GroupVisibility.PrivateList | ||||
| @ -465,51 +464,51 @@ module EditPreferences = | ||||
| type EditRequest = | ||||
|     {   /// The ID of the request | ||||
|         RequestId : string | ||||
|          | ||||
| 
 | ||||
|         /// The type of the request | ||||
|         RequestType : string | ||||
|          | ||||
| 
 | ||||
|         /// The date of the request | ||||
|         EnteredDate : string option | ||||
|          | ||||
| 
 | ||||
|         /// Whether to update the date or not | ||||
|         SkipDateUpdate : bool option | ||||
|          | ||||
| 
 | ||||
|         /// The requestor or subject | ||||
|         Requestor : string option | ||||
|          | ||||
| 
 | ||||
|         /// How this request is expired | ||||
|         Expiration : string | ||||
|          | ||||
| 
 | ||||
|         /// The text of the request | ||||
|         Text : string | ||||
|     } | ||||
| with | ||||
|    | ||||
| 
 | ||||
|     /// Is this a new request? | ||||
|     member this.IsNew = emptyGuid = this.RequestId | ||||
| 
 | ||||
| /// Support for the EditRequest type | ||||
| module EditRequest = | ||||
|      | ||||
| 
 | ||||
|     /// An empty instance to use for new requests | ||||
|     let empty = | ||||
|         {   RequestId      = emptyGuid | ||||
|             RequestType    = PrayerRequestType.toCode CurrentRequest | ||||
|             RequestType    = string CurrentRequest | ||||
|             EnteredDate    = None | ||||
|             SkipDateUpdate = None | ||||
|             Requestor      = None | ||||
|             Expiration     = Expiration.toCode Automatic | ||||
|             Expiration     = string Automatic | ||||
|             Text           = "" | ||||
|         } | ||||
|      | ||||
| 
 | ||||
|     /// Create an instance from an existing request | ||||
|     let fromRequest (req : PrayerRequest) = | ||||
|     let fromRequest (req: PrayerRequest) = | ||||
|         { empty with | ||||
|             RequestId   = shortGuid req.Id.Value | ||||
|             RequestType = PrayerRequestType.toCode req.RequestType | ||||
|             RequestType = string req.RequestType | ||||
|             Requestor   = req.Requestor | ||||
|             Expiration  = Expiration.toCode req.Expiration | ||||
|             Expiration  = string req.Expiration | ||||
|             Text        = req.Text | ||||
|         } | ||||
| 
 | ||||
| @ -519,20 +518,20 @@ module EditRequest = | ||||
| type EditSmallGroup = | ||||
|     {   /// The ID of the small group | ||||
|         SmallGroupId : string | ||||
|          | ||||
| 
 | ||||
|         /// The name of the small group | ||||
|         Name : string | ||||
|          | ||||
| 
 | ||||
|         /// The ID of the church to which this small group belongs | ||||
|         ChurchId : string | ||||
|     } | ||||
| with | ||||
|      | ||||
| 
 | ||||
|     /// Is this a new small group? | ||||
|     member this.IsNew = emptyGuid = this.SmallGroupId | ||||
|      | ||||
| 
 | ||||
|     /// Populate a small group from this form | ||||
|     member this.populateGroup (grp : SmallGroup) = | ||||
|     member this.populateGroup (grp: SmallGroup) = | ||||
|         { grp with | ||||
|             Name     = this.Name | ||||
|             ChurchId = idFromShort ChurchId this.ChurchId | ||||
| @ -540,14 +539,14 @@ with | ||||
| 
 | ||||
| /// Support for the EditSmallGroup type | ||||
| module EditSmallGroup = | ||||
|      | ||||
| 
 | ||||
|     /// Create an instance from an existing small group | ||||
|     let fromGroup (grp : SmallGroup) = | ||||
|     let fromGroup (grp: SmallGroup) = | ||||
|         {   SmallGroupId = shortGuid grp.Id.Value | ||||
|             Name         = grp.Name | ||||
|             ChurchId     = shortGuid grp.ChurchId.Value | ||||
|         } | ||||
|      | ||||
| 
 | ||||
|     /// An empty instance (used when adding a new group) | ||||
|     let empty = | ||||
|         {   SmallGroupId = emptyGuid | ||||
| @ -561,32 +560,32 @@ module EditSmallGroup = | ||||
| type EditUser = | ||||
|     {   /// The ID of the user | ||||
|         UserId : string | ||||
|          | ||||
| 
 | ||||
|         /// The first name of the user | ||||
|         FirstName : string | ||||
|          | ||||
| 
 | ||||
|         /// The last name of the user | ||||
|         LastName : string | ||||
|          | ||||
| 
 | ||||
|         /// The e-mail address for the user | ||||
|         Email : string | ||||
|          | ||||
| 
 | ||||
|         /// The password for the user | ||||
|         Password : string | ||||
|          | ||||
| 
 | ||||
|         /// The password hash for the user a second time | ||||
|         PasswordConfirm : string | ||||
|          | ||||
| 
 | ||||
|         /// Is this user a PrayerTracker administrator? | ||||
|         IsAdmin : bool option | ||||
|     } | ||||
| with | ||||
|    | ||||
| 
 | ||||
|     /// Is this a new user? | ||||
|     member this.IsNew = emptyGuid = this.UserId | ||||
|    | ||||
| 
 | ||||
|     /// Populate a user from the form | ||||
|     member this.PopulateUser (user : User) hasher = | ||||
|     member this.PopulateUser (user: User) hasher = | ||||
|         { user with | ||||
|             FirstName = this.FirstName | ||||
|             LastName  = this.LastName | ||||
| @ -599,7 +598,7 @@ with | ||||
| 
 | ||||
| /// Support for the EditUser type | ||||
| module EditUser = | ||||
|    | ||||
| 
 | ||||
|     /// An empty instance | ||||
|     let empty = | ||||
|         {   UserId          = emptyGuid | ||||
| @ -610,9 +609,9 @@ module EditUser = | ||||
|             PasswordConfirm = "" | ||||
|             IsAdmin         = None | ||||
|         } | ||||
|      | ||||
| 
 | ||||
|     /// Create an instance from an existing user | ||||
|     let fromUser (user : User) = | ||||
|     let fromUser (user: User) = | ||||
|         { empty with | ||||
|             UserId    = shortGuid user.Id.Value | ||||
|             FirstName = user.FirstName | ||||
| @ -627,17 +626,17 @@ module EditUser = | ||||
| type GroupLogOn = | ||||
|     {   /// The ID of the small group to which the user is logging on | ||||
|         SmallGroupId : string | ||||
|          | ||||
| 
 | ||||
|         /// The password entered | ||||
|         Password : string | ||||
|          | ||||
| 
 | ||||
|         /// Whether to remember the login | ||||
|         RememberMe : bool option | ||||
|     } | ||||
| 
 | ||||
| /// Support for the GroupLogOn type | ||||
| module GroupLogOn = | ||||
|    | ||||
| 
 | ||||
|     /// An empty instance | ||||
|     let empty = | ||||
|         {   SmallGroupId = emptyGuid | ||||
| @ -651,27 +650,27 @@ module GroupLogOn = | ||||
| type MaintainRequests = | ||||
|     {   /// The requests to be displayed | ||||
|         Requests : PrayerRequest list | ||||
|          | ||||
| 
 | ||||
|         /// The small group to which the requests belong | ||||
|         SmallGroup : SmallGroup | ||||
|          | ||||
| 
 | ||||
|         /// Whether only active requests are included | ||||
|         OnlyActive : bool option | ||||
|          | ||||
| 
 | ||||
|         /// The search term for the requests | ||||
|         SearchTerm : string option | ||||
|          | ||||
| 
 | ||||
|         /// The page number of the results | ||||
|         PageNbr : int option | ||||
|     } | ||||
| 
 | ||||
| /// Support for the MaintainRequests type | ||||
| module MaintainRequests = | ||||
|      | ||||
| 
 | ||||
|     /// An empty instance | ||||
|     let empty = | ||||
|         {   Requests   = [] | ||||
|             SmallGroup = SmallGroup.empty  | ||||
|             SmallGroup = SmallGroup.Empty | ||||
|             OnlyActive = None | ||||
|             SearchTerm = None | ||||
|             PageNbr    = None | ||||
| @ -683,16 +682,16 @@ module MaintainRequests = | ||||
| type Overview = | ||||
|     {   /// The total number of active requests | ||||
|         TotalActiveReqs : int | ||||
|          | ||||
| 
 | ||||
|         /// The numbers of active requests by request type | ||||
|         ActiveReqsByType : Map<PrayerRequestType, int> | ||||
|          | ||||
| 
 | ||||
|         /// A count of all requests | ||||
|         AllReqs : int | ||||
|          | ||||
| 
 | ||||
|         /// A count of all members | ||||
|         TotalMembers : int | ||||
|          | ||||
| 
 | ||||
|         /// The users authorized to administer this group | ||||
|         Admins : User list | ||||
|     } | ||||
| @ -703,23 +702,23 @@ type Overview = | ||||
| type UserLogOn = | ||||
|     {   /// The e-mail address of the user | ||||
|         Email : string | ||||
|          | ||||
| 
 | ||||
|         /// The password entered | ||||
|         Password : string | ||||
|          | ||||
| 
 | ||||
|         /// The ID of the small group to which the user is logging on | ||||
|         SmallGroupId : string | ||||
|          | ||||
| 
 | ||||
|         /// Whether to remember the login | ||||
|         RememberMe : bool option | ||||
|          | ||||
| 
 | ||||
|         /// The URL to which the user should be redirected once login is successful | ||||
|         RedirectUrl : string option | ||||
|     } | ||||
| 
 | ||||
| /// Support for the UserLogOn type | ||||
| module UserLogOn = | ||||
|      | ||||
| 
 | ||||
|     /// An empty instance | ||||
|     let empty = | ||||
|         {   Email        = "" | ||||
| @ -737,32 +736,32 @@ open Giraffe.ViewEngine | ||||
| type RequestList = | ||||
|     {   /// The prayer request list | ||||
|         Requests : PrayerRequest list | ||||
|          | ||||
| 
 | ||||
|         /// The date for which this list is being generated | ||||
|         Date : LocalDate | ||||
|          | ||||
| 
 | ||||
|         /// The small group to which this list belongs | ||||
|         SmallGroup : SmallGroup | ||||
|          | ||||
| 
 | ||||
|         /// Whether to show the class header | ||||
|         ShowHeader : bool | ||||
|          | ||||
| 
 | ||||
|         /// The list of recipients (populated if requests are e-mailed) | ||||
|         Recipients : Member list | ||||
|          | ||||
| 
 | ||||
|         /// Whether the user can e-mail this list | ||||
|         CanEmail : bool | ||||
|     } | ||||
| with | ||||
| 
 | ||||
|     /// Group requests by their type, along with the type and its localized string | ||||
|     member this.RequestsByType (s : IStringLocalizer) = | ||||
|     member this.RequestsByType (s: IStringLocalizer) = | ||||
|         ReferenceList.requestTypeList s | ||||
|         |> List.map (fun (typ, name) -> | ||||
|             let sort = | ||||
|                 match this.SmallGroup.Preferences.RequestSort with | ||||
|                 | SortByDate -> Seq.sortByDescending (fun req -> req.UpdatedDate) | ||||
|                 | SortByRequestor -> Seq.sortBy (fun req -> req.Requestor) | ||||
|                 | SortByDate -> Seq.sortByDescending _.UpdatedDate | ||||
|                 | SortByRequestor -> Seq.sortBy _.Requestor | ||||
|             let reqs = | ||||
|                 this.Requests | ||||
|                 |> Seq.ofList | ||||
| @ -771,14 +770,14 @@ with | ||||
|                 |> List.ofSeq | ||||
|             typ, name, reqs) | ||||
|         |> List.filter (fun (_, _, reqs) -> not (List.isEmpty reqs)) | ||||
|      | ||||
| 
 | ||||
|     /// Is this request new? | ||||
|     member this.IsNew (req : PrayerRequest) = | ||||
|         let reqDate = req.UpdatedDate.InZone(SmallGroup.timeZone this.SmallGroup).Date | ||||
|     member this.IsNew (req: PrayerRequest) = | ||||
|         let reqDate = req.UpdatedDate.InZone(this.SmallGroup.TimeZone).Date | ||||
|         Period.Between(reqDate, this.Date, PeriodUnits.Days).Days <= this.SmallGroup.Preferences.DaysToKeepNew | ||||
|      | ||||
| 
 | ||||
|     /// Generate this list as HTML | ||||
|     member this.AsHtml (s : IStringLocalizer) = | ||||
|     member this.AsHtml (s: IStringLocalizer) = | ||||
|         let p        = this.SmallGroup.Preferences | ||||
|         let asOfSize = Math.Round (float p.TextFontSize * 0.8, 2) | ||||
|         [   if this.ShowHeader then | ||||
| @ -804,7 +803,7 @@ with | ||||
|                         ] | ||||
|                     ] | ||||
|                 ] | ||||
|                 let tz = SmallGroup.timeZone this.SmallGroup | ||||
|                 let tz = this.SmallGroup.TimeZone | ||||
|                 reqs | ||||
|                 |> List.map (fun req -> | ||||
|                     let bullet = if this.IsNew req then "circle" else "disc" | ||||
| @ -822,8 +821,8 @@ with | ||||
|                         | LongDate -> | ||||
|                             let dt = | ||||
|                                 match p.AsOfDateDisplay with | ||||
|                                 | ShortDate -> req.UpdatedDate.InZone(tz).Date.ToString ("d", null) | ||||
|                                 | LongDate -> req.UpdatedDate.InZone(tz).Date.ToString ("D", null) | ||||
|                                 | ShortDate -> req.UpdatedDate.InZone(tz).Date.ToString("d", null) | ||||
|                                 | LongDate -> req.UpdatedDate.InZone(tz).Date.ToString("D", null) | ||||
|                                 | _ -> "" | ||||
|                             i [ _style $"font-size:%.2f{asOfSize}pt" ] [ | ||||
|                                 rawText "  ("; str s["as of"].Value; str " "; str dt; rawText ")" | ||||
| @ -835,17 +834,17 @@ with | ||||
|         |> RenderView.AsString.htmlNodes | ||||
| 
 | ||||
|     /// Generate this list as plain text | ||||
|     member this.AsText (s : IStringLocalizer) = | ||||
|         let tz = SmallGroup.timeZone this.SmallGroup | ||||
|     member this.AsText (s: IStringLocalizer) = | ||||
|         let tz = this.SmallGroup.TimeZone | ||||
|         seq { | ||||
|             this.SmallGroup.Name | ||||
|             s["Prayer Requests"].Value | ||||
|             this.Date.ToString (s["MMMM d, yyyy"].Value, null) | ||||
|             this.Date.ToString(s["MMMM d, yyyy"].Value, null) | ||||
|             " " | ||||
|             for _, name, reqs in this.RequestsByType s do | ||||
|                 let dashes = String.replicate (name.Value.Length + 4) "-" | ||||
|                 dashes | ||||
|                 $"  {name.Value.ToUpper ()}" | ||||
|                 $"  {name.Value.ToUpper()}" | ||||
|                 dashes | ||||
|                 for req in reqs do | ||||
|                     let bullet    = if this.IsNew req then "+" else "-" | ||||
| @ -855,8 +854,8 @@ with | ||||
|                     | _ -> | ||||
|                         let dt = | ||||
|                             match this.SmallGroup.Preferences.AsOfDateDisplay with | ||||
|                             | ShortDate -> req.UpdatedDate.InZone(tz).Date.ToString ("d", null) | ||||
|                             | LongDate -> req.UpdatedDate.InZone(tz).Date.ToString ("D", null) | ||||
|                             | ShortDate -> req.UpdatedDate.InZone(tz).Date.ToString("d", null) | ||||
|                             | LongDate -> req.UpdatedDate.InZone(tz).Date.ToString("D", null) | ||||
|                             | _ -> "" | ||||
|                         $"""  ({s["as of"].Value} {dt})""" | ||||
|                     |> sprintf "  %s %s%s%s" bullet requestor (htmlToPlainText req.Text) | ||||
		Loading…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user