From adbbf9cf4e29d1680727ca355f88ced97c1be302 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Thu, 27 Jun 2024 07:36:24 -0400 Subject: [PATCH 1/4] Update deps - formatting changes --- .../PrayerTracker.Tests.fsproj | 2 +- src/PrayerTracker.Tests/Program.fs | 2 +- src/PrayerTracker.UI/PrayerTracker.UI.fsproj | 2 +- src/PrayerTracker.UI/Utils.fs | 14 +-- src/PrayerTracker/App.fs | 82 +++++++------- src/PrayerTracker/Church.fs | 4 +- src/PrayerTracker/CommonFunctions.fs | 42 ++++---- src/PrayerTracker/Email.fs | 101 +++++++++--------- src/PrayerTracker/Extensions.fs | 18 ++-- src/PrayerTracker/Home.fs | 10 +- src/PrayerTracker/PrayerRequest.fs | 96 ++++++++--------- src/PrayerTracker/PrayerTracker.fsproj | 2 +- src/PrayerTracker/SmallGroup.fs | 86 +++++++-------- src/PrayerTracker/User.fs | 61 +++++------ 14 files changed, 250 insertions(+), 272 deletions(-) diff --git a/src/PrayerTracker.Tests/PrayerTracker.Tests.fsproj b/src/PrayerTracker.Tests/PrayerTracker.Tests.fsproj index 5b9db06..1d93b6b 100644 --- a/src/PrayerTracker.Tests/PrayerTracker.Tests.fsproj +++ b/src/PrayerTracker.Tests/PrayerTracker.Tests.fsproj @@ -14,7 +14,7 @@ - + diff --git a/src/PrayerTracker.Tests/Program.fs b/src/PrayerTracker.Tests/Program.fs index fbce67e..2b0e8ff 100644 --- a/src/PrayerTracker.Tests/Program.fs +++ b/src/PrayerTracker.Tests/Program.fs @@ -2,4 +2,4 @@ [] let main argv = - runTestsInAssembly defaultConfig argv + runTestsInAssemblyWithCLIArgs [] argv diff --git a/src/PrayerTracker.UI/PrayerTracker.UI.fsproj b/src/PrayerTracker.UI/PrayerTracker.UI.fsproj index d8909fc..b1fbf11 100644 --- a/src/PrayerTracker.UI/PrayerTracker.UI.fsproj +++ b/src/PrayerTracker.UI/PrayerTracker.UI.fsproj @@ -15,7 +15,7 @@ - + diff --git a/src/PrayerTracker.UI/Utils.fs b/src/PrayerTracker.UI/Utils.fs index 07778af..2c48b2a 100644 --- a/src/PrayerTracker.UI/Utils.fs +++ b/src/PrayerTracker.UI/Utils.fs @@ -5,7 +5,7 @@ open System open Giraffe /// Parse a short-GUID-based ID from a string -let idFromShort<'T> (f : Guid -> 'T) strValue = +let idFromShort<'T> (f: Guid -> 'T) strValue = (ShortGuid.toGuid >> f) strValue /// Format a GUID as a short GUID @@ -19,19 +19,19 @@ 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) = + let replaceFirst (needle: string) replacement (haystack: string) = match haystack.IndexOf needle with | -1 -> haystack | idx -> String.concat "" [ haystack[0..idx - 1]; replacement; haystack[idx + needle.Length..] ] /// Convert a string to an option, with null, blank, and whitespace becoming None - let noneIfBlank (str : string) = + let noneIfBlank (str: string) = match str with | null -> None | it when it.Trim () = "" -> None @@ -46,7 +46,7 @@ let stripTags allowedTags input = let stripHtmlExp = Regex @"(<\/?[^>]+>)" let mutable output = input for tag in stripHtmlExp.Matches input do - let htmlTag = tag.Value.ToLower () + let htmlTag = tag.Value.ToLower() let shouldReplace = allowedTags |> List.fold (fun acc t -> @@ -100,7 +100,7 @@ let ckEditorToText (text : string) = "

", "" "

