Version 8 #43
|
@ -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"
|
||||
|
|
|
@ -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 "") []
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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> ()
|
||||
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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 ()
|
||||
}
|
||||
|
|
|
@ -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 }
|
||||
|
|
|
@ -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", _
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue
Block a user