Version 8 #43
|
@ -65,10 +65,6 @@ type AppDbContext (options : DbContextOptions<AppDbContext>) =
|
||||||
with get() = this.userGroupXref
|
with get() = this.userGroupXref
|
||||||
and set v = this.userGroupXref <- v
|
and set v = this.userGroupXref <- v
|
||||||
|
|
||||||
/// F#-style async for saving changes
|
|
||||||
member this.AsyncSaveChanges () =
|
|
||||||
this.SaveChangesAsync () |> Async.AwaitTask
|
|
||||||
|
|
||||||
override _.OnConfiguring (optionsBuilder : DbContextOptionsBuilder) =
|
override _.OnConfiguring (optionsBuilder : DbContextOptionsBuilder) =
|
||||||
base.OnConfiguring optionsBuilder
|
base.OnConfiguring optionsBuilder
|
||||||
optionsBuilder.UseQueryTrackingBehavior QueryTrackingBehavior.NoTracking |> ignore
|
optionsBuilder.UseQueryTrackingBehavior QueryTrackingBehavior.NoTracking |> ignore
|
||||||
|
|
|
@ -25,7 +25,6 @@ module private Helpers =
|
||||||
|
|
||||||
|
|
||||||
open System
|
open System
|
||||||
open System.Collections.Generic
|
|
||||||
open Microsoft.EntityFrameworkCore
|
open Microsoft.EntityFrameworkCore
|
||||||
open Microsoft.FSharpLu
|
open Microsoft.FSharpLu
|
||||||
|
|
||||||
|
@ -198,13 +197,6 @@ type AppDbContext with
|
||||||
| _ -> return None
|
| _ -> return None
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Check a cookie log on for a small group
|
|
||||||
member this.TryGroupLogOnByCookie groupId pwHash (hasher : string -> string) = backgroundTask {
|
|
||||||
match! this.TryGroupById groupId with
|
|
||||||
| None -> return None
|
|
||||||
| Some grp -> return if pwHash = hasher grp.Preferences.GroupPassword then Some grp else None
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Count small groups for the given church Id
|
/// Count small groups for the given church Id
|
||||||
member this.CountGroupsByChurch churchId = backgroundTask {
|
member this.CountGroupsByChurch churchId = backgroundTask {
|
||||||
return! this.SmallGroups.CountAsync (fun sg -> sg.ChurchId = churchId)
|
return! this.SmallGroups.CountAsync (fun sg -> sg.ChurchId = churchId)
|
||||||
|
@ -212,12 +204,6 @@ type AppDbContext with
|
||||||
|
|
||||||
(*-- TIME ZONE EXTENSIONS --*)
|
(*-- TIME ZONE EXTENSIONS --*)
|
||||||
|
|
||||||
/// Get a time zone by its Id
|
|
||||||
member this.TryTimeZoneById tzId = backgroundTask {
|
|
||||||
let! zone = this.TimeZones.SingleOrDefaultAsync (fun tz -> tz.Id = tzId)
|
|
||||||
return Option.fromObject zone
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Get all time zones
|
/// Get all time zones
|
||||||
member this.AllTimeZones () = backgroundTask {
|
member this.AllTimeZones () = backgroundTask {
|
||||||
let! zones = this.TimeZones.OrderBy(fun tz -> tz.SortOrder).ToListAsync ()
|
let! zones = this.TimeZones.OrderBy(fun tz -> tz.SortOrder).ToListAsync ()
|
||||||
|
@ -258,26 +244,6 @@ type AppDbContext with
|
||||||
return users |> List.map (fun u -> { Member.empty with Email = u.Email; Name = u.Name })
|
return users |> List.map (fun u -> { Member.empty with Email = u.Email; Name = u.Name })
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Find a user based on their credentials
|
|
||||||
member this.TryUserLogOnByPassword email pwHash groupId = backgroundTask {
|
|
||||||
let! usr =
|
|
||||||
this.Users.SingleOrDefaultAsync (fun u ->
|
|
||||||
u.Email = email
|
|
||||||
&& u.PasswordHash = pwHash
|
|
||||||
&& u.SmallGroups.Any (fun xref -> xref.SmallGroupId = groupId))
|
|
||||||
return Option.fromObject usr
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Find a user based on credentials stored in a cookie
|
|
||||||
member this.TryUserLogOnByCookie uId gId pwHash = backgroundTask {
|
|
||||||
match! this.TryUserByIdWithGroups uId with
|
|
||||||
| None -> return None
|
|
||||||
| Some usr ->
|
|
||||||
if pwHash = usr.PasswordHash && usr.SmallGroups |> Seq.exists (fun xref -> xref.SmallGroupId = gId) then
|
|
||||||
return Some { usr with PasswordHash = ""; Salt = None; SmallGroups = List<UserSmallGroup>() }
|
|
||||||
else return None
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Count the number of users for a small group
|
/// Count the number of users for a small group
|
||||||
member this.CountUsersBySmallGroup groupId = backgroundTask {
|
member this.CountUsersBySmallGroup groupId = backgroundTask {
|
||||||
return! this.Users.CountAsync (fun u -> u.SmallGroups.Any (fun xref -> xref.SmallGroupId = groupId))
|
return! this.Users.CountAsync (fun u -> u.SmallGroups.Any (fun xref -> xref.SmallGroupId = groupId))
|
||||||
|
|
|
@ -417,8 +417,8 @@
|
||||||
<data name="There are no classes with passwords defined" xml:space="preserve">
|
<data name="There are no classes with passwords defined" xml:space="preserve">
|
||||||
<value>No hay clases con contraseñas se define</value>
|
<value>No hay clases con contraseñas se define</value>
|
||||||
</data>
|
</data>
|
||||||
<data name="This is likely due to one of the following reasons:<ul><li>The e-mail address “{0}” is invalid.</li><li>The password entered does not match the password for the given e-mail address.</li><li>You are not authorized to administer the group “{1}”.</li></ul>" xml:space="preserve">
|
<data name="This is likely due to one of the following reasons:<ul><li>The e-mail address “{0}” is invalid.</li><li>The password entered does not match the password for the given e-mail address.</li><li>You are not authorized to administer the selected group.</li></ul>" xml:space="preserve">
|
||||||
<value>Esto es probablemente debido a una de las siguientes razones:<ul><li>La dirección de correo electrónico “{0}” no es válida.</li><li>La contraseña introducida no coincide con la contraseña de la determinada dirección de correo electrónico.</li><li>Usted no está autorizado para administrar el grupo “{1}”.</li></ul></value>
|
<value>Esto es probablemente debido a una de las siguientes razones:<ul><li>La dirección de correo electrónico “{0}” no es válida.</li><li>La contraseña introducida no coincide con la contraseña de la determinada dirección de correo electrónico.</li><li>Usted no está autorizado para administrar el grupo seleccionado.</li></ul></value>
|
||||||
</data>
|
</data>
|
||||||
<data name="This page loaded in {0:N3} seconds" xml:space="preserve">
|
<data name="This page loaded in {0:N3} seconds" xml:space="preserve">
|
||||||
<value>Esta página cargada en {0:N3} segundos</value>
|
<value>Esta página cargada en {0:N3} segundos</value>
|
||||||
|
|
|
@ -5,18 +5,6 @@ open System
|
||||||
open System.Security.Cryptography
|
open System.Security.Cryptography
|
||||||
open System.Text
|
open System.Text
|
||||||
|
|
||||||
/// Hash a string with a SHA1 hash
|
|
||||||
let sha1Hash (x : string) =
|
|
||||||
use alg = SHA1.Create ()
|
|
||||||
alg.ComputeHash (Encoding.ASCII.GetBytes x)
|
|
||||||
|> Seq.map (fun chr -> chr.ToString "x2")
|
|
||||||
|> String.concat ""
|
|
||||||
|
|
||||||
/// Hash a string using 1,024 rounds of PBKDF2 and a salt
|
|
||||||
let pbkdf2Hash (salt : Guid) (x : string) =
|
|
||||||
use alg = new Rfc2898DeriveBytes (x, Encoding.UTF8.GetBytes (salt.ToString "N"), 1024)
|
|
||||||
(alg.GetBytes >> Convert.ToBase64String) 64
|
|
||||||
|
|
||||||
open Giraffe
|
open Giraffe
|
||||||
|
|
||||||
/// Parse a short-GUID-based ID from a string
|
/// Parse a short-GUID-based ID from a string
|
||||||
|
|
|
@ -49,9 +49,9 @@ module Configure =
|
||||||
let _ =
|
let _ =
|
||||||
svc.Configure<RequestLocalizationOptions>(fun (opts : RequestLocalizationOptions) ->
|
svc.Configure<RequestLocalizationOptions>(fun (opts : RequestLocalizationOptions) ->
|
||||||
let supportedCultures =[|
|
let supportedCultures =[|
|
||||||
CultureInfo "en-US"; CultureInfo "en-GB"; CultureInfo "en-AU"; CultureInfo "en"
|
CultureInfo "en-US"; CultureInfo "en-GB"; CultureInfo "en-AU"; CultureInfo "en"
|
||||||
CultureInfo "es-MX"; CultureInfo "es-ES"; CultureInfo "es"
|
CultureInfo "es-MX"; CultureInfo "es-ES"; CultureInfo "es"
|
||||||
|]
|
|]
|
||||||
opts.DefaultRequestCulture <- RequestCulture ("en-US", "en-US")
|
opts.DefaultRequestCulture <- RequestCulture ("en-US", "en-US")
|
||||||
opts.SupportedCultures <- supportedCultures
|
opts.SupportedCultures <- supportedCultures
|
||||||
opts.SupportedUICultures <- supportedCultures)
|
opts.SupportedUICultures <- supportedCultures)
|
||||||
|
@ -213,19 +213,54 @@ module Configure =
|
||||||
/// The web application
|
/// The web application
|
||||||
module App =
|
module App =
|
||||||
|
|
||||||
|
open System.Text
|
||||||
|
open Microsoft.EntityFrameworkCore
|
||||||
|
open Microsoft.Extensions.DependencyInjection
|
||||||
|
|
||||||
|
let migratePasswords (app : IWebHost) =
|
||||||
|
task {
|
||||||
|
use db = app.Services.GetService<AppDbContext>()
|
||||||
|
let! v1Users = db.Users.FromSqlRaw("SELECT * FROM pt.pt_user WHERE salt IS NULL").ToListAsync ()
|
||||||
|
for user in v1Users do
|
||||||
|
let pw =
|
||||||
|
[| 254uy
|
||||||
|
yield! (Encoding.UTF8.GetBytes user.PasswordHash)
|
||||||
|
|]
|
||||||
|
|> Convert.ToBase64String
|
||||||
|
db.UpdateEntry { user with PasswordHash = pw }
|
||||||
|
let! v1Count = db.SaveChangesAsync ()
|
||||||
|
printfn $"Updated {v1Count} users with version 1 password"
|
||||||
|
let! v2Users =
|
||||||
|
db.Users.FromSqlRaw("SELECT * FROM pt.pt_user WHERE salt IS NOT NULL").ToListAsync ()
|
||||||
|
for user in v2Users do
|
||||||
|
let pw =
|
||||||
|
[| 255uy
|
||||||
|
yield! (user.Salt.Value.ToByteArray ())
|
||||||
|
yield! (Encoding.UTF8.GetBytes user.PasswordHash)
|
||||||
|
|]
|
||||||
|
|> Convert.ToBase64String
|
||||||
|
db.UpdateEntry { user with PasswordHash = pw }
|
||||||
|
let! v2Count = db.SaveChangesAsync ()
|
||||||
|
printfn $"Updated {v2Count} users with version 2 password"
|
||||||
|
} |> Async.AwaitTask |> Async.RunSynchronously
|
||||||
|
|
||||||
open System.IO
|
open System.IO
|
||||||
|
|
||||||
[<EntryPoint>]
|
[<EntryPoint>]
|
||||||
let main _ =
|
let main args =
|
||||||
let contentRoot = Directory.GetCurrentDirectory ()
|
let contentRoot = Directory.GetCurrentDirectory ()
|
||||||
WebHostBuilder()
|
let app =
|
||||||
.UseContentRoot(contentRoot)
|
WebHostBuilder()
|
||||||
.ConfigureAppConfiguration(Configure.configuration)
|
.UseContentRoot(contentRoot)
|
||||||
.UseKestrel(Configure.kestrel)
|
.ConfigureAppConfiguration(Configure.configuration)
|
||||||
.UseWebRoot(Path.Combine (contentRoot, "wwwroot"))
|
.UseKestrel(Configure.kestrel)
|
||||||
.ConfigureServices(Configure.services)
|
.UseWebRoot(Path.Combine (contentRoot, "wwwroot"))
|
||||||
.ConfigureLogging(Configure.logging)
|
.ConfigureServices(Configure.services)
|
||||||
.Configure(System.Action<IApplicationBuilder> Configure.app)
|
.ConfigureLogging(Configure.logging)
|
||||||
.Build()
|
.Configure(System.Action<IApplicationBuilder> Configure.app)
|
||||||
.Run ()
|
.Build()
|
||||||
|
if args.Length > 0 then
|
||||||
|
if args[0] = "migrate-passwords" then migratePasswords app
|
||||||
|
else printfn $"Unrecognized option {args[0]}"
|
||||||
|
else app.Run ()
|
||||||
0
|
0
|
||||||
|
|
|
@ -107,13 +107,14 @@ let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validat
|
||||||
match! ctx.Db.TryGroupLogOnByPassword (idFromShort SmallGroupId model.SmallGroupId) model.Password with
|
match! ctx.Db.TryGroupLogOnByPassword (idFromShort SmallGroupId model.SmallGroupId) model.Password with
|
||||||
| Some group ->
|
| Some group ->
|
||||||
ctx.Session.CurrentGroup <- Some group
|
ctx.Session.CurrentGroup <- Some group
|
||||||
let claims = Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value) |> Seq.singleton
|
let identity = ClaimsIdentity (
|
||||||
let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
|
Seq.singleton (Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value)),
|
||||||
do! ctx.SignInAsync
|
CookieAuthenticationDefaults.AuthenticationScheme)
|
||||||
(identity.AuthenticationType, ClaimsPrincipal identity,
|
do! ctx.SignInAsync (
|
||||||
AuthenticationProperties (
|
identity.AuthenticationType, ClaimsPrincipal identity,
|
||||||
IssuedUtc = DateTimeOffset.UtcNow,
|
AuthenticationProperties (
|
||||||
IsPersistent = defaultArg model.RememberMe false))
|
IssuedUtc = DateTimeOffset.UtcNow,
|
||||||
|
IsPersistent = defaultArg model.RememberMe false))
|
||||||
addInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
|
addInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
|
||||||
return! redirectTo false "/prayer-requests/view" next ctx
|
return! redirectTo false "/prayer-requests/view" next ctx
|
||||||
| None ->
|
| None ->
|
||||||
|
|
|
@ -1,36 +1,78 @@
|
||||||
module PrayerTracker.Handlers.User
|
module PrayerTracker.Handlers.User
|
||||||
|
|
||||||
open System
|
open System
|
||||||
open System.Collections.Generic
|
|
||||||
open Giraffe
|
open Giraffe
|
||||||
open Microsoft.AspNetCore.Http
|
open Microsoft.AspNetCore.Http
|
||||||
|
open Microsoft.AspNetCore.Identity
|
||||||
open PrayerTracker
|
open PrayerTracker
|
||||||
open PrayerTracker.Entities
|
open PrayerTracker.Entities
|
||||||
open PrayerTracker.ViewModels
|
open PrayerTracker.ViewModels
|
||||||
|
|
||||||
/// Retrieve a user from the database by password
|
/// Password hashing implementation extending ASP.NET Core's identity implementation
|
||||||
// If the hashes do not match, determine if it matches a previous scheme, and upgrade them if it does
|
[<AutoOpen>]
|
||||||
|
module Hashing =
|
||||||
|
|
||||||
|
open System.Security.Cryptography
|
||||||
|
open System.Text
|
||||||
|
|
||||||
|
/// Custom password hasher used to verify and upgrade old password hashes
|
||||||
|
type PrayerTrackerPasswordHasher () =
|
||||||
|
inherit PasswordHasher<User> ()
|
||||||
|
|
||||||
|
override this.VerifyHashedPassword (user, hashedPassword, providedPassword) =
|
||||||
|
if isNull hashedPassword then nullArg (nameof hashedPassword)
|
||||||
|
if isNull providedPassword then nullArg (nameof providedPassword)
|
||||||
|
|
||||||
|
let hashBytes = Convert.FromBase64String hashedPassword
|
||||||
|
|
||||||
|
match hashBytes[0] with
|
||||||
|
| 255uy ->
|
||||||
|
// v2 hashes - PBKDF2 (RFC 2898), 1,024 rounds
|
||||||
|
if hashBytes.Length < 49 then PasswordVerificationResult.Failed
|
||||||
|
else
|
||||||
|
let v2Hash =
|
||||||
|
use alg = new Rfc2898DeriveBytes (
|
||||||
|
providedPassword, Encoding.UTF8.GetBytes ((Guid hashBytes[1..16]).ToString "N"), 1024)
|
||||||
|
(alg.GetBytes >> Convert.ToBase64String) 64
|
||||||
|
if Encoding.UTF8.GetString hashBytes[17..] = v2Hash then
|
||||||
|
PasswordVerificationResult.SuccessRehashNeeded
|
||||||
|
else PasswordVerificationResult.Failed
|
||||||
|
| 254uy ->
|
||||||
|
// v1 hashes - SHA-1
|
||||||
|
let v1Hash =
|
||||||
|
use alg = SHA1.Create ()
|
||||||
|
alg.ComputeHash (Encoding.ASCII.GetBytes providedPassword)
|
||||||
|
|> Seq.map (fun byt -> byt.ToString "x2")
|
||||||
|
|> String.concat ""
|
||||||
|
if Encoding.UTF8.GetString hashBytes[1..] = v1Hash then
|
||||||
|
PasswordVerificationResult.SuccessRehashNeeded
|
||||||
|
else
|
||||||
|
PasswordVerificationResult.Failed
|
||||||
|
| _ -> base.VerifyHashedPassword (user, hashedPassword, providedPassword)
|
||||||
|
|
||||||
|
|
||||||
|
/// Retrieve a user from the database by password, upgrading password hashes if required
|
||||||
let private findUserByPassword model (db : AppDbContext) = task {
|
let private findUserByPassword model (db : AppDbContext) = task {
|
||||||
|
let bareUser user = Some { user with PasswordHash = ""; SmallGroups = ResizeArray<UserSmallGroup>() }
|
||||||
match! db.TryUserByEmailAndGroup model.Email (idFromShort SmallGroupId model.SmallGroupId) with
|
match! db.TryUserByEmailAndGroup model.Email (idFromShort SmallGroupId model.SmallGroupId) with
|
||||||
| Some u when Option.isSome u.Salt ->
|
| Some user ->
|
||||||
// Already upgraded; match = success
|
let hasher = PrayerTrackerPasswordHasher ()
|
||||||
let pwHash = pbkdf2Hash (Option.get u.Salt) model.Password
|
match hasher.VerifyHashedPassword (user, user.PasswordHash, model.Password) with
|
||||||
if u.PasswordHash = pwHash then
|
| PasswordVerificationResult.Success -> return bareUser user
|
||||||
return Some { u with PasswordHash = ""; Salt = None; SmallGroups = List<UserSmallGroup>() }
|
| PasswordVerificationResult.SuccessRehashNeeded ->
|
||||||
else return None
|
db.UpdateEntry { user with PasswordHash = hasher.HashPassword (user, model.Password) }
|
||||||
| Some u when u.PasswordHash = sha1Hash model.Password ->
|
let! _ = db.SaveChangesAsync ()
|
||||||
// Not upgraded, but password is good; upgrade 'em!
|
return bareUser user
|
||||||
// Upgrade 'em!
|
| _ -> return None
|
||||||
let salt = Guid.NewGuid ()
|
| None -> return None
|
||||||
let pwHash = pbkdf2Hash salt model.Password
|
|
||||||
let upgraded = { u with Salt = Some salt; PasswordHash = pwHash }
|
|
||||||
db.UpdateEntry upgraded
|
|
||||||
let! _ = db.SaveChangesAsync ()
|
|
||||||
return Some { u with PasswordHash = ""; Salt = None; SmallGroups = List<UserSmallGroup>() }
|
|
||||||
| _ -> return None
|
|
||||||
}
|
}
|
||||||
|
|
||||||
open System.Threading.Tasks
|
/// Return a default URL if the given URL is non-local or otherwise questionable
|
||||||
|
let sanitizeUrl providedUrl defaultUrl =
|
||||||
|
let url = match defaultArg providedUrl "" with "" -> defaultUrl | it -> it
|
||||||
|
if url.IndexOf "\\" >= 0 || url.IndexOf "//" >= 0 then defaultUrl
|
||||||
|
elif Seq.exists Char.IsControl url then defaultUrl
|
||||||
|
else url
|
||||||
|
|
||||||
/// POST /user/password/change
|
/// POST /user/password/change
|
||||||
let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
|
let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
|
||||||
|
@ -38,25 +80,21 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f
|
||||||
| Ok model ->
|
| Ok model ->
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
let curUsr = ctx.Session.CurrentUser.Value
|
let curUsr = ctx.Session.CurrentUser.Value
|
||||||
let! dbUsr = ctx.Db.TryUserById curUsr.Id
|
let hasher = PrayerTrackerPasswordHasher ()
|
||||||
let group = ctx.Session.CurrentGroup.Value
|
let! user = task {
|
||||||
let! user =
|
match! ctx.Db.TryUserById curUsr.Id with
|
||||||
match dbUsr with
|
|
||||||
| Some usr ->
|
| Some usr ->
|
||||||
// Check the old password against a possibly non-salted hash
|
if hasher.VerifyHashedPassword (usr, usr.PasswordHash, model.OldPassword)
|
||||||
(match usr.Salt with Some salt -> pbkdf2Hash salt | None -> sha1Hash) model.OldPassword
|
= PasswordVerificationResult.Success then
|
||||||
|> ctx.Db.TryUserLogOnByCookie curUsr.Id group.Id
|
return Some usr
|
||||||
| _ -> Task.FromResult None
|
else return None
|
||||||
|
| _ -> return None
|
||||||
|
}
|
||||||
match user with
|
match user with
|
||||||
| Some _ when model.NewPassword = model.NewPasswordConfirm ->
|
| Some usr when model.NewPassword = model.NewPasswordConfirm ->
|
||||||
match dbUsr with
|
ctx.Db.UpdateEntry { usr with PasswordHash = hasher.HashPassword (usr, model.NewPassword) }
|
||||||
| Some usr ->
|
let! _ = ctx.Db.SaveChangesAsync ()
|
||||||
// Generate new salt whenever the password is changed
|
addInfo ctx s["Your password was changed successfully"]
|
||||||
let salt = Guid.NewGuid ()
|
|
||||||
ctx.Db.UpdateEntry { usr with PasswordHash = pbkdf2Hash salt model.NewPassword; Salt = Some salt }
|
|
||||||
let! _ = ctx.Db.SaveChangesAsync ()
|
|
||||||
addInfo ctx s["Your password was changed successfully"]
|
|
||||||
| None -> addError ctx s["Unable to change password"]
|
|
||||||
return! redirectTo false "/" next ctx
|
return! redirectTo false "/" next ctx
|
||||||
| Some _ ->
|
| Some _ ->
|
||||||
addError ctx s["The new passwords did not match - your password was NOT changed"]
|
addError ctx s["The new passwords did not match - your password was NOT changed"]
|
||||||
|
@ -90,55 +128,41 @@ open Microsoft.AspNetCore.Html
|
||||||
let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task {
|
let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task {
|
||||||
match! ctx.TryBindFormAsync<UserLogOn> () with
|
match! ctx.TryBindFormAsync<UserLogOn> () with
|
||||||
| Ok model ->
|
| Ok model ->
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
let! usr = findUserByPassword model ctx.Db
|
match! findUserByPassword model ctx.Db with
|
||||||
match! ctx.Db.TryGroupById (idFromShort SmallGroupId model.SmallGroupId) with
|
| Some user ->
|
||||||
| Some group ->
|
match! ctx.Db.TryGroupById (idFromShort SmallGroupId model.SmallGroupId) with
|
||||||
let! nextUrl = backgroundTask {
|
| Some group ->
|
||||||
match usr with
|
ctx.Session.CurrentUser <- Some user
|
||||||
| Some user ->
|
ctx.Session.CurrentGroup <- Some group
|
||||||
ctx.Session.CurrentUser <- usr
|
let identity = ClaimsIdentity (
|
||||||
ctx.Session.CurrentGroup <- Some group
|
seq {
|
||||||
let claims = seq {
|
|
||||||
Claim (ClaimTypes.NameIdentifier, shortGuid user.Id.Value)
|
Claim (ClaimTypes.NameIdentifier, shortGuid user.Id.Value)
|
||||||
Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value)
|
Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value)
|
||||||
Claim (ClaimTypes.Role, if user.IsAdmin then "Admin" else "User")
|
}, CookieAuthenticationDefaults.AuthenticationScheme)
|
||||||
}
|
do! ctx.SignInAsync (
|
||||||
let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
|
identity.AuthenticationType, ClaimsPrincipal identity,
|
||||||
do! ctx.SignInAsync
|
AuthenticationProperties (
|
||||||
(identity.AuthenticationType, ClaimsPrincipal identity,
|
IssuedUtc = DateTimeOffset.UtcNow,
|
||||||
AuthenticationProperties (
|
IsPersistent = defaultArg model.RememberMe false))
|
||||||
IssuedUtc = DateTimeOffset.UtcNow,
|
addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
|
||||||
IsPersistent = defaultArg model.RememberMe false))
|
return! redirectTo false (sanitizeUrl model.RedirectUrl "/small-group") next ctx
|
||||||
addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
|
| None -> return! fourOhFour ctx
|
||||||
return
|
| None ->
|
||||||
match model.RedirectUrl with
|
{ UserMessage.error with
|
||||||
| None -> "/small-group"
|
Text = htmlLocString s["Invalid credentials - log on unsuccessful"]
|
||||||
| Some x when x = ""-> "/small-group"
|
Description =
|
||||||
| Some x when x.IndexOf "://" < 0 -> x
|
let detail =
|
||||||
| _ -> "/small-group"
|
[ "This is likely due to one of the following reasons:<ul>"
|
||||||
| _ ->
|
"<li>The e-mail address “{0}” is invalid.</li>"
|
||||||
{ UserMessage.error with
|
"<li>The password entered does not match the password for the given e-mail address.</li>"
|
||||||
Text = htmlLocString s["Invalid credentials - log on unsuccessful"]
|
"<li>You are not authorized to administer the selected group.</li></ul>"
|
||||||
Description =
|
]
|
||||||
[ s["This is likely due to one of the following reasons"].Value
|
|> String.concat ""
|
||||||
":<ul><li>"
|
Some (HtmlString (s[detail, WebUtility.HtmlEncode model.Email].Value))
|
||||||
s["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode model.Email].Value
|
|
||||||
"</li><li>"
|
|
||||||
s["The password entered does not match the password for the given e-mail address."].Value
|
|
||||||
"</li><li>"
|
|
||||||
s["You are not authorized to administer the group “{0}”.",
|
|
||||||
WebUtility.HtmlEncode group.Name].Value
|
|
||||||
"</li></ul>"
|
|
||||||
]
|
|
||||||
|> String.concat ""
|
|
||||||
|> (HtmlString >> Some)
|
|
||||||
}
|
|
||||||
|> addUserMessage ctx
|
|
||||||
return "/user/log-on"
|
|
||||||
}
|
}
|
||||||
return! redirectTo false nextUrl next ctx
|
|> addUserMessage ctx
|
||||||
| None -> return! fourOhFour ctx
|
return! redirectTo false "/user/log-on" next ctx
|
||||||
| Result.Error e -> return! bindError e next ctx
|
| Result.Error e -> return! bindError e next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -191,6 +215,8 @@ let password : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
|
||||||
|> Views.User.changePassword ctx
|
|> Views.User.changePassword ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
|
|
||||||
|
open System.Threading.Tasks
|
||||||
|
|
||||||
/// POST /user/save
|
/// POST /user/save
|
||||||
let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
|
let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
|
||||||
match! ctx.TryBindFormAsync<EditUser> () with
|
match! ctx.TryBindFormAsync<EditUser> () with
|
||||||
|
@ -198,20 +224,10 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
|
||||||
let! user =
|
let! user =
|
||||||
if model.IsNew then Task.FromResult (Some { User.empty with Id = (Guid.NewGuid >> UserId) () })
|
if model.IsNew then Task.FromResult (Some { User.empty with Id = (Guid.NewGuid >> UserId) () })
|
||||||
else ctx.Db.TryUserById (idFromShort UserId model.UserId)
|
else ctx.Db.TryUserById (idFromShort UserId model.UserId)
|
||||||
let saltedUser =
|
match user with
|
||||||
match user with
|
| Some usr ->
|
||||||
| Some u ->
|
let hasher = PrayerTrackerPasswordHasher ()
|
||||||
match u.Salt with
|
let updatedUser = model.PopulateUser usr (fun pw -> hasher.HashPassword (usr, pw))
|
||||||
| None when model.Password <> "" ->
|
|
||||||
// Generate salt so that a new password hash can be generated
|
|
||||||
Some { u with Salt = Some (Guid.NewGuid ()) }
|
|
||||||
| _ ->
|
|
||||||
// Leave the user with no salt, so prior hash can be validated/upgraded
|
|
||||||
user
|
|
||||||
| _ -> user
|
|
||||||
match saltedUser with
|
|
||||||
| Some u ->
|
|
||||||
let updatedUser = model.PopulateUser u (pbkdf2Hash (Option.get u.Salt))
|
|
||||||
updatedUser |> if model.IsNew then ctx.Db.AddEntry else ctx.Db.UpdateEntry
|
updatedUser |> if model.IsNew then ctx.Db.AddEntry else ctx.Db.UpdateEntry
|
||||||
let! _ = ctx.Db.SaveChangesAsync ()
|
let! _ = ctx.Db.SaveChangesAsync ()
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
|
@ -224,7 +240,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
|
||||||
|> Some
|
|> Some
|
||||||
}
|
}
|
||||||
|> addUserMessage ctx
|
|> addUserMessage ctx
|
||||||
return! redirectTo false $"/user/{shortGuid u.Id.Value}/small-groups" next ctx
|
return! redirectTo false $"/user/{shortGuid usr.Id.Value}/small-groups" next ctx
|
||||||
else
|
else
|
||||||
addInfo ctx s["Successfully {0} user", s["Updated"].Value.ToLower ()]
|
addInfo ctx s["Successfully {0} user", s["Updated"].Value.ToLower ()]
|
||||||
return! redirectTo false "/users" next ctx
|
return! redirectTo false "/users" next ctx
|
||||||
|
|
Loading…
Reference in New Issue
Block a user