Version 8 #43

Merged
danieljsummers merged 37 commits from version-8 into main 2022-08-19 19:08:31 +00:00
10 changed files with 92 additions and 57 deletions
Showing only changes of commit 5a44c7f767 - Show all commits

View File

@ -17,7 +17,7 @@ module Navigation =
let top m = let top m =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let menuSpacer = rawText "  " let menuSpacer = rawText "  "
let _dropdown = _class "dropbtn" let _dropdown = _class "dropdown-btn"
let leftLinks = [ let leftLinks = [
match m.User with match m.User with
| Some u -> | Some u ->
@ -282,7 +282,7 @@ let private htmlFooter viewInfo =
_title imgText _title imgText
_width "331"; _height "28" ] _width "331"; _height "28" ]
] ]
str viewInfo.Version span [ _id "pt-version" ] [ str viewInfo.Version ]
space space
i [ _title s["This page loaded in {0:N3} seconds", resultTime].Value; _class "material-icons md-18" ] [ i [ _title s["This page loaded in {0:N3} seconds", resultTime].Value; _class "material-icons md-18" ] [
str "schedule" str "schedule"

View File

@ -52,11 +52,9 @@ let changePassword ctx viewInfo =
toHtmlIds [ nameof model.OldPassword; nameof model.NewPassword; nameof model.NewPasswordConfirm ] toHtmlIds [ nameof model.OldPassword; nameof model.NewPassword; nameof model.NewPasswordConfirm ]
$"{fields} {{ width: 10rem; }}" $"{fields} {{ width: 10rem; }}"
] ]
p [ _class "pt-center-text" ] [ [ p [ _class "pt-center-text" ] [
locStr s["To change your password, enter your current password in the specified box below, then enter your new password twice."] locStr s["To change your password, enter your current password in the specified box below, then enter your new password twice."]
] ]
|> List.singleton
|> List.append [
form [ _action "/user/password/change" form [ _action "/user/password/change"
_method "post" _method "post"
_onsubmit $"""return PT.compareValidation('{nameof model.NewPassword}','{nameof model.NewPasswordConfirm}','%A{s["The passwords do not match"]}')""" _onsubmit $"""return PT.compareValidation('{nameof model.NewPassword}','{nameof model.NewPasswordConfirm}','%A{s["The passwords do not match"]}')"""
@ -79,8 +77,9 @@ let changePassword ctx viewInfo =
] ]
] ]
div [ _fieldRow ] [ div [ _fieldRow ] [
submit [ _onclick $"document.getElementById('{nameof model.NewPasswordConfirm}').setCustomValidity('')" ] submit [
"done" s["Change Your Password"] _onclick $"document.getElementById('{nameof model.NewPasswordConfirm}').setCustomValidity('')"
] "done" s["Change Your Password"]
] ]
] ]
] ]
@ -147,7 +146,7 @@ let edit (model : EditUser) ctx viewInfo =
/// View for the user log on page /// View for the user log on page
let logOn (model : UserLogOn) groups ctx viewInfo = let logOn (model : UserLogOn) groups ctx viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let vi = AppViewInfo.withScopedStyles [ "#email { width: 20rem; }" ] viewInfo let vi = AppViewInfo.withScopedStyles [ $"#{nameof model.Email} {{ width: 20rem; }}" ] viewInfo
form [ _action "/user/log-on"; _method "post"; _class "pt-center-columns"; Target.body ] [ form [ _action "/user/log-on"; _method "post"; _class "pt-center-columns"; Target.body ] [
csrfToken ctx csrfToken ctx
inputField "hidden" (nameof model.RedirectUrl) (defaultArg model.RedirectUrl "") [] inputField "hidden" (nameof model.RedirectUrl) (defaultArg model.RedirectUrl "") []

View File

@ -14,7 +14,6 @@ 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

@ -61,6 +61,7 @@ module Configure =
opts.ExpireTimeSpan <- TimeSpan.FromMinutes 120. opts.ExpireTimeSpan <- TimeSpan.FromMinutes 120.
opts.SlidingExpiration <- true opts.SlidingExpiration <- true
opts.AccessDeniedPath <- "/error/403") opts.AccessDeniedPath <- "/error/403")
let _ = svc.AddAuthorization ()
let _ = svc.AddDistributedMemoryCache() let _ = svc.AddDistributedMemoryCache()
let _ = svc.AddSession() let _ = svc.AddSession()
let _ = svc.AddAntiforgery() let _ = svc.AddAntiforgery()
@ -203,6 +204,8 @@ module Configure =
let _ = app.UseSession () let _ = app.UseSession ()
let _ = app.UseRequestLocalization let _ = app.UseRequestLocalization
(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value) (app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value)
let _ = app.UseAuthentication ()
let _ = app.UseAuthorization ()
let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints routes) let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints routes)
Views.I18N.setUpFactories <| app.ApplicationServices.GetRequiredService<IStringLocalizerFactory> () Views.I18N.setUpFactories <| app.ApplicationServices.GetRequiredService<IStringLocalizerFactory> ()

