Use ASP.NET Core's password hasher (#39)

- Add migration for old-style passwords
- Remove unused database queries

src/PrayerTracker.Data/AppDbContext.fs

@@ -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

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<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))

src/PrayerTracker.UI/Resources/Common.es.resx

@@ -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:&lt;ul&gt;&lt;li&gt;The e-mail address “{0}” is invalid.&lt;/li&gt;&lt;li&gt;The password entered does not match the password for the given e-mail address.&lt;/li&gt;&lt;li&gt;You are not authorized to administer the group “{1}”.&lt;/li&gt;&lt;/ul&gt;" xml:space="preserve">
+  <data name="This is likely due to one of the following reasons:&lt;ul&gt;&lt;li&gt;The e-mail address “{0}” is invalid.&lt;/li&gt;&lt;li&gt;The password entered does not match the password for the given e-mail address.&lt;/li&gt;&lt;li&gt;You are not authorized to administer the selected group.&lt;/li&gt;&lt;/ul&gt;" xml:space="preserve">
-    <value>Esto es probablemente debido a una de las siguientes razones:&lt;ul&gt;&lt;li&gt;La dirección de correo electrónico “{0}” no es válida.&lt;/li&gt;&lt;li&gt;La contraseña introducida no coincide con la contraseña de la determinada dirección de correo electrónico.&lt;/li&gt;&lt;li&gt;Usted no está autorizado para administrar el grupo “{1}”.&lt;/li&gt;&lt;/ul&gt;</value>
+    <value>Esto es probablemente debido a una de las siguientes razones:&lt;ul&gt;&lt;li&gt;La dirección de correo electrónico “{0}” no es válida.&lt;/li&gt;&lt;li&gt;La contraseña introducida no coincide con la contraseña de la determinada dirección de correo electrónico.&lt;/li&gt;&lt;li&gt;Usted no está autorizado para administrar el grupo seleccionado.&lt;/li&gt;&lt;/ul&gt;</value>
   </data>
   <data name="This page loaded in {0:N3} seconds" xml:space="preserve">
     <value>Esta página cargada en {0:N3} segundos</value>

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

src/PrayerTracker/App.fs

@@ -213,11 +213,43 @@ 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 ()
+        let app =
             WebHostBuilder()
                 .UseContentRoot(contentRoot)
                 .ConfigureAppConfiguration(Configure.configuration)
@@ -227,5 +259,8 @@ module App =
                 .ConfigureLogging(Configure.logging)
                 .Configure(System.Action<IApplicationBuilder> Configure.app)
                 .Build()
-            .Run ()
+        if args.Length > 0 then
+            if args[0] = "migrate-passwords" then migratePasswords app
+            else printfn $"Unrecognized option {args[0]}"
+        else app.Run ()
         0

src/PrayerTracker/SmallGroup.fs

