From 0a32181e65728d172748f24cb9afefbd21f644fe Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sun, 24 Jul 2022 16:32:37 -0400 Subject: [PATCH] WIP on theme upload (#20) --- src/MyWebLog.Domain/ViewModels.fs | 8 ++ src/MyWebLog/Caches.fs | 5 +- src/MyWebLog/Handlers/Admin.fs | 80 ++++++++++--------- src/MyWebLog/Handlers/Routes.fs | 6 +- src/MyWebLog/Maintenance.fs | 12 ++- ...pload-theme.liquid => theme-upload.liquid} | 8 +- 6 files changed, 66 insertions(+), 53 deletions(-) rename src/admin-theme/{upload-theme.liquid => theme-upload.liquid} (73%) diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index f7c61eb..757bb96 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -1161,6 +1161,14 @@ type UploadFileModel = } +/// View model for uploading a theme +[] +type UploadThemeModel = + { /// Whether the uploaded theme should overwrite an existing theme + DoOverwrite : bool + } + + /// A message displayed to the user [] type UserMessage = diff --git a/src/MyWebLog/Caches.fs b/src/MyWebLog/Caches.fs index ce7b49a..28f20fa 100644 --- a/src/MyWebLog/Caches.fs +++ b/src/MyWebLog/Caches.fs @@ -169,9 +169,10 @@ module TemplateCache = } /// Invalidate all template cache entries for the given theme ID - let invalidateTheme (themeId : string) = + let invalidateTheme (themeId : ThemeId) = + let keyPrefix = ThemeId.toString themeId _cache.Keys - |> Seq.filter (fun key -> key.StartsWith themeId) + |> Seq.filter (fun key -> key.StartsWith keyPrefix) |> List.ofSeq |> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ()) diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index b63384e..3d12bd9 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -194,11 +194,11 @@ let listThemes : HttpHandler = requireAccess Administrator >=> fun next ctx -> t |> adminView "theme-list" next ctx } -// GET /admin/theme/update -let themeUpdatePage : HttpHandler = requireAccess Administrator >=> fun next ctx -> - hashForPage "Upload Theme" +// GET /admin/theme/new +let addTheme : HttpHandler = requireAccess Administrator >=> fun next ctx -> + hashForPage "Upload a Theme File" |> withAntiCsrf ctx - |> adminView "upload-theme" next ctx + |> adminView "theme-upload" next ctx /// Update the name and version for a theme based on the version.txt file, if present let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = backgroundTask { @@ -214,14 +214,6 @@ let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = background | None -> return { theme with Name = ThemeId.toString theme.Id; Version = now () } } -/// Delete all theme assets, and remove templates from theme -let private checkForCleanLoad (theme : Theme) cleanLoad (data : IData) = backgroundTask { - if cleanLoad then - do! data.ThemeAsset.DeleteByTheme theme.Id - return { theme with Templates = [] } - else return theme -} - /// Update the theme with all templates from the ZIP archive let private updateTemplates (theme : Theme) (zip : ZipArchive) = backgroundTask { let tasks = @@ -255,48 +247,62 @@ let private updateAssets themeId (zip : ZipArchive) (data : IData) = backgroundT } /// Get the theme name from the file name given -let getThemeName (fileName : string) = +let getThemeIdFromFileName (fileName : string) = let themeName = fileName.Split(".").[0].ToLowerInvariant().Replace (" ", "-") 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" + if Regex.IsMatch (themeName, """^[a-z0-9\-]+$""") then + Ok (ThemeId (themeName.Substring (0, themeName.Length - 6))) + else Error $"Theme ID {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 { - use zip = new ZipArchive (file, ZipArchiveMode.Read) - let themeId = ThemeId themeName - let! theme = backgroundTask { +let loadThemeFromZip themeId file (data : IData) = backgroundTask { + let! isNew, theme = backgroundTask { match! data.Theme.FindById themeId with - | Some t -> return t - | None -> return { Theme.empty with Id = themeId } + | Some t -> return false, t + | None -> return true, { Theme.empty with Id = themeId } } - let! theme = updateNameAndVersion theme zip - let! theme = checkForCleanLoad theme clean data - let! theme = updateTemplates theme zip + use zip = new ZipArchive (file, ZipArchiveMode.Read) + let! theme = updateNameAndVersion theme zip + if not isNew then do! data.ThemeAsset.DeleteByTheme theme.Id + let! theme = updateTemplates { theme with Templates = [] } zip do! data.Theme.Save theme do! updateAssets themeId zip data return theme } -// POST /admin/theme/update -let updateTheme : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { +// POST /admin/theme/new +let saveTheme : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then let themeFile = Seq.head ctx.Request.Form.Files - match getThemeName themeFile.FileName with - | Ok themeName when themeName <> "admin" -> - let data = ctx.Data - use stream = new MemoryStream () - do! themeFile.CopyToAsync stream - 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" } - return! redirectToGet "admin/dashboard" next ctx + match getThemeIdFromFileName themeFile.FileName with + | Ok themeId when themeId <> adminTheme -> + let data = ctx.Data + let! theme = data.Theme.FindByIdWithoutText themeId + let isNew = Option.isNone theme + let! model = ctx.BindFormAsync () + if isNew || model.DoOverwrite then + // Load the theme to the database + use stream = new MemoryStream () + do! themeFile.CopyToAsync stream + let! _ = loadThemeFromZip themeId stream data + do! ThemeAssetCache.refreshTheme themeId data + TemplateCache.invalidateTheme themeId + // Save the .zip file + use file = new FileStream ($"{themeId}-theme.zip", FileMode.Create) + do! stream.CopyToAsync file + do! addMessage ctx { UserMessage.success with Message = "Theme updated successfully" } + return! redirectToGet "admin/dashboard" next ctx + else + do! addMessage ctx + { UserMessage.error with + Message = "Theme exists and overwriting was not requested; nothing saved" + } + return! redirectToGet "admin/theme/new" next ctx | Ok _ -> do! addMessage ctx { UserMessage.error with Message = "You may not replace the admin theme" } - return! redirectToGet "admin/theme/update" next ctx + return! redirectToGet "admin/theme/new" next ctx | Error message -> do! addMessage ctx { UserMessage.error with Message = message } return! redirectToGet "admin/theme/update" next ctx diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs index 0dbe5f9..4448c47 100644 --- a/src/MyWebLog/Handlers/Routes.fs +++ b/src/MyWebLog/Handlers/Routes.fs @@ -141,8 +141,8 @@ let router : HttpHandler = choose [ ]) ]) subRoute "/theme" (choose [ - route "s" >=> Admin.listThemes - route "/update" >=> Admin.themeUpdatePage + route "s" >=> Admin.listThemes + route "/new" >=> Admin.addTheme ]) subRoute "/upload" (choose [ route "s" >=> Upload.list @@ -188,7 +188,7 @@ let router : HttpHandler = choose [ routef "/%s/delete" Admin.deleteMapping ]) ]) - route "/theme/update" >=> Admin.updateTheme + route "/theme/new" >=> Admin.saveTheme subRoute "/upload" (choose [ route "/save" >=> Upload.save routexp "/delete/(.*)" Upload.deleteFromDisk diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index bbbeede..2c2dccd 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -132,26 +132,24 @@ open Microsoft.Extensions.Logging /// Load a theme from the given ZIP file let loadTheme (args : string[]) (sp : IServiceProvider) = task { - if args.Length > 1 then + if args.Length = 2 then let fileName = match args[1].LastIndexOf Path.DirectorySeparatorChar with | -1 -> args[1] | it -> args[1][(it + 1)..] - match Handlers.Admin.getThemeName fileName with - | Ok themeName -> + match Handlers.Admin.getThemeIdFromFileName fileName with + | Ok themeId -> let data = sp.GetRequiredService () - let clean = if args.Length > 2 then bool.Parse args[2] else true use stream = File.Open (args[1], FileMode.Open) use copy = new MemoryStream () do! stream.CopyToAsync copy - let! theme = Handlers.Admin.loadThemeFromZip themeName copy clean data + let! theme = Handlers.Admin.loadThemeFromZip themeId copy data let fac = sp.GetRequiredService () 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]" - eprintfn " * optional, defaults to true" + eprintfn "Usage: MyWebLog load-theme [theme-zip-file-name]" } /// Back up a web log's data diff --git a/src/admin-theme/upload-theme.liquid b/src/admin-theme/theme-upload.liquid similarity index 73% rename from src/admin-theme/upload-theme.liquid rename to src/admin-theme/theme-upload.liquid index 5066cdc..c014487 100644 --- a/src/admin-theme/upload-theme.liquid +++ b/src/admin-theme/theme-upload.liquid @@ -1,6 +1,6 @@ -

Upload a Theme

+

{{ page_title }}

-
@@ -12,8 +12,8 @@
- - + +