Version 8 #43
| @ -65,10 +65,6 @@ type AppDbContext (options : DbContextOptions<AppDbContext>) = | ||||
|       with get() = this.userGroupXref | ||||
|        and set v = this.userGroupXref <- v | ||||
| 
 | ||||
|     /// F#-style async for saving changes | ||||
|     member this.AsyncSaveChanges () = | ||||
|         this.SaveChangesAsync () |> Async.AwaitTask | ||||
| 
 | ||||
|     override _.OnConfiguring (optionsBuilder : DbContextOptionsBuilder) = | ||||
|         base.OnConfiguring optionsBuilder | ||||
|         optionsBuilder.UseQueryTrackingBehavior QueryTrackingBehavior.NoTracking |> ignore | ||||
|  | ||||
| @ -25,7 +25,6 @@ module private Helpers = | ||||
| 
 | ||||
| 
 | ||||
| open System | ||||
| open System.Collections.Generic | ||||
| open Microsoft.EntityFrameworkCore | ||||
| open Microsoft.FSharpLu | ||||
| 
 | ||||
| @ -198,13 +197,6 @@ type AppDbContext with | ||||
|         | _ -> return None | ||||
|     } | ||||
| 
 | ||||
|     /// Check a cookie log on for a small group | ||||
|     member this.TryGroupLogOnByCookie groupId pwHash (hasher : string -> string) = backgroundTask { | ||||
|         match! this.TryGroupById groupId with | ||||
|         | None -> return None | ||||
|         | Some grp -> return if pwHash = hasher grp.Preferences.GroupPassword then Some grp else None | ||||
|     } | ||||
| 
 | ||||
