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

Compare commits

base: bit-badger:main
Branches Tags
bit-badger:main
bit-badger:version-three
bit-badger:v2.2
bit-badger:v2.1.1
bit-badger:v2.1
bit-badger:v2.0
bit-badger:v2.0-rc2
bit-badger:v2.0-rc1
bit-badger:v2.0-beta05
bit-badger:v2.0-beta04
bit-badger:v2.0-beta03
bit-badger:v2.0-beta02
bit-badger:v2.0-beta01
..
compare: bit-badger:v2.1.1
Branches Tags
bit-badger:version-three
bit-badger:main
bit-badger:v2.2
bit-badger:v2.1.1
bit-badger:v2.1
bit-badger:v2.0
bit-badger:v2.0-rc2
bit-badger:v2.0-rc1
bit-badger:v2.0-beta05
bit-badger:v2.0-beta04
bit-badger:v2.0-beta03
bit-badger:v2.0-beta02
bit-badger:v2.0-beta01

No commits in common. "main" and "v2.1.1" have entirely different histories.
main ... v2.1.1

19 changed files with 69 additions and 121 deletions
Show Stats Expand all files Collapse all files

2
build.fs
View File

@ -33,7 +33,7 @@ let zipTheme (name : string) (_ : TargetParameter) =
|> Zip.zipSpec $"{releasePath}/{name}-theme.zip"
/// Frameworks supported by this build
let frameworks = [ "net6.0"; "net8.0" ]
let frameworks = [ "net6.0"; "net7.0"; "net8.0" ]
/// Publish the project for the given runtime ID
let publishFor rid (_ : TargetParameter) =

8
src/Directory.Build.props
View File

@ -1,9 +1,9 @@
<Project>
<PropertyGroup>
<TargetFrameworks>net6.0;net8.0</TargetFrameworks>
<TargetFrameworks>net6.0;net7.0;net8.0</TargetFrameworks>
<DebugType>embedded</DebugType>
<AssemblyVersion>2.2.0.0</AssemblyVersion>
<FileVersion>2.2.0.0</FileVersion>
<Version>2.2.0</Version>
<AssemblyVersion>2.1.0.0</AssemblyVersion>
<FileVersion>2.1.0.0</FileVersion>
<Version>2.1.0</Version>
</PropertyGroup>
</Project>

10
src/MyWebLog.Data/MyWebLog.Data.fsproj
View File

@ -5,17 +5,17 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="BitBadger.Documents.Postgres" Version="3.1.0" />
<PackageReference Include="BitBadger.Documents.Sqlite" Version="3.1.0" />
<PackageReference Include="Microsoft.Data.Sqlite" Version="8.0.6" />
<PackageReference Include="BitBadger.Documents.Postgres" Version="3.0.0-rc-2" />
<PackageReference Include="BitBadger.Documents.Sqlite" Version="3.0.0-rc-2" />
<PackageReference Include="Microsoft.Data.Sqlite" Version="8.0.3" />
<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="8.0.0" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="8.0.0" />
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" />
<PackageReference Include="Npgsql.NodaTime" Version="8.0.3" />
<PackageReference Include="Npgsql.NodaTime" Version="8.0.2" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
<PackageReference Update="FSharp.Core" Version="8.0.300" />
<PackageReference Update="FSharp.Core" Version="8.0.200" />
</ItemGroup>
<ItemGroup>

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

