WIP on theme upload (#20)

src/MyWebLog.Domain/ViewModels.fs

@@ -1161,6 +1161,14 @@ type UploadFileModel =
     }
 
 
+/// View model for uploading a theme
+[<CLIMutable; NoComparison; NoEquality>]
+type UploadThemeModel =
+    {   /// Whether the uploaded theme should overwrite an existing theme
+        DoOverwrite : bool
+    }
+
+
 /// A message displayed to the user
 [<CLIMutable; NoComparison; NoEquality>]
 type UserMessage =

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 _, _ -> ())
 

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
+// GET /admin/theme/new
-let themeUpdatePage : HttpHandler = requireAccess Administrator >=> fun next ctx ->
+let addTheme : HttpHandler = requireAccess Administrator >=> fun next ctx ->
-    hashForPage "Upload Theme"
+    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))
+        if Regex.IsMatch (themeName, """^[a-z0-9\-]+$""") then
-        else Error $"Theme name {fileName} is invalid"
+            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 {
+let loadThemeFromZip themeId file (data : IData) = backgroundTask {
-    use  zip     = new ZipArchive (file, ZipArchiveMode.Read)
+    let! isNew, theme = backgroundTask {
-    let  themeId = ThemeId themeName
-    let! theme   = backgroundTask {
         match! data.Theme.FindById themeId with
-        | Some t -> return t
+        | Some t -> return false, t
-        | None   -> return { Theme.empty with Id = themeId }
+        | None   -> return true, { Theme.empty with Id = themeId }
     }
+    use  zip   = new ZipArchive (file, ZipArchiveMode.Read)
     let! theme = updateNameAndVersion theme zip
-    let! theme = checkForCleanLoad    theme   clean data
+    if not isNew then do! data.ThemeAsset.DeleteByTheme theme.Id
-    let! theme = updateTemplates      theme   zip
+    let! theme = updateTemplates { theme with Templates = [] } zip
     do! data.Theme.Save theme
     do! updateAssets themeId zip data
     
     return theme
 }
 
-// POST /admin/theme/update
+// POST /admin/theme/new
-let updateTheme : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
+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
+        match getThemeIdFromFileName themeFile.FileName with
-        | Ok themeName when themeName <> "admin" ->
+        | Ok themeId when themeId <> adminTheme ->
             let  data  = ctx.Data
+            let! theme = data.Theme.FindByIdWithoutText themeId
+            let  isNew = Option.isNone theme
+            let! model = ctx.BindFormAsync<UploadThemeModel> ()
+            if isNew || model.DoOverwrite then 
+                // Load the theme to the database
                 use stream = new MemoryStream ()
                 do! themeFile.CopyToAsync stream
-            let! _ = loadThemeFromZip themeName stream true data
+                let! _ = loadThemeFromZip themeId stream data
-            do! ThemeAssetCache.refreshTheme (ThemeId themeName) data
+                do! ThemeAssetCache.refreshTheme themeId data
-            TemplateCache.invalidateTheme themeName
+                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

src/MyWebLog/Handlers/Routes.fs

@@ -142,7 +142,7 @@ let router : HttpHandler = choose [
             ])
             subRoute "/theme" (choose [
                 route "s"    >=> Admin.listThemes
-                route "/update" >=> Admin.themeUpdatePage
+                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

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
+        match Handlers.Admin.getThemeIdFromFileName fileName with
-        | Ok themeName ->
+        | Ok themeId ->
             let data   = sp.GetRequiredService<IData> ()
-            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<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]"
+        eprintfn "Usage: MyWebLog load-theme [theme-zip-file-name]"
-        eprintfn "         * optional, defaults to true"
 }
 
 /// Back up a web log's data

src/admin-theme/theme-upload.liquid

@@ -1,6 +1,6 @@
-<h2>Upload a Theme</h2>
+<h2>{{ page_title }}</h2>
 <article>
-  <form action="{{ "admin/theme/update" | relative_link }}"
+  <form action="{{ "admin/theme/new" | relative_link }}"
         method="post" class="container" enctype="multipart/form-data" hx-boost="false">
     <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
     <div class="row">
@@ -12,8 +12,8 @@
       </div>
       <div class="col-12 col-sm-6 pb-3">
         <div class="form-check form-switch pb-2">
-          <input type="checkbox" name="clean" id="clean" class="form-check-input" value="true">
+          <input type="checkbox" name="DoOverwrite" id="doOverwrite" class="form-check-input" value="true">
-          <label for="clean" class="form-check-label">Delete Existing Theme Files</label>
+          <label for="doOverwrite" class="form-check-label">Overwrite an Existing Theme If Required</label>
         </div>
       </div>
     </div>