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

- Added v2.2 migration to lower existing e-mails

src/MyWebLog.Data/PostgresData.fs

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

src/MyWebLog.Data/RethinkDbData.fs

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

src/MyWebLog.Data/SQLiteData.fs

@@ -431,11 +431,19 @@ 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 {
         let mutable v = defaultArg version ""
@@ -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

src/MyWebLog.Data/Utils.fs

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

src/MyWebLog.Domain/ViewModels.fs

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

src/MyWebLog/Handlers/User.fs

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

src/MyWebLog/Maintenance.fs

@@ -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
+    let homePageId = PageId.Create()
+    
+    // Create the web log
+    let webLog =
         { WebLog.Empty with
-                Id          = webLogId
+            Id          = WebLogId.Create()
             Name        = args[2]
-                Slug        = slug
+            Slug        = Handlers.Upload.makeSlug args[2]
-                UrlBase     = args[1]
+            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
+            Id            = WebLogUserId.Create()
-            WebLogId      = webLogId
+            WebLogId      = webLog.Id
-            Email         = args[3]
+            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
+                WebLogId    = webLog.Id
-                AuthorId    = userId
+                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]"
 }