Upload / delete themes (#20)

- Moved themes to section of installation admin page (will also implement #23 there)
2022-07-24 19:18:20 -04:00 · 2022-07-24 19:18:20 -04:00 · d854178255
commit d854178255
parent 0a32181e65
10 changed files with 180 additions and 63 deletions
--- a/src/MyWebLog.Data/Interfaces.fs
+++ b/src/MyWebLog.Data/Interfaces.fs
@ -170,6 +170,12 @@ type IThemeData =
    /// Retrieve all themes (except "admin") (excluding the text of templates)
    abstract member All : unit -> Task<Theme list>
    
+    /// Delete a theme
+    abstract member Delete : ThemeId -> Task<bool>
+    
+    /// Determine if a theme exists
+    abstract member Exists : ThemeId -> Task<bool>
+    
    /// Find a theme by its ID
    abstract member FindById : ThemeId -> Task<Theme option>
    
--- a/src/MyWebLog.Data/RethinkDbData.fs
+++ b/src/MyWebLog.Data/RethinkDbData.fs
@ -180,6 +180,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
    /// The batch size for restoration methods
    let restoreBatchSize = 100
    
+    /// Delete assets for the given theme ID
+    let deleteAssetsByTheme themeId = rethink {
+        withTable Table.ThemeAsset
+        filter (matchAssetByThemeId themeId)
+        delete
+        write; withRetryDefault; ignoreResult conn
+    }
+
    /// The connection for this instance
    member _.Conn = conn
    
@ -720,6 +728,16 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                    result; withRetryDefault conn
                }
                
+                member _.Exists themeId = backgroundTask {
+                    let! count = rethink<int> {
+                        withTable Table.Theme
+                        filter (nameof Theme.empty.Id) themeId
+                        count
+                        result; withRetryDefault conn
+                    }
+                    return count > 0
+                }
+                
                member _.FindById themeId = rethink<Theme> {
                    withTable Table.Theme
                    get themeId
@ -733,6 +751,20 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                    resultOption; withRetryOptionDefault conn
                }
                
+                member this.Delete themeId = backgroundTask {
+                    match! this.FindByIdWithoutText themeId with
+                    | Some _ ->
+                        do! deleteAssetsByTheme themeId
+                        do! rethink {
+                            withTable Table.Theme
+                            get themeId
+                            delete
+                            write; withRetryDefault; ignoreResult conn
+                        }
+                        return true
+                    | None -> return false
+                }
+                
                member _.Save theme = rethink {
                    withTable Table.Theme
                    get theme.Id
@ -750,12 +782,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                    result; withRetryDefault conn
                }
                
-                member _.DeleteByTheme themeId = rethink {
-                    withTable Table.ThemeAsset
-                    filter (matchAssetByThemeId themeId)
-                    delete
-                    write; withRetryDefault; ignoreResult conn
-                }
+                member _.DeleteByTheme themeId = deleteAssetsByTheme themeId
                
                member _.FindById assetId = rethink<ThemeAsset> {
                    withTable Table.ThemeAsset
--- a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs
+++ b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs
@ -26,6 +26,15 @@ type SQLiteThemeData (conn : SqliteConnection) =
                { t with Templates = templates |> List.filter (fun tt -> fst tt = t.Id) |> List.map snd })
    }
    
+    /// Does a given theme exist?
+    let exists themeId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT COUNT(id) FROM theme WHERE id = @id"
+        cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
+        let! count = count cmd
+        return count > 0
+    }
+    
    /// Find a theme by its ID
    let findById themeId = backgroundTask {
        use cmd = conn.CreateCommand ()
@ -53,6 +62,21 @@ type SQLiteThemeData (conn : SqliteConnection) =
        | None -> return None
    }
    
