From a4913615fe676b152df52e2b9ccaca7b75904063 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sun, 21 Aug 2022 17:15:02 -0400 Subject: [PATCH] Convert to ASP.NET password hashing --- src/MyWebLog.Data/Postgres/PostgresHelpers.fs | 1 - .../Postgres/PostgresWebLogUserData.fs | 24 ++++----- src/MyWebLog.Data/PostgresData.fs | 3 +- src/MyWebLog.Data/RethinkDbData.fs | 1 - src/MyWebLog.Data/SQLite/Helpers.fs | 1 - .../SQLite/SQLiteWebLogUserData.fs | 6 +-- src/MyWebLog.Data/SQLiteData.fs | 12 ++--- src/MyWebLog.Domain/DataTypes.fs | 4 -- src/MyWebLog/Handlers/User.fs | 54 ++++++++++--------- src/MyWebLog/Maintenance.fs | 52 +++++++++++------- src/MyWebLog/Program.fs | 2 + 11 files changed, 86 insertions(+), 74 deletions(-) diff --git a/src/MyWebLog.Data/Postgres/PostgresHelpers.fs b/src/MyWebLog.Data/Postgres/PostgresHelpers.fs index 32c90fb..4f289ab 100644 --- a/src/MyWebLog.Data/Postgres/PostgresHelpers.fs +++ b/src/MyWebLog.Data/Postgres/PostgresHelpers.fs @@ -233,7 +233,6 @@ module Map = LastName = row.string "last_name" PreferredName = row.string "preferred_name" PasswordHash = row.string "password_hash" - Salt = row.uuid "salt" Url = row.stringOrNone "url" AccessLevel = row.string "access_level" |> AccessLevel.parse CreatedOn = row.fieldValue "created_on" diff --git a/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs b/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs index 87d4f4b..333f5ec 100644 --- a/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs @@ -11,25 +11,24 @@ type PostgresWebLogUserData (conn : NpgsqlConnection) = /// The INSERT statement for a user let userInsert = "INSERT INTO web_log_user ( - id, web_log_id, email, first_name, last_name, preferred_name, password_hash, salt, url, access_level, + id, web_log_id, email, first_name, last_name, preferred_name, password_hash, url, access_level, created_on, last_seen_on ) VALUES ( - @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel, + @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @url, @accessLevel, @createdOn, @lastSeenOn )" /// Parameters for saving web log users let userParams (user : WebLogUser) = [ - "@id", Sql.string (WebLogUserId.toString user.Id) - "@webLogId", Sql.string (WebLogId.toString user.WebLogId) - "@email", Sql.string user.Email - "@firstName", Sql.string user.FirstName - "@lastName", Sql.string user.LastName - "@preferredName", Sql.string user.PreferredName - "@passwordHash", Sql.string user.PasswordHash - "@salt", Sql.uuid user.Salt - "@url", Sql.stringOrNone user.Url - "@accessLevel", Sql.string (AccessLevel.toString user.AccessLevel) + "@id", Sql.string (WebLogUserId.toString user.Id) + "@webLogId", Sql.string (WebLogId.toString user.WebLogId) + "@email", Sql.string user.Email + "@firstName", Sql.string user.FirstName + "@lastName", Sql.string user.LastName + "@preferredName", Sql.string user.PreferredName + "@passwordHash", Sql.string user.PasswordHash + "@url", Sql.stringOrNone user.Url + "@accessLevel", Sql.string (AccessLevel.toString user.AccessLevel) typedParam "createdOn" user.CreatedOn optParam "lastSeenOn" user.LastSeenOn ] @@ -128,7 +127,6 @@ type PostgresWebLogUserData (conn : NpgsqlConnection) = last_name = @lastName, preferred_name = @preferredName, password_hash = @passwordHash, - salt = @salt, url = @url, access_level = @accessLevel, created_on = @createdOn, diff --git a/src/MyWebLog.Data/PostgresData.fs b/src/MyWebLog.Data/PostgresData.fs index 98df821..223efc5 100644 --- a/src/MyWebLog.Data/PostgresData.fs +++ b/src/MyWebLog.Data/PostgresData.fs @@ -93,7 +93,6 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger, ser : J last_name TEXT NOT NULL, preferred_name TEXT NOT NULL, password_hash TEXT NOT NULL, - salt UUID NOT NULL, url TEXT, access_level TEXT NOT NULL, created_on TIMESTAMPTZ NOT NULL, @@ -194,7 +193,7 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger, ser : J // Database version table if needsTable "db_version" then - "CREATE TABLE db_version (id TEXT NOT NULL PRIMARY KEY" + "CREATE TABLE db_version (id TEXT NOT NULL PRIMARY KEY)" $"INSERT INTO db_version VALUES ('{Utils.currentDbVersion}')" } diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index c5d7d91..475923d 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -1132,7 +1132,6 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger AccessLevel.parse CreatedOn = getInstant "created_on" rdr diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs index fd9ccd8..8eb8cd9 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs @@ -18,7 +18,6 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = cmd.Parameters.AddWithValue ("@lastName", user.LastName) cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName) cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash) - cmd.Parameters.AddWithValue ("@salt", user.Salt) cmd.Parameters.AddWithValue ("@url", maybe user.Url) cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel) cmd.Parameters.AddWithValue ("@createdOn", instantParam user.CreatedOn) @@ -32,10 +31,10 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = use cmd = conn.CreateCommand () cmd.CommandText <- "INSERT INTO web_log_user ( - id, web_log_id, email, first_name, last_name, preferred_name, password_hash, salt, url, access_level, + id, web_log_id, email, first_name, last_name, preferred_name, password_hash, url, access_level, created_on, last_seen_on ) VALUES ( - @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel, + @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @url, @accessLevel, @createdOn, @lastSeenOn )" addWebLogUserParameters cmd user @@ -134,7 +133,6 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = last_name = @lastName, preferred_name = @preferredName, password_hash = @passwordHash, - salt = @salt, url = @url, access_level = @accessLevel, created_on = @createdOn, diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index 3b33874..3c3bf91 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -97,7 +97,6 @@ type SQLiteData (conn : SqliteConnection, log : ILogger, ser : JsonS last_name TEXT NOT NULL, preferred_name TEXT NOT NULL, password_hash TEXT NOT NULL, - salt TEXT NOT NULL, url TEXT, access_level TEXT NOT NULL, created_on TEXT NOT NULL, @@ -517,12 +516,13 @@ type SQLiteData (conn : SqliteConnection, log : ILogger, ser : JsonS conn.Close () conn.Open () - logStep "Dropping old tables" + logStep "Dropping old tables and columns" cmd.CommandText <- - "DROP TABLE post_episode; - DROP TABLE post_meta; - DROP TABLE page_meta; - DROP TABLE web_log_feed_podcast" + "ALTER TABLE web_log_user DROP COLUMN salt; + DROP TABLE post_episode; + DROP TABLE post_meta; + DROP TABLE page_meta; + DROP TABLE web_log_feed_podcast" do! write cmd logStep "Setting database version to v2-rc2" diff --git a/src/MyWebLog.Domain/DataTypes.fs b/src/MyWebLog.Domain/DataTypes.fs index 42f9793..87b9a1c 100644 --- a/src/MyWebLog.Domain/DataTypes.fs +++ b/src/MyWebLog.Domain/DataTypes.fs @@ -442,9 +442,6 @@ type WebLogUser = /// The hash of the user's password PasswordHash : string - /// Salt used to calculate the user's password hash - Salt : Guid - /// The URL of the user's personal site Url : string option @@ -470,7 +467,6 @@ module WebLogUser = LastName = "" PreferredName = "" PasswordHash = "" - Salt = Guid.Empty Url = None AccessLevel = Author CreatedOn = Noda.epoch diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index bbfd4ee..6a67a61 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -2,20 +2,32 @@ module MyWebLog.Handlers.User open System -open System.Security.Cryptography -open System.Text +open Microsoft.AspNetCore.Http +open Microsoft.AspNetCore.Identity +open MyWebLog open NodaTime // ~~ LOG ON / LOG OFF ~~ -/// Hash a password for a given user -let hashedPassword (plainText : string) (email : string) (salt : Guid) = - let allSalt = Array.concat [ salt.ToByteArray (); Encoding.UTF8.GetBytes email ] - use alg = new Rfc2898DeriveBytes (plainText, allSalt, 2_048) - Convert.ToBase64String (alg.GetBytes 64) +/// Create a password hash a password for a given user +let createPasswordHash user password = + PasswordHasher().HashPassword (user, password) + +/// Verify whether a password is valid +let verifyPassword user password (ctx : HttpContext) = backgroundTask { + match user with + | Some usr -> + let hasher = PasswordHasher () + match hasher.VerifyHashedPassword (usr, usr.PasswordHash, password) with + | PasswordVerificationResult.Success -> return Ok () + | PasswordVerificationResult.SuccessRehashNeeded -> + do! ctx.Data.WebLogUser.Update { usr with PasswordHash = hasher.HashPassword (usr, password) } + return Ok () + | _ -> return Error "Log on attempt unsuccessful" + | None -> return Error "Log on attempt unsuccessful" +} open Giraffe -open MyWebLog open MyWebLog.ViewModels // GET /user/log-on @@ -36,10 +48,12 @@ open Microsoft.AspNetCore.Authentication.Cookies // POST /user/log-on let doLogOn : HttpHandler = fun next ctx -> task { - let! model = ctx.BindFormAsync () - let data = ctx.Data - match! data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id with - | Some user when user.PasswordHash = hashedPassword model.Password user.Email user.Salt -> + let! model = ctx.BindFormAsync () + let data = ctx.Data + let! tryUser = data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id + match! verifyPassword tryUser model.Password ctx with + | Ok _ -> + let user = tryUser.Value let claims = seq { Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id) Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}") @@ -60,8 +74,8 @@ let doLogOn : HttpHandler = fun next ctx -> task { match model.ReturnTo with | Some url -> redirectTo false url next ctx | None -> redirectToGet "admin/dashboard" next ctx - | _ -> - do! addMessage ctx { UserMessage.error with Message = "Log on attempt unsuccessful" } + | Error msg -> + do! addMessage ctx { UserMessage.error with Message = msg } return! logOn model.ReturnTo next ctx } @@ -167,19 +181,13 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task { let data = ctx.Data match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with | Some user when model.NewPassword = model.NewPasswordConfirm -> - let pw, salt = - if model.NewPassword = "" then - user.PasswordHash, user.Salt - else - let newSalt = Guid.NewGuid () - hashedPassword model.NewPassword user.Email newSalt, newSalt + let pw = if model.NewPassword = "" then user.PasswordHash else createPasswordHash user model.NewPassword let user = { user with FirstName = model.FirstName LastName = model.LastName PreferredName = model.PreferredName PasswordHash = pw - Salt = salt } do! data.WebLogUser.Update user let pwMsg = if model.NewPassword = "" then "" else " and updated your password" @@ -214,9 +222,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { else let toUpdate = if model.Password = "" then updatedUser - else - let salt = Guid.NewGuid () - { updatedUser with PasswordHash = hashedPassword model.Password model.Email salt; Salt = salt } + else { updatedUser with PasswordHash = createPasswordHash updatedUser model.Password } do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate do! addMessage ctx { UserMessage.success with diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 9fb32d8..544de4f 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -42,22 +42,19 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { } // Create the admin user - let salt = Guid.NewGuid () - let now = SystemClock.Instance.GetCurrentInstant () - - do! data.WebLogUser.Add - { WebLogUser.empty with - Id = userId - WebLogId = webLogId - Email = args[3] - FirstName = "Admin" - LastName = "User" - PreferredName = "Admin" - PasswordHash = Handlers.User.hashedPassword args[4] args[3] salt - Salt = salt - AccessLevel = accessLevel - CreatedOn = now - } + let now = Noda.now () + let user = + { WebLogUser.empty with + Id = userId + WebLogId = webLogId + Email = args[3] + FirstName = "Admin" + LastName = "User" + PreferredName = "Admin" + AccessLevel = accessLevel + CreatedOn = now + } + do! data.WebLogUser.Add { user with PasswordHash = Handlers.User.createPasswordHash user args[4] } // Create the default home page do! data.Page.Add @@ -71,8 +68,8 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { UpdatedOn = now Text = "