|     /// Count small groups for the given church Id | ||||
|     member this.CountGroupsByChurch churchId = backgroundTask { | ||||
|         return! this.SmallGroups.CountAsync (fun sg -> sg.ChurchId = churchId) | ||||
| @ -212,12 +204,6 @@ type AppDbContext with | ||||
|          | ||||
|     (*-- TIME ZONE EXTENSIONS --*) | ||||
| 
 | ||||
|     /// Get a time zone by its Id | ||||
|     member this.TryTimeZoneById tzId = backgroundTask { | ||||
|         let! zone = this.TimeZones.SingleOrDefaultAsync (fun tz -> tz.Id = tzId) | ||||
|         return Option.fromObject zone | ||||
|     } | ||||
| 
 | ||||
|     /// Get all time zones | ||||
|     member this.AllTimeZones () = backgroundTask { | ||||
|         let! zones = this.TimeZones.OrderBy(fun tz -> tz.SortOrder).ToListAsync () | ||||
| @ -258,26 +244,6 @@ type AppDbContext with | ||||
|         return users |> List.map (fun u -> { Member.empty with Email = u.Email; Name = u.Name }) | ||||
|     } | ||||
| 
 | ||||
|     /// Find a user based on their credentials | ||||
|     member this.TryUserLogOnByPassword email pwHash groupId = backgroundTask { | ||||
|         let! usr = | ||||
|             this.Users.SingleOrDefaultAsync (fun u -> | ||||
|                    u.Email = email | ||||
|                 && u.PasswordHash = pwHash | ||||
|                 && u.SmallGroups.Any (fun xref -> xref.SmallGroupId = groupId)) | ||||
|         return Option.fromObject usr | ||||
|     } | ||||
| 
 | ||||
|     /// Find a user based on credentials stored in a cookie | ||||
|     member this.TryUserLogOnByCookie uId gId pwHash = backgroundTask { | ||||
|         match! this.TryUserByIdWithGroups uId with | ||||
|         | None -> return None | ||||
|         | Some usr -> | ||||
|             if pwHash = usr.PasswordHash && usr.SmallGroups |> Seq.exists (fun xref -> xref.SmallGroupId = gId) then | ||||
|                 return Some { usr with PasswordHash = ""; Salt = None; SmallGroups = List<UserSmallGroup>() } | ||||
|             else return None | ||||
|     } | ||||
| 
 | ||||
|     /// Count the number of users for a small group | ||||
|     member this.CountUsersBySmallGroup groupId = backgroundTask { | ||||
|         return! this.Users.CountAsync (fun u -> u.SmallGroups.Any (fun xref -> xref.SmallGroupId = groupId)) | ||||
|  | ||||
| @ -417,8 +417,8 @@ | ||||
|   <data name="There are no classes with passwords defined" xml:space="preserve"> | ||||
|     <value>No hay clases con contraseñas se define</value> | ||||
|   </data> | ||||
|   <data name="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 group “{1}”.</li></ul>" xml:space="preserve"> | ||||
|     <value>Esto es probablemente debido a una de las siguientes razones:<ul><li>La dirección de correo electrónico “{0}” no es válida.</li><li>La contraseña introducida no coincide con la contraseña de la determinada dirección de correo electrónico.</li><li>Usted no está autorizado para administrar el grupo “{1}”.</li></ul></value> | ||||
|   <data name="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>" xml:space="preserve"> | ||||
|     <value>Esto es probablemente debido a una de las siguientes razones:<ul><li>La dirección de correo electrónico “{0}” no es válida.</li><li>La contraseña introducida no coincide con la contraseña de la determinada dirección de correo electrónico.</li><li>Usted no está autorizado para administrar el grupo seleccionado.</li></ul></value> | ||||
|   </data> | ||||
|   <data name="This page loaded in {0:N3} seconds" xml:space="preserve"> | ||||
|     <value>Esta página cargada en {0:N3} segundos</value> | ||||
|  | ||||
| @ -5,18 +5,6 @@ open System | ||||
| open System.Security.Cryptography | ||||
| open System.Text | ||||
| 
 | ||||
| /// Hash a string with a SHA1 hash | ||||
| let sha1Hash (x : string) = | ||||
|     use alg = SHA1.Create () | ||||
|     alg.ComputeHash (Encoding.ASCII.GetBytes x) | ||||
|     |> Seq.map (fun chr -> chr.ToString "x2") | ||||
|     |> String.concat "" | ||||
| 
 | ||||
| /// Hash a string using 1,024 rounds of PBKDF2 and a salt | ||||
| let pbkdf2Hash (salt : Guid) (x : string) = | ||||
|     use alg = new Rfc2898DeriveBytes (x, Encoding.UTF8.GetBytes (salt.ToString "N"), 1024) | ||||
|     (alg.GetBytes >> Convert.ToBase64String) 64 | ||||
| 
 | ||||
| open Giraffe | ||||
| 
 | ||||
| /// Parse a short-GUID-based ID from a string | ||||
|  | ||||
| @ -49,9 +49,9 @@ module Configure = | ||||
|         let _ = | ||||
|             svc.Configure<RequestLocalizationOptions>(fun (opts : RequestLocalizationOptions) -> | ||||
|                 let supportedCultures =[| | ||||
|                      CultureInfo "en-US"; CultureInfo "en-GB"; CultureInfo "en-AU"; CultureInfo "en" | ||||
|                      CultureInfo "es-MX"; CultureInfo "es-ES"; CultureInfo "es" | ||||
|                     |] | ||||
|                     CultureInfo "en-US"; CultureInfo "en-GB"; CultureInfo "en-AU"; CultureInfo "en" | ||||
|                     CultureInfo "es-MX"; CultureInfo "es-ES"; CultureInfo "es" | ||||
|                 |] | ||||
|                 opts.DefaultRequestCulture <- RequestCulture ("en-US", "en-US") | ||||
|                 opts.SupportedCultures     <- supportedCultures | ||||
|                 opts.SupportedUICultures   <- supportedCultures) | ||||
| @ -212,20 +212,55 @@ module Configure = | ||||
| 
 | ||||
| /// The web application | ||||
| module App = | ||||
|    | ||||
|      | ||||
|     open System.Text | ||||
|     open Microsoft.EntityFrameworkCore | ||||
|     open Microsoft.Extensions.DependencyInjection | ||||
|      | ||||
|     let migratePasswords (app : IWebHost) = | ||||
|         task { | ||||
|             use db = app.Services.GetService<AppDbContext>() | ||||
|             let! v1Users = db.Users.FromSqlRaw("SELECT * FROM pt.pt_user WHERE salt IS NULL").ToListAsync () | ||||
|             for user in v1Users do | ||||
|                 let pw = | ||||
|                     [|  254uy  | ||||
|                         yield! (Encoding.UTF8.GetBytes user.PasswordHash) | ||||
|                     |] | ||||
|                     |> Convert.ToBase64String | ||||
|                 db.UpdateEntry { user with PasswordHash = pw } | ||||
|             let! v1Count = db.SaveChangesAsync () | ||||
|             printfn $"Updated {v1Count} users with version 1 password" | ||||
|             let! v2Users = | ||||
|                 db.Users.FromSqlRaw("SELECT * FROM pt.pt_user WHERE salt IS NOT NULL").ToListAsync () | ||||
|             for user in v2Users do | ||||
|                 let pw = | ||||
|                     [|  255uy | ||||
|                         yield! (user.Salt.Value.ToByteArray ()) | ||||
|                         yield! (Encoding.UTF8.GetBytes user.PasswordHash) | ||||
|                     |] | ||||
|                     |> Convert.ToBase64String | ||||
|                 db.UpdateEntry { user with PasswordHash = pw } | ||||
|             let! v2Count = db.SaveChangesAsync () | ||||
|             printfn $"Updated {v2Count} users with version 2 password" | ||||
|         } |> Async.AwaitTask |> Async.RunSynchronously | ||||
|      | ||||
|     open System.IO | ||||
| 
 | ||||
|     [<EntryPoint>] | ||||
|     let main _ = | ||||
|     let main args = | ||||
|         let contentRoot = Directory.GetCurrentDirectory () | ||||
|         WebHostBuilder() | ||||
|             .UseContentRoot(contentRoot) | ||||
|             .ConfigureAppConfiguration(Configure.configuration) | ||||
|             .UseKestrel(Configure.kestrel) | ||||
|             .UseWebRoot(Path.Combine (contentRoot, "wwwroot")) | ||||
|             .ConfigureServices(Configure.services) | ||||
|             .ConfigureLogging(Configure.logging) | ||||
|             .Configure(System.Action<IApplicationBuilder> Configure.app) | ||||
|             .Build() | ||||
|             .Run () | ||||
|         let app = | ||||
|             WebHostBuilder() | ||||
|                 .UseContentRoot(contentRoot) | ||||
|                 .ConfigureAppConfiguration(Configure.configuration) | ||||
|                 .UseKestrel(Configure.kestrel) | ||||
|                 .UseWebRoot(Path.Combine (contentRoot, "wwwroot")) | ||||
|                 .ConfigureServices(Configure.services) | ||||
|                 .ConfigureLogging(Configure.logging) | ||||
|                 .Configure(System.Action<IApplicationBuilder> Configure.app) | ||||
|                 .Build() | ||||
|         if args.Length > 0 then | ||||
|             if args[0] = "migrate-passwords" then migratePasswords app | ||||
|             else printfn $"Unrecognized option {args[0]}" | ||||
|         else app.Run () | ||||
|         0 | ||||
|  | ||||
| @ -107,13 +107,14 @@ let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validat | ||||
|         match! ctx.Db.TryGroupLogOnByPassword (idFromShort SmallGroupId model.SmallGroupId) model.Password with | ||||
|         | Some group -> | ||||
|             ctx.Session.CurrentGroup <- Some group | ||||
|             let claims   = Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value) |> Seq.singleton | ||||
|             let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme) | ||||
|             do! ctx.SignInAsync | ||||
|                     (identity.AuthenticationType, ClaimsPrincipal identity, | ||||
|                      AuthenticationProperties ( | ||||
|                          IssuedUtc    = DateTimeOffset.UtcNow, | ||||
|                          IsPersistent = defaultArg model.RememberMe false)) | ||||
|             let identity = ClaimsIdentity ( | ||||
|                 Seq.singleton (Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value)), | ||||
|                 CookieAuthenticationDefaults.AuthenticationScheme) | ||||
|             do! ctx.SignInAsync ( | ||||
|                     identity.AuthenticationType, ClaimsPrincipal identity, | ||||
|                     AuthenticationProperties ( | ||||
|                         IssuedUtc    = DateTimeOffset.UtcNow, | ||||
|                         IsPersistent = defaultArg model.RememberMe false)) | ||||
|             addInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]] | ||||
|             return! redirectTo false "/prayer-requests/view" next ctx | ||||
|         | None -> | ||||
|  | ||||
| @ -1,36 +1,78 @@ | ||||
| module PrayerTracker.Handlers.User | ||||
| 
 | ||||
