diff --git a/build.fs b/build.fs index 9e17e7f..0e9eb60 100644 --- a/build.fs +++ b/build.fs @@ -33,7 +33,7 @@ let zipTheme (name : string) (_ : TargetParameter) = |> Zip.zipSpec $"{releasePath}/{name}-theme.zip" /// Frameworks supported by this build -let frameworks = [ "net6.0"; "net7.0"; "net8.0" ] +let frameworks = [ "net6.0"; "net8.0" ] /// Publish the project for the given runtime ID let publishFor rid (_ : TargetParameter) = diff --git a/src/Directory.Build.props b/src/Directory.Build.props index 548e37b..c9977df 100644 --- a/src/Directory.Build.props +++ b/src/Directory.Build.props @@ -1,9 +1,9 @@ - net6.0;net7.0;net8.0 + net6.0;net8.0 embedded - 2.1.0.0 - 2.1.0.0 - 2.1.0 + 2.2.0.0 + 2.2.0.0 + 2.2.0 diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index a3d9a77..6a5985b 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -5,17 +5,17 @@ - - - + + + - + - + diff --git a/src/MyWebLog.Data/PostgresData.fs b/src/MyWebLog.Data/PostgresData.fs index 4e1efd8..0100983 100644 --- a/src/MyWebLog.Data/PostgresData.fs +++ b/src/MyWebLog.Data/PostgresData.fs @@ -211,6 +211,16 @@ type PostgresData(log: ILogger, 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, 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 diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index 6547819..938ae32 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -239,11 +239,23 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger {| Email = row[nameof WebLogUser.Empty.Email].Downcase() |}) + write; withRetryOnce; ignoreResult conn + } + Utils.Migration.logStep log "v2.1.1 to v2.2" "Setting database version to v2.2" + 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 Utils.Migration.currentDbVersion then log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}" do! setDbVersion Utils.Migration.currentDbVersion diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index 95b3936..d926894 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -431,10 +431,18 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, 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, 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 diff --git a/src/MyWebLog.Data/Utils.fs b/src/MyWebLog.Data/Utils.fs index da18e59..cbed976 100644 --- a/src/MyWebLog.Data/Utils.fs +++ b/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 = diff --git a/src/MyWebLog.Domain/MyWebLog.Domain.fsproj b/src/MyWebLog.Domain/MyWebLog.Domain.fsproj index fa34b80..1eecef4 100644 --- a/src/MyWebLog.Domain/MyWebLog.Domain.fsproj +++ b/src/MyWebLog.Domain/MyWebLog.Domain.fsproj @@ -7,11 +7,11 @@ - - + + - + diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index d52cd10..65935d5 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -154,7 +154,9 @@ type DisplayTheme = { /// Create a display theme from a theme static member FromTheme inUseFunc (theme: Theme) = - let fileName = if string theme.Id = "default" then "default-theme.zip" else $"./themes/{theme.Id}-theme.zip" + let fileName = + if string theme.Id = "default" then "default-theme.zip" + else Path.Combine(".", "themes", $"{theme.Id}-theme.zip") { Id = string theme.Id Name = theme.Name Version = theme.Version @@ -937,7 +939,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 diff --git a/src/MyWebLog.Tests/Domain/ViewModelsTests.fs b/src/MyWebLog.Tests/Domain/ViewModelsTests.fs index da29a2b..67bc0d4 100644 --- a/src/MyWebLog.Tests/Domain/ViewModelsTests.fs +++ b/src/MyWebLog.Tests/Domain/ViewModelsTests.fs @@ -118,16 +118,19 @@ let displayThemeTests = testList "DisplayTheme.FromTheme" [ Expect.isFalse model.IsOnDisk "IsOnDisk should not have been set" } test "succeeds when a non-default theme is not in use and is on disk" { - let dir = Directory.CreateDirectory "themes" - let file = File.Create "./themes/another-theme.zip" + let dir = Directory.CreateDirectory "themes" try - let model = DisplayTheme.FromTheme (fun _ -> false) { theme with Id = ThemeId "another" } - Expect.isFalse model.IsInUse "IsInUse should not have been set" - Expect.isTrue model.IsOnDisk "IsOnDisk should have been set" + let testFile = Path.Combine(".", "themes", "another-theme.zip") + let file = File.Create testFile + try + let model = DisplayTheme.FromTheme (fun _ -> false) { theme with Id = ThemeId "another" } + Expect.isFalse model.IsInUse "IsInUse should not have been set" + Expect.isTrue model.IsOnDisk "IsOnDisk should have been set" + finally + file.Close() + file.Dispose() + File.Delete testFile finally - file.Close() - file.Dispose() - File.Delete "./themes/another-theme.zip" dir.Delete() } test "succeeds when the default theme is on disk" { diff --git a/src/MyWebLog.Tests/MyWebLog.Tests.fsproj b/src/MyWebLog.Tests/MyWebLog.Tests.fsproj index 353d71d..64edcd9 100644 --- a/src/MyWebLog.Tests/MyWebLog.Tests.fsproj +++ b/src/MyWebLog.Tests/MyWebLog.Tests.fsproj @@ -28,7 +28,7 @@ - + diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index a482305..38cfcf3 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -399,8 +399,11 @@ module Theme = let! _ = loadFromZip themeId stream data do! ThemeAssetCache.refreshTheme themeId data TemplateCache.invalidateTheme themeId + // Ensure the themes directory exists + let themeDir = Path.Combine(".", "themes") + if not (Directory.Exists themeDir) then Directory.CreateDirectory themeDir |> ignore // Save the .zip file - use file = new FileStream($"./themes/{themeId}-theme.zip", FileMode.Create) + use file = new FileStream(Path.Combine(".", "themes", $"{themeId}-theme.zip"), FileMode.Create) do! themeFile.CopyToAsync file do! addMessage ctx { UserMessage.Success with @@ -435,7 +438,7 @@ module Theme = | _ -> match! data.Theme.Delete (ThemeId themeId) with | true -> - let zippedTheme = $"./themes/{themeId}-theme.zip" + let zippedTheme = Path.Combine(".", "themes", $"{themeId}-theme.zip") if File.Exists zippedTheme then File.Delete zippedTheme do! addMessage ctx { UserMessage.Success with Message = $"Theme ID {themeId} deleted successfully" } return! all next ctx diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index 5f972ac..f9a6edb 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/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() 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 diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 43caaca..c49c5d5 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/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 - { 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 "

