7 Commits
v7.4 ... v7.5

Author SHA1 Message Date
b0d3bd4e35 Update to F# 5 (#27) 2020-11-15 21:57:09 -05:00
e3583f9152 Update branch name in AppVeyor link 2020-06-19 16:36:00 -05:00
7fd15a5cff Display new user name (#26)
Also did some refactoring to pull static members into modules
2020-06-10 23:11:28 -05:00
Daniel J. Summers
cb8c2558e0 Update to .NET Core 3.1 (and deps) (#25) 2020-03-07 12:22:39 -06:00
ffc008e07a Merge pull request #24 from bit-badger/dependabot/bundler/docs/nokogiri-1.10.8
Bump nokogiri from 1.10.4 to 1.10.8 in /docs
2020-03-07 11:24:51 -06:00
dependabot[bot]
81445d48f3 Bump nokogiri from 1.10.4 to 1.10.8 in /docs
Bumps [nokogiri](https://github.com/sparklemotion/nokogiri) from 1.10.4 to 1.10.8.
- [Release notes](https://github.com/sparklemotion/nokogiri/releases)
- [Changelog](https://github.com/sparklemotion/nokogiri/blob/master/CHANGELOG.md)
- [Commits](https://github.com/sparklemotion/nokogiri/compare/v1.10.4...v1.10.8)

Signed-off-by: dependabot[bot] <support@github.com>
2020-02-25 21:22:27 +00:00
Daniel J. Summers
1c33c1368f Change from address (#23) 2019-12-02 21:37:27 -06:00
32 changed files with 382 additions and 406 deletions

2
.gitignore vendored
View File

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

View File

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

View File

@@ -208,9 +208,9 @@ GEM
jekyll-seo-tag (~> 2.1) jekyll-seo-tag (~> 2.1)
minitest (5.12.2) minitest (5.12.2)
multipart-post (2.1.1) multipart-post (2.1.1)
nokogiri (1.10.4) nokogiri (1.10.8)
mini_portile2 (~> 2.4.0) mini_portile2 (~> 2.4.0)
nokogiri (1.10.4-x64-mingw32) nokogiri (1.10.8-x64-mingw32)
mini_portile2 (~> 2.4.0) mini_portile2 (~> 2.4.0)
octokit (4.14.0) octokit (4.14.0)
sawyer (~> 0.8.0, >= 0.5.3) sawyer (~> 0.8.0, >= 0.5.3)
@@ -244,7 +244,6 @@ GEM
tzinfo-data (1.2019.3) tzinfo-data (1.2019.3)
tzinfo (>= 1.0.0) tzinfo (>= 1.0.0)
unicode-display_width (1.6.0) unicode-display_width (1.6.0)
wdm (0.1.1)
PLATFORMS PLATFORMS
ruby ruby
@@ -253,7 +252,6 @@ PLATFORMS
DEPENDENCIES DEPENDENCIES
github-pages github-pages
tzinfo-data tzinfo-data
wdm (~> 0.1.0)
BUNDLED WITH BUNDLED WITH
2.0.2 2.0.2

View File

@@ -1,9 +1,9 @@
<Project> <Project>
<PropertyGroup> <PropertyGroup>
<AssemblyVersion>7.4.0.0</AssemblyVersion> <AssemblyVersion>7.5.0.0</AssemblyVersion>
<FileVersion>7.4.0.0</FileVersion> <FileVersion>7.5.0.0</FileVersion>
<Authors>danieljsummers</Authors> <Authors>danieljsummers</Authors>
<Company>Bit Badger Solutions</Company> <Company>Bit Badger Solutions</Company>
<Version>7.4.0</Version> <Version>7.5.0</Version>
</PropertyGroup> </PropertyGroup>
</Project> </Project>

View File

@@ -239,7 +239,7 @@ type AppDbContext with
} }
let! grps = q.ToListAsync () let! grps = q.ToListAsync ()
return grps return grps
|> Seq.map (fun grp -> grp.smallGroupId.ToString "N", sprintf "%s | %s" grp.church.name grp.name) |> Seq.map (fun grp -> grp.smallGroupId.ToString "N", $"{grp.church.name} | {grp.name}")
|> List.ofSeq |> List.ofSeq
} }

View File

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

View File

@@ -2,7 +2,7 @@
<PropertyGroup> <PropertyGroup>
<OutputType>Exe</OutputType> <OutputType>Exe</OutputType>
<TargetFramework>netcoreapp3.0</TargetFramework> <TargetFramework>net5.0</TargetFramework>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
@@ -15,7 +15,7 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Expecto" Version="8.12.0" /> <PackageReference Include="Expecto" Version="8.13.1" />
<PackageReference Include="Expecto.VisualStudio.TestAdapter" Version="10.0.2" /> <PackageReference Include="Expecto.VisualStudio.TestAdapter" Version="10.0.2" />
<PackageReference Include="NodaTime.Testing" Version="2.4.7" /> <PackageReference Include="NodaTime.Testing" Version="2.4.7" />
</ItemGroup> </ItemGroup>
@@ -26,8 +26,4 @@
<ProjectReference Include="..\PrayerTracker\PrayerTracker.fsproj" /> <ProjectReference Include="..\PrayerTracker\PrayerTracker.fsproj" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.7.0" />
</ItemGroup>
</Project> </Project>

View File

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

View File

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

View File

@@ -28,7 +28,7 @@ let space = rawText " "
let icon name = i [ _class "material-icons" ] [ rawText name ] let icon name = i [ _class "material-icons" ] [ rawText name ]
/// Generate a Material Design icon, specifying the point size (must be defined in CSS) /// Generate a Material Design icon, specifying the point size (must be defined in CSS)
let iconSized size name = i [ _class (sprintf "material-icons md-%i" size) ] [ rawText name ] let iconSized size name = i [ _class $"material-icons md-{size}" ] [ rawText name ]
/// Generate a CSRF prevention token /// Generate a CSRF prevention token
let csrfToken (ctx : HttpContext) = let csrfToken (ctx : HttpContext) =
@@ -72,7 +72,7 @@ let namedColorList name selected attrs (s : IStringLocalizer) =
|> Seq.map (fun color -> |> Seq.map (fun color ->
let (colorName, dispText, txtColor) = color let (colorName, dispText, txtColor) = color
option [ yield _value colorName option [ yield _value colorName
yield _style (sprintf "background-color:%s;color:%s;" colorName txtColor) yield _style $"background-color:{colorName};color:{txtColor};"
match colorName = selected with true -> yield _selected | false -> () ] [ match colorName = selected with true -> yield _selected | false -> () ] [
encodedText (dispText.Value.ToLower ()) encodedText (dispText.Value.ToLower ())
]) ])
@@ -97,7 +97,7 @@ let selectList name selected attrs items =
|> select (List.concat [ [ _name name; _id name ]; attrs ]) |> select (List.concat [ [ _name name; _id name ]; attrs ])
/// Generate the text for a default entry at the top of a select list /// Generate the text for a default entry at the top of a select list
let selectDefault text = sprintf "— %s —" text let selectDefault text = $"— {text} —"
/// Generate a standard submit button with icon and text /// Generate a standard submit button with icon and text
let submit attrs ico text = button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ] let submit attrs ico text = button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ]
@@ -115,7 +115,7 @@ let blockquote = tag "blockquote"
/// role attribute /// role attribute
let _role = attr "role" let _role = attr "role"
/// aria-* attribute /// aria-* attribute
let _aria typ = attr (sprintf "aria-%s" typ) let _aria typ = attr $"aria-{typ}"
/// onclick attribute /// onclick attribute
let _onclick = attr "onclick" let _onclick = attr "onclick"
/// onsubmit attribute /// onsubmit attribute

View File

@@ -35,9 +35,9 @@ let error code vi =
br [] br []
hr [] hr []
div [ _style "font-size:70%;font-family:-apple-system,BlinkMacSystemFont,'Segoe UI',Roboto,Oxygen-Sans,Ubuntu,Cantarell,'Helvetica Neue',sans-serif" ] [ div [ _style "font-size:70%;font-family:-apple-system,BlinkMacSystemFont,'Segoe UI',Roboto,Oxygen-Sans,Ubuntu,Cantarell,'Helvetica Neue',sans-serif" ] [
img [ _src (sprintf "/img/%A.png" s.["footer_en"]) img [ _src $"""/img/%A{s.["footer_en"]}.png"""
_alt (sprintf "%A %A" s.["PrayerTracker"] s.["from Bit Badger Solutions"]) _alt $"""%A{s.["PrayerTracker"]} %A{s.["from Bit Badger Solutions"]}"""
_title (sprintf "%A %A" s.["PrayerTracker"] s.["from Bit Badger Solutions"]) _title $"""%A{s.["PrayerTracker"]} %A{s.["from Bit Badger Solutions"]}"""
_style "vertical-align:text-bottom;" ] _style "vertical-align:text-bottom;" ]
str vi.version str vi.version
] ]

View File

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

View File

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

View File

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

View File

@@ -1,7 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup> <PropertyGroup>
<TargetFramework>netstandard2.1</TargetFramework> <TargetFramework>net5.0</TargetFramework>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
@@ -19,12 +19,12 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="Giraffe" Version="4.0.1" /> <PackageReference Include="Giraffe" Version="4.0.1" />
<PackageReference Include="MailKit" Version="2.3.2" /> <PackageReference Include="MailKit" Version="2.5.1" />
<PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.2.0" /> <PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.2.0" />
<PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" /> <PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" />
<PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" /> <PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" />
<PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" /> <PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" />
<PackageReference Include="Newtonsoft.Json" Version="12.0.2" /> <PackageReference Include="Newtonsoft.Json" Version="12.0.3" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
@@ -61,8 +61,4 @@
</EmbeddedResource> </EmbeddedResource>
</ItemGroup> </ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.7.0" />
</ItemGroup>
</Project> </Project>

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -26,7 +26,7 @@ module Configure =
let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) = let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) =
cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath) cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath)
.AddJsonFile("appsettings.json", optional = true, reloadOnChange = true) .AddJsonFile("appsettings.json", optional = true, reloadOnChange = true)
.AddJsonFile(sprintf "appsettings.%s.json" ctx.HostingEnvironment.EnvironmentName, optional = true) .AddJsonFile($"appsettings.{ctx.HostingEnvironment.EnvironmentName}.json", optional = true)
.AddEnvironmentVariables() .AddEnvironmentVariables()
|> ignore |> ignore