", "" ] - |> List.fold (fun (txt : string) (x, y) -> String.replace x y txt) text + |> List.fold (fun (txt: string) (x, y) -> String.replace x y txt) text |> String.trim diff --git a/src/PrayerTracker/App.fs b/src/PrayerTracker/App.fs index 9254290..86b05be 100644 --- a/src/PrayerTracker/App.fs +++ b/src/PrayerTracker/App.fs @@ -3,9 +3,9 @@ namespace PrayerTracker open Microsoft.AspNetCore.Http /// Middleware to add the starting ticks for the request -type RequestStartMiddleware (next : RequestDelegate) = +type RequestStartMiddleware (next: RequestDelegate) = - member this.InvokeAsync (ctx : HttpContext) = task { + member this.InvokeAsync (ctx: HttpContext) = task { ctx.Items[Key.startTime] <- ctx.Now return! next.Invoke ctx } @@ -21,7 +21,7 @@ open Microsoft.Extensions.Configuration module Configure = /// Set up the configuration for the app - let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) = + let configuration (ctx: WebHostBuilderContext) (cfg: IConfigurationBuilder) = cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath) .AddJsonFile("appsettings.json", optional = true, reloadOnChange = true) .AddJsonFile($"appsettings.{ctx.HostingEnvironment.EnvironmentName}.json", optional = true) @@ -31,7 +31,7 @@ module Configure = open Microsoft.AspNetCore.Server.Kestrel.Core /// Configure Kestrel from appsettings.json - let kestrel (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) = + let kestrel (ctx: WebHostBuilderContext) (opts: KestrelServerOptions) = (ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel" open System.Globalization @@ -46,37 +46,37 @@ module Configure = /// Configure ASP.NET Core's service collection (dependency injection container) let services (svc : IServiceCollection) = - let _ = svc.AddOptions () - let _ = svc.AddLocalization (fun options -> options.ResourcesPath <- "Resources") + let _ = svc.AddOptions() + let _ = svc.AddLocalization(fun options -> options.ResourcesPath <- "Resources") let _ = - svc.Configure (fun (opts : RequestLocalizationOptions) -> + svc.Configure(fun (opts: RequestLocalizationOptions) -> 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.DefaultRequestCulture <- RequestCulture("en-US", "en-US") opts.SupportedCultures <- supportedCultures opts.SupportedUICultures <- supportedCultures) let _ = svc.AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme) - .AddCookie (fun opts -> + .AddCookie(fun opts -> opts.ExpireTimeSpan <- TimeSpan.FromMinutes 120. opts.SlidingExpiration <- true opts.AccessDeniedPath <- "/error/403") - let _ = svc.AddAuthorization () + let _ = svc.AddAuthorization() - let cfg = svc.BuildServiceProvider().GetService () - let dsb = NpgsqlDataSourceBuilder (cfg.GetConnectionString "PrayerTracker") + let cfg = svc.BuildServiceProvider().GetService() + let dsb = NpgsqlDataSourceBuilder(cfg.GetConnectionString "PrayerTracker") let _ = dsb.UseNodaTime() - Configuration.useDataSource (dsb.Build ()) + dsb.Build() |> Configuration.useDataSource let emailCfg = cfg.GetSection "Email" if (emailCfg.GetChildren >> Seq.isEmpty >> not) () then ConfigurationBinder.Bind(emailCfg, Email.smtpOptions) - let _ = svc.AddSingleton () - let _ = svc.AddSession () - let _ = svc.AddAntiforgery () - let _ = svc.AddRouting () + let _ = svc.AddSingleton() + let _ = svc.AddSession() + let _ = svc.AddAntiforgery() + let _ = svc.AddRouting() let _ = svc.AddSingleton SystemClock.Instance () @@ -172,16 +172,16 @@ module Configure = open Microsoft.Extensions.Logging /// Giraffe error handler - let errorHandler (ex : exn) (logger : ILogger) = - logger.LogError (EventId(), ex, "An unhandled exception has occurred while executing the request.") + 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 () - if env.IsDevelopment () then log else log.AddFilter (fun l -> l > LogLevel.Information) + let logging (log: ILoggingBuilder) = + let env = log.Services.BuildServiceProvider().GetService() + if env.IsDevelopment() then log else log.AddFilter(fun l -> l > LogLevel.Information) |> function l -> l.AddConsole().AddDebug() |> ignore @@ -191,27 +191,27 @@ module Configure = /// Configure the application let app (app : IApplicationBuilder) = - let env = app.ApplicationServices.GetRequiredService () - if env.IsDevelopment () then - app.UseDeveloperExceptionPage () + let env = app.ApplicationServices.GetRequiredService() + if env.IsDevelopment() then + app.UseDeveloperExceptionPage() else app.UseGiraffeErrorHandler errorHandler |> ignore - let _ = app.UseForwardedHeaders () - let _ = app.UseCanonicalDomains () + let _ = app.UseForwardedHeaders() + let _ = app.UseCanonicalDomains() let _ = app.UseStatusCodePagesWithReExecute "/error/{0}" - let _ = app.UseStaticFiles () - let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict)) - let _ = app.UseMiddleware () - let _ = app.UseRouting () - let _ = app.UseSession () - let _ = app.UseRequestLocalization - (app.ApplicationServices.GetService>().Value) - let _ = app.UseAuthentication () - let _ = app.UseAuthorization () - let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints routes) - Views.I18N.setUpFactories <| app.ApplicationServices.GetRequiredService () + let _ = app.UseStaticFiles() + let _ = app.UseCookiePolicy(CookiePolicyOptions(MinimumSameSitePolicy = SameSiteMode.Strict)) + let _ = app.UseMiddleware() + let _ = app.UseRouting() + let _ = app.UseSession() + let _ = app.UseRequestLocalization( + app.ApplicationServices.GetService>().Value) + let _ = app.UseAuthentication() + let _ = app.UseAuthorization() + let _ = app.UseEndpoints(fun e -> e.MapGiraffeEndpoints routes) + app.ApplicationServices.GetRequiredService() |> Views.I18N.setUpFactories /// The web application @@ -221,16 +221,16 @@ module App = [] let main args = - let contentRoot = Directory.GetCurrentDirectory () + let contentRoot = Directory.GetCurrentDirectory() let app = WebHostBuilder() .UseContentRoot(contentRoot) .ConfigureAppConfiguration(Configure.configuration) .UseKestrel(Configure.kestrel) - .UseWebRoot(Path.Combine (contentRoot, "wwwroot")) + .UseWebRoot(Path.Combine(contentRoot, "wwwroot")) .ConfigureServices(Configure.services) .ConfigureLogging(Configure.logging) .Configure(System.Action Configure.app) .Build() - if args.Length > 0 then printfn $"Unrecognized option {args[0]}" else app.Run () + if args.Length > 0 then printfn $"Unrecognized option {args[0]}" else app.Run() 0 diff --git a/src/PrayerTracker/Church.fs b/src/PrayerTracker/Church.fs index 7f13810..e3c6978 100644 --- a/src/PrayerTracker/Church.fs +++ b/src/PrayerTracker/Church.fs @@ -63,12 +63,12 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c match! ctx.TryBindFormAsync () 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 -> do! Churches.save (model.PopulateChurch ch) - let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower () + let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower() addInfo ctx ctx.Strings["Successfully {0} church “{1}”", act, model.Name] return! redirectTo false "/churches" next ctx | None -> return! fourOhFour ctx diff --git a/src/PrayerTracker/CommonFunctions.fs b/src/PrayerTracker/CommonFunctions.fs index 173c803..c0ad350 100644 --- a/src/PrayerTracker/CommonFunctions.fs +++ b/src/PrayerTracker/CommonFunctions.fs @@ -5,22 +5,21 @@ module PrayerTracker.Handlers.CommonFunctions open Microsoft.AspNetCore.Mvc.Rendering /// Create a select list from an enumeration -let toSelectList<'T> valFunc textFunc withDefault emptyText (items : 'T seq) = +let toSelectList<'T> valFunc textFunc withDefault emptyText (items: 'T seq) = if isNull items then nullArg (nameof items) - [ match withDefault with - | true -> - let s = PrayerTracker.Views.I18N.localizer.Force () - SelectListItem ($"""— %A{s[emptyText]} —""", "") - | _ -> () - yield! items |> Seq.map (fun x -> SelectListItem (textFunc x, valFunc x)) - ] + [ match withDefault with + | true -> + let s = PrayerTracker.Views.I18N.localizer.Force() + 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) = +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) = +let toSelectListWithDefault<'T> valFunc textFunc (items: 'T seq) = toSelectList valFunc textFunc true "Select" items /// The version of PrayerTracker @@ -49,7 +48,7 @@ open PrayerTracker open PrayerTracker.ViewModels /// Create the common view information heading -let viewInfo (ctx : HttpContext) = +let viewInfo (ctx: HttpContext) = let msg = match ctx.Session.Messages with | [] -> [] @@ -67,8 +66,7 @@ let viewInfo (ctx : HttpContext) = RequestStart = ctx.Items[Key.startTime] :?> Instant User = ctx.Session.CurrentUser Group = ctx.Session.CurrentGroup - Layout = layout - } + Layout = layout } /// The view is the last parameter, so it can be composed let renderHtml next ctx view = @@ -77,24 +75,24 @@ let renderHtml next ctx view = open Microsoft.Extensions.Logging /// Display an error regarding form submission -let bindError (msg : string) = +let bindError (msg: string) = handleContext (fun ctx -> ctx.GetService().CreateLogger("PrayerTracker.Handlers").LogError msg (setStatusCode 400 >=> text msg) earlyReturn ctx) /// Handler that will return a status code 404 and the text "Not Found" -let fourOhFour (ctx : HttpContext) = +let fourOhFour (ctx: HttpContext) = (setStatusCode 404 >=> text "Not Found") earlyReturn ctx /// Handler to validate CSRF prevention token let validateCsrf : HttpHandler = fun next ctx -> task { - match! (ctx.GetService ()).IsRequestValidAsync ctx with + match! ctx.GetService().IsRequestValidAsync ctx with | true -> return! next ctx | false -> return! (clearResponse >=> setStatusCode 400 >=> text "Quit hacking...") earlyReturn ctx } /// Add a message to the session -let addUserMessage (ctx : HttpContext) msg = +let addUserMessage (ctx: HttpContext) msg = ctx.Session.Messages <- msg :: ctx.Session.Messages @@ -102,10 +100,10 @@ open Microsoft.AspNetCore.Html open Microsoft.Extensions.Localization /// Convert a localized string to an HTML string -let htmlLocString (x : LocalizedString) = +let htmlLocString (x: LocalizedString) = (System.Net.WebUtility.HtmlEncode >> HtmlString) x.Value -let htmlString (x : LocalizedString) = +let htmlString (x: LocalizedString) = HtmlString x.Value /// Add an error message to the session @@ -143,8 +141,8 @@ open PrayerTracker.Entities /// Require one of the given access roles let requireAccess levels : HttpHandler = fun next ctx -> task { // These calls fill the user and group in the session, making .Value safe to use for the rest of the request - let! user = ctx.CurrentUser () - let! group = ctx.CurrentGroup () + let! user = ctx.CurrentUser() + let! group = ctx.CurrentGroup() match user, group with | _, _ when List.contains Public levels -> return! next ctx | Some _, _ when List.contains User levels -> return! next ctx @@ -155,7 +153,7 @@ let requireAccess levels : HttpHandler = fun next ctx -> task { return! redirectTo false "/unauthorized" next ctx | _, _ when List.contains User levels -> // Redirect to the user log on page - ctx.Session.SetString (Key.Session.redirectUrl, ctx.Request.GetEncodedPathAndQuery ()) + ctx.Session.SetString(Key.Session.redirectUrl, ctx.Request.GetEncodedPathAndQuery()) return! redirectTo false "/user/log-on" next ctx | _, _ when List.contains Group levels -> // Redirect to the small group log on page diff --git a/src/PrayerTracker/Email.fs b/src/PrayerTracker/Email.fs index 28d190a..27a68b6 100644 --- a/src/PrayerTracker/Email.fs +++ b/src/PrayerTracker/Email.fs @@ -8,63 +8,62 @@ open PrayerTracker.Entities /// Parameters required to send an e-mail type EmailOptions = - { /// The SMTP client - Client : SmtpClient - - /// The people who should receive the e-mail - Recipients : Member list - - /// The small group for which this e-mail is being sent - Group : SmallGroup - - /// The subject of the e-mail - Subject : string - - /// The body of the e-mail in HTML - HtmlBody : string - - /// The body of the e-mail in plain text - PlainTextBody : string - - /// Use the current user's preferred language - Strings : IStringLocalizer - } + { /// The SMTP client + Client: SmtpClient + + /// The people who should receive the e-mail + Recipients: Member list + + /// The small group for which this e-mail is being sent + Group: SmallGroup + + /// The subject of the e-mail + Subject: string + + /// The body of the e-mail in HTML + HtmlBody: string + + /// The body of the e-mail in plain text + PlainTextBody: string + + /// Use the current user's preferred language + Strings: IStringLocalizer } /// Options to use when sending e-mail type SmtpServerOptions() = /// The hostname of the SMTP server - member val SmtpHost : string = "localhost" with get, set + member val SmtpHost: string = "localhost" with get, set /// The port over which SMTP communication should occur - member val Port : int = 25 with get, set + member val Port: int = 25 with get, set /// Whether to use SSL when communicating with the SMTP server - member val UseSsl : bool = false with get, set + member val UseSsl: bool = false with get, set /// The authentication to use with the SMTP server - member val Authentication : string = "" with get, set + member val Authentication: string = "" with get, set /// The e-mail address from which messages should be sent - member val FromAddress : string = "prayer@bitbadger.solutions" with get, set + member val FromAddress: string = "prayer@bitbadger.solutions" with get, set /// The options for the SMTP server -let smtpOptions = SmtpServerOptions () +let smtpOptions = SmtpServerOptions() /// Get an SMTP client connection let getConnection () = task { - let client = new SmtpClient () - do! client.ConnectAsync (smtpOptions.SmtpHost, smtpOptions.Port, smtpOptions.UseSsl) - do! client.AuthenticateAsync (smtpOptions.FromAddress, smtpOptions.Authentication) + let client = new SmtpClient() + do! client.ConnectAsync(smtpOptions.SmtpHost, smtpOptions.Port, smtpOptions.UseSsl) + do! client.AuthenticateAsync(smtpOptions.FromAddress, smtpOptions.Authentication) return client } /// Create a mail message object, filled with everything but the body content let createMessage opts = - let msg = new MimeMessage () - msg.From.Add (MailboxAddress (opts.Group.Preferences.EmailFromName, smtpOptions.FromAddress)) + let msg = new MimeMessage() + msg.From.Add(MailboxAddress(opts.Group.Preferences.EmailFromName, smtpOptions.FromAddress)) msg.Subject <- opts.Subject - msg.ReplyTo.Add (MailboxAddress (opts.Group.Preferences.EmailFromName, opts.Group.Preferences.EmailFromAddress)) + msg.ReplyTo.Add(MailboxAddress(opts.Group.Preferences.EmailFromName, opts.Group.Preferences.EmailFromAddress)) msg open MimeKit.Text @@ -72,31 +71,29 @@ open MimeKit.Text /// Create an HTML-format e-mail message let createHtmlMessage opts = let bodyText = - [ """""" - opts.HtmlBody - """

