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<Instant>       "created_on"

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)
+        "@id",            Sql.string       (WebLogUserId.toString user.Id)
-        "@webLogId",      Sql.string            (WebLogId.toString user.WebLogId)
+        "@webLogId",      Sql.string       (WebLogId.toString user.WebLogId)
-        "@email",         Sql.string            user.Email
+        "@email",         Sql.string       user.Email
-        "@firstName",     Sql.string            user.FirstName
+        "@firstName",     Sql.string       user.FirstName
-        "@lastName",      Sql.string            user.LastName
+        "@lastName",      Sql.string       user.LastName
-        "@preferredName", Sql.string            user.PreferredName
+        "@preferredName", Sql.string       user.PreferredName
-        "@passwordHash",  Sql.string            user.PasswordHash
+        "@passwordHash",  Sql.string       user.PasswordHash
-        "@salt",          Sql.uuid              user.Salt
+        "@url",           Sql.stringOrNone user.Url
-        "@url",           Sql.stringOrNone      user.Url
+        "@accessLevel",   Sql.string       (AccessLevel.toString user.AccessLevel)
-        "@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,

src/MyWebLog.Data/PostgresData.fs

@@ -93,7 +93,6 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, 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<PostgresData>, 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}')"
         }
         

src/MyWebLog.Data/RethinkDbData.fs

@@ -1132,7 +1132,6 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                         nameof user.LastName,      user.LastName
                         nameof user.PreferredName, user.PreferredName
                         nameof user.PasswordHash,  user.PasswordHash
-                        nameof user.Salt,          user.Salt
                         nameof user.Url,           user.Url
                         nameof user.AccessLevel,   user.AccessLevel
                         ]

src/MyWebLog.Data/SQLite/Helpers.fs

@@ -303,7 +303,6 @@ module Map =
             LastName      = getString  "last_name"      rdr
             PreferredName = getString  "preferred_name" rdr
             PasswordHash  = getString  "password_hash"  rdr
-            Salt          = getGuid    "salt"           rdr
             Url           = tryString  "url"            rdr
             AccessLevel   = getString  "access_level"   rdr |> AccessLevel.parse
             CreatedOn     = getInstant "created_on"     rdr

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,

src/MyWebLog.Data/SQLiteData.fs

@@ -97,7 +97,6 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, 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<SQLiteData>, ser : JsonS
         conn.Close ()
         conn.Open ()
         
-        logStep "Dropping old tables"
+        logStep "Dropping old tables and columns"
         cmd.CommandText <-
-            "DROP TABLE post_episode;
+            "ALTER TABLE web_log_user DROP COLUMN salt;
-             DROP TABLE post_meta;
+             DROP  TABLE post_episode;
-             DROP TABLE page_meta;
+             DROP  TABLE post_meta;
-             DROP TABLE web_log_feed_podcast"
+             DROP  TABLE page_meta;
+             DROP  TABLE web_log_feed_podcast"
         do! write cmd
         
         logStep "Setting database version to v2-rc2"

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

src/MyWebLog/Handlers/User.fs

@@ -2,20 +2,32 @@
 module MyWebLog.Handlers.User
 
 open System
-open System.Security.Cryptography
+open Microsoft.AspNetCore.Http
-open System.Text
+open Microsoft.AspNetCore.Identity
+open MyWebLog
 open NodaTime
 
 // ~~ LOG ON / LOG OFF ~~
 
-/// Hash a password for a given user
+/// Create a password hash a password for a given user
-let hashedPassword (plainText : string) (email : string) (salt : Guid) =
+let createPasswordHash user password =
-    let allSalt = Array.concat [ salt.ToByteArray (); Encoding.UTF8.GetBytes email ] 
+    PasswordHasher<WebLogUser>().HashPassword (user, password)
-    use alg     = new Rfc2898DeriveBytes (plainText, allSalt, 2_048)
+
-    Convert.ToBase64String (alg.GetBytes 64)
+/// Verify whether a password is valid
+let verifyPassword user password (ctx : HttpContext) = backgroundTask {
+    match user with
+    | Some usr ->
+        let hasher = PasswordHasher<WebLogUser> ()
+        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<LogOnModel> ()
+    let! model   = ctx.BindFormAsync<LogOnModel> ()
-    let  data  = ctx.Data
+    let  data    = ctx.Data
-    match! data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id with 
+    let! tryUser = data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id
-    | Some user when user.PasswordHash = hashedPassword model.Password user.Email user.Salt ->
+    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
-    | _ ->
+    | Error msg ->
-        do! addMessage ctx { UserMessage.error with Message = "Log on attempt unsuccessful" }
+        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 =
+        let pw = if model.NewPassword = "" then user.PasswordHash else createPasswordHash user model.NewPassword
-            if model.NewPassword = "" then
-                user.PasswordHash, user.Salt
-            else
-                let newSalt = Guid.NewGuid ()
-                hashedPassword model.NewPassword user.Email newSalt, newSalt
         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
+                else { updatedUser with PasswordHash = createPasswordHash updatedUser model.Password }
-                    let salt = Guid.NewGuid ()
-                    { updatedUser with PasswordHash = hashedPassword model.Password model.Email salt; Salt = salt }
             do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate
             do! addMessage ctx
                     { UserMessage.success with

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  = Noda.now ()
-    let now  = SystemClock.Instance.GetCurrentInstant ()
+    let user =
-    
+        { WebLogUser.empty with
-    do! data.WebLogUser.Add 
+            Id            = userId
-            { WebLogUser.empty with
+            WebLogId      = webLogId
-                Id            = userId
+            Email         = args[3]
-                WebLogId      = webLogId
+            FirstName     = "Admin"
-                Email         = args[3]
+            LastName      = "User"
-                FirstName     = "Admin"
+            PreferredName = "Admin"
-                LastName      = "User"
+            AccessLevel   = accessLevel
-                PreferredName = "Admin"
+            CreatedOn     = now
-                PasswordHash  = Handlers.User.hashedPassword args[4] args[3] salt
+        }
-                Salt          = salt
+    do! data.WebLogUser.Add { user with PasswordHash = Handlers.User.createPasswordHash user args[4] }
-                AccessLevel   = accessLevel
-                CreatedOn     = now
-            }
 
     // Create the default home page
     do! data.Page.Add
@@ -71,8 +68,8 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
                 UpdatedOn   = now
                 Text        = "<p>This is your default home page.</p>"
                 Revisions   = [
-                    { AsOf = now
+                    {   AsOf = now
-                      Text = Html "<p>This is your default home page.</p>"
+                        Text = Html "<p>This is your default home page.</p>"
                     }
                 ]
             }
@@ -491,3 +488,22 @@ let upgradeUser (args : string[]) (sp : IServiceProvider) = task {
     | 3 -> do! doUserUpgrade args[1] args[2] (sp.GetRequiredService<IData> ())
     | _ -> 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<IData> ())
+    | _ -> eprintfn "Usage: myWebLog set-password [web-log-url-base] [email-address] [password]"
+}

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:"""