+    /// Delete a theme by its ID
+    let delete themeId = backgroundTask {
+        match! findByIdWithoutText themeId with
+        | Some _ ->
+            use cmd = conn.CreateCommand ()
+            cmd.CommandText <- """
+                DELETE FROM theme_asset    WHERE theme_id = @id;
+                DELETE FROM theme_template WHERE theme_id = @id;
+                DELETE FROM theme          WHERE id       = @id"""
+            cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
+            do! write cmd
+            return true
+        | None -> return false
+    }
+    
    /// Save a theme
    let save (theme : Theme) = backgroundTask {
        use cmd = conn.CreateCommand ()
@ -112,6 +136,8 @@ type SQLiteThemeData (conn : SqliteConnection) =
    
    interface IThemeData with
        member _.All () = all ()
+        member _.Delete themeId = delete themeId
+        member _.Exists themeId = exists themeId
        member _.FindById themeId = findById themeId
        member _.FindByIdWithoutText themeId = findByIdWithoutText themeId
        member _.Save theme = save theme
--- a/src/MyWebLog/Handlers/Admin.fs
+++ b/src/MyWebLog/Handlers/Admin.fs
@ -6,7 +6,9 @@ open Giraffe
 open MyWebLog
 open MyWebLog.ViewModels

-// GET /admin
+// ~~ DASHBOARDS ~~
+
+// GET /admin/dashboard
 let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
    let getCount (f : WebLogId -> Task<int>) = f ctx.WebLog.Id
    let data    = ctx.Data
@ -30,7 +32,24 @@ let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
        |> adminView "dashboard" next ctx
 }

-// -- CATEGORIES --
+// GET /admin/dashboard/administration
+let adminDashboard : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
+    let! themes = ctx.Data.Theme.All ()
+    let! bodyTemplate = TemplateCache.get adminTheme "theme-list-body" ctx.Data
+    let! hash =
+        hashForPage "myWebLog Administration"
+        |> withAntiCsrf ctx
+        |> addToHash "themes" (themes |> List.map (DisplayTheme.fromTheme WebLogCache.isThemeInUse) |> Array.ofList)
+        |> addViewContext ctx
+    return!
+        addToHash "theme_list" (bodyTemplate.Render hash) hash
+        |> adminView "admin-dashboard" next ctx
+}
+
+/// Redirect the user to the admin dashboard
+let toAdminDashboard : HttpHandler = redirectToGet "admin/dashboard/administration"
+
+// ~~ CATEGORIES ~~

 // GET /admin/categories
 let listCategories : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
@ -106,7 +125,7 @@ let deleteCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next

 open Microsoft.AspNetCore.Http

-// -- TAG MAPPINGS --
+// ~~ TAG MAPPINGS ~~

 /// Get the hash necessary to render the tag mapping list
 let private tagMappingHash (ctx : HttpContext) = task {
@ -173,7 +192,7 @@ let deleteMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun nex
    return! tagMappingsBare next ctx
 }

-// -- THEMES --
+// ~~ THEMES ~~

 open System
 open System.IO
@ -181,24 +200,21 @@ open System.IO.Compression
 open System.Text.RegularExpressions
 open MyWebLog.Data

-// GET /admin/themes
-let listThemes : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
+// GET /admin/theme/list
+let listThemes : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { 
    let! themes = ctx.Data.Theme.All ()
-    let! bodyTemplate = TemplateCache.get adminTheme "theme-list-body" ctx.Data
-    let hash =
-        hashForPage "Theme Administration"
+    return!
+        hashForPage "Themes"
        |> withAntiCsrf ctx
        |> addToHash "themes" (themes |> List.map (DisplayTheme.fromTheme WebLogCache.isThemeInUse) |> Array.ofList)
-    return!
-        addToHash "theme_list" (bodyTemplate.Render hash) hash
-        |> adminView "theme-list" next ctx
+        |> adminBareView "theme-list-body" next ctx
 }

 // GET /admin/theme/new
 let addTheme : HttpHandler = requireAccess Administrator >=> fun next ctx ->
    hashForPage "Upload a Theme File"
    |> withAntiCsrf ctx
-    |> adminView "theme-upload" next ctx
+    |> adminBareView "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 {
@ -278,10 +294,10 @@ let saveTheme : HttpHandler = requireAccess Administrator >=> fun next ctx -> ta
        let themeFile = Seq.head ctx.Request.Form.Files
        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<UploadThemeModel> ()
+            let  data   = ctx.Data
+            let! exists = data.Theme.Exists themeId
+            let  isNew  = not exists
+            let! model  = ctx.BindFormAsync<UploadThemeModel> ()
            if isNew || model.DoOverwrite then 
                // Load the theme to the database
                use stream = new MemoryStream ()
@ -290,26 +306,45 @@ let saveTheme : HttpHandler = requireAccess Administrator >=> fun next ctx -> ta
                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