| open System | ||||
| open System.Collections.Generic | ||||
| open Giraffe | ||||
| open Microsoft.AspNetCore.Http | ||||
| open Microsoft.AspNetCore.Identity | ||||
| open PrayerTracker | ||||
| open PrayerTracker.Entities | ||||
| open PrayerTracker.ViewModels | ||||
| 
 | ||||
| /// Retrieve a user from the database by password | ||||
| // If the hashes do not match, determine if it matches a previous scheme, and upgrade them if it does | ||||
| /// Password hashing implementation extending ASP.NET Core's identity implementation | ||||
| [<AutoOpen>] | ||||
| module Hashing = | ||||
|      | ||||
|     open System.Security.Cryptography | ||||
|     open System.Text | ||||
|      | ||||
|     /// Custom password hasher used to verify and upgrade old password hashes | ||||
|     type PrayerTrackerPasswordHasher () = | ||||
|         inherit PasswordHasher<User> () | ||||
|          | ||||
|         override this.VerifyHashedPassword (user, hashedPassword, providedPassword) = | ||||
|             if isNull hashedPassword   then nullArg (nameof hashedPassword) | ||||
|             if isNull providedPassword then nullArg (nameof providedPassword) | ||||
|              | ||||
|             let hashBytes = Convert.FromBase64String hashedPassword | ||||
|              | ||||
|             match hashBytes[0] with | ||||
|             | 255uy -> | ||||
|                 // v2 hashes - PBKDF2 (RFC 2898), 1,024 rounds | ||||
|                 if hashBytes.Length < 49 then PasswordVerificationResult.Failed | ||||
|                 else | ||||
|                     let v2Hash = | ||||
|                         use alg = new Rfc2898DeriveBytes ( | ||||
|                             providedPassword, Encoding.UTF8.GetBytes ((Guid hashBytes[1..16]).ToString "N"), 1024) | ||||
|                         (alg.GetBytes >> Convert.ToBase64String) 64 | ||||
|                     if Encoding.UTF8.GetString hashBytes[17..] = v2Hash then | ||||
|                         PasswordVerificationResult.SuccessRehashNeeded | ||||
|                     else PasswordVerificationResult.Failed | ||||
|             | 254uy -> | ||||
|                 // v1 hashes - SHA-1 | ||||
|                 let v1Hash = | ||||
|                     use alg = SHA1.Create () | ||||
|                     alg.ComputeHash (Encoding.ASCII.GetBytes providedPassword) | ||||
|                     |> Seq.map (fun byt -> byt.ToString "x2") | ||||
|                     |> String.concat "" | ||||
|                 if Encoding.UTF8.GetString hashBytes[1..] = v1Hash then | ||||
|                     PasswordVerificationResult.SuccessRehashNeeded | ||||
|                 else | ||||
|                     PasswordVerificationResult.Failed | ||||
|             | _ -> base.VerifyHashedPassword (user, hashedPassword, providedPassword) | ||||
| 
 | ||||