@@ -107,10 +107,11 @@ 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 (
-            let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
+                Seq.singleton (Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value)),
-            do! ctx.SignInAsync
+                CookieAuthenticationDefaults.AuthenticationScheme)
-                    (identity.AuthenticationType, ClaimsPrincipal identity,
+            do! ctx.SignInAsync (
+                    identity.AuthenticationType, ClaimsPrincipal identity,
                     AuthenticationProperties (
                         IssuedUtc    = DateTimeOffset.UtcNow,
                         IsPersistent = defaultArg model.RememberMe false))

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
+/// Password hashing implementation extending ASP.NET Core's identity implementation
-// If the hashes do not match, determine if it matches a previous scheme, and upgrade them if it does
+[<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 ->
+    | Some user ->
-        // Already upgraded; match = success
+        let hasher = PrayerTrackerPasswordHasher ()
-        let pwHash = pbkdf2Hash (Option.get u.Salt) model.Password
+        match hasher.VerifyHashedPassword (user, user.PasswordHash, model.Password) with
-        if u.PasswordHash = pwHash then
+        | PasswordVerificationResult.Success -> return bareUser user
-            return Some { u with PasswordHash = ""; Salt = None; SmallGroups = List<UserSmallGroup>() }
+        | PasswordVerificationResult.SuccessRehashNeeded ->
-        else return None
+            db.UpdateEntry { user with PasswordHash = hasher.HashPassword (user, model.Password) }
-    | 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 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  hasher = PrayerTrackerPasswordHasher ()
-        let  group  = ctx.Session.CurrentGroup.Value
+        let! user   = task {
-        let! user   =
+            match! ctx.Db.TryUserById curUsr.Id with
-            match dbUsr with
             | Some usr ->
-                // Check the old password against a possibly non-salted hash
+                if hasher.VerifyHashedPassword (usr, usr.PasswordHash, model.OldPassword)
-                (match usr.Salt with Some salt -> pbkdf2Hash salt | None -> sha1Hash) model.OldPassword
+                       = PasswordVerificationResult.Success then
-                |> ctx.Db.TryUserLogOnByCookie curUsr.Id group.Id
+                    return Some usr
-            | _ -> Task.FromResult None
+                else return None
+            | _ -> return None
+        }
         match user with
-        | Some _ when model.NewPassword = model.NewPasswordConfirm ->
+        | Some usr when model.NewPassword = model.NewPasswordConfirm ->
-            match dbUsr with
+            ctx.Db.UpdateEntry { usr with PasswordHash = hasher.HashPassword (usr, model.NewPassword) }
-            | 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"]
             return! redirectTo false "/" next ctx
         | Some _ ->
             addError ctx s["The new passwords did not match - your password was NOT changed"]
@@ -91,54 +129,40 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr
     match! ctx.TryBindFormAsync<UserLogOn> () with
     | Ok model -> 
         let s = Views.I18N.localizer.Force ()
-        let! usr = findUserByPassword model ctx.Db
+        match! findUserByPassword model ctx.Db with
+        | Some user ->
             match! ctx.Db.TryGroupById (idFromShort SmallGroupId model.SmallGroupId) with
             | Some group ->
-            let! nextUrl = backgroundTask {
+                ctx.Session.CurrentUser  <- Some user
-                match usr with
-                | Some user ->
-                    ctx.Session.CurrentUser  <- usr
                 ctx.Session.CurrentGroup <- Some group
-                    let claims = seq {
+                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")
+                    }, CookieAuthenticationDefaults.AuthenticationScheme)
-                    }
+                do! ctx.SignInAsync (
-                    let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
+                        identity.AuthenticationType, ClaimsPrincipal identity,
-                    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
+                return! redirectTo false (sanitizeUrl model.RedirectUrl "/small-group") next ctx
-                        match model.RedirectUrl with
+            | None -> return! fourOhFour ctx
-                        | None -> "/small-group"
+        | None ->
-                        | 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
+                    let detail =
-                                ":<ul><li>"
+                        [   "This is likely due to one of the following reasons:<ul>"
-                                s["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode model.Email].Value
+                            "<li>The e-mail address “{0}” is invalid.</li>"
-                                "</li><li>"
+                            "<li>The password entered does not match the password for the given e-mail address.</li>"
-                                s["The password entered does not match the password for the given e-mail address."].Value
+                            "<li>You are not authorized to administer the selected group.</li></ul>"
-                                "</li><li>"
-                                s["You are not authorized to administer the group “{0}”.",
-                                    WebUtility.HtmlEncode group.Name].Value
-                                "</li></ul>"
                         ]
                         |> String.concat ""
-                            |> (HtmlString >> Some)
+                    Some (HtmlString (s[detail, WebUtility.HtmlEncode model.Email].Value))
             }
             |> addUserMessage ctx
-                    return "/user/log-on"
+            return! redirectTo false "/user/log-on" next ctx
-            }
-            return! redirectTo false nextUrl next ctx
-        | None -> return! fourOhFour 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 ->
+        | Some usr ->
-                match u.Salt with
+            let hasher      = PrayerTrackerPasswordHasher ()
-                | None when model.Password <> "" ->
+            let updatedUser = model.PopulateUser usr (fun pw -> hasher.HashPassword (usr, pw))
-                    // 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))
             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