+                use file = new FileStream ($"{ThemeId.toString themeId}-theme.zip", FileMode.Create)
+                do! themeFile.CopyToAsync file
+                do! addMessage ctx
+                        { UserMessage.success with
+                            Message = $"""Theme {if isNew then "add" else "updat"}ed successfully"""
+                        }
+                return! toAdminDashboard 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
+                return! toAdminDashboard next ctx
        | Ok _ ->
            do! addMessage ctx { UserMessage.error with Message = "You may not replace the admin theme" }
-            return! redirectToGet "admin/theme/new" next ctx
+            return! toAdminDashboard next ctx
        | Error message ->
            do! addMessage ctx { UserMessage.error with Message = message }
-            return! redirectToGet "admin/theme/update" next ctx
+            return! toAdminDashboard next ctx
    else return! RequestErrors.BAD_REQUEST "Bad request" next ctx
 }

-// -- WEB LOG SETTINGS --
+// POST /admin/theme/{id}/delete
+let deleteTheme themeId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
+    let data = ctx.Data
+    if themeId = "admin" || themeId = "default" then
+        do! addMessage ctx { UserMessage.error with Message = $"You may not delete the {themeId} theme" }
+        return! listThemes next ctx
+    else
+        match! data.Theme.Delete (ThemeId themeId) with
+        | true ->
+            let zippedTheme = $"{themeId}-theme.zip"
+            if File.Exists zippedTheme then File.Delete zippedTheme
+            do! addMessage ctx { UserMessage.success with Message = $"Theme ID {themeId} deleted successfully" }
+            return! listThemes next ctx
+        | false -> return! Error.notFound next ctx
+}
+
+// ~~ WEB LOG SETTINGS ~~

 open System.Collections.Generic

--- a/src/MyWebLog/Handlers/Routes.fs
+++ b/src/MyWebLog/Handlers/Routes.fs
@ -111,7 +111,8 @@ let router : HttpHandler = choose [
                route  "ies/bare"  >=> Admin.listCategoriesBare
                routef "y/%s/edit"     Admin.editCategory
            ])
-            route    "/dashboard" >=> Admin.dashboard
+            route    "/dashboard"                >=> Admin.dashboard
+            route    "/dashboard/administration" >=> Admin.adminDashboard
            subRoute "/page" (choose [
                route  "s"                       >=> Page.all 1
                routef "s/page/%i"                   Page.all
@ -141,8 +142,8 @@ let router : HttpHandler = choose [
                ])
            ])
            subRoute "/theme" (choose [
-                route "s"    >=> Admin.listThemes
-                route "/new" >=> Admin.addTheme
+                route "/list" >=> Admin.listThemes
+                route "/new"  >=> Admin.addTheme
            ])
            subRoute "/upload" (choose [
                route "s"    >=> Upload.list
@ -188,7 +189,10 @@ let router : HttpHandler = choose [
                    routef "/%s/delete"     Admin.deleteMapping
                ])
            ])
