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

Force URLs and e-mail to be lowercase (#45)

Browse Source 
- Added v2.2 migration to lower existing e-mails
This commit is contained in:
Daniel J. Summers 2024-06-18 22:01:41 -04:00
parent 823286255b
commit 7ae15b9e93
7 changed files with 78 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -211,6 +211,16 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
return! setDbVersion "v2.1.1"
}
/// Migrate from v2.1.1 to v2.2
let migrateV2point1point1ToV2point2 () = backgroundTask {
Utils.Migration.logStep log "v2.1.1 to v2.2" "Setting e-mail to lowercase"
do! Custom.nonQuery
$"""UPDATE {Table.WebLogUser} SET data = data || '{{"Email":"' || lower(data->>'Email') || '"}}'::jsonb"""
[]
Utils.Migration.logStep log "v2.1.1 to v2.2" "Setting database version to v2.2"
return! setDbVersion "v2.2"
}
/// Do required data migration between versions
let migrate version = backgroundTask {
let mutable v = defaultArg version ""
@ -226,6 +236,10 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
let! ver = migrateV2ToV2point1point1 ()
v <- ver
if v = "v2.1.1" then
let! ver = migrateV2point1point1ToV2point2 ()
v <- ver
if v <> Utils.Migration.currentDbVersion then
log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}"
let! _ = setDbVersion Utils.Migration.currentDbVersion

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

@ -239,11 +239,23 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
}
/// Migrate from v2.1 to v2.1.1
let migrateV2ToV2point1point1 () = backgroundTask {
let migrateV2point1ToV2point1point1 () = backgroundTask {
Utils.Migration.logStep log "v2.1 to v2.1.1" "Setting database version; no migration required"
do! setDbVersion "v2.1.1"
}
/// Migrate from v2.1.1 to v2.2
let migrateV2point1point1ToV2point2 () = backgroundTask {
Utils.Migration.logStep log "v2.1.1 to v2.2" "Setting e-mail to lowercase"
do! rethink {
withTable Table.WebLogUser
update (fun row -> {| Email = row[nameof WebLogUser.Empty.Email].Downcase() |})
write; withRetryOnce; ignoreResult conn
}
Utils.Migration.logStep log "v2.1.1 to v2.2" "Setting database version; no migration required"
do! setDbVersion "v2.2"
}
/// Migrate data between versions
let migrate version = backgroundTask {
let mutable v = defaultArg version ""
@ -261,9 +273,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
v <- "v2.1"
if v = "v2.1" then
do! migrateV2ToV2point1point1 ()
do! migrateV2point1ToV2point1point1 ()
v <- "v2.1.1"
if v = "v2.1.1" then
do! migrateV2point1point1ToV2point2 ()
v <- "v2.2"
if v <> Utils.Migration.currentDbVersion then
log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}"
do! setDbVersion Utils.Migration.currentDbVersion

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

@ -431,10 +431,18 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
}
/// Migrate from v2.1 to v2.1.1
let migrateV2ToV2point1point1 () = backgroundTask {
let migrateV2point1ToV2point1point1 () = backgroundTask {
Utils.Migration.logStep log "v2.1 to v2.1.1" "Setting database version; no migration required"
do! setDbVersion "v2.1.1"
}
/// Migrate from v2.1.1 to v2.2
let migrateV2point1point1ToV2point2 () = backgroundTask {
Utils.Migration.logStep log "v2.1.1 to v2.2" "Setting e-mail to lowercase"
do! Custom.nonQuery $"UPDATE {Table.WebLogUser} SET data = json_set(data, '$.Email', lower(data->>'Email'))" []
Utils.Migration.logStep log "v2.1.1 to v2.2" "Setting database version to v2.2"
do! setDbVersion "v2.2"
}
/// Migrate data among versions (up only)
let migrate version = backgroundTask {
@ -453,9 +461,13 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
v <- "v2.1"
if v = "v2.1" then
do! migrateV2ToV2point1point1 ()
do! migrateV2point1ToV2point1point1 ()
v <- "v2.1.1"
if v = "v2.1.1" then
do! migrateV2point1point1ToV2point2 ()
v <- "v2.2"
if v <> Utils.Migration.currentDbVersion then
log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}"
do! setDbVersion Utils.Migration.currentDbVersion

2
src/MyWebLog.Data/Utils.fs
View File

@ -54,7 +54,7 @@ module Migration =
open Microsoft.Extensions.Logging
/// The current database version
let currentDbVersion = "v2.1.1"
let currentDbVersion = "v2.2"
/// Log a migration step
let logStep<'T> (log: ILogger<'T>) migration message =

2
src/MyWebLog.Domain/ViewModels.fs
View File