@ -211,16 +211,6 @@ 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 ""
@ -236,10 +226,6 @@ 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,23 +239,11 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
}
/// Migrate from v2.1 to v2.1.1
let migrateV2point1ToV2point1point1 () = backgroundTask {
let migrateV2ToV2point1point1 () = 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 to v2.2"
do! setDbVersion "v2.2"
}
/// Migrate data between versions
let migrate version = backgroundTask {
let mutable v = defaultArg version ""
@ -273,13 +261,9 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
v <- "v2.1"
if v = "v2.1" then
do! migrateV2point1ToV2point1point1 ()
do! migrateV2ToV2point1point1 ()
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,18 +431,10 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
}
/// Migrate from v2.1 to v2.1.1
let migrateV2point1ToV2point1point1 () = backgroundTask {
let migrateV2ToV2point1point1 () = 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 {
@ -461,13 +453,9 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
v <- "v2.1"
if v = "v2.1" then
do! migrateV2point1ToV2point1point1 ()
do! migrateV2ToV2point1point1 ()
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.2"
let currentDbVersion = "v2.1.1"
/// Log a migration step
let logStep<'T> (log: ILogger<'T>) migration message =

6
src/MyWebLog.Domain/MyWebLog.Domain.fsproj
View File

@ -7,11 +7,11 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="Markdig" Version="0.37.0" />
<PackageReference Include="Markdown.ColorCode" Version="2.2.2" />
<PackageReference Include="Markdig" Version="0.36.2" />
<PackageReference Include="Markdown.ColorCode" Version="2.2.1" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.3" />
<PackageReference Include="NodaTime" Version="3.1.11" />
<PackageReference Update="FSharp.Core" Version="8.0.300" />
<PackageReference Update="FSharp.Core" Version="8.0.200" />
</ItemGroup>
</Project>

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

@ -154,9 +154,7 @@ 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 Path.Combine(".", "themes", $"{theme.Id}-theme.zip")
let fileName = if string theme.Id = "default" then "default-theme.zip" else $"./themes/{theme.Id}-theme.zip"
{ Id = string theme.Id
Name = theme.Name
Version = theme.Version
@ -939,7 +937,7 @@ type EditUserModel = {
member this.UpdateUser (user: WebLogUser) =
{ user with
AccessLevel = AccessLevel.Parse this.AccessLevel
Email = this.Email.ToLowerInvariant()
Email = this.Email
Url = noneIfBlank this.Url
FirstName = this.FirstName
LastName = this.LastName

19
src/MyWebLog.Tests/Domain/ViewModelsTests.fs
View File

@ -118,19 +118,16 @@ 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 dir = Directory.CreateDirectory "themes"
let file = File.Create "./themes/another-theme.zip"
try
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
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 "./themes/another-theme.zip"
dir.Delete()
}
test "succeeds when the default theme is on disk" {

2
src/MyWebLog.Tests/MyWebLog.Tests.fsproj
View File

@ -28,7 +28,7 @@
<ItemGroup>
<PackageReference Include="Expecto" Version="10.2.1" />
<PackageReference Include="ThrowawayDb.Postgres" Version="1.4.0" />
<PackageReference Update="FSharp.Core" Version="8.0.300" />
<PackageReference Update="FSharp.Core" Version="8.0.200" />
</ItemGroup>
<ItemGroup>

7
src/MyWebLog/Handlers/Admin.fs
View File

@ -399,11 +399,8 @@ 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(Path.Combine(".", "themes", $"{themeId}-theme.zip"), FileMode.Create)
use file = new FileStream($"./themes/{themeId}-theme.zip", FileMode.Create)
do! themeFile.CopyToAsync file
do! addMessage ctx
{ UserMessage.Success with
@ -438,7 +435,7 @@ module Theme =
| _ ->
match! data.Theme.Delete (ThemeId themeId) with
| true ->
let zippedTheme = Path.Combine(".", "themes", $"{themeId}-theme.zip")
let zippedTheme = $"./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

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.ToLowerInvariant()) ctx.WebLog.Id
let! tryUser = data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id
match! verifyPassword tryUser model.Password ctx with
| Ok _ ->
let user = tryUser.Value

57
src/MyWebLog/Maintenance.fs
View File

@ -20,31 +20,33 @@ 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
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
do! data.WebLog.Add
{ WebLog.Empty with
Id = webLogId
Name = args[2]
Slug = slug
UrlBase = args[1]
DefaultPage = string homePageId
TimeZone = timeZone }
// Create the admin user
let now = Noda.now ()
let user =
{ WebLogUser.Empty with
Id = WebLogUserId.Create()
WebLogId = webLog.Id
Email = args[3].ToLowerInvariant()
Id = userId
WebLogId = webLogId
Email = args[3]
FirstName = "Admin"
LastName = "User"
PreferredName = "Admin"
@ -56,8 +58,8 @@ let private doCreateWebLog (args: string[]) (sp: IServiceProvider) = task {
do! data.Page.Add
{ Page.Empty with
Id = homePageId
WebLogId = webLog.Id
AuthorId = user.Id
WebLogId = webLogId
AuthorId = userId
Title = "Welcome to myWebLog!"
Permalink = Permalink "welcome-to-myweblog.html"
PublishedOn = now
@ -68,11 +70,11 @@ let private doCreateWebLog (args: string[]) (sp: IServiceProvider) = task {
Text = Html "<p>This is your default home page.</p>" }
] }
printfn $"Successfully initialized database for {webLog.Name} with URL base {webLog.UrlBase}"
printfn $"Successfully initialized database for {args[2]} with URL base {args[1]}"
match accessLevel with
| Administrator -> printfn $" ({user.Email} is an installation administrator)"
| Administrator -> printfn $" ({args[3]} is an installation administrator)"
| WebLogAdmin ->
printfn $" ({user.Email} is a web log administrator;"
printfn $" ({args[3]} is a web log administrator;"
printfn """ use "upgrade-user" to promote to installation administrator)"""
| _ -> ()
}
@ -420,9 +422,8 @@ 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 url with
match! data.WebLog.FindByHost args[1] with
| Some webLog ->
let fileName =
if args.Length = 2 || (args.Length = 3 && args[2] = "pretty") then
@ -433,7 +434,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 {url}"
| None -> eprintfn $"Error: no web log found for {args[1]}"
else
eprintfn """Usage: myWebLog backup [url-base] [*backup-file-name] [**"pretty"]"""
eprintfn """ * optional - default is [web-log-slug].json"""
@ -444,7 +445,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].ToLowerInvariant()) else None
let newUrlBase = if args.Length = 3 then Some args[2] else None
do! restoreBackup args[1] newUrlBase (args[0] <> "do-restore") true data
else
eprintfn "Usage: myWebLog restore [backup-file-name] [*url-base]"
@ -471,7 +472,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].ToLowerInvariant()) (args[2].ToLowerInvariant()) (sp.GetRequiredService<IData>())
| 3 -> do! doUserUpgrade args[1] args[2] (sp.GetRequiredService<IData>())
| _ -> eprintfn "Usage: myWebLog upgrade-user [web-log-url-base] [email-address]"
}
@ -490,8 +491,6 @@ 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].ToLowerInvariant()) (args[2].ToLowerInvariant()) args[3] (sp.GetRequiredService<IData>())
| 4 -> do! doSetPassword args[1] args[2] args[3] (sp.GetRequiredService<IData>())
| _ -> eprintfn "Usage: myWebLog set-password [web-log-url-base] [email-address] [password]"
}