-            route    "/theme/new" >=> Admin.saveTheme
+            subRoute "/theme" (choose [
+                route  "/new"       >=> Admin.saveTheme
+                routef "/%s/delete"     Admin.deleteTheme
+            ])
            subRoute "/upload" (choose [
                route   "/save"        >=> Upload.save
                routexp "/delete/(.*)"     Upload.deleteFromDisk
--- a/src/admin-theme/_layout.liquid
+++ b/src/admin-theme/_layout.liquid
@ -21,7 +21,7 @@
              {{ "admin/settings" | nav_link: "Settings" }}
            {%- endif %}
            {%- if is_administrator %}
-              {{ "admin/themes" | nav_link: "Themes" }}
+              {{ "admin/dashboard/administration" | nav_link: "Admin" }}
            {%- endif %}
          </ul>
        {%- endif %}
--- a/src/admin-theme/admin-dashboard.liquid
+++ b/src/admin-theme/admin-dashboard.liquid
@ -0,0 +1,32 @@
+<h2 class="my-3">{{ page_title }}</h2>
+<article>
+  <fieldset class="container pb-3">
+    <legend>Themes</legend>
+    <div class="row">
+      <div class="col">
+        <a href="{{ "admin/theme/new" | relative_link }}" class="btn btn-primary btn-sm mb-3"
+           hx-target="#theme_new">
+          Upload a New Theme
+        </a>
+        <div class="container">
+          {% include_template "_theme-list-columns" %}
+          <div class="row mwl-table-heading">
+            <div class="{{ theme_col }}">Theme</div>
+            <div class="{{ slug_col }} d-none d-md-inline-block">Slug</div>
+            <div class="{{ tmpl_col }} d-none d-md-inline-block">Templates</div>
+          </div>
+        </div>
+        <div class="row mwl-table-detail" id="theme_new"></div>
+        {{ theme_list }}
+      </div>
+    </div>
+  </fieldset>
+  <fieldset class="container">
+    <legend>Caches</legend>
+    <div class="row">
+      <div class="col">
+        TODO
+      </div>
+    </div>
+  </fieldset>
+</article>
--- a/src/admin-theme/theme-list-body.liquid
+++ b/src/admin-theme/theme-list-body.liquid
@ -1,6 +1,5 @@
 <form method="post" id="themeList" class="container" hx-target="this" hx-swap="outerHTML show:window:top">
  <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-  <div class="row mwl-table-detail" id="theme_new"></div>
  {% include_template "_theme-list-columns" %}
  {% for theme in themes -%}
    <div class="row mwl-table-detail" id="theme_{{ theme.id }}">
@ -16,7 +15,7 @@
          <span class="text-muted">v{{ theme.version }}</span>
          {% unless theme.is_in_use or theme.id == "default" %}
            <span class="text-muted"> &bull; </span>
-            {%- assign theme_del_link = "admin/" | append: theme.id | append: "/delete" | relative_link -%}
+            {%- assign theme_del_link = "admin/theme/" | append: theme.id | append: "/delete" | relative_link -%}
            <a href="{{ theme_del_link }}" hx-post="{{ theme_del_link }}" class="text-danger"
               hx-confirm="Are you sure you want to delete the theme &ldquo;{{ theme.name }}&rdquo;? This action cannot be undone.">
              Delete
--- a/src/admin-theme/theme-list.liquid
+++ b/src/admin-theme/theme-list.liquid
@ -1,16 +0,0 @@
-<h2 class="my-3">{{ page_title }}</h2>
-<article>
-  <a href="{{ "admin/theme/upload" | relative_link }}" class="btn btn-primary btn-sm mb-3"
-     hx-target="#theme_new">
-    Upload a New Theme
-  </a>
-  <div class="container">
-    {% include_template "_theme-list-columns" %}
-    <div class="row mwl-table-heading">
-      <div class="{{ theme_col }}">Theme</div>
-      <div class="{{ slug_col }} d-none d-md-inline-block">Slug</div>
-      <div class="{{ tmpl_col }} d-none d-md-inline-block">Templates</div>
-    </div>
-  </div>
-  {{ theme_list }}
-</article>
--- a/src/admin-theme/theme-upload.liquid
+++ b/src/admin-theme/theme-upload.liquid
@ -1,26 +1,30 @@
-<h2>{{ page_title }}</h2>
-<article>
-  <form action="{{ "admin/theme/new" | relative_link }}"
-        method="post" class="container" enctype="multipart/form-data" hx-boost="false">
+<div class="col">
+  <h5>{{ page_title }}</h5>
+  <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">
-      <div class="col-12 col-sm-6 offset-sm-3 pb-3">
+      <div class="col-12 col-sm-6 pb-3">
        <div class="form-floating">
          <input type="file" id="file" name="file" class="form-control" accept=".zip" placeholder="Theme File" required>
          <label for="file">Theme File</label>
        </div>
      </div>
-      <div class="col-12 col-sm-6 pb-3">
+      <div class="col-12 col-sm-6 pb-3 d-flex justify-content-center align-items-center">
        <div class="form-check form-switch pb-2">
          <input type="checkbox" name="DoOverwrite" id="doOverwrite" class="form-check-input" value="true">
-          <label for="doOverwrite" class="form-check-label">Overwrite an Existing Theme If Required</label>
+          <label for="doOverwrite" class="form-check-label">Overwrite</label>
        </div>
      </div>
    </div>
    <div class="row pb-3">
      <div class="col text-center">
-        <button type="submit" class="btn btn-primary">Upload Theme</button>
+        <button type="submit" class="btn btn-sm btn-primary">Upload Theme</button>
+        <button type="button" class="btn btn-sm btn-secondary ms-3"
+                onclick="document.getElementById('theme_new').innerHTML = ''">
+          Cancel
+        </button>
      </div>
    </div>
  </form>
-</article>
+</div>