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

v2 RC2 (#33)

Browse Source 
* Add PostgreSQL back end (#30)
* Upgrade password storage (#32)
* Change podcast/episode storage for SQLite (#29)
* Move date/time handling to NodaTime (#31)
This commit was merged in pull request #33.
This commit is contained in:
Daniel J. Summers
2022-08-21 18:56:18 -04:00
committed by GitHub
parent 1ec664ad24
commit 5f3daa1de9
45 changed files with 3820 additions and 1306 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/MyWebLog/Handlers/User.fs
+37 -29
View File
@@ -2,19 +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
@@ -35,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}")
@@ -59,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
}
@@ -147,7 +162,9 @@ let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandl
|> addToHash ViewContext.Model model
|> addToHash "access_level" (AccessLevel.toString user.AccessLevel)
|> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn)
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog (defaultArg user.LastSeenOn DateTime.UnixEpoch))
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog
(defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
|> adminView "my-info" next ctx
@@ -164,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"
@@ -198,9 +209,9 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let tryUser =
if model.IsNew then
{ WebLogUser.empty with
Id = WebLogUserId.create ()
WebLogId = ctx.WebLog.Id
CreatedOn = DateTime.UtcNow
Id = WebLogUserId.create ()
WebLogId = ctx.WebLog.Id
CreatedOn = Noda.now ()
} |> someTask
else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
match! tryUser with
@@ -211,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
@@ -227,4 +236,3 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
next ctx
| None -> return! Error.notFound next ctx
}