8
src/MyWebLog/MyWebLog.fsproj
View File

@ -31,13 +31,13 @@
<ItemGroup>
<PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.0.0" />
<PackageReference Include="DotLiquid" Version="2.2.692" />
<PackageReference Include="Giraffe" Version="6.4.0" />
<PackageReference Include="Giraffe.Htmx" Version="2.0.0" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.0" />
<PackageReference Include="Giraffe" Version="6.3.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.9.11" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.11" />
<PackageReference Include="NeoSmart.Caching.Sqlite.AspNetCore" Version="8.0.0" />
<PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" />
<PackageReference Include="System.ServiceModel.Syndication" Version="8.0.0" />
<PackageReference Update="FSharp.Core" Version="8.0.300" />
<PackageReference Update="FSharp.Core" Version="8.0.200" />
</ItemGroup>
<ItemGroup>

5
src/MyWebLog/Program.fs
View File

@ -218,9 +218,8 @@ 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
let themePath = Path.Combine(".", "themes")
if Directory.Exists themePath then
for themeFile in Directory.EnumerateFiles(themePath, "*-theme.zip") do
if Directory.Exists "./themes" then
for themeFile in Directory.EnumerateFiles("./themes", "*-theme.zip") do
do! Maintenance.loadTheme [| ""; themeFile |] app.Services
let _ = app.UseForwardedHeaders()

2
src/MyWebLog/appsettings.json
View File

@ -1,5 +1,5 @@
{
"Generator": "myWebLog 2.2",
"Generator": "myWebLog 2.1.1",
"Logging": {
"LogLevel": {
"MyWebLog.Handlers": "Information"

2
src/admin-theme/version.txt
View File

@ -1,2 +1,2 @@
myWebLog Admin
2.2
2.1.1

2
src/default-theme/version.txt
View File

@ -1,2 +1,2 @@
myWebLog Default Theme
2.2
2.1.1