|      | ||||
| /// Retrieve a user from the database by password, upgrading password hashes if required | ||||
| let private findUserByPassword model (db : AppDbContext) = task { | ||||
|     let bareUser user = Some { user with PasswordHash = ""; SmallGroups = ResizeArray<UserSmallGroup>() } | ||||
|     match! db.TryUserByEmailAndGroup model.Email (idFromShort SmallGroupId model.SmallGroupId) with | ||||
|     | Some u when Option.isSome u.Salt -> | ||||
|         // Already upgraded; match = success | ||||
|         let pwHash = pbkdf2Hash (Option.get u.Salt) model.Password | ||||
|         if u.PasswordHash = pwHash then | ||||
|             return Some { u with PasswordHash = ""; Salt = None; SmallGroups = List<UserSmallGroup>() } | ||||
|         else return None | ||||
|     | Some u when u.PasswordHash = sha1Hash model.Password -> | ||||
|         // Not upgraded, but password is good; upgrade 'em! | ||||
|         // Upgrade 'em! | ||||
|         let salt     = Guid.NewGuid () | ||||
|         let pwHash   = pbkdf2Hash salt model.Password | ||||
|         let upgraded = { u with Salt = Some salt; PasswordHash = pwHash } | ||||
|         db.UpdateEntry upgraded | ||||
|         let! _ = db.SaveChangesAsync () | ||||
|         return Some { u with PasswordHash = ""; Salt = None; SmallGroups = List<UserSmallGroup>() } | ||||
|     | _ -> return None | ||||
|     | Some user -> | ||||
|         let hasher = PrayerTrackerPasswordHasher () | ||||
|         match hasher.VerifyHashedPassword (user, user.PasswordHash, model.Password) with | ||||
|         | PasswordVerificationResult.Success -> return bareUser user | ||||
|         | PasswordVerificationResult.SuccessRehashNeeded -> | ||||
|             db.UpdateEntry { user with PasswordHash = hasher.HashPassword (user, model.Password) } | ||||
|             let! _ = db.SaveChangesAsync () | ||||
|             return bareUser user | ||||
|         | _ -> return None | ||||
|     | None -> return None | ||||
| } | ||||
| 
 | ||||
