Skip to content

Commit

Permalink
Load themes at startup (#20)
Browse files Browse the repository at this point in the history
- Adjust release packaging (#20)
- Fix default theme for beta-5 changes (#24)
- Remove RethinkDB case fix (cleanup from #21)
- Bump versions for next release
  • Loading branch information
danieljsummers committed Jul 22, 2022
1 parent 99ccdeb commit 4514c48
Show file tree
Hide file tree
Showing 15 changed files with 88 additions and 247 deletions.
15 changes: 8 additions & 7 deletions build.fsx
Expand Up @@ -36,7 +36,7 @@ let zipTheme (name : string) (_ : TargetParameter) =
!! $"{path}/**/*"
|> Zip.filesAsSpecs path //$"src/{name}-theme"
|> Seq.filter (fun (_, name) -> not (name.EndsWith ".zip"))
|> Zip.zipSpec $"{releasePath}/{name}.zip"
|> Zip.zipSpec $"{releasePath}/{name}-theme.zip"

/// Publish the project for the given runtime ID
let publishFor rid (_ : TargetParameter) =
Expand All @@ -45,11 +45,12 @@ let publishFor rid (_ : TargetParameter) =
/// Package published output for the given runtime ID
let packageFor (rid : string) (_ : TargetParameter) =
let path = $"{projectPath}/bin/Release/net6.0/{rid}/publish"
let prodSettings = $"{path}/appsettings.Production.json"
if File.exists prodSettings then File.delete prodSettings
[ !! $"{path}/**/*"
|> Zip.filesAsSpecs path
|> Zip.moveToFolder "app"
Seq.singleton ($"{releasePath}/admin.zip", "admin.zip")
Seq.singleton ($"{releasePath}/default.zip", "default.zip")
Seq.singleton ($"{releasePath}/admin-theme.zip", "admin-theme.zip")
Seq.singleton ($"{releasePath}/default-theme.zip", "default-theme.zip")
]
|> Seq.concat
|> Zip.zipSpec $"{releasePath}/myWebLog-{version}.{rid}.zip"
Expand Down Expand Up @@ -86,7 +87,7 @@ Target.create "RepackageLinux" (fun _ ->
Shell.mkdir workDir
Zip.unzip workDir zipArchive
Shell.cd workDir
sh "chmod" [ "+x"; "app/MyWebLog" ]
sh "chmod" [ "+x"; "./MyWebLog" ]
sh "tar" [ "cfj"; $"../myWebLog-{version}.linux-x64.tar.bz2"; "." ]
Shell.cd "../.."
Shell.rm zipArchive
Expand All @@ -96,8 +97,8 @@ Target.create "RepackageLinux" (fun _ ->
Target.create "All" ignore

Target.create "RemoveThemeArchives" (fun _ ->
Shell.rm $"{releasePath}/admin.zip"
Shell.rm $"{releasePath}/default.zip"
Shell.rm $"{releasePath}/admin-theme.zip"
Shell.rm $"{releasePath}/default-theme.zip"
)

Target.create "CI" ignore
Expand Down
171 changes: 0 additions & 171 deletions rethink-case-fix.js

This file was deleted.

10 changes: 10 additions & 0 deletions src/Directory.Build.props
@@ -0,0 +1,10 @@
<Project>
<PropertyGroup>
<TargetFramework>net6.0</TargetFramework>
<DebugType>embedded</DebugType>
<AssemblyVersion>2.0.0.0</AssemblyVersion>
<FileVersion>2.0.0.0</FileVersion>
<Version>2.0.0</Version>
<VersionSuffix>rc1</VersionSuffix>
</PropertyGroup>
</Project>
6 changes: 0 additions & 6 deletions src/MyWebLog.Data/MyWebLog.Data.fsproj
@@ -1,11 +1,5 @@
<Project Sdk="Microsoft.NET.Sdk">

<PropertyGroup>
<TargetFramework>net6.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<DebugType>embedded</DebugType>
</PropertyGroup>

<ItemGroup>
<ProjectReference Include="..\MyWebLog.Domain\MyWebLog.Domain.fsproj" />
</ItemGroup>
Expand Down
6 changes: 0 additions & 6 deletions src/MyWebLog.Domain/MyWebLog.Domain.fsproj
@@ -1,11 +1,5 @@
<Project Sdk="Microsoft.NET.Sdk">

<PropertyGroup>
<TargetFramework>net6.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<DebugType>embedded</DebugType>
</PropertyGroup>

<ItemGroup>
<Compile Include="SupportTypes.fs" />
<Compile Include="DataTypes.fs" />
Expand Down
9 changes: 7 additions & 2 deletions src/MyWebLog/Handlers/Admin.fs
Expand Up @@ -244,7 +244,10 @@ let private updateAssets themeId (zip : ZipArchive) (data : IData) = backgroundT
/// Get the theme name from the file name given
let getThemeName (fileName : string) =
let themeName = fileName.Split(".").[0].ToLowerInvariant().Replace (" ", "-")
if Regex.IsMatch (themeName, """^[a-z0-9\-]+$""") then Ok themeName else Error $"Theme name {fileName} is invalid"
if themeName.EndsWith "-theme" then
if Regex.IsMatch (themeName, """^[a-z0-9\-]+$""") then Ok (themeName.Substring (0, themeName.Length - 6))
else Error $"Theme name {fileName} is invalid"
else Error "Theme .zip file name must end in \"-theme.zip\""

/// Load a theme from the given stream, which should contain a ZIP archive
let loadThemeFromZip themeName file clean (data : IData) = backgroundTask {
Expand All @@ -260,6 +263,8 @@ let loadThemeFromZip themeName file clean (data : IData) = backgroundTask {
let! theme = updateTemplates theme zip
do! data.Theme.Save theme
do! updateAssets themeId zip data

return theme
}

// POST /admin/theme/update
Expand All @@ -271,7 +276,7 @@ let updateTheme : HttpHandler = requireAccess Administrator >=> fun next ctx ->
let data = ctx.Data
use stream = new MemoryStream ()
do! themeFile.CopyToAsync stream
do! loadThemeFromZip themeName stream true data
let! _ = loadThemeFromZip themeName stream true data
do! ThemeAssetCache.refreshTheme (ThemeId themeName) data
TemplateCache.invalidateTheme themeName
do! addMessage ctx { UserMessage.success with Message = "Theme updated successfully" }
Expand Down
78 changes: 41 additions & 37 deletions src/MyWebLog/Handlers/User.fs
Expand Up @@ -128,43 +128,6 @@ let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> tas
| None -> return! Error.notFound next ctx
}

// POST /admin/user/save
let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel> ()
let data = ctx.Data
let tryUser =
if model.IsNew then
{ WebLogUser.empty with
Id = WebLogUserId.create ()
WebLogId = ctx.WebLog.Id
CreatedOn = DateTime.UtcNow
} |> someTask
else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
match! tryUser with
| Some user when model.Password = model.PasswordConfirm ->
let updatedUser = model.UpdateUser user
if updatedUser.AccessLevel = Administrator && not (ctx.HasAccessLevel Administrator) then
return! goAway next ctx
else
let updatedUser =
if model.Password = "" then updatedUser
else
let salt = Guid.NewGuid ()
{ updatedUser with PasswordHash = hashedPassword model.Password model.Email salt; Salt = salt }
do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) updatedUser
do! addMessage ctx
{ UserMessage.success with
Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully"""
}
return! bare next ctx
| Some _ ->
do! addMessage ctx { UserMessage.error with Message = "The passwords did not match; nothing saved" }
return!
(withHxRetarget $"#user_{model.Id}" >=> showEdit { model with Password = ""; PasswordConfirm = "" })
next ctx
| None -> return! Error.notFound next ctx
}

// POST /admin/user/{id}/delete
let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
Expand Down Expand Up @@ -237,3 +200,44 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
return! showMyInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user next ctx
| None -> return! Error.notFound next ctx
}

// User save is not statically compilable; not sure why, but we'll revisit it at some point
#nowarn "3511"

// POST /admin/user/save
let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel> ()
let data = ctx.Data
let tryUser =
if model.IsNew then
{ WebLogUser.empty with
Id = WebLogUserId.create ()
WebLogId = ctx.WebLog.Id
CreatedOn = DateTime.UtcNow
} |> someTask
else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
match! tryUser with
| Some user when model.Password = model.PasswordConfirm ->
let updatedUser = model.UpdateUser user
if updatedUser.AccessLevel = Administrator && not (ctx.HasAccessLevel Administrator) then
return! goAway next ctx
else
let toUpdate =
if model.Password = "" then updatedUser
else
let salt = Guid.NewGuid ()
{ updatedUser with PasswordHash = hashedPassword model.Password model.Email salt; Salt = salt }
do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate
do! addMessage ctx
{ UserMessage.success with
Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully"""
}
return! bare next ctx
| Some _ ->
do! addMessage ctx { UserMessage.error with Message = "The passwords did not match; nothing saved" }
return!
(withHxRetarget $"#user_{model.Id}" >=> showEdit { model with Password = ""; PasswordConfirm = "" })
next ctx
| None -> return! Error.notFound next ctx
}

8 changes: 6 additions & 2 deletions src/MyWebLog/Maintenance.fs
Expand Up @@ -128,6 +128,8 @@ let importLinks args sp = task {
// Loading a theme and restoring a backup are not statically compilable; this is OK
#nowarn "3511"

open Microsoft.Extensions.Logging

/// Load a theme from the given ZIP file
let loadTheme (args : string[]) (sp : IServiceProvider) = task {
if args.Length > 1 then
Expand All @@ -142,8 +144,10 @@ let loadTheme (args : string[]) (sp : IServiceProvider) = task {
use stream = File.Open (args[1], FileMode.Open)
use copy = new MemoryStream ()
do! stream.CopyToAsync copy
do! Handlers.Admin.loadThemeFromZip themeName copy clean data
printfn $"Theme {themeName} loaded successfully"
let! theme = Handlers.Admin.loadThemeFromZip themeName copy clean data
let fac = sp.GetRequiredService<ILoggerFactory> ()
let log = fac.CreateLogger "MyWebLog.Themes"
log.LogInformation $"{theme.Name} v{theme.Version} ({ThemeId.toString theme.Id}) loaded"
| Error message -> eprintfn $"{message}"
else
eprintfn "Usage: MyWebLog load-theme [theme-zip-file-name] [*clean-load]"
Expand Down

0 comments on commit 4514c48

Please sign in to comment.