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

v8.4 #53

Merged
danieljsummers merged 4 commits from 8point4 into main 2024-06-29 00:22:44 +00:00
Conversation 0 Commits 4 Files Changed 56 +250 -272
14 changed files with 250 additions and 272 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit adbbf9cf4e - Show all commits

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

@ -14,7 +14,7 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="Expecto" Version="9.0.4" />
<PackageReference Include="Expecto" Version="10.2.1" />
<PackageReference Include="NodaTime.Testing" Version="3.1.11" />
<PackageReference Update="FSharp.Core" Version="8.0.300" />
</ItemGroup>

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

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

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

@ -15,7 +15,7 @@
<ItemGroup>
<PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.12" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.0" />
<PackageReference Include="MailKit" Version="4.6.0" />
<PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.2.0" />
<PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" />

8
src/PrayerTracker/App.fs
View File

@ -68,7 +68,7 @@ module Configure =
let cfg = svc.BuildServiceProvider().GetService<IConfiguration>()
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)
@ -206,12 +206,12 @@ module Configure =
let _ = app.UseMiddleware<RequestStartMiddleware>()
let _ = app.UseRouting()
let _ = app.UseSession()
let _ = app.UseRequestLocalization
(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value)
let _ = app.UseRequestLocalization(
app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value)
let _ = app.UseAuthentication()
let _ = app.UseAuthorization()
let _ = app.UseEndpoints(fun e -> e.MapGiraffeEndpoints routes)
Views.I18N.setUpFactories <| app.ApplicationServices.GetRequiredService<IStringLocalizerFactory> ()
app.ApplicationServices.GetRequiredService<IStringLocalizerFactory>() |> Views.I18N.setUpFactories
/// The web application

8
src/PrayerTracker/CommonFunctions.fs
View File

@ -12,8 +12,7 @@ let toSelectList<'T> valFunc textFunc withDefault emptyText (items : 'T seq) =
let s = PrayerTracker.Views.I18N.localizer.Force()
SelectListItem($"""&mdash; %A{s[emptyText]} &mdash;""", "")
| _ -> ()
yield! items |> Seq.map (fun x -> SelectListItem (textFunc x, valFunc x))
]
yield! items |> Seq.map (fun x -> SelectListItem(textFunc x, valFunc x)) ]
/// Create a select list from an enumeration
let toSelectListWithEmpty<'T> valFunc textFunc emptyText (items: 'T seq) =
@ -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 =
@ -88,7 +86,7 @@ let fourOhFour (ctx : HttpContext) =
/// Handler to validate CSRF prevention token
let validateCsrf : HttpHandler = fun next ctx -> task {
match! (ctx.GetService<Microsoft.AspNetCore.Antiforgery.IAntiforgery> ()).IsRequestValidAsync ctx with
match! ctx.GetService<Microsoft.AspNetCore.Antiforgery.IAntiforgery>().IsRequestValidAsync ctx with
| true -> return! next ctx
| false -> return! (clearResponse >=> setStatusCode 400 >=> text "Quit hacking...") earlyReturn ctx
}

9
src/PrayerTracker/Email.fs
View File

@ -27,8 +27,7 @@ type EmailOptions =
PlainTextBody: string
/// Use the current user's preferred language
Strings : IStringLocalizer
}
Strings: IStringLocalizer }
/// Options to use when sending e-mail
type SmtpServerOptions() =
@ -78,8 +77,7 @@ let createHtmlMessage opts =
opts.Strings["Generated by P R A Y E R T R A C K E R"].Value
"<br><small>"
opts.Strings["from Bit Badger Solutions"].Value
"</small></div></body></html>"
]
"</small></div></body></html>" ]
|> String.concat ""
let msg = createMessage opts
msg.Body <- new TextPart(TextFormat.Html, Text = bodyText)
@ -92,8 +90,7 @@ let createTextMessage opts =
"\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.Strings["from Bit Badger Solutions"].Value ]
|> String.concat ""
let msg = createMessage opts
msg.Body <- new TextPart(TextFormat.Plain, Text = bodyText)

24
src/PrayerTracker/PrayerRequest.fs
View File

@ -27,16 +27,14 @@ let private generateRequestList (ctx : HttpContext) date = task {
Clock = ctx.Clock
ListDate = Some listDate
ActiveOnly = true
PageNumber = 0
}
PageNumber = 0 }
return
{ Requests = reqs
Date = listDate
SmallGroup = group
ShowHeader = true
CanEmail = Option.isSome ctx.User.UserId
Recipients = []
}
Recipients = [] }
}
open NodaTime.Text
@ -96,8 +94,7 @@ let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
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
}
Strings = s }
do! client.DisconnectAsync true
return!
viewInfo ctx
@ -137,8 +134,7 @@ let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun ne
Clock = ctx.Clock
ListDate = None
ActiveOnly = true
PageNumber = 0
}
PageNumber = 0 }
return!
viewInfo ctx
|> Views.PrayerRequest.list
@ -147,8 +143,7 @@ let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun ne
SmallGroup = group
ShowHeader = true
CanEmail = Option.isSome ctx.User.UserId
Recipients = []
}
Recipients = [] }
|> renderHtml next ctx
| Some _ ->
addError ctx ctx.Strings["The request list for the group you tried to view is not public."]
@ -182,8 +177,7 @@ 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
@ -191,14 +185,12 @@ let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx
Clock = ctx.Clock
ListDate = None
ActiveOnly = onlyActive
PageNumber = pageNbr
}
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 }

2
src/PrayerTracker/PrayerTracker.fsproj
View File

@ -25,7 +25,7 @@
<ItemGroup>
<PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.0.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.9.12" />
<PackageReference Include="Giraffe.Htmx" Version="2.0.0" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" />
<PackageReference Update="FSharp.Core" Version="8.0.300" />
</ItemGroup>

20
src/PrayerTracker/SmallGroup.fs
View File

@ -146,8 +146,7 @@ let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
Clock = ctx.Clock
ListDate = None
ActiveOnly = true
PageNumber = 0
}
PageNumber = 0 }
let! reqCount = PrayerRequests.countByGroup group.Id
let! mbrCount = Members.countByGroup group.Id
let! admins = Users.listByGroupId group.Id
@ -160,11 +159,9 @@ let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
|> 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)
|> Seq.map (fun reqType -> reqType, reqs |> List.filter (fun r -> r.RequestType = reqType) |> List.length)
|> Map.ofSeq)
Admins = admins
}
Admins = admins }
return!
viewInfo ctx
|> Views.SmallGroup.overview model
@ -213,8 +210,7 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun n
{ mbr with
Name = model.Name
Email = model.Email
Format = String.noneIfBlank model.Format |> Option.map EmailFormat.fromCode
}
Format = String.noneIfBlank model.Format |> Option.map EmailFormat.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
@ -275,11 +271,10 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
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
now.ToString("h:mm tt", null).ToLower()].Value
HtmlBody = htmlText
PlainTextBody = plainText
Strings = s
}
Strings = s }
do! client.DisconnectAsync true
// Add to the request list if desired
match model.SendToClass, model.AddToRequestList with
@ -296,8 +291,7 @@ 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

9
src/PrayerTracker/User.fs
View File

@ -155,11 +155,9 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr
[ "This is likely due to one of the following reasons:<ul>"
"<li>The e-mail address “{0}” is invalid.</li>"
"<li>The password entered does not match the password for the given e-mail address.</li>"
"<li>You are not authorized to administer the selected group.</li></ul>"
]
"<li>You are not authorized to administer the selected group.</li></ul>" ]
|> 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
@ -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