View File

@ -141,6 +141,7 @@ open PrayerTracker.Entities
/// Require one of the given access roles /// Require one of the given access roles
let requireAccess levels : HttpHandler = fun next ctx -> task { let requireAccess levels : HttpHandler = fun next ctx -> task {
// These calls fill the user and group in the session, making .Value safe to use for the rest of the request
let! user = ctx.CurrentUser () let! user = ctx.CurrentUser ()
let! group = ctx.CurrentGroup () let! group = ctx.CurrentGroup ()
match user, group with match user, group with
@ -154,11 +155,10 @@ let requireAccess levels : HttpHandler = fun next ctx -> task {
return! redirectTo false "/unauthorized" next ctx return! redirectTo false "/unauthorized" next ctx
| _, _ when List.contains User levels -> | _, _ when List.contains User levels ->
// Redirect to the user log on page // Redirect to the user log on page
ctx.Session.SetString (Key.Session.redirectUrl, ctx.Request.GetEncodedUrl ()) ctx.Session.SetString (Key.Session.redirectUrl, ctx.Request.GetEncodedPathAndQuery ())
return! redirectTo false "/user/log-on" next ctx return! redirectTo false "/user/log-on" next ctx
| _, _ when List.contains Group levels -> | _, _ when List.contains Group levels ->
// Redirect to the small group log on page // Redirect to the small group log on page
ctx.Session.SetString (Key.Session.redirectUrl, ctx.Request.GetEncodedUrl ())
return! redirectTo false "/small-group/log-on" next ctx return! redirectTo false "/small-group/log-on" next ctx
| _, _ -> | _, _ ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()

View File

@ -8,6 +8,30 @@ open MimeKit
open MimeKit.Text open MimeKit.Text
open PrayerTracker.Entities open PrayerTracker.Entities
/// Parameters required to send an e-mail
type EmailOptions =
{ /// The SMTP client
Client : SmtpClient
/// The people who should receive the e-mail
Recipients : Member list
/// The small group for which this e-mail is being sent
Group : SmallGroup
/// The subject of the e-mail
Subject : string
/// The body of the e-mail in HTML
HtmlBody : string
/// The body of the e-mail in plain text
PlainTextBody : string
/// Use the current user's preferred language
Strings : IStringLocalizer
}
/// The e-mail address from which e-mail is sent /// The e-mail address from which e-mail is sent
let private fromAddress = "prayer@bitbadger.solutions" let private fromAddress = "prayer@bitbadger.solutions"
@ -20,57 +44,57 @@ let getConnection () = task {
} }
/// Create a mail message object, filled with everything but the body content /// Create a mail message object, filled with everything but the body content
let createMessage (grp : SmallGroup) subj = let createMessage opts =
let msg = new MimeMessage () let msg = new MimeMessage ()
msg.From.Add (MailboxAddress (grp.Preferences.EmailFromName, fromAddress)) msg.From.Add (MailboxAddress (opts.Group.Preferences.EmailFromName, fromAddress))
msg.Subject <- subj msg.Subject <- opts.Subject
msg.ReplyTo.Add (MailboxAddress (grp.Preferences.EmailFromName, grp.Preferences.EmailFromAddress)) msg.ReplyTo.Add (MailboxAddress (opts.Group.Preferences.EmailFromName, opts.Group.Preferences.EmailFromAddress))
msg msg
/// Create an HTML-format e-mail message /// Create an HTML-format e-mail message
let createHtmlMessage grp subj body (s : IStringLocalizer) = let createHtmlMessage opts =
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 opts.HtmlBody
"""<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 opts.Strings["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 opts.Strings["from Bit Badger Solutions"].Value
"</small></div></body></html>" "</small></div></body></html>"
] ]
|> String.concat "" |> String.concat ""
let msg = createMessage grp subj let msg = createMessage opts
msg.Body <- new TextPart (TextFormat.Html, Text = bodyText) msg.Body <- new TextPart (TextFormat.Html, Text = bodyText)
msg msg
/// Create a plain-text-format e-mail message /// Create a plain-text-format e-mail message
let createTextMessage grp subj body (s : IStringLocalizer) = let createTextMessage opts =
let bodyText = let bodyText =
[ body [ opts.PlainTextBody
"\n\n--\n" "\n\n--\n"
s["Generated by P R A Y E R T R A C K E R"].Value opts.Strings["Generated by P R A Y E R T R A C K E R"].Value
"\n" "\n"
s["from Bit Badger Solutions"].Value opts.Strings["from Bit Badger Solutions"].Value
] ]
|> String.concat "" |> String.concat ""
let msg = createMessage grp subj let msg = createMessage opts
msg.Body <- new TextPart (TextFormat.Plain, Text = bodyText) msg.Body <- new TextPart (TextFormat.Plain, Text = bodyText)
msg msg
/// Send e-mails to a class /// Send e-mails to a class
let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html text s = task { let sendEmails opts = task {
use htmlMsg = createHtmlMessage grp subj html s use htmlMsg = createHtmlMessage opts
use plainTextMsg = createTextMessage grp subj text s use plainTextMsg = createTextMessage opts
for mbr in recipients do for mbr in opts.Recipients do
let emailTo = MailboxAddress (mbr.Name, mbr.Email) let emailTo = MailboxAddress (mbr.Name, mbr.Email)
match defaultArg mbr.Format grp.Preferences.DefaultEmailType with match defaultArg mbr.Format opts.Group.Preferences.DefaultEmailType with
| HtmlFormat -> | HtmlFormat ->
htmlMsg.To.Add emailTo htmlMsg.To.Add emailTo
let! _ = client.SendAsync htmlMsg let! _ = opts.Client.SendAsync htmlMsg
htmlMsg.To.Clear () htmlMsg.To.Clear ()
| PlainTextFormat -> | PlainTextFormat ->
plainTextMsg.To.Add emailTo plainTextMsg.To.Add emailTo
let! _ = client.SendAsync plainTextMsg let! _ = opts.Client.SendAsync plainTextMsg
plainTextMsg.To.Clear () plainTextMsg.To.Clear ()
} }

View File

@ -78,9 +78,15 @@ let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let! list = generateRequestList ctx listDate let! list = generateRequestList ctx listDate
let! recipients = ctx.Db.AllMembersForSmallGroup group.Id let! recipients = ctx.Db.AllMembersForSmallGroup group.Id
use! client = Email.getConnection () use! client = Email.getConnection ()
do! Email.sendEmails client recipients do! Email.sendEmails
group s["Prayer Requests for {0} - {1:MMMM d, yyyy}", group.Name, list.Date].Value { Client = client
(list.AsHtml s) (list.AsText s) s Recipients = recipients
Group = group
Subject = s["Prayer Requests for {0} - {1:MMMM d, yyyy}", group.Name, list.Date].Value
HtmlBody = list.AsHtml s
PlainTextBody = list.AsText s
Strings = s
}
return! return!
viewInfo ctx viewInfo ctx
|> Views.PrayerRequest.email { list with Recipients = recipients } |> Views.PrayerRequest.email { list with Recipients = recipients }

View File

@ -276,10 +276,16 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
| "N" when usr.IsAdmin -> ctx.Db.AllUsersAsMembers () | "N" when usr.IsAdmin -> ctx.Db.AllUsersAsMembers ()
| _ -> ctx.Db.AllMembersForSmallGroup group.Id | _ -> ctx.Db.AllMembersForSmallGroup group.Id
use! client = Email.getConnection () use! client = Email.getConnection ()
do! Email.sendEmails client recipients group do! Email.sendEmails
s["Announcement for {0} - {1:MMMM d, yyyy} {2}", group.Name, now.Date, { Client = client
(now.ToString "h:mm tt").ToLower ()].Value Recipients = recipients
htmlText plainText s Group = group
Subject = s["Announcement for {0} - {1:MMMM d, yyyy} {2}", group.Name, now.Date,
(now.ToString "h:mm tt").ToLower ()].Value
HtmlBody = htmlText
PlainTextBody = plainText
Strings = s
}
// Add to the request list if desired // Add to the request list if desired
match model.SendToClass, model.AddToRequestList with match model.SendToClass, model.AddToRequestList with
| "N", _ | "N", _

View File

@ -142,7 +142,6 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
} }
/// GET /user/[user-id]/edit /// GET /user/[user-id]/edit
let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let userId = UserId usrId let userId = UserId usrId
@ -161,7 +160,6 @@ let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
| _ -> return! fourOhFour ctx | _ -> return! fourOhFour ctx
} }
/// GET /user/log-on /// GET /user/log-on
let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
@ -178,7 +176,6 @@ let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
/// GET /users /// GET /users
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let! users = ctx.Db.AllUsers () let! users = ctx.Db.AllUsers ()
@ -188,14 +185,12 @@ let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
|> renderHtml next ctx |> renderHtml next ctx
} }
/// GET /user/password /// GET /user/password
let password : HttpHandler = requireAccess [ User ] >=> fun next ctx -> let password : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
{ viewInfo ctx with HelpLink = Some Help.changePassword } { viewInfo ctx with HelpLink = Some Help.changePassword }
|> Views.User.changePassword ctx |> Views.User.changePassword ctx
|> renderHtml next ctx |> renderHtml next ctx
/// POST /user/save /// POST /user/save
let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditUser> () with match! ctx.TryBindFormAsync<EditUser> () with
@ -237,7 +232,6 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
} }
/// POST /user/small-groups/save /// POST /user/small-groups/save
let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<AssignGroups> () with match! ctx.TryBindFormAsync<AssignGroups> () with
@ -270,7 +264,6 @@ let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
} }
/// GET /user/[user-id]/small-groups /// GET /user/[user-id]/small-groups
let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let userId = UserId usrId let userId = UserId usrId

View File

@ -73,7 +73,7 @@ a > img {
float: left; float: left;
} }
.pt-title-bar li a, .pt-title-bar li a,
.pt-title-bar .dropbtn, .pt-title-bar .dropdown-btn,
.pt-title-bar .home-link { .pt-title-bar .home-link {
display: inline-block; display: inline-block;
color: #9d9d9d; color: #9d9d9d;
@ -85,7 +85,7 @@ a > img {
font-size: 1.1rem; font-size: 1.1rem;
} }
.pt-title-bar li a:hover, .pt-title-bar li a:hover,
.pt-title-bar .dropdown:hover .dropbtn { .pt-title-bar .dropdown:hover .dropdown-btn {
color: white; color: white;
border-bottom: none; border-bottom: none;
} }
@ -215,9 +215,14 @@ footer.pt-footer {
color: navy; color: navy;
background-color: #eee; background-color: #eee;
} }
#pt-footer img { #pt-footer img,
#pt-footer span,
#pt-footer i {
vertical-align: bottom; vertical-align: bottom;
} }
#pt-version {
padding-left: .25rem;
}
footer a:hover { footer a:hover {
border-bottom: 0; border-bottom: 0;
} }