Finish auth migration (#39)

- Tweak footer styles (#38)
- Create structure for e-mail parameters
This commit is contained in:
Daniel J. Summers 2022-08-04 20:24:49 -04:00
parent c3f7067899
commit 5a44c7f767
10 changed files with 92 additions and 57 deletions

View File

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

View File

@ -52,11 +52,9 @@ let changePassword ctx viewInfo =
toHtmlIds [ nameof model.OldPassword; nameof model.NewPassword; nameof model.NewPasswordConfirm ]
$"{fields} {{ width: 10rem; }}"
]
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."]
]
|> List.singleton
|> List.append [
[ 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."]
]
form [ _action "/user/password/change"
_method "post"
_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 ] [
submit [ _onclick $"document.getElementById('{nameof model.NewPasswordConfirm}').setCustomValidity('')" ]
"done" s["Change Your Password"]
submit [
_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
let logOn (model : UserLogOn) groups ctx viewInfo =
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 ] [
csrfToken ctx
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}"
ProjectSection(SolutionItems) = preProject
Directory.Build.props = Directory.Build.props
global.json = global.json
EndProjectSection
EndProject
Global

View File

@ -61,6 +61,7 @@ module Configure =
opts.ExpireTimeSpan <- TimeSpan.FromMinutes 120.
opts.SlidingExpiration <- true
opts.AccessDeniedPath <- "/error/403")
let _ = svc.AddAuthorization ()
let _ = svc.AddDistributedMemoryCache()
let _ = svc.AddSession()
let _ = svc.AddAntiforgery()
@ -203,6 +204,8 @@ module Configure =
let _ = app.UseSession ()
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> ()

View File

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

View File

@ -8,6 +8,30 @@ open MimeKit
open MimeKit.Text
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
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
let createMessage (grp : SmallGroup) subj =
let createMessage opts =
let msg = new MimeMessage ()
msg.From.Add (MailboxAddress (grp.Preferences.EmailFromName, fromAddress))
msg.Subject <- subj
msg.ReplyTo.Add (MailboxAddress (grp.Preferences.EmailFromName, grp.Preferences.EmailFromAddress))
msg.From.Add (MailboxAddress (opts.Group.Preferences.EmailFromName, fromAddress))
msg.Subject <- opts.Subject
msg.ReplyTo.Add (MailboxAddress (opts.Group.Preferences.EmailFromName, opts.Group.Preferences.EmailFromAddress))
msg
/// Create an HTML-format e-mail message
let createHtmlMessage grp subj body (s : IStringLocalizer) =
let createHtmlMessage opts =
let bodyText =
[ """<!DOCTYPE html><html xmlns="http://www.w3.org/1999/xhtml"><head><title></title></head><body>"""
body
"""<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
"<br><small>"
s["from Bit Badger Solutions"].Value
"</small></div></body></html>"
[ """<!DOCTYPE html><html xmlns="http://www.w3.org/1999/xhtml"><head><title></title></head><body>"""
opts.HtmlBody
"""<hr><div style="text-align:right;font-family:Arial,Helvetica,sans-serif;font-size:8pt;padding-right:10px;">"""
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>"
]
|> String.concat ""
let msg = createMessage grp subj
let msg = createMessage opts
msg.Body <- new TextPart (TextFormat.Html, Text = bodyText)
msg
/// Create a plain-text-format e-mail message
let createTextMessage grp subj body (s : IStringLocalizer) =
let createTextMessage opts =
let bodyText =
[ body
"\n\n--\n"
s["Generated by P R A Y E R T R A C K E R"].Value
"\n"
s["from Bit Badger Solutions"].Value
[ opts.PlainTextBody
"\n\n--\n"
opts.Strings["Generated by P R A Y E R T R A C K E R"].Value
"\n"
opts.Strings["from Bit Badger Solutions"].Value
]
|> String.concat ""
let msg = createMessage grp subj
let msg = createMessage opts
msg.Body <- new TextPart (TextFormat.Plain, Text = bodyText)
msg
/// Send e-mails to a class
let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html text s = task {
use htmlMsg = createHtmlMessage grp subj html s
use plainTextMsg = createTextMessage grp subj text s
let sendEmails opts = task {
use htmlMsg = createHtmlMessage opts
use plainTextMsg = createTextMessage opts
for mbr in recipients do
for mbr in opts.Recipients do
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 ->
htmlMsg.To.Add emailTo
let! _ = client.SendAsync htmlMsg
let! _ = opts.Client.SendAsync htmlMsg
htmlMsg.To.Clear ()
| PlainTextFormat ->
plainTextMsg.To.Add emailTo
let! _ = client.SendAsync plainTextMsg
let! _ = opts.Client.SendAsync plainTextMsg
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! recipients = ctx.Db.AllMembersForSmallGroup group.Id
use! client = Email.getConnection ()
do! Email.sendEmails client recipients
group s["Prayer Requests for {0} - {1:MMMM d, yyyy}", group.Name, list.Date].Value
(list.AsHtml s) (list.AsText s) s
do! Email.sendEmails
{ Client = client
Recipients = recipients
Group = group
Subject = s["Prayer Requests for {0} - {1:MMMM d, yyyy}", group.Name, list.Date].Value
HtmlBody = list.AsHtml s
PlainTextBody = list.AsText s
Strings = s
}
return!
viewInfo ctx
|> 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 ()
| _ -> ctx.Db.AllMembersForSmallGroup group.Id
use! client = Email.getConnection ()
do! Email.sendEmails client recipients group
s["Announcement for {0} - {1:MMMM d, yyyy} {2}", group.Name, now.Date,
(now.ToString "h:mm tt").ToLower ()].Value
htmlText plainText s
do! Email.sendEmails
{ Client = client
Recipients = recipients
Group = group
Subject = s["Announcement for {0} - {1:MMMM d, yyyy} {2}", group.Name, now.Date,
(now.ToString "h:mm tt").ToLower ()].Value
HtmlBody = htmlText
PlainTextBody = plainText
Strings = s
}
// Add to the request list if desired
match model.SendToClass, model.AddToRequestList with
| "N", _

View File

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

View File

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