View File

@@ -26,16 +26,15 @@ let delete churchId : HttpHandler =
>=> fun next ctx -> >=> fun next ctx ->
let db = ctx.dbContext () let db = ctx.dbContext ()
task { task {
let! church = db.TryChurchById churchId match! db.TryChurchById churchId with
match church with | Some church ->
| Some ch ->
let! _, stats = findStats db churchId let! _, stats = findStats db churchId
db.RemoveEntry ch db.RemoveEntry church
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addInfo ctx addInfo ctx
s.["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)", s.["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)",
ch.name, stats.smallGroups, stats.prayerRequests, stats.users] church.name, stats.smallGroups, stats.prayerRequests, stats.users]
return! redirectTo false "/web/churches" next ctx return! redirectTo false "/web/churches" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
@@ -54,13 +53,12 @@ let edit churchId : HttpHandler =
|> Views.Church.edit EditChurch.empty ctx |> Views.Church.edit EditChurch.empty ctx
|> renderHtml next ctx |> renderHtml next ctx
| _ -> | _ ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! church = db.TryChurchById churchId match! db.TryChurchById churchId with
match church with | Some church ->
| Some ch ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.Church.edit (EditChurch.fromChurch ch) ctx |> Views.Church.edit (EditChurch.fromChurch church) ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
@@ -89,8 +87,7 @@ let save : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<EditChurch> () match! ctx.TryBindFormAsync<EditChurch> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! church = let! church =

View File

@@ -24,7 +24,7 @@ let toSelectList<'T> valFunc textFunc withDefault emptyText (items : 'T seq) =
[ match withDefault with [ match withDefault with
| true -> | true ->
let s = PrayerTracker.Views.I18N.localizer.Force () let s = PrayerTracker.Views.I18N.localizer.Force ()
yield SelectListItem (sprintf "&mdash; %A &mdash;" s.[emptyText], "") yield SelectListItem ($"""&mdash; %A{s.[emptyText]} &mdash;""", "")
| _ -> () | _ -> ()
yield! items |> Seq.map (fun x -> SelectListItem (textFunc x, valFunc x)) yield! items |> Seq.map (fun x -> SelectListItem (textFunc x, valFunc x))
] ]
@@ -41,15 +41,15 @@ let toSelectListWithDefault<'T> valFunc textFunc (items : 'T seq) =
let appVersion = let appVersion =
let v = Assembly.GetExecutingAssembly().GetName().Version let v = Assembly.GetExecutingAssembly().GetName().Version
#if (DEBUG) #if (DEBUG)
sprintf "v%A" v $"v{v}"
#else #else
seq { seq {
sprintf "v%d" v.Major $"v%d{v.Major}"
match v.Minor with match v.Minor with
| 0 -> match v.Build with 0 -> () | _ -> sprintf ".0.%d" v.Build | 0 -> match v.Build with 0 -> () | _ -> $".0.%d{v.Build}"
| _ -> | _ ->
sprintf ".%d" v.Minor $".%d{v.Minor}"
match v.Build with 0 -> () | _ -> sprintf ".%d" v.Build match v.Build with 0 -> () | _ -> $".%d{v.Build}"
} }
|> String.concat "" |> String.concat ""
#endif #endif
@@ -142,19 +142,19 @@ let htmlString (x : LocalizedString) =
/// Add an error message to the session /// Add an error message to the session
let addError ctx msg = let addError ctx msg =
addUserMessage ctx { UserMessage.Error with text = htmlLocString msg } addUserMessage ctx { UserMessage.error with text = htmlLocString msg }
/// Add an informational message to the session /// Add an informational message to the session
let addInfo ctx msg = let addInfo ctx msg =
addUserMessage ctx { UserMessage.Info with text = htmlLocString msg } addUserMessage ctx { UserMessage.info with text = htmlLocString msg }
/// Add an informational HTML message to the session /// Add an informational HTML message to the session
let addHtmlInfo ctx msg = let addHtmlInfo ctx msg =
addUserMessage ctx { UserMessage.Info with text = htmlString msg } addUserMessage ctx { UserMessage.info with text = htmlString msg }
/// Add a warning message to the session /// Add a warning message to the session
let addWarning ctx msg = let addWarning ctx msg =
addUserMessage ctx { UserMessage.Warning with text = htmlLocString msg } addUserMessage ctx { UserMessage.warning with text = htmlLocString msg }
/// A level of required access /// A level of required access