This is your default home page.

" } ] } - 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() - 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() - 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()) + | 3 -> do! doUserUpgrade (args[1].ToLowerInvariant()) (args[2].ToLowerInvariant()) (sp.GetRequiredService()) | _ -> 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()) + | 4 -> + do! doSetPassword + (args[1].ToLowerInvariant()) (args[2].ToLowerInvariant()) args[3] (sp.GetRequiredService()) | _ -> eprintfn "Usage: myWebLog set-password [web-log-url-base] [email-address] [password]" } diff --git a/src/MyWebLog/MyWebLog.fsproj b/src/MyWebLog/MyWebLog.fsproj index 227afcb..9bb4bce 100644 --- a/src/MyWebLog/MyWebLog.fsproj +++ b/src/MyWebLog/MyWebLog.fsproj @@ -31,13 +31,13 @@ - - - + + + - + diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 32abcdc..4dc7880 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -218,8 +218,9 @@ let main args = // Load admin and default themes, and all themes in the /themes directory do! Maintenance.loadTheme [| ""; "./admin-theme.zip" |] app.Services do! Maintenance.loadTheme [| ""; "./default-theme.zip" |] app.Services - if Directory.Exists "./themes" then - for themeFile in Directory.EnumerateFiles("./themes", "*-theme.zip") do + let themePath = Path.Combine(".", "themes") + if Directory.Exists themePath then + for themeFile in Directory.EnumerateFiles(themePath, "*-theme.zip") do do! Maintenance.loadTheme [| ""; themeFile |] app.Services let _ = app.UseForwardedHeaders() diff --git a/src/MyWebLog/appsettings.json b/src/MyWebLog/appsettings.json index cad98ac..207a6c5 100644 --- a/src/MyWebLog/appsettings.json +++ b/src/MyWebLog/appsettings.json @@ -1,5 +1,5 @@ { - "Generator": "myWebLog 2.1.1", + "Generator": "myWebLog 2.2", "Logging": { "LogLevel": { "MyWebLog.Handlers": "Information" diff --git a/src/admin-theme/version.txt b/src/admin-theme/version.txt index d23a661..f3f14b6 100644 --- a/src/admin-theme/version.txt +++ b/src/admin-theme/version.txt @@ -1,2 +1,2 @@ myWebLog Admin -2.1.1 \ No newline at end of file +2.2 \ No newline at end of file diff --git a/src/default-theme/version.txt b/src/default-theme/version.txt index dccf21b..d57272f 100644 --- a/src/default-theme/version.txt +++ b/src/default-theme/version.txt @@ -1,2 +1,2 @@ myWebLog Default Theme -2.1.1 \ No newline at end of file +2.2 \ No newline at end of file