bit-badger/myWebLog
1
0
Fork 0
Code Issues 4 Pull Requests Packages Projects Releases 11 Activity

v2 RC2 #33

Merged
danieljsummers merged 13 commits from add-pgsql into main 2022-08-21 22:56:18 +00:00
Conversation 0 Commits 13 Files Changed 45 +86 -74
11 changed files with 86 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit a4913615fe - Show all commits

1
src/MyWebLog.Data/Postgres/PostgresHelpers.fs
View File

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

24
src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs
View File

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

3
src/MyWebLog.Data/PostgresData.fs
View File

@ -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}')"
}

1
src/MyWebLog.Data/RethinkDbData.fs
View File

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

1
src/MyWebLog.Data/SQLite/Helpers.fs
View File

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

6
src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs
View File

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

12
src/MyWebLog.Data/SQLiteData.fs
View File

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

4
src/MyWebLog.Domain/DataTypes.fs
View File

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

54
src/MyWebLog/Handlers/User.fs
View File

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

52
src/MyWebLog/Maintenance.fs
View File

@ -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]"
}

2
src/MyWebLog/Program.fs
View File

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