""" - opts.Strings["Generated by P R A Y E R T R A C K E R"].Value - "
" - opts.Strings["from Bit Badger Solutions"].Value - "
" - ] + [ """""" + opts.HtmlBody + """
""" + opts.Strings["Generated by P R A Y E R T R A C K E R"].Value + "
" + opts.Strings["from Bit Badger Solutions"].Value + "
" ] |> String.concat "" let msg = createMessage opts - msg.Body <- new TextPart (TextFormat.Html, Text = bodyText) + msg.Body <- new TextPart(TextFormat.Html, Text = bodyText) msg /// Create a plain-text-format e-mail message let createTextMessage opts = let bodyText = - [ opts.PlainTextBody - "\n\n--\n" - opts.Strings["Generated by P R A Y E R T R A C K E R"].Value - "\n" - opts.Strings["from Bit Badger Solutions"].Value - ] + [ opts.PlainTextBody + "\n\n--\n" + opts.Strings["Generated by P R A Y E R T R A C K E R"].Value + "\n" + opts.Strings["from Bit Badger Solutions"].Value ] |> String.concat "" let msg = createMessage opts - msg.Body <- new TextPart (TextFormat.Plain, Text = bodyText) + msg.Body <- new TextPart(TextFormat.Plain, Text = bodyText) msg /// Send e-mails to a class @@ -105,14 +102,14 @@ let sendEmails opts = task { use plainTextMsg = createTextMessage opts for mbr in opts.Recipients do - let emailTo = MailboxAddress (mbr.Name, mbr.Email) + let emailTo = MailboxAddress(mbr.Name, mbr.Email) match defaultArg mbr.Format opts.Group.Preferences.DefaultEmailType with | HtmlFormat -> htmlMsg.To.Add emailTo let! _ = opts.Client.SendAsync htmlMsg - htmlMsg.To.Clear () + htmlMsg.To.Clear() | PlainTextFormat -> plainTextMsg.To.Add emailTo let! _ = opts.Client.SendAsync plainTextMsg - plainTextMsg.To.Clear () + plainTextMsg.To.Clear() } diff --git a/src/PrayerTracker/Extensions.fs b/src/PrayerTracker/Extensions.fs index 7cb69ac..8c50073 100644 --- a/src/PrayerTracker/Extensions.fs +++ b/src/PrayerTracker/Extensions.fs @@ -16,19 +16,19 @@ let private jsonSettings = JsonSerializerSettings().ConfigureForNodaTime DateTim type ISession with /// Set an object in the session - member this.SetObject<'T> key (value : 'T) = - this.SetString (key, JsonConvert.SerializeObject (value, jsonSettings)) + member this.SetObject<'T> key (value: 'T) = + this.SetString(key, JsonConvert.SerializeObject(value, jsonSettings)) /// 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 (JsonConvert.DeserializeObject<'T>(v, jsonSettings)) /// The currently logged on small group member this.CurrentGroup with get () = this.TryGetObject 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 @@ -36,7 +36,7 @@ type ISession with /// The currently logged on user member this.CurrentUser with get () = this.TryGetObject Key.Session.currentUser - and set (v : User option) = + and set (v: User option) = match v with | Some user -> this.SetObject Key.Session.currentUser { user with PasswordHash = "" } | None -> this.Remove Key.Session.currentUser @@ -46,7 +46,7 @@ type ISession with with get () = this.TryGetObject Key.Session.userMessages |> Option.defaultValue List.empty - and set (v : UserMessage list) = this.SetObject Key.Session.userMessages v + and set (v: UserMessage list) = this.SetObject Key.Session.userMessages v open System.Security.Claims @@ -74,13 +74,13 @@ open Npgsql type HttpContext with /// The system clock (via DI) - member this.Clock = this.GetService () + member this.Clock = this.GetService() /// The current instant - member this.Now = this.Clock.GetCurrentInstant () + member this.Now = this.Clock.GetCurrentInstant() /// The common string localizer - member _.Strings = Views.I18N.localizer.Force () + 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 { diff --git a/src/PrayerTracker/Home.fs b/src/PrayerTracker/Home.fs index 261c48c..cc77185 100644 --- a/src/PrayerTracker/Home.fs +++ b/src/PrayerTracker/Home.fs @@ -27,17 +27,17 @@ let language culture : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fu | "" | "en" -> "en-US" | "es" -> "es-MX" - | _ -> $"{culture}-{culture.ToUpper ()}" + | _ -> $"{culture}-{culture.ToUpper()}" |> (CultureInfo >> Option.ofObj) with | :? CultureNotFoundException | :? ArgumentException -> None |> function | Some c -> - ctx.Response.Cookies.Append ( + ctx.Response.Cookies.Append( CookieRequestCultureProvider.DefaultCookieName, - CookieRequestCultureProvider.MakeCookieValue (RequestCulture c), - CookieOptions (Expires = Nullable (DateTimeOffset (DateTime.Now.AddYears 1)))) + CookieRequestCultureProvider.MakeCookieValue(RequestCulture c), + CookieOptions(Expires = Nullable(DateTimeOffset(DateTime.Now.AddYears 1)))) | _ -> () let url = match string ctx.Request.Headers["Referer"] with null | "" -> "/" | r -> r redirectTo false url next ctx @@ -59,7 +59,7 @@ open Microsoft.AspNetCore.Authentication.Cookies // GET /log-off let logOff : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { - ctx.Session.Clear () + ctx.Session.Clear() do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme addHtmlInfo ctx ctx.Strings["Log Off Successful • Have a nice day!"] return! redirectTo false "/" next ctx diff --git a/src/PrayerTracker/PrayerRequest.fs b/src/PrayerTracker/PrayerRequest.fs index 732a228..762a348 100644 --- a/src/PrayerTracker/PrayerRequest.fs +++ b/src/PrayerTracker/PrayerRequest.fs @@ -8,7 +8,7 @@ open PrayerTracker.Entities open PrayerTracker.ViewModels /// Retrieve a prayer request, and ensure that it belongs to the current class -let private findRequest (ctx : HttpContext) reqId = task { +let private findRequest (ctx: HttpContext) reqId = task { match! PrayerRequests.tryById reqId with | Some req when req.SmallGroupId = ctx.Session.CurrentGroup.Value.Id -> return Ok req | Some _ -> @@ -18,31 +18,29 @@ let private findRequest (ctx : HttpContext) reqId = task { } /// Generate a list of requests for the given date -let private generateRequestList (ctx : HttpContext) date = task { +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! reqs = PrayerRequests.forGroup - { SmallGroup = group - Clock = ctx.Clock - ListDate = Some listDate - ActiveOnly = true - PageNumber = 0 - } + { SmallGroup = group + Clock = ctx.Clock + ListDate = Some listDate + ActiveOnly = true + PageNumber = 0 } return - { Requests = reqs - Date = listDate - SmallGroup = group - ShowHeader = true - CanEmail = Option.isSome ctx.User.UserId - Recipients = [] - } + { Requests = reqs + Date = listDate + SmallGroup = group + ShowHeader = true + CanEmail = Option.isSome ctx.User.UserId + Recipients = [] } } open NodaTime.Text /// Parse a string into a date (optionally, of course) -let private parseListDate (date : string option) = +let private parseListDate (date: string option) = match date with | Some dt -> match LocalDatePattern.Iso.Parse dt with it when it.Success -> Some it.Value | _ -> None | None -> None @@ -57,7 +55,7 @@ let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { if requestId.Value = Guid.Empty then return! { viewInfo ctx with HelpLink = Some Help.editRequest } - |> Views.PrayerRequest.edit EditRequest.empty (now.ToString ("R", null)) ctx + |> Views.PrayerRequest.edit EditRequest.empty (now.ToString("R", null)) ctx |> renderHtml next ctx else match! findRequest ctx requestId with @@ -90,14 +88,13 @@ let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let! recipients = Members.forGroup group.Id use! client = Email.getConnection () do! Email.sendEmails - { Client = client - Recipients = recipients - Group = group - Subject = s["Prayer Requests for {0} - {1:MMMM d, yyyy}", group.Name, list.Date].Value - HtmlBody = list.AsHtml s - PlainTextBody = list.AsText s - Strings = s - } + { Client = client + Recipients = recipients + Group = group + Subject = s["Prayer Requests for {0} - {1:MMMM d, yyyy}", group.Name, list.Date].Value + HtmlBody = list.AsHtml s + PlainTextBody = list.AsText s + Strings = s } do! client.DisconnectAsync true return! viewInfo ctx @@ -122,7 +119,7 @@ let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task match! findRequest ctx requestId with | Ok req -> do! PrayerRequests.updateExpiration { req with Expiration = Forced } false - addInfo ctx ctx.Strings["Successfully {0} prayer request", ctx.Strings["Expired"].Value.ToLower ()] + addInfo ctx ctx.Strings["Successfully {0} prayer request", ctx.Strings["Expired"].Value.ToLower()] return! redirectTo false "/prayer-requests" next ctx | Result.Error e -> return! e } @@ -133,22 +130,20 @@ let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun ne | Some group when group.Preferences.IsPublic -> let! reqs = PrayerRequests.forGroup - { SmallGroup = group - Clock = ctx.Clock - ListDate = None - ActiveOnly = true - PageNumber = 0 - } + { SmallGroup = group + Clock = ctx.Clock + ListDate = None + ActiveOnly = true + PageNumber = 0 } return! viewInfo ctx |> Views.PrayerRequest.list - { Requests = reqs - Date = SmallGroup.localDateNow ctx.Clock group - SmallGroup = group - ShowHeader = true - CanEmail = Option.isSome ctx.User.UserId - Recipients = [] - } + { Requests = reqs + Date = SmallGroup.localDateNow ctx.Clock group + SmallGroup = group + ShowHeader = true + CanEmail = Option.isSome ctx.User.UserId + Recipients = [] } |> renderHtml next ctx | Some _ -> addError ctx ctx.Strings["The request list for the group you tried to view is not public."] @@ -182,23 +177,20 @@ let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx { MaintainRequests.empty with Requests = reqs SearchTerm = Some search - PageNbr = Some pageNbr - } + PageNbr = Some pageNbr } | Result.Error _ -> let! reqs = PrayerRequests.forGroup - { SmallGroup = group - Clock = ctx.Clock - ListDate = None - ActiveOnly = onlyActive - PageNumber = pageNbr - } + { SmallGroup = group + Clock = ctx.Clock + ListDate = None + ActiveOnly = onlyActive + PageNumber = pageNbr } return { MaintainRequests.empty with Requests = reqs OnlyActive = Some onlyActive - PageNbr = if onlyActive then None else Some pageNbr - } + PageNbr = if onlyActive then None else Some pageNbr } } return! { viewInfo ctx with HelpLink = Some Help.maintainRequests } @@ -229,7 +221,7 @@ open System.Threading.Tasks // POST /prayer-request/save let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { - match! ctx.TryBindFormAsync () with + match! ctx.TryBindFormAsync() with | Ok model -> let group = ctx.Session.CurrentGroup.Value let! req = @@ -247,7 +239,7 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct let updated = { pr with RequestType = PrayerRequestType.fromCode model.RequestType - Requestor = match model.Requestor with Some x when x.Trim () = "" -> None | x -> x + Requestor = match model.Requestor with Some x when x.Trim() = "" -> None | x -> x Text = ckEditorToText model.Text Expiration = Expiration.fromCode model.Expiration } @@ -262,7 +254,7 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct | it -> { it with UpdatedDate = ctx.Now } do! PrayerRequests.save updated let act = if model.IsNew then "Added" else "Updated" - addInfo ctx ctx.Strings["Successfully {0} prayer request", ctx.Strings[act].Value.ToLower ()] + addInfo ctx ctx.Strings["Successfully {0} prayer request", ctx.Strings[act].Value.ToLower()] return! redirectTo false "/prayer-requests" next ctx | Some _ | None -> return! fourOhFour ctx diff --git a/src/PrayerTracker/PrayerTracker.fsproj b/src/PrayerTracker/PrayerTracker.fsproj index 424217f..577d838 100644 --- a/src/PrayerTracker/PrayerTracker.fsproj +++ b/src/PrayerTracker/PrayerTracker.fsproj @@ -25,7 +25,7 @@ - + diff --git a/src/PrayerTracker/SmallGroup.fs b/src/PrayerTracker/SmallGroup.fs index 6fe720a..143df7a 100644 --- a/src/PrayerTracker/SmallGroup.fs +++ b/src/PrayerTracker/SmallGroup.fs @@ -97,17 +97,17 @@ open Microsoft.AspNetCore.Authentication.Cookies // POST /small-group/log-on/submit let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task { - match! ctx.TryBindFormAsync () with + match! ctx.TryBindFormAsync() with | Ok model -> match! SmallGroups.logOn (idFromShort SmallGroupId model.SmallGroupId) model.Password with | Some group -> ctx.Session.CurrentGroup <- Some group - let identity = ClaimsIdentity ( - Seq.singleton (Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value)), + let identity = ClaimsIdentity( + Seq.singleton (Claim(ClaimTypes.GroupSid, shortGuid group.Id.Value)), CookieAuthenticationDefaults.AuthenticationScheme) - do! ctx.SignInAsync ( + do! ctx.SignInAsync( identity.AuthenticationType, ClaimsPrincipal identity, - AuthenticationProperties ( + AuthenticationProperties( IssuedUtc = DateTimeOffset.UtcNow, IsPersistent = defaultArg model.RememberMe false)) addInfo ctx ctx.Strings["Log On Successful • Welcome to {0}", ctx.Strings["PrayerTracker"]] @@ -142,29 +142,26 @@ let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let group = ctx.Session.CurrentGroup.Value let! reqs = PrayerRequests.forGroup - { SmallGroup = group - Clock = ctx.Clock - ListDate = None - ActiveOnly = true - PageNumber = 0 - } + { SmallGroup = group + Clock = ctx.Clock + ListDate = None + ActiveOnly = true + PageNumber = 0 } let! reqCount = PrayerRequests.countByGroup group.Id let! mbrCount = Members.countByGroup group.Id let! admins = Users.listByGroupId group.Id let model = - { TotalActiveReqs = List.length reqs - AllReqs = reqCount - TotalMembers = mbrCount - ActiveReqsByType = ( - reqs - |> Seq.ofList - |> Seq.map (fun req -> req.RequestType) - |> Seq.distinct - |> Seq.map (fun reqType -> - reqType, reqs |> List.filter (fun r -> r.RequestType = reqType) |> List.length) - |> Map.ofSeq) - Admins = admins - } + { TotalActiveReqs = List.length reqs + AllReqs = reqCount + TotalMembers = mbrCount + ActiveReqsByType = ( + reqs + |> Seq.ofList + |> Seq.map (fun req -> req.RequestType) + |> Seq.distinct + |> Seq.map (fun reqType -> reqType, reqs |> List.filter (fun r -> r.RequestType = reqType) |> List.length) + |> Map.ofSeq) + Admins = admins } return! viewInfo ctx |> Views.SmallGroup.overview model @@ -183,15 +180,15 @@ open System.Threading.Tasks // POST /small-group/save let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { - match! ctx.TryBindFormAsync () with + match! ctx.TryBindFormAsync() 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 - let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower () + 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 | None -> return! fourOhFour ctx @@ -200,12 +197,12 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c // POST /small-group/member/save let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { - match! ctx.TryBindFormAsync () with + match! ctx.TryBindFormAsync() with | Ok model -> 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 -> @@ -213,9 +210,8 @@ 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 - } - let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower () + Format = String.noneIfBlank model.Format |> Option.map EmailFormat.fromCode } + 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 | Some _ @@ -225,7 +221,7 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun n // POST /small-group/preferences/save let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { - match! ctx.TryBindFormAsync () with + match! ctx.TryBindFormAsync() with | Ok model -> // Since the class is stored in the session, we'll use an intermediate instance to persist it; once that works, // we can repopulate the session instance. That way, if the update fails, the page should still show the @@ -249,7 +245,7 @@ open Microsoft.Extensions.Configuration // POST /small-group/announcement/send let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { - match! ctx.TryBindFormAsync () with + match! ctx.TryBindFormAsync() with | Ok model -> let group = ctx.Session.CurrentGroup.Value let pref = group.Preferences @@ -271,15 +267,14 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> } use! client = Email.getConnection () do! Email.sendEmails - { Client = client - Recipients = recipients - Group = group - Subject = s["Announcement for {0} - {1:MMMM d, yyyy} {2}", group.Name, now.Date, - (now.ToString ("h:mm tt", null)).ToLower ()].Value - HtmlBody = htmlText - PlainTextBody = plainText - Strings = s - } + { Client = client + Recipients = recipients + Group = group + Subject = s["Announcement for {0} - {1:MMMM d, yyyy} {2}", group.Name, now.Date, + now.ToString("h:mm tt", null).ToLower()].Value + HtmlBody = htmlText + PlainTextBody = plainText + Strings = s } do! client.DisconnectAsync true // Add to the request list if desired match model.SendToClass, model.AddToRequestList with @@ -296,12 +291,11 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> RequestType = (Option.get >> PrayerRequestType.fromCode) model.RequestType Text = requestText EnteredDate = now.Date.AtStartOfDayInZone(zone).ToInstant() - UpdatedDate = now.InZoneLeniently(zone).ToInstant() - } + UpdatedDate = now.InZoneLeniently(zone).ToInstant() } // Tell 'em what they've won, Johnny! let toWhom = if model.SendToClass = "N" then s["{0} users", s["PrayerTracker"]].Value - else s["Group Members"].Value.ToLower () + else s["Group Members"].Value.ToLower() let andAdded = match model.AddToRequestList with Some x when x -> "and added it to the request list" | _ -> "" addInfo ctx s["Successfully sent announcement to all {0} {1}", toWhom, s[andAdded]] return! diff --git a/src/PrayerTracker/User.fs b/src/PrayerTracker/User.fs index f3828eb..7e16833 100644 --- a/src/PrayerTracker/User.fs +++ b/src/PrayerTracker/User.fs @@ -19,10 +19,10 @@ module Hashing = open System.Text /// Custom password hasher used to verify and upgrade old password hashes - type PrayerTrackerPasswordHasher () = - inherit PasswordHasher () + type PrayerTrackerPasswordHasher() = + inherit PasswordHasher() - override this.VerifyHashedPassword (user, hashedPassword, providedPassword) = + override this.VerifyHashedPassword(user, hashedPassword, providedPassword) = if isNull hashedPassword then nullArg (nameof hashedPassword) if isNull providedPassword then nullArg (nameof providedPassword) @@ -43,7 +43,7 @@ module Hashing = | 254uy -> // v1 hashes - SHA-1 let v1Hash = - use alg = SHA1.Create () + use alg = SHA1.Create() alg.ComputeHash (Encoding.ASCII.GetBytes providedPassword) |> Seq.map (fun byt -> byt.ToString "x2") |> String.concat "" @@ -51,18 +51,18 @@ module Hashing = PasswordVerificationResult.SuccessRehashNeeded else PasswordVerificationResult.Failed - | _ -> base.VerifyHashedPassword (user, hashedPassword, providedPassword) + | _ -> 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 | Some user -> - let hasher = PrayerTrackerPasswordHasher () - match hasher.VerifyHashedPassword (user, user.PasswordHash, model.Password) with + let hasher = PrayerTrackerPasswordHasher() + match hasher.VerifyHashedPassword(user, user.PasswordHash, model.Password) with | PasswordVerificationResult.Success -> return Some user | PasswordVerificationResult.SuccessRehashNeeded -> - let upgraded = { user with PasswordHash = hasher.HashPassword (user, model.Password) } + let upgraded = { user with PasswordHash = hasher.HashPassword(user, model.Password) } do! Users.updatePassword upgraded return Some upgraded | _ -> return None @@ -78,14 +78,14 @@ let sanitizeUrl providedUrl defaultUrl = // POST /user/password/change let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { - match! ctx.TryBindFormAsync () with + match! ctx.TryBindFormAsync() with | Ok model -> let curUsr = ctx.Session.CurrentUser.Value - let hasher = PrayerTrackerPasswordHasher () + let hasher = PrayerTrackerPasswordHasher() let! user = task { match! Users.tryById curUsr.Id with | Some usr -> - if hasher.VerifyHashedPassword (usr, usr.PasswordHash, model.OldPassword) + if hasher.VerifyHashedPassword(usr, usr.PasswordHash, model.OldPassword) = PasswordVerificationResult.Success then return Some usr else return None @@ -93,7 +93,7 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f } match user with | Some usr when model.NewPassword = model.NewPasswordConfirm -> - do! Users.updatePassword { usr with PasswordHash = hasher.HashPassword (usr, model.NewPassword) } + do! Users.updatePassword { usr with PasswordHash = hasher.HashPassword(usr, model.NewPassword) } addInfo ctx ctx.Strings["Your password was changed successfully"] return! redirectTo false "/" next ctx | Some _ -> @@ -124,7 +124,7 @@ open Microsoft.AspNetCore.Html // POST /user/log-on let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task { - match! ctx.TryBindFormAsync () with + match! ctx.TryBindFormAsync() with | Ok model -> let s = ctx.Strings match! findUserByPassword model with @@ -133,14 +133,14 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr | Some group -> ctx.Session.CurrentUser <- Some user ctx.Session.CurrentGroup <- Some group - let identity = ClaimsIdentity ( + let identity = ClaimsIdentity( seq { - Claim (ClaimTypes.NameIdentifier, shortGuid user.Id.Value) - Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value) + Claim(ClaimTypes.NameIdentifier, shortGuid user.Id.Value) + Claim(ClaimTypes.GroupSid, shortGuid group.Id.Value) }, CookieAuthenticationDefaults.AuthenticationScheme) - do! ctx.SignInAsync ( + do! ctx.SignInAsync( identity.AuthenticationType, ClaimsPrincipal identity, - AuthenticationProperties ( + AuthenticationProperties( IssuedUtc = DateTimeOffset.UtcNow, IsPersistent = defaultArg model.RememberMe false)) do! Users.updateLastSeen user.Id ctx.Now @@ -152,14 +152,12 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr Text = htmlLocString s["Invalid credentials - log on unsuccessful"] Description = let detail = - [ "This is likely due to one of the following reasons:
    " - "
  • The e-mail address “{0}” is invalid.
    • " - "
  • The password entered does not match the password for the given e-mail address.
    • " - "
  • You are not authorized to administer the selected group.
" - ] + [ "This is likely due to one of the following reasons:
    " + "
  • The e-mail address “{0}” is invalid.
    • " + "
  • The password entered does not match the password for the given e-mail address.
    • " + "
  • You are not authorized to administer the selected group.
" ] |> String.concat "" - Some (HtmlString (s[detail, WebUtility.HtmlEncode model.Email].Value)) - } + Some (HtmlString(s[detail, WebUtility.HtmlEncode model.Email].Value)) } |> addUserMessage ctx return! redirectTo false "/user/log-on" next ctx | Result.Error e -> return! bindError e next ctx @@ -217,15 +215,15 @@ open System.Threading.Tasks // POST /user/save let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { - match! ctx.TryBindFormAsync () with + match! ctx.TryBindFormAsync() 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 -> - let hasher = PrayerTrackerPasswordHasher () - let updatedUser = model.PopulateUser usr (fun pw -> hasher.HashPassword (usr, pw)) + let hasher = PrayerTrackerPasswordHasher() + let updatedUser = model.PopulateUser usr (fun pw -> hasher.HashPassword(usr, pw)) do! Users.save updatedUser let s = ctx.Strings if model.IsNew then @@ -235,8 +233,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c Description = h s["Please select at least one group for which this user ({0}) is authorized", updatedUser.Name] - |> Some - } + |> Some } |> addUserMessage ctx return! redirectTo false $"/user/{shortGuid usr.Id.Value}/small-groups" next ctx else @@ -248,7 +245,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c // POST /user/small-groups/save let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { - match! ctx.TryBindFormAsync () with + match! ctx.TryBindFormAsync() with | Ok model -> match Seq.length model.SmallGroups with | 0 -> -- 2.45.1 From 0698c25e80f4bafe8eff2248b6636d7240e55ea0 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Thu, 27 Jun 2024 21:21:48 -0400 Subject: [PATCH 2/4] Add help index, req edit pages --- src/PrayerTracker.UI/Help.fs | 74 ++++ src/PrayerTracker.UI/Layout.fs | 343 +++++++++--------- src/PrayerTracker.UI/PrayerTracker.UI.fsproj | 7 + src/PrayerTracker.UI/Resources/Common.es.resx | 18 + .../Resources/Views/Help/Index.es.resx | 70 ++++ .../Views/Help/Requests/Edit.es.resx | 133 +++++++ src/PrayerTracker/App.fs | 6 + src/PrayerTracker/Help.fs | 24 ++ src/PrayerTracker/PrayerTracker.fsproj | 1 + src/PrayerTracker/wwwroot/css/help.css | 18 + 10 files changed, 514 insertions(+), 180 deletions(-) create mode 100644 src/PrayerTracker.UI/Help.fs create mode 100644 src/PrayerTracker.UI/Resources/Views/Help/Index.es.resx create mode 100644 src/PrayerTracker.UI/Resources/Views/Help/Requests/Edit.es.resx create mode 100644 src/PrayerTracker/Help.fs diff --git a/src/PrayerTracker.UI/Help.fs b/src/PrayerTracker.UI/Help.fs new file mode 100644 index 0000000..054b21a --- /dev/null +++ b/src/PrayerTracker.UI/Help.fs @@ -0,0 +1,74 @@ +/// Help content for PrayerTracker +module PrayerTracker.Views.Help + +open System.IO +open Giraffe.ViewEngine + +/// The help index page +let index () = + let s = I18N.localizer.Force() + let l = I18N.forView "Help/Index" + use sw = new StringWriter() + let raw = rawLocText sw + [ p [] [ + raw l["Throughout PrayerTracker, you'll see an icon (a question mark in a circle) next to the title on each page."]; space + raw l["Clicking this will open a new, small window with directions on using that page."]; space + raw l["If you are looking for a quick overview of PrayerTracker, start with the “Add / Edit a Request” and “Change Preferences” entries."] ] + hr [] + p [ _class "pt-center-text" ] [ strong [] [ locStr s["Help Topics"] ] ] + p [] [ a [ _href "/help/small-group/preferences" ] [ locStr s["Change Preferences"] ] ] + p [] [ a [ _href "/help/small-group/announcement" ] [ locStr s["Send Announcement"] ] ] + p [] [ a [ _href "/help/small-group/members" ] [ locStr s["Maintain Group Members"] ] ] + p [] [ a [ _href "/help/requests/edit" ] [ locStr s["Add / Edit a Request"] ] ] + p [] [ a [ _href "/help/requests/maintain" ] [ locStr s["Maintain Requests"] ] ] + p [] [ a [ _href "/help/requests/view" ] [ locStr s["View Request List"] ] ] + p [] [ a [ _href "/help/user/log-on" ] [ locStr s["Log On"] ] ] + p [] [ a [ _href "/help/user/password" ] [ locStr s["Change Your Password"] ] ] ] + + +/// Help for prayer requests +module Requests = + + /// Add / Edit a Request + let edit () = + let s = I18N.localizer.Force() + let l = I18N.forView "Help/Requests/Edit" + use sw = new StringWriter() + let raw = rawLocText sw + [ p [] [ raw l["This page allows you to enter or update a new prayer request."] ] + h2 [] [ locStr s["Request Type"] ] + p [] [ + raw l["There are 5 request types in PrayerTracker."]; space + raw l["“Current Requests” are your regular requests that people may have regarding things happening over the next week or so."]; space + raw l["“Long-Term Requests” are requests that may occur repeatedly or continue indefinitely."]; space + raw l["“Praise Reports” are like “Current Requests”, but they are answers to prayer to share with your group."]; space + raw l["“Expecting” is for those who are pregnant."]; space + raw l["“Announcements” are like “Current Requests”, but instead of a request, they are simply passing information along about something coming up."] ] + p [] [ + raw l["The order above is the order in which the request types appear on the list."]; space + raw l["“Long-Term Requests” and “Expecting” are not subject to the automatic expiration (set on the “Change Preferences” page) that the other requests are."] ] + h2 [] [ locStr s["Date"] ] + p [] [ + raw l["For new requests, this is a box with a calendar date picker."]; space + raw l["Click or tab into the box to display the calendar, which will be preselected to today's date."]; space + raw l["For existing requests, there will be a check box labeled “Check to not update the date”."]; space + raw l["This can be used if you are correcting spelling or punctuation, and do not have an actual update to make to the request."] + ] + h2 [] [ locStr s["Requestor / Subject"] ] + p [] [ + raw l["For requests or praises, this field is for the name of the person who made the request or offered the praise report."]; space + raw l["For announcements, this should contain the subject of the announcement."]; space + raw l["For all types, it is optional; I used to have an announcement with no subject that ran every week, telling where to send requests and updates."] ] + h2 [] [ locStr s["Expiration"] ] + p [] [ + raw l["“Expire Normally” means that the request is subject to the expiration days in the group preferences."]; space + raw l["“Request Never Expires” can be used to make a request never expire (note that this is redundant for “Long-Term Requests” and “Expecting”)."]; space + raw l["If you are editing an existing request, a third option appears."]; space + raw l["“Expire Immediately” will make the request expire when it is saved."]; space + raw l["Apart from the icons on the request maintenance page, this is the only way to expire “Long-Term Requests” and “Expecting” requests, but it can be used for any request type."] ] + h2 [] [ locStr s["Request"] ] + p [] [ + raw l["This is the text of the request."]; space + raw l["The editor provides many formatting capabilities, including “Spell Check as you Type” (enabled by default), “Paste from Word”, and “Paste Plain”, as well as “Source” view, if you want to edit the HTML yourself."]; space + raw l["It also supports undo and redo, and the editor supports full-screen mode. Hover over each icon to see what each button does."] ] ] + \ No newline at end of file diff --git a/src/PrayerTracker.UI/Layout.fs b/src/PrayerTracker.UI/Layout.fs index e32b3be..556a557 100644 --- a/src/PrayerTracker.UI/Layout.fs +++ b/src/PrayerTracker.UI/Layout.fs @@ -15,130 +15,93 @@ module Navigation = /// Top navigation bar let top m = - let s = I18N.localizer.Force () + let s = I18N.localizer.Force() let menuSpacer = rawText "  " let _dropdown = _class "dropdown-btn" - let leftLinks = [ - match m.User with - | Some u -> - li [ _class "dropdown" ] [ - 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"] - ] - ] - ] - li [ _class "dropdown" ] [ - a [ _dropdown; _ariaLabel s["Group"].Value; _title s["Group"].Value; _roleButton ] [ - icon "group"; space; locStr s["Group"]; space; icon "keyboard_arrow_down" - ] - div [ _class "dropdown-content"; _roleMenuBar ] [ - a [ _href "/small-group/members"; _roleMenuItem ] [ - icon "email"; menuSpacer; locStr s["Maintain Group Members"] - ] - a [ _href "/small-group/announcement"; _roleMenuItem ] [ - icon "send"; menuSpacer; locStr s["Send Announcement"] - ] - a [ _href "/small-group/preferences"; _roleMenuItem ] [ - icon "build"; menuSpacer; locStr s["Change Preferences"] - ] - ] - ] - if u.IsAdmin then - li [ _class "dropdown" ] [ - a [ _dropdown - _ariaLabel s["Administration"].Value - _title s["Administration"].Value - _roleButton ] [ - icon "settings"; space; locStr s["Administration"]; space; icon "keyboard_arrow_down" - ] - div [ _class "dropdown-content"; _roleMenuBar ] [ - a [ _href "/churches"; _roleMenuItem ] [ icon "home"; menuSpacer; locStr s["Churches"] ] - a [ _href "/small-groups"; _roleMenuItem ] [ icon "send"; menuSpacer; locStr s["Groups"] ] - a [ _href "/users"; _roleMenuItem ] [ icon "build"; menuSpacer; locStr s["Users"] ] - ] - ] - | None -> - 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"] - ] - ] - | None -> - li [ _class "dropdown" ] [ - a [ _dropdown; _ariaLabel s["Log On"].Value; _title s["Log On"].Value; _roleButton ] [ - icon "security"; space; locStr s["Log On"]; space; icon "keyboard_arrow_down" - ] - div [ _class "dropdown-content"; _roleMenuBar ] [ - a [ _href "/user/log-on"; _roleMenuItem ] [ icon "person"; menuSpacer; locStr s["User"] ] - a [ _href "/small-group/log-on"; _roleMenuItem ] [ - icon "group"; menuSpacer; locStr s["Group"] - ] - ] - ] - li [] [ - a [ _href "/prayer-requests/lists" - _ariaLabel s["View Request List"].Value - _title s["View Request List"].Value ] [ - icon "list"; space; locStr s["View Request List"] - ] - ] - li [] [ - a [ _href $"https://docs.prayer.bitbadger.solutions/{langCode ()}" - _ariaLabel s["Help"].Value - _title s["View Help"].Value - _target "_blank" - _relNoOpener ] [ - icon "help"; space; locStr s["Help"] - ] - ] - ] + let leftLinks = + [ match m.User with + | Some u -> + li [ _class "dropdown" ] [ + 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"] ] ] ] + li [ _class "dropdown" ] [ + a [ _dropdown; _ariaLabel s["Group"].Value; _title s["Group"].Value; _roleButton ] [ + icon "group"; space; locStr s["Group"]; space; icon "keyboard_arrow_down" ] + div [ _class "dropdown-content"; _roleMenuBar ] [ + a [ _href "/small-group/members"; _roleMenuItem ] [ + icon "email"; menuSpacer; locStr s["Maintain Group Members"] ] + a [ _href "/small-group/announcement"; _roleMenuItem ] [ + icon "send"; menuSpacer; locStr s["Send Announcement"] ] + a [ _href "/small-group/preferences"; _roleMenuItem ] [ + icon "build"; menuSpacer; locStr s["Change Preferences"] ] ] ] + if u.IsAdmin then + li [ _class "dropdown" ] [ + a [ _dropdown + _ariaLabel s["Administration"].Value + _title s["Administration"].Value + _roleButton ] [ + icon "settings"; space; locStr s["Administration"]; space; icon "keyboard_arrow_down" ] + div [ _class "dropdown-content"; _roleMenuBar ] [ + a [ _href "/churches"; _roleMenuItem ] [ icon "home"; menuSpacer; locStr s["Churches"] ] + a [ _href "/small-groups"; _roleMenuItem ] [ + icon "send"; menuSpacer; locStr s["Groups"] ] + a [ _href "/users"; _roleMenuItem ] [ icon "build"; menuSpacer; locStr s["Users"] ] ] ] + | None -> + 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"] ] ] + | None -> + li [ _class "dropdown" ] [ + a [ _dropdown; _ariaLabel s["Log On"].Value; _title s["Log On"].Value; _roleButton ] [ + icon "security"; space; locStr s["Log On"]; space; icon "keyboard_arrow_down" ] + div [ _class "dropdown-content"; _roleMenuBar ] [ + a [ _href "/user/log-on"; _roleMenuItem ] [ icon "person"; menuSpacer; locStr s["User"] ] + a [ _href "/small-group/log-on"; _roleMenuItem ] [ + icon "group"; menuSpacer; locStr s["Group"] ] ] ] + li [] [ + a [ _href "/prayer-requests/lists" + _ariaLabel s["View Request List"].Value + _title s["View Request List"].Value ] [ + icon "list"; space; locStr s["View Request List"] ] ] + li [] [ + a [ _href "/help"; _ariaLabel s["Help"].Value; _title s["View Help"].Value; _target "_blank" ] [ + icon "help"; space; locStr s["Help"] ] ] ] let rightLinks = match m.Group with | Some _ -> - [ match m.User with - | Some _ -> - li [] [ - a [ _href "/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"] - ] - ] - ] + [ match m.User with + | Some _ -> + li [] [ + a [ _href "/user/password" + _ariaLabel s["Change Your Password"].Value + _title s["Change Your Password"].Value ] [ + icon "lock"; space; locStr s["Change Your Password"] ] ] + | None -> () + li [] [ + a [ _href "/log-off"; _ariaLabel s["Log Off"].Value; _title s["Log Off"].Value; Target.body ] [ + icon "power_settings_new"; space; locStr s["Log Off"] ] ] ] | None -> [] header [ _class "pt-title-bar"; Target.content ] [ section [ _class "pt-title-bar-left"; _ariaLabel "Left side of top menu" ] [ span [ _class "pt-title-bar-home" ] [ - a [ _href "/"; _title s["Home"].Value ] [ locStr s["PrayerTracker"] ] - ] - ul [] leftLinks - ] + a [ _href "/"; _title s["Home"].Value ] [ locStr s["PrayerTracker"] ] ] + ul [] leftLinks ] section [ _class "pt-title-bar-center"; _ariaLabel "Empty center space in top menu" ] [] section [ _class "pt-title-bar-right"; _roleToolBar; _ariaLabel "Right side of top menu" ] [ - ul [] rightLinks - ] - ] + ul [] rightLinks ] ] /// Identity bar (below top nav) let identity m = - let s = I18N.localizer.Force () + let s = I18N.localizer.Force() header [ _id "pt-language"; Target.body ] [ div [] [ span [ _title s["Language"].Value ] [ icon "record_voice_over"; space ] @@ -150,29 +113,26 @@ module Navigation = | _ -> strong [] [ locStr s["English"] ] rawText "     " - a [ _href "/language/es" ] [ locStr s["Cambie a Español"] ] - ] + a [ _href "/language/es" ] [ locStr s["Cambie a Español"] ] ] match m.Group with | Some g -> - [ match m.User with - | Some u -> - span [ _class "u" ] [ locStr s["Currently Logged On"] ] - rawText "   " - icon "person" - strong [] [ str u.Name ] - rawText "    " - | None -> - locStr s["Logged On as a Member of"] - rawText "  " - icon "group" - space - match m.User with - | Some _ -> a [ _href "/small-group"; Target.content ] [ strong [] [ str g.Name ] ] - | None -> strong [] [ str g.Name ] - ] + [ match m.User with + | Some u -> + span [ _class "u" ] [ locStr s["Currently Logged On"] ] + rawText "   " + icon "person" + strong [] [ str u.Name ] + rawText "    " + | None -> + locStr s["Logged On as a Member of"] + rawText "  " + icon "group" + space + match m.User with + | Some _ -> a [ _href "/small-group"; Target.content ] [ strong [] [ str g.Name ] ] + | None -> strong [] [ str g.Name ] ] | None -> [] - |> div [] - ] + |> div [] ] /// Content layouts @@ -198,7 +158,7 @@ let private commonHead = [ /// Render the portion of the page let private htmlHead viewInfo pgTitle = - let s = I18N.localizer.Force () + let s = I18N.localizer.Force() head [] [ meta [ _charset "UTF-8" ] title [] [ locStr pgTitle; titleSep; locStr s["PrayerTracker"] ] @@ -212,7 +172,7 @@ open Giraffe.ViewEngine.Htmx /// Render a link to the help page for the current page let private helpLink link = - let s = I18N.localizer.Force () + let s = I18N.localizer.Force() sup [ _class "pt-help-link" ] [ a [ _href link _title s["Click for Help on This Page"].Value @@ -233,7 +193,7 @@ let private renderPageTitle viewInfo pgTitle = /// Render the messages that may need to be displayed to the user let private messages viewInfo = - let s = I18N.localizer.Force () + let s = I18N.localizer.Force() if List.isEmpty viewInfo.Messages then [] else viewInfo.Messages @@ -259,70 +219,61 @@ open NodaTime /// Render the