| open System.Threading.Tasks | ||||
| /// Return a default URL if the given URL is non-local or otherwise questionable | ||||
| let sanitizeUrl providedUrl defaultUrl = | ||||
|     let url = match defaultArg providedUrl "" with "" -> defaultUrl | it -> it | ||||
|     if url.IndexOf "\\" >= 0 || url.IndexOf "//" >= 0 then defaultUrl | ||||
|     elif Seq.exists Char.IsControl url then defaultUrl | ||||
|     else url | ||||
| 
 | ||||
| /// POST /user/password/change | ||||
| let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { | ||||
| @ -38,25 +80,21 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f | ||||
|     | Ok model -> | ||||
|         let  s      = Views.I18N.localizer.Force () | ||||
|         let  curUsr = ctx.Session.CurrentUser.Value | ||||
|         let! dbUsr  = ctx.Db.TryUserById curUsr.Id | ||||
|         let  group  = ctx.Session.CurrentGroup.Value | ||||
|         let! user   = | ||||
|             match dbUsr with | ||||
|         let  hasher = PrayerTrackerPasswordHasher () | ||||
|         let! user   = task { | ||||
|             match! ctx.Db.TryUserById curUsr.Id with | ||||
|             | Some usr -> | ||||
|                 // Check the old password against a possibly non-salted hash | ||||
|                 (match usr.Salt with Some salt -> pbkdf2Hash salt | None -> sha1Hash) model.OldPassword | ||||
|                 |> ctx.Db.TryUserLogOnByCookie curUsr.Id group.Id | ||||
|             | _ -> Task.FromResult None | ||||
|                 if hasher.VerifyHashedPassword (usr, usr.PasswordHash, model.OldPassword) | ||||
|                        = PasswordVerificationResult.Success then | ||||
|                     return Some usr | ||||
|                 else return None | ||||
|             | _ -> return None | ||||
|         } | ||||
|         match user with | ||||
|         | Some _ when model.NewPassword = model.NewPasswordConfirm -> | ||||
|             match dbUsr with | ||||
|             | Some usr -> | ||||
|                 // Generate new salt whenever the password is changed | ||||
|                 let salt = Guid.NewGuid () | ||||
|                 ctx.Db.UpdateEntry { usr with PasswordHash = pbkdf2Hash salt model.NewPassword; Salt = Some salt } | ||||
|                 let! _ = ctx.Db.SaveChangesAsync () | ||||
|                 addInfo ctx s["Your password was changed successfully"] | ||||
|             | None -> addError ctx s["Unable to change password"] | ||||
|         | Some usr when model.NewPassword = model.NewPasswordConfirm -> | ||||
|             ctx.Db.UpdateEntry { usr with PasswordHash = hasher.HashPassword (usr, model.NewPassword) } | ||||
|             let! _ = ctx.Db.SaveChangesAsync () | ||||
|             addInfo ctx s["Your password was changed successfully"] | ||||
|             return! redirectTo false "/" next ctx | ||||
|         | Some _ -> | ||||
|             addError ctx s["The new passwords did not match - your password was NOT changed"] | ||||
| @ -90,55 +128,41 @@ open Microsoft.AspNetCore.Html | ||||
| let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task { | ||||
|     match! ctx.TryBindFormAsync<UserLogOn> () with | ||||
|     | Ok model ->  | ||||
|         let  s   = Views.I18N.localizer.Force () | ||||
|         let! usr = findUserByPassword model ctx.Db | ||||
|         match! ctx.Db.TryGroupById (idFromShort SmallGroupId model.SmallGroupId) with | ||||
|         | Some group -> | ||||
|             let! nextUrl = backgroundTask { | ||||
|                 match usr with | ||||
|                 | Some user -> | ||||
|                     ctx.Session.CurrentUser  <- usr | ||||
|                     ctx.Session.CurrentGroup <- Some group | ||||
|                     let claims = seq { | ||||
|         let s = Views.I18N.localizer.Force () | ||||
|         match! findUserByPassword model ctx.Db with | ||||
|         | Some user -> | ||||
|             match! ctx.Db.TryGroupById (idFromShort SmallGroupId model.SmallGroupId) with | ||||
|             | Some group -> | ||||
|                 ctx.Session.CurrentUser  <- Some user | ||||
|                 ctx.Session.CurrentGroup <- Some group | ||||
|                 let identity = ClaimsIdentity ( | ||||
|                     seq { | ||||
|                         Claim (ClaimTypes.NameIdentifier, shortGuid user.Id.Value) | ||||
|                         Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value) | ||||
|                         Claim (ClaimTypes.Role, if user.IsAdmin then "Admin" else "User") | ||||
|                     } | ||||
|                     let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme) | ||||
|                     do! ctx.SignInAsync | ||||
|                             (identity.AuthenticationType, ClaimsPrincipal identity, | ||||
|                              AuthenticationProperties ( | ||||
|                                  IssuedUtc    = DateTimeOffset.UtcNow, | ||||
|                                  IsPersistent = defaultArg model.RememberMe false)) | ||||
|                     addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]] | ||||
|                     return | ||||
|                         match model.RedirectUrl with | ||||
|                         | None -> "/small-group" | ||||
|                         | Some x when x = ""-> "/small-group" | ||||
|                         | Some x when x.IndexOf "://" < 0 -> x | ||||
|                         | _ -> "/small-group" | ||||
|                 | _ -> | ||||
|                     { UserMessage.error with | ||||
|                         Text        = htmlLocString s["Invalid credentials - log on unsuccessful"] | ||||
|                         Description = | ||||
|                             [   s["This is likely due to one of the following reasons"].Value | ||||
|                                 ":<ul><li>" | ||||
|                                 s["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode model.Email].Value | ||||
|                                 "</li><li>" | ||||
|                                 s["The password entered does not match the password for the given e-mail address."].Value | ||||
|                                 "</li><li>" | ||||
|                                 s["You are not authorized to administer the group “{0}”.", | ||||
|                                     WebUtility.HtmlEncode group.Name].Value | ||||
|                                 "</li></ul>" | ||||
|                             ] | ||||
|                             |> String.concat "" | ||||
|                             |> (HtmlString >> Some) | ||||
|                     } | ||||
|                     |> addUserMessage ctx | ||||
|                     return "/user/log-on" | ||||
|                     }, CookieAuthenticationDefaults.AuthenticationScheme) | ||||
|                 do! ctx.SignInAsync ( | ||||
|                         identity.AuthenticationType, ClaimsPrincipal identity, | ||||
|                         AuthenticationProperties ( | ||||
|                             IssuedUtc    = DateTimeOffset.UtcNow, | ||||
|                             IsPersistent = defaultArg model.RememberMe false)) | ||||
|                 addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]] | ||||
|                 return! redirectTo false (sanitizeUrl model.RedirectUrl "/small-group") next ctx | ||||
|             | None -> return! fourOhFour ctx | ||||
|         | None -> | ||||
|             { UserMessage.error with | ||||
|                 Text        = htmlLocString s["Invalid credentials - log on unsuccessful"] | ||||
|                 Description = | ||||
|                     let detail = | ||||
|                         [   "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>" | ||||
|                         ] | ||||
|                         |> String.concat "" | ||||
|                     Some (HtmlString (s[detail, WebUtility.HtmlEncode model.Email].Value)) | ||||
|             } | ||||
|             return! redirectTo false nextUrl next ctx | ||||
|         | None -> return! fourOhFour ctx | ||||
|             |> addUserMessage ctx | ||||
|             return! redirectTo false "/user/log-on" next ctx | ||||
|     | Result.Error e -> return! bindError e next ctx | ||||
| } | ||||
| 
 | ||||
