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…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user