This is your default home page.

" Revisions = [ - { AsOf = now - Text = Html "

This is your default home page.

" + { AsOf = now + Text = Html "

This is your default home page.

" } ] } @@ -491,3 +488,22 @@ let upgradeUser (args : string[]) (sp : IServiceProvider) = task { | 3 -> do! doUserUpgrade args[1] args[2] (sp.GetRequiredService ()) | _ -> eprintfn "Usage: myWebLog upgrade-user [web-log-url-base] [email-address]" } + +/// Set a user's password +let doSetPassword urlBase email password (data : IData) = task { + match! data.WebLog.FindByHost urlBase with + | Some webLog -> + match! data.WebLogUser.FindByEmail email webLog.Id with + | Some user -> + do! data.WebLogUser.Update { user with PasswordHash = Handlers.User.createPasswordHash user password } + printfn $"Password for user {email} at {webLog.Name} set successfully" + | None -> eprintfn $"ERROR: no user {email} found at {urlBase}" + | None -> eprintfn $"ERROR: no web log found for {urlBase}" +} + +/// Set a user's password if the command-line arguments are good +let setPassword (args : string[]) (sp : IServiceProvider) = task { + match args.Length with + | 4 -> do! doSetPassword args[1] args[2] args[3] (sp.GetRequiredService ()) + | _ -> eprintfn "Usage: myWebLog set-password [web-log-url-base] [email-address] [password]" +} diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 0aa0d85..a9fecf4 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -85,6 +85,7 @@ let showHelp () = printfn "init Initializes a new web log" printfn "load-theme Load a theme" printfn "restore Restore a JSON file backup (prompt before overwriting)" + printfn "set-password Set a password for a specific user" printfn "upgrade-user Upgrade a WebLogAdmin user to a full Administrator" printfn " " printfn "For more information on a particular command, run it with no options." @@ -183,6 +184,7 @@ let rec main args = | Some it when it = "restore" -> Maintenance.Backup.restoreFromBackup args app.Services | Some it when it = "do-restore" -> Maintenance.Backup.restoreFromBackup args app.Services | Some it when it = "upgrade-user" -> Maintenance.upgradeUser args app.Services + | Some it when it = "set-password" -> Maintenance.setPassword args app.Services | Some it when it = "help" -> showHelp () | Some it -> printfn $"""Unrecognized command "{it}" - valid commands are:"""