diff --git a/src/PrayerTracker.Data/AppDbContext.fs b/src/PrayerTracker.Data/AppDbContext.fs index e095a33..da8cb3a 100644 --- a/src/PrayerTracker.Data/AppDbContext.fs +++ b/src/PrayerTracker.Data/AppDbContext.fs @@ -65,10 +65,6 @@ type AppDbContext (options : DbContextOptions) = 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 diff --git a/src/PrayerTracker.Data/DataAccess.fs b/src/PrayerTracker.Data/DataAccess.fs index 870701c..9d5e7cd 100644 --- a/src/PrayerTracker.Data/DataAccess.fs +++ b/src/PrayerTracker.Data/DataAccess.fs @@ -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() } - 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)) diff --git a/src/PrayerTracker.UI/Resources/Common.es.resx b/src/PrayerTracker.UI/Resources/Common.es.resx index dd12103..4ad4283 100644 --- a/src/PrayerTracker.UI/Resources/Common.es.resx +++ b/src/PrayerTracker.UI/Resources/Common.es.resx @@ -417,8 +417,8 @@ No hay clases con contraseñas se define - - 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> + + 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> Esta página cargada en {0:N3} segundos diff --git a/src/PrayerTracker.UI/Utils.fs b/src/PrayerTracker.UI/Utils.fs index b68e28b..c904b4e 100644 --- a/src/PrayerTracker.UI/Utils.fs +++ b/src/PrayerTracker.UI/Utils.fs @@ -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 diff --git a/src/PrayerTracker/App.fs b/src/PrayerTracker/App.fs index c7e7e12..56456a5 100644 --- a/src/PrayerTracker/App.fs +++ b/src/PrayerTracker/App.fs @@ -49,9 +49,9 @@ module Configure = let _ = svc.Configure(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() + 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 [] - 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 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 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 diff --git a/src/PrayerTracker/SmallGroup.fs b/src/PrayerTracker/SmallGroup.fs index 86bb20e..f504efa 100644 --- a/src/PrayerTracker/SmallGroup.fs +++ b/src/PrayerTracker/SmallGroup.fs @@ -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 -> diff --git a/src/PrayerTracker/User.fs b/src/PrayerTracker/User.fs index bc6d31e..a130317 100644 --- a/src/PrayerTracker/User.fs +++ b/src/PrayerTracker/User.fs @@ -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 +[] +module Hashing = + + open System.Security.Cryptography + open System.Text + + /// Custom password hasher used to verify and upgrade old password hashes + type PrayerTrackerPasswordHasher () = + inherit PasswordHasher () + + 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() } 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() } - 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() } - | _ -> 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 () 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 - ":
  • " - s["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode model.Email].Value - "
  • " - s["The password entered does not match the password for the given e-mail address."].Value - "
  • " - s["You are not authorized to administer the group “{0}”.", - WebUtility.HtmlEncode group.Name].Value - "
" - ] - |> 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:
    " + "
  • The e-mail address “{0}” is invalid.
    • " + "
  • The password entered does not match the password for the given e-mail address.
    • " + "
  • You are not authorized to administer the selected group.
" + ] + |> 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 () 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