@ -937,7 +937,7 @@ type EditUserModel = {
member this.UpdateUser (user: WebLogUser) =
{ user with
AccessLevel = AccessLevel.Parse this.AccessLevel
Email = this.Email
Email = this.Email.ToLowerInvariant()
Url = noneIfBlank this.Url
FirstName = this.FirstName
LastName = this.LastName

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

@ -46,7 +46,7 @@ open Microsoft.AspNetCore.Authentication.Cookies
let doLogOn : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel>()
let data = ctx.Data
let! tryUser = data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id
let! tryUser = data.WebLogUser.FindByEmail (model.EmailAddress.ToLowerInvariant()) ctx.WebLog.Id
match! verifyPassword tryUser model.Password ctx with
| Ok _ ->
let user = tryUser.Value

57
src/MyWebLog/Maintenance.fs
View File

@ -20,33 +20,31 @@ let private doCreateWebLog (args: string[]) (sp: IServiceProvider) = task {
| true, ianaId -> ianaId
| false, _ -> raise <| TimeZoneNotFoundException $"Cannot find IANA timezone for {local}"
// Create the web log
let webLogId = WebLogId.Create()
let userId = WebLogUserId.Create()
let homePageId = PageId.Create()
let slug = Handlers.Upload.makeSlug args[2]
// If this is the first web log being created, the user will be an installation admin; otherwise, they will be an
// admin just over their web log
let! webLogs = data.WebLog.All()
let accessLevel = if List.isEmpty webLogs then Administrator else WebLogAdmin
do! data.WebLog.Add
{ WebLog.Empty with
Id = webLogId
Name = args[2]
Slug = slug
UrlBase = args[1]
DefaultPage = string homePageId
TimeZone = timeZone }
let homePageId = PageId.Create()
// Create the web log
let webLog =
{ WebLog.Empty with
Id = WebLogId.Create()
Name = args[2]
Slug = Handlers.Upload.makeSlug args[2]
UrlBase = args[1].ToLowerInvariant()
DefaultPage = string homePageId
TimeZone = timeZone }
do! data.WebLog.Add webLog
// Create the admin user
let now = Noda.now ()
let user =
{ WebLogUser.Empty with
Id = userId
WebLogId = webLogId
Email = args[3]
Id = WebLogUserId.Create()
WebLogId = webLog.Id
Email = args[3].ToLowerInvariant()
FirstName = "Admin"
LastName = "User"
PreferredName = "Admin"
@ -58,8 +56,8 @@ let private doCreateWebLog (args: string[]) (sp: IServiceProvider) = task {
do! data.Page.Add
{ Page.Empty with
Id = homePageId
WebLogId = webLogId
AuthorId = userId
WebLogId = webLog.Id
AuthorId = user.Id
Title = "Welcome to myWebLog!"
Permalink = Permalink "welcome-to-myweblog.html"
PublishedOn = now
@ -70,11 +68,11 @@ let private doCreateWebLog (args: string[]) (sp: IServiceProvider) = task {
Text = Html "<p>This is your default home page.</p>" }
] }
printfn $"Successfully initialized database for {args[2]} with URL base {args[1]}"
printfn $"Successfully initialized database for {webLog.Name} with URL base {webLog.UrlBase}"
match accessLevel with
| Administrator -> printfn $" ({args[3]} is an installation administrator)"
| Administrator -> printfn $" ({user.Email} is an installation administrator)"
| WebLogAdmin ->
printfn $" ({args[3]} is a web log administrator;"
printfn $" ({user.Email} is a web log administrator;"
printfn """ use "upgrade-user" to promote to installation administrator)"""
| _ -> ()
}
@ -422,8 +420,9 @@ module Backup =
/// Generate a backup archive
let generateBackup (args: string[]) (sp: IServiceProvider) = task {
if args.Length > 1 && args.Length < 5 then
let url = args[1].ToLowerInvariant()
let data = sp.GetRequiredService<IData>()
match! data.WebLog.FindByHost args[1] with
match! data.WebLog.FindByHost url with
| Some webLog ->
let fileName =
if args.Length = 2 || (args.Length = 3 && args[2] = "pretty") then
@ -434,7 +433,7 @@ module Backup =
$"{args[2]}.json"
let prettyOutput = (args.Length = 3 && args[2] = "pretty") || (args.Length = 4 && args[3] = "pretty")
do! createBackup webLog fileName prettyOutput data
| None -> eprintfn $"Error: no web log found for {args[1]}"
| None -> eprintfn $"Error: no web log found for {url}"
else
eprintfn """Usage: myWebLog backup [url-base] [*backup-file-name] [**"pretty"]"""
eprintfn """ * optional - default is [web-log-slug].json"""
@ -445,7 +444,7 @@ module Backup =
let restoreFromBackup (args: string[]) (sp: IServiceProvider) = task {
if args.Length = 2 || args.Length = 3 then
let data = sp.GetRequiredService<IData>()
let newUrlBase = if args.Length = 3 then Some args[2] else None
let newUrlBase = if args.Length = 3 then Some (args[2].ToLowerInvariant()) else None
do! restoreBackup args[1] newUrlBase (args[0] <> "do-restore") true data
else
eprintfn "Usage: myWebLog restore [backup-file-name] [*url-base]"
@ -472,7 +471,7 @@ let private doUserUpgrade urlBase email (data: IData) = task {
/// Upgrade a WebLogAdmin user to an Administrator user if the command-line arguments are good
let upgradeUser (args: string[]) (sp: IServiceProvider) = task {
match args.Length with
| 3 -> do! doUserUpgrade args[1] args[2] (sp.GetRequiredService<IData>())
| 3 -> do! doUserUpgrade (args[1].ToLowerInvariant()) (args[2].ToLowerInvariant()) (sp.GetRequiredService<IData>())
| _ -> eprintfn "Usage: myWebLog upgrade-user [web-log-url-base] [email-address]"
}
@ -491,6 +490,8 @@ let doSetPassword urlBase email password (data: IData) = task {
/// 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>())
| 4 ->
do! doSetPassword
(args[1].ToLowerInvariant()) (args[2].ToLowerInvariant()) args[3] (sp.GetRequiredService<IData>())
| _ -> eprintfn "Usage: myWebLog set-password [web-log-url-base] [email-address] [password]"
}