v2 RC2 #33
|
@ -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"
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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}')"
|
||||
}
|
||||
|
||||
|
|
|
@ -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
|
||||
]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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;
|
||||
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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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<WebLogUser>().HashPassword (user, password)
|
||||
|
||||
/// 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 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<LogOnModel> ()
|
||||
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
|
||||
|
|
|
@ -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 = "<p>This is your default home page.</p>"
|
||||
Revisions = [
|
||||
{ AsOf = now
|
||||
Text = Html "<p>This is your default home page.</p>"
|
||||
{ AsOf = now
|
||||
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]"
|
||||
}
|
||||
|
|
|
@ -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:"""
|
||||
|
|
Loading…
Reference in New Issue
Block a user