From d8541782556784410b7a3893133866c16e6a53cc Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sun, 24 Jul 2022 19:18:20 -0400 Subject: [PATCH] Upload / delete themes (#20) - Moved themes to section of installation admin page (will also implement #23 there) --- src/MyWebLog.Data/Interfaces.fs | 6 ++ src/MyWebLog.Data/RethinkDbData.fs | 39 ++++++++-- src/MyWebLog.Data/SQLite/SQLiteThemeData.fs | 26 +++++++ src/MyWebLog/Handlers/Admin.fs | 85 +++++++++++++++------ src/MyWebLog/Handlers/Routes.fs | 12 ++- src/admin-theme/_layout.liquid | 2 +- src/admin-theme/admin-dashboard.liquid | 32 ++++++++ src/admin-theme/theme-list-body.liquid | 3 +- src/admin-theme/theme-list.liquid | 16 ---- src/admin-theme/theme-upload.liquid | 22 +++--- 10 files changed, 180 insertions(+), 63 deletions(-) create mode 100644 src/admin-theme/admin-dashboard.liquid delete mode 100644 src/admin-theme/theme-list.liquid diff --git a/src/MyWebLog.Data/Interfaces.fs b/src/MyWebLog.Data/Interfaces.fs index 91d58f3..1adbd39 100644 --- 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 + /// Delete a theme + abstract member Delete : ThemeId -> Task + + /// Determine if a theme exists + abstract member Exists : ThemeId -> Task + /// Find a theme by its ID abstract member FindById : ThemeId -> Task diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index 0e529f6..0947d9d 100644 --- 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 { + withTable Table.Theme + filter (nameof Theme.empty.Id) themeId + count + result; withRetryDefault conn + } + return count > 0 + } + member _.FindById themeId = rethink { withTable Table.Theme get themeId @@ -733,6 +751,20 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger + 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 { withTable Table.ThemeAsset diff --git a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs index 0674aa4..53c4204 100644 --- 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 diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index 3d12bd9..286b615 100644 --- 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) = 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 () + let data = ctx.Data + let! exists = data.Theme.Exists themeId + let isNew = not exists + let! model = ctx.BindFormAsync () 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 diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs index 4448c47..89fa80c 100644 --- 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 diff --git a/src/admin-theme/_layout.liquid b/src/admin-theme/_layout.liquid index 82cf089..1fa59df 100644 --- 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 %} {%- endif %} diff --git a/src/admin-theme/admin-dashboard.liquid b/src/admin-theme/admin-dashboard.liquid new file mode 100644 index 0000000..1eeee40 --- /dev/null +++ b/src/admin-theme/admin-dashboard.liquid @@ -0,0 +1,32 @@ +

{{ page_title }}

+
+
+ Themes +
+
+ + Upload a New Theme + +
+ {% include_template "_theme-list-columns" %} +
+
Theme
+
Slug
+
Templates
+
+
+
+ {{ theme_list }} +
+
+
+
+ Caches +
+
+ TODO +
+
+
+
diff --git a/src/admin-theme/theme-list-body.liquid b/src/admin-theme/theme-list-body.liquid index 6df0e57..c48d54c 100644 --- a/src/admin-theme/theme-list-body.liquid +++ b/src/admin-theme/theme-list-body.liquid @@ -1,6 +1,5 @@ 
-
{% include_template "_theme-list-columns" %} {% for theme in themes -%}
@@ -16,7 +15,7 @@ v{{ theme.version }} {% unless theme.is_in_use or theme.id == "default" %} • - {%- 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 -%} Delete diff --git a/src/admin-theme/theme-list.liquid b/src/admin-theme/theme-list.liquid deleted file mode 100644 index 7fb20b0..0000000 --- a/src/admin-theme/theme-list.liquid +++ /dev/null @@ -1,16 +0,0 @@ -

{{ page_title }}

- diff --git a/src/admin-theme/theme-upload.liquid b/src/admin-theme/theme-upload.liquid index c014487..95932fe 100644 --- a/src/admin-theme/theme-upload.liquid +++ b/src/admin-theme/theme-upload.liquid @@ -1,26 +1,30 @@ -

{{ page_title }}

-
- +
+
{{ page_title }}
+
-
+
-
+
- +
- + +
-
+