View File

@@ -121,7 +121,7 @@ type UserCookie =
/// Create a salted hash to use to validate the idle timeout key /// Create a salted hash to use to validate the idle timeout key
let saltedTimeoutHash (c : TimeoutCookie) = let saltedTimeoutHash (c : TimeoutCookie) =
sha1Hash (sprintf "Prayer%ATracker%AIdle%dTimeout" c.Id c.GroupId c.Until) sha1Hash $"Prayer%A{c.Id}Tracker%A{c.GroupId}Idle%d{c.Until}Timeout"
/// Cookie options to push an expiration out by 100 days /// Cookie options to push an expiration out by 100 days
let autoRefresh = let autoRefresh =

View File

@@ -8,10 +8,9 @@ open Microsoft.Extensions.Localization
open MimeKit open MimeKit
open MimeKit.Text open MimeKit.Text
open PrayerTracker.Entities open PrayerTracker.Entities
open System
/// The e-mail address from which e-mail is sent (must match Google account) /// The e-mail address from which e-mail is sent
let private fromAddress = "prayer@djs-consulting.com" let private fromAddress = "prayer@bitbadger.solutions"
/// Get an SMTP client connection /// Get an SMTP client connection
// FIXME: make host configurable // FIXME: make host configurable
@@ -33,9 +32,9 @@ let createMessage (grp : SmallGroup) subj =
/// Create an HTML-format e-mail message /// Create an HTML-format e-mail message
let createHtmlMessage grp subj body (s : IStringLocalizer) = let createHtmlMessage grp subj body (s : IStringLocalizer) =
let bodyText = let bodyText =
[ @"<!DOCTYPE html><html xmlns=""http://www.w3.org/1999/xhtml""><head><title></title></head><body>" [ """<!DOCTYPE html><html xmlns="http://www.w3.org/1999/xhtml"><head><title></title></head><body>"""
body body
@"<hr><div style=""text-align:right;font-family:Arial,Helvetica,sans-serif;font-size:8pt;padding-right:10px;"">" """<hr><div style="text-align:right;font-family:Arial,Helvetica,sans-serif;font-size:8pt;padding-right:10px;">"""
s.["Generated by P R A Y E R T R A C K E R"].Value s.["Generated by P R A Y E R T R A C K E R"].Value
"<br><small>" "<br><small>"
s.["from Bit Badger Solutions"].Value s.["from Bit Badger Solutions"].Value

View File

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

View File

@@ -13,9 +13,8 @@ open System.Threading.Tasks
/// Retrieve a prayer request, and ensure that it belongs to the current class /// Retrieve a prayer request, and ensure that it belongs to the current class
let private findRequest (ctx : HttpContext) reqId = let private findRequest (ctx : HttpContext) reqId =
task { task {
let! req = ctx.dbContext().TryRequestById reqId match! ctx.dbContext().TryRequestById reqId with
match req with | Some req when req.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok req
| Some pr when pr.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok pr
| Some _ -> | Some _ ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addError ctx s.["The prayer request you tried to access is not assigned to your group"] addError ctx s.["The prayer request you tried to access is not assigned to your group"]
@@ -62,13 +61,12 @@ let edit (reqId : PrayerRequestId) : HttpHandler =
|> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx |> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> | false ->
let! result = findRequest ctx reqId match! findRequest ctx reqId with
match result with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match req.isExpired now grp.preferences.daysToExpire with match req.isExpired now grp.preferences.daysToExpire with
| true -> | true ->
{ UserMessage.Warning with { UserMessage.warning with
text = htmlLocString s.["This request is expired."] text = htmlLocString s.["This request is expired."]
description = description =
s.["To make it active again, update it as necessary, leave “{0}” and “{1}” unchecked, and it will return as an active request.", s.["To make it active again, update it as necessary, leave “{0}” and “{1}” unchecked, and it will return as an active request.",
@@ -113,12 +111,11 @@ let delete reqId : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = findRequest ctx reqId match! findRequest ctx reqId with
match result with | Ok req ->
| Ok r ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
db.PrayerRequests.Remove r |> ignore db.PrayerRequests.Remove req |> ignore
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
addInfo ctx s.["The prayer request was deleted successfully"] addInfo ctx s.["The prayer request was deleted successfully"]
return! redirectTo false "/web/prayer-requests" next ctx return! redirectTo false "/web/prayer-requests" next ctx
@@ -131,12 +128,11 @@ let expire reqId : HttpHandler =
requireAccess [ User ] requireAccess [ User ]
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = findRequest ctx reqId match! findRequest ctx reqId with
match result with | Ok req ->
| Ok r ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
db.UpdateEntry { r with expiration = Forced } db.UpdateEntry { req with expiration = Forced }
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
addInfo ctx s.["Successfully {0} prayer request", s.["Expired"].Value.ToLower ()] addInfo ctx s.["Successfully {0} prayer request", s.["Expired"].Value.ToLower ()]
return! redirectTo false "/web/prayer-requests" next ctx return! redirectTo false "/web/prayer-requests" next ctx
@@ -151,17 +147,16 @@ let list groupId : HttpHandler =
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let db = ctx.dbContext () let db = ctx.dbContext ()
task { task {
let! grp = db.TryGroupById groupId match! db.TryGroupById groupId with
match grp with | Some grp when grp.preferences.isPublic ->
| Some g when g.preferences.isPublic ->
let clock = ctx.GetService<IClock> () let clock = ctx.GetService<IClock> ()
let reqs = db.AllRequestsForSmallGroup g clock None true 0 let reqs = db.AllRequestsForSmallGroup grp clock None true 0
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.PrayerRequest.list |> Views.PrayerRequest.list
{ requests = List.ofSeq reqs { requests = List.ofSeq reqs
date = g.localDateNow clock date = grp.localDateNow clock
listGroup = g listGroup = grp
showHeader = true showHeader = true
canEmail = (tryCurrentUser >> Option.isSome) ctx canEmail = (tryCurrentUser >> Option.isSome) ctx
recipients = [] recipients = []
@@ -242,12 +237,11 @@ let restore reqId : HttpHandler =
requireAccess [ User ] requireAccess [ User ]
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = findRequest ctx reqId match! findRequest ctx reqId with
match result with | Ok req ->
| Ok r ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
db.UpdateEntry { r with expiration = Automatic; updatedDate = DateTime.Now } db.UpdateEntry { req with expiration = Automatic; updatedDate = DateTime.Now }
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
addInfo ctx s.["Successfully {0} prayer request", s.["Restored"].Value.ToLower ()] addInfo ctx s.["Successfully {0} prayer request", s.["Restored"].Value.ToLower ()]
return! redirectTo false "/web/prayer-requests" next ctx return! redirectTo false "/web/prayer-requests" next ctx

View File

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

View File

@@ -16,7 +16,7 @@ open System.Threading.Tasks
/// Set a small group "Remember Me" cookie /// Set a small group "Remember Me" cookie
let private setGroupCookie (ctx : HttpContext) pwHash = let private setGroupCookie (ctx : HttpContext) pwHash =
ctx.Response.Cookies.Append ctx.Response.Cookies.Append
(Key.Cookie.group, { GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload(), autoRefresh) (Key.Cookie.group, { GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (), autoRefresh)
/// GET /small-group/announcement /// GET /small-group/announcement
@@ -37,16 +37,15 @@ let delete groupId : HttpHandler =
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
task { task {
let! grp = db.TryGroupById groupId match! db.TryGroupById groupId with
match grp with | Some grp ->
| Some g ->
let! reqs = db.CountRequestsBySmallGroup groupId let! reqs = db.CountRequestsBySmallGroup groupId
let! usrs = db.CountUsersBySmallGroup groupId let! usrs = db.CountUsersBySmallGroup groupId
db.RemoveEntry g db.RemoveEntry grp
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
addInfo ctx addInfo ctx
s.["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)", s.["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
g.name, reqs, usrs] grp.name, reqs, usrs]
return! redirectTo false "/web/small-groups" next ctx return! redirectTo false "/web/small-groups" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
@@ -60,12 +59,11 @@ let deleteMember memberId : HttpHandler =
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
task { task {
let! mbr = db.TryMemberById memberId match! db.TryMemberById memberId with
match mbr with | Some mbr when mbr.smallGroupId = (currentGroup ctx).smallGroupId ->
| Some m when m.smallGroupId = (currentGroup ctx).smallGroupId -> db.RemoveEntry mbr
db.RemoveEntry m
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
addHtmlInfo ctx s.["The group member &ldquo;{0}&rdquo; was deleted successfully", m.memberName] addHtmlInfo ctx s.["The group member &ldquo;{0}&rdquo; was deleted successfully", mbr.memberName]
return! redirectTo false "/web/small-group/members" next ctx return! redirectTo false "/web/small-group/members" next ctx
| Some _ | Some _
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
@@ -87,12 +85,11 @@ let edit (groupId : SmallGroupId) : HttpHandler =
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx |> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> | false ->
let! grp = db.TryGroupById groupId match! db.TryGroupById groupId with
match grp with | Some grp ->
| Some g ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.edit (EditSmallGroup.fromGroup g) churches ctx |> Views.SmallGroup.edit (EditSmallGroup.fromGroup grp) churches ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
@@ -115,12 +112,11 @@ let editMember (memberId : MemberId) : HttpHandler =
|> Views.SmallGroup.editMember EditMember.empty typs ctx |> Views.SmallGroup.editMember EditMember.empty typs ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> | false ->
let! mbr = db.TryMemberById memberId match! db.TryMemberById memberId with
match mbr with | Some mbr when mbr.smallGroupId = grp.smallGroupId ->
| Some m when m.smallGroupId = grp.smallGroupId ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.editMember (EditMember.fromMember m) typs ctx |> Views.SmallGroup.editMember (EditMember.fromMember mbr) typs ctx
|> renderHtml next ctx |> renderHtml next ctx
| Some _ | Some _
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
@@ -148,22 +144,20 @@ let logOnSubmit : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<GroupLogOn> () match! ctx.TryBindFormAsync<GroupLogOn> () with
match result with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let! grp = ctx.dbContext().TryGroupLogOnByPassword m.smallGroupId m.password match! ctx.dbContext().TryGroupLogOnByPassword m.smallGroupId m.password with
match grp with | Some grp ->
| Some _ -> (Some >> ctx.Session.SetSmallGroup) grp
ctx.Session.SetSmallGroup grp
match m.rememberMe with match m.rememberMe with
| Some x when x -> (setGroupCookie ctx << Utils.sha1Hash) m.password | Some x when x -> (setGroupCookie ctx << sha1Hash) m.password
| _ -> () | _ -> ()
addInfo ctx s.["Log On Successful Welcome to {0}", s.["PrayerTracker"]] addInfo ctx s.["Log On Successful Welcome to {0}", s.["PrayerTracker"]]
return! redirectTo false "/web/prayer-requests/view" next ctx return! redirectTo false "/web/prayer-requests/view" next ctx
| None -> | None ->
addError ctx s.["Password incorrect - login unsuccessful"] addError ctx s.["Password incorrect - login unsuccessful"]
return! redirectTo false (sprintf "/web/small-group/log-on/%s" (flatGuid m.smallGroupId)) next ctx return! redirectTo false $"/web/small-group/log-on/{flatGuid m.smallGroupId}" next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
@@ -251,22 +245,21 @@ let save : HttpHandler =
>=> fun next ctx -> >=> fun next ctx ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
task { task {
let! result = ctx.TryBindFormAsync<EditSmallGroup> () match! ctx.TryBindFormAsync<EditSmallGroup> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! grp = let! group =
match m.isNew () with match m.isNew () with
| true -> Task.FromResult<SmallGroup option>(Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () }) | true -> Task.FromResult<SmallGroup option>(Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () })
| false -> db.TryGroupById m.smallGroupId | false -> db.TryGroupById m.smallGroupId
match grp with match group with
| Some g -> | Some grp ->
m.populateGroup g m.populateGroup grp
|> function |> function
| g when m.isNew () -> | grp when m.isNew () ->
db.AddEntry g db.AddEntry grp
db.AddEntry { g.preferences with smallGroupId = g.smallGroupId } db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId }
| g -> db.UpdateEntry g | grp -> db.UpdateEntry grp
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower () let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
addHtmlInfo ctx s.["Successfully {0} group “{1}”", act, m.name] addHtmlInfo ctx s.["Successfully {0} group “{1}”", act, m.name]
@@ -282,8 +275,7 @@ let saveMember : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<EditMember> () match! ctx.TryBindFormAsync<EditMember> () with
match result with
| Ok m -> | Ok m ->
let grp = currentGroup ctx let grp = currentGroup ctx
let db = ctx.dbContext () let db = ctx.dbContext ()
@@ -322,21 +314,19 @@ let savePreferences : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<EditPreferences> () match! ctx.TryBindFormAsync<EditPreferences> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
// Since the class is stored in the session, we'll use an intermediate instance to persist it; once that // Since the class is stored in the session, we'll use an intermediate instance to persist it; once that
// works, we can repopulate the session instance. That way, if the update fails, the page should still show // works, we can repopulate the session instance. That way, if the update fails, the page should still show
// the database values, not the then out-of-sync session ones. // the database values, not the then out-of-sync session ones.
let! grp = db.TryGroupById (currentGroup ctx).smallGroupId match! db.TryGroupById (currentGroup ctx).smallGroupId with
match grp with | Some grp ->
| Some g -> let prefs = m.populatePreferences grp.preferences
let prefs = m.populatePreferences g.preferences
db.UpdateEntry prefs db.UpdateEntry prefs
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
// Refresh session instance // Refresh session instance
ctx.Session.SetSmallGroup <| Some { g with preferences = prefs } ctx.Session.SetSmallGroup <| Some { grp with preferences = prefs }
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addInfo ctx s.["Group preferences updated successfully"] addInfo ctx s.["Group preferences updated successfully"]
return! redirectTo false "/web/small-group/preferences" next ctx return! redirectTo false "/web/small-group/preferences" next ctx
@@ -352,8 +342,7 @@ let sendAnnouncement : HttpHandler =
>=> fun next ctx -> >=> fun next ctx ->
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
task { task {
let! result = ctx.TryBindFormAsync<Announcement> () match! ctx.TryBindFormAsync<Announcement> () with
match result with
| Ok m -> | Ok m ->
let grp = currentGroup ctx let grp = currentGroup ctx
let usr = currentUser ctx let usr = currentUser ctx
@@ -363,7 +352,7 @@ let sendAnnouncement : HttpHandler =
// Reformat the text to use the class's font stylings // Reformat the text to use the class's font stylings
let requestText = ckEditorToText m.text let requestText = ckEditorToText m.text
let htmlText = let htmlText =
p [ _style (sprintf "font-family:%s;font-size:%dpt;" grp.preferences.listFonts grp.preferences.textFontSize) ] p [ _style $"font-family:{grp.preferences.listFonts};font-size:%d{grp.preferences.textFontSize}pt;" ]
[ rawText requestText ] [ rawText requestText ]
|> renderHtmlNode |> renderHtmlNode
let plainText = (htmlToPlainText >> wordWrap 74) htmlText let plainText = (htmlToPlainText >> wordWrap 74) htmlText

View File

@@ -18,7 +18,7 @@ open System.Threading.Tasks
let private setUserCookie (ctx : HttpContext) pwHash = let private setUserCookie (ctx : HttpContext) pwHash =
ctx.Response.Cookies.Append ( ctx.Response.Cookies.Append (
Key.Cookie.user, Key.Cookie.user,
{ Id = (currentUser ctx).userId; GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload(), { Id = (currentUser ctx).userId; GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (),
autoRefresh) autoRefresh)
/// Retrieve a user from the database by password /// Retrieve a user from the database by password
@@ -26,26 +26,21 @@ let private setUserCookie (ctx : HttpContext) pwHash =
let private findUserByPassword m (db : AppDbContext) = let private findUserByPassword m (db : AppDbContext) =
task { task {
match! db.TryUserByEmailAndGroup m.emailAddress m.smallGroupId with match! db.TryUserByEmailAndGroup m.emailAddress m.smallGroupId with
| Some u -> | Some u when Option.isSome u.salt ->
match u.salt with // Already upgraded; match = success
| Some salt -> let pwHash = pbkdf2Hash (Option.get u.salt) m.password
// Already upgraded; match = success match u.passwordHash = pwHash with
let pwHash = pbkdf2Hash salt m.password | true -> return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
match u.passwordHash = pwHash with | _ -> return None, ""
| true -> return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash | Some u when u.passwordHash = sha1Hash m.password ->
| _ -> return None, "" // Not upgraded, but password is good; upgrade 'em!
| _ -> // Upgrade 'em!
// Not upgraded; check against old hash let salt = Guid.NewGuid ()
match u.passwordHash = sha1Hash m.password with let pwHash = pbkdf2Hash salt m.password
| true -> let upgraded = { u with salt = Some salt; passwordHash = pwHash }
// Upgrade 'em! db.UpdateEntry upgraded
let salt = Guid.NewGuid () let! _ = db.SaveChangesAsync ()
let pwHash = pbkdf2Hash salt m.password return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
let upgraded = { u with salt = Some salt; passwordHash = pwHash }
db.UpdateEntry upgraded
let! _ = db.SaveChangesAsync ()
return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
| _ -> return None, ""
| _ -> return None, "" | _ -> return None, ""
} }
@@ -56,8 +51,7 @@ let changePassword : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<ChangePassword> () match! ctx.TryBindFormAsync<ChangePassword> () with
match result with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let db = ctx.dbContext () let db = ctx.dbContext ()
@@ -101,14 +95,13 @@ let delete userId : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let db = ctx.dbContext () let db = ctx.dbContext ()
let! user = db.TryUserById userId match! db.TryUserById userId with
match user with | Some user ->
| Some u -> db.RemoveEntry user
db.RemoveEntry u
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addInfo ctx s.["Successfully deleted user {0}", u.fullName] addInfo ctx s.["Successfully deleted user {0}", user.fullName]
return! redirectTo false "/web/users" next ctx return! redirectTo false "/web/users" next ctx
| _ -> return! fourOhFour next ctx | _ -> return! fourOhFour next ctx
} }
@@ -120,8 +113,7 @@ let doLogOn : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<UserLogOn> () match! ctx.TryBindFormAsync<UserLogOn> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
@@ -140,7 +132,7 @@ let doLogOn : HttpHandler =
| Some x -> x | Some x -> x
| _ -> | _ ->
let grpName = match grp with Some g -> g.name | _ -> "N/A" let grpName = match grp with Some g -> g.name | _ -> "N/A"
{ UserMessage.Error with { UserMessage.error with
text = htmlLocString s.["Invalid credentials - log on unsuccessful"] text = htmlLocString s.["Invalid credentials - log on unsuccessful"]
description = description =
[ s.["This is likely due to one of the following reasons"].Value [ s.["This is likely due to one of the following reasons"].Value
@@ -175,12 +167,11 @@ let edit (userId : UserId) : HttpHandler =
|> Views.User.edit EditUser.empty ctx |> Views.User.edit EditUser.empty ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> | false ->
let! user = ctx.dbContext().TryUserById userId match! ctx.dbContext().TryUserById userId with
match user with | Some user ->
| Some u ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.User.edit (EditUser.fromUser u) ctx |> Views.User.edit (EditUser.fromUser user) ctx
|> renderHtml next ctx |> renderHtml next ctx
| _ -> return! fourOhFour next ctx | _ -> return! fourOhFour next ctx
} }
@@ -236,8 +227,7 @@ let save : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<EditUser> () match! ctx.TryBindFormAsync<EditUser> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! user = let! user =
@@ -257,21 +247,22 @@ let save : HttpHandler =
| _ -> user | _ -> user
match saltedUser with match saltedUser with
| Some u -> | Some u ->
m.populateUser u (pbkdf2Hash (Option.get u.salt)) let updatedUser = m.populateUser u (pbkdf2Hash (Option.get u.salt))
|> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry) updatedUser |> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry)
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match m.isNew () with match m.isNew () with
| true -> | true ->
let h = CommonFunctions.htmlString let h = CommonFunctions.htmlString
{ UserMessage.Info with { UserMessage.info with
text = h s.["Successfully {0} user", s.["Added"].Value.ToLower ()] text = h s.["Successfully {0} user", s.["Added"].Value.ToLower ()]
description = description =
h s.[ "Please select at least one group for which this user ({0}) is authorized", u.fullName] h s.["Please select at least one group for which this user ({0}) is authorized",
updatedUser.fullName]
|> Some |> Some
} }
|> addUserMessage ctx |> addUserMessage ctx
return! redirectTo false (sprintf "/web/user/%s/small-groups" (flatGuid u.userId)) next ctx return! redirectTo false $"/web/user/{flatGuid u.userId}/small-groups" next ctx
| false -> | false ->
addInfo ctx s.["Successfully {0} user", s.["Updated"].Value.ToLower ()] addInfo ctx s.["Successfully {0} user", s.["Updated"].Value.ToLower ()]
return! redirectTo false "/web/users" next ctx return! redirectTo false "/web/users" next ctx
@@ -286,30 +277,28 @@ let saveGroups : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<AssignGroups> () match! ctx.TryBindFormAsync<AssignGroups> () with
match result with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match Seq.length m.smallGroups with match Seq.length m.smallGroups with
| 0 -> | 0 ->
addError ctx s.["You must select at least one group to assign"] addError ctx s.["You must select at least one group to assign"]
return! redirectTo false (sprintf "/web/user/%s/small-groups" (flatGuid m.userId)) next ctx return! redirectTo false $"/web/user/{flatGuid m.userId}/small-groups" next ctx
| _ -> | _ ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! user = db.TryUserByIdWithGroups m.userId match! db.TryUserByIdWithGroups m.userId with
match user with | Some user ->
| Some u ->
let grps = let grps =
m.smallGroups.Split ',' m.smallGroups.Split ','
|> Array.map Guid.Parse |> Array.map Guid.Parse
|> List.ofArray |> List.ofArray
u.smallGroups user.smallGroups
|> Seq.filter (fun x -> not (grps |> List.exists (fun y -> y = x.smallGroupId))) |> Seq.filter (fun x -> not (grps |> List.exists (fun y -> y = x.smallGroupId)))
|> db.UserGroupXref.RemoveRange |> db.UserGroupXref.RemoveRange
grps grps
|> Seq.ofList |> Seq.ofList
|> Seq.filter (fun x -> not (u.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x))) |> Seq.filter (fun x -> not (user.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x)))
|> Seq.map (fun x -> { UserSmallGroup.empty with userId = u.userId; smallGroupId = x }) |> Seq.map (fun x -> { UserSmallGroup.empty with userId = user.userId; smallGroupId = x })
|> List.ofSeq |> List.ofSeq
|> List.iter db.AddEntry |> List.iter db.AddEntry
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
@@ -327,14 +316,13 @@ let smallGroups userId : HttpHandler =
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let db = ctx.dbContext () let db = ctx.dbContext ()
task { task {
let! user = db.TryUserByIdWithGroups userId match! db.TryUserByIdWithGroups userId with
match user with | Some user ->
| Some u ->
let! grps = db.GroupList () let! grps = db.GroupList ()
let curGroups = u.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq let curGroups = user.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.User.assignGroups (AssignGroups.fromUser u) grps curGroups ctx |> Views.User.assignGroups (AssignGroups.fromUser user) grps curGroups ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }

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

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