| @ -191,6 +215,8 @@ let password : HttpHandler = requireAccess [ User ] >=> fun next ctx -> | ||||
|     |> Views.User.changePassword ctx | ||||
|     |> renderHtml next ctx | ||||
| 
 | ||||
| open System.Threading.Tasks | ||||
| 
 | ||||
| /// POST /user/save | ||||
| let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { | ||||
|     match! ctx.TryBindFormAsync<EditUser> () with | ||||
| @ -198,20 +224,10 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c | ||||
|         let! user = | ||||
|             if model.IsNew then Task.FromResult (Some { User.empty with Id = (Guid.NewGuid >> UserId) () }) | ||||
|             else ctx.Db.TryUserById (idFromShort UserId model.UserId) | ||||
|         let saltedUser =  | ||||
|             match user with | ||||
|             | Some u -> | ||||
|                 match u.Salt with | ||||
|                 | None when model.Password <> "" -> | ||||
|                     // Generate salt so that a new password hash can be generated | ||||
|                     Some { u with Salt = Some (Guid.NewGuid ()) } | ||||
|                 | _ -> | ||||
|                     // Leave the user with no salt, so prior hash can be validated/upgraded | ||||
|                     user | ||||
|             | _ -> user | ||||
|         match saltedUser with | ||||
|         | Some u -> | ||||
|             let updatedUser = model.PopulateUser u (pbkdf2Hash (Option.get u.Salt)) | ||||
|         match user with | ||||
|         | Some usr -> | ||||
|             let hasher      = PrayerTrackerPasswordHasher () | ||||
|             let updatedUser = model.PopulateUser usr (fun pw -> hasher.HashPassword (usr, pw)) | ||||
|             updatedUser |> if model.IsNew then ctx.Db.AddEntry else ctx.Db.UpdateEntry | ||||
|             let! _ = ctx.Db.SaveChangesAsync () | ||||
|             let  s = Views.I18N.localizer.Force () | ||||
| @ -224,7 +240,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c | ||||
|                       |> Some | ||||
|                 } | ||||
|                 |> addUserMessage ctx | ||||
|                 return! redirectTo false $"/user/{shortGuid u.Id.Value}/small-groups" next ctx | ||||
|                 return! redirectTo false $"/user/{shortGuid usr.Id.Value}/small-groups" next ctx | ||||
|             else | ||||
|                 addInfo ctx s["Successfully {0} user", s["Updated"].Value.ToLower ()] | ||||
|                 return! redirectTo false "/users" next ctx | ||||
|  | ||||
		Loading…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user