diff --git a/src/MyWebLog/Caches.fs b/src/MyWebLog/Caches.fs index 28f20fa..de81cf2 100644 --- a/src/MyWebLog/Caches.fs +++ b/src/MyWebLog/Caches.fs @@ -80,6 +80,10 @@ module WebLogCache = let set webLog = _cache <- webLog :: (_cache |> List.filter (fun wl -> wl.Id <> webLog.Id)) + /// Get all cached web logs + let all () = + _cache + /// Fill the web log cache from the database let fill (data : IData) = backgroundTask { let! webLogs = data.WebLog.All () @@ -97,22 +101,30 @@ module PageListCache = open MyWebLog.ViewModels /// Cache of displayed pages - let private _cache = ConcurrentDictionary () + let private _cache = ConcurrentDictionary () - /// Are there pages cached for this web log? - let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.UrlBase - - /// Get the pages for the web log for this request - let get (ctx : HttpContext) = _cache[ctx.WebLog.UrlBase] - - /// Update the pages for the current web log - let update (ctx : HttpContext) = backgroundTask { - let webLog = ctx.WebLog - let! pages = ctx.Data.Page.FindListed webLog.Id - _cache[webLog.UrlBase] <- + let private fillPages (webLog : WebLog) pages = + _cache[webLog.Id] <- pages |> List.map (fun pg -> DisplayPage.fromPage webLog { pg with Text = "" }) |> Array.ofList + + /// Are there pages cached for this web log? + let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.Id + + /// Get the pages for the web log for this request + let get (ctx : HttpContext) = _cache[ctx.WebLog.Id] + + /// Update the pages for the current web log + let update (ctx : HttpContext) = backgroundTask { + let! pages = ctx.Data.Page.FindListed ctx.WebLog.Id + fillPages ctx.WebLog pages + } + + /// Refresh the pages for the given web log + let refresh (webLog : WebLog) (data : IData) = backgroundTask { + let! pages = data.Page.FindListed webLog.Id + fillPages webLog pages } @@ -122,18 +134,24 @@ module CategoryCache = open MyWebLog.ViewModels /// The cache itself - let private _cache = ConcurrentDictionary () + let private _cache = ConcurrentDictionary () /// Are there categories cached for this web log? - let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.UrlBase + let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.Id /// Get the categories for the web log for this request - let get (ctx : HttpContext) = _cache[ctx.WebLog.UrlBase] + let get (ctx : HttpContext) = _cache[ctx.WebLog.Id] /// Update the cache with fresh data let update (ctx : HttpContext) = backgroundTask { let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.Id - _cache[ctx.WebLog.UrlBase] <- cats + _cache[ctx.WebLog.Id] <- cats + } + + /// Refresh the category cache for the given web log + let refresh webLogId (data : IData) = backgroundTask { + let! cats = data.Category.FindAllForView webLogId + _cache[webLogId] <- cats } @@ -168,6 +186,10 @@ module TemplateCache = return _cache[templatePath] } + /// Get all theme/template names currently cached + let allNames () = + _cache.Keys |> Seq.sort |> Seq.toList + /// Invalidate all template cache entries for the given theme ID let invalidateTheme (themeId : ThemeId) = let keyPrefix = ThemeId.toString themeId @@ -175,6 +197,10 @@ module TemplateCache = |> Seq.filter (fun key -> key.StartsWith keyPrefix) |> List.ofSeq |> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ()) + + /// Remove all entries from the template cache + let empty () = + _cache.Clear () /// A cache of asset names by themes diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index e8d8ceb..cee5e12 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -34,12 +34,28 @@ let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task { // 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! themes = ctx.Data.Theme.All () + let! bodyTemplate = TemplateCache.get adminTheme "theme-list-body" ctx.Data + let cachedTemplates = TemplateCache.allNames () let! hash = hashForPage "myWebLog Administration" |> withAntiCsrf ctx |> addToHash "themes" (themes |> List.map (DisplayTheme.fromTheme WebLogCache.isThemeInUse) |> Array.ofList) + |> addToHash "cached_themes" ( + themes + |> Seq.ofList + |> Seq.map (fun it -> [| + ThemeId.toString it.Id + it.Name + cachedTemplates |> List.filter (fun n -> n.StartsWith (ThemeId.toString it.Id)) |> List.length |> string + |]) + |> Array.ofSeq) + |> addToHash "web_logs" ( + WebLogCache.all () + |> Seq.ofList + |> Seq.sortBy (fun it -> it.Name) + |> Seq.map (fun it -> [| WebLogId.toString it.Id; it.Name; it.UrlBase |]) + |> Array.ofSeq) |> addViewContext ctx return! addToHash "theme_list" (bodyTemplate.Render hash) hash @@ -49,6 +65,54 @@ let adminDashboard : HttpHandler = requireAccess Administrator >=> fun next ctx /// Redirect the user to the admin dashboard let toAdminDashboard : HttpHandler = redirectToGet "admin/dashboard/administration" +// ~~ CACHES ~~ + +// POST /admin/cache/web-log/{id}/refresh +let refreshWebLogCache webLogId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { + let data = ctx.Data + if webLogId = "all" then + do! WebLogCache.fill data + for webLog in WebLogCache.all () do + do! PageListCache.refresh webLog data + do! CategoryCache.refresh webLog.Id data + do! addMessage ctx { UserMessage.success with Message = "Successfully refresh web log cache for all web logs" } + else + match! data.WebLog.FindById (WebLogId webLogId) with + | Some webLog -> + WebLogCache.set webLog + do! PageListCache.refresh webLog data + do! CategoryCache.refresh webLog.Id data + do! addMessage ctx + { UserMessage.success with Message = $"Successfully refreshed web log cache for {webLog.Name}" } + | None -> + do! addMessage ctx { UserMessage.error with Message = $"No web log exists with ID {webLogId}" } + return! toAdminDashboard next ctx +} + +// POST /admin/cache/theme/{id}/refresh +let refreshThemeCache themeId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { + let data = ctx.Data + if themeId = "all" then + TemplateCache.empty () + do! ThemeAssetCache.fill data + do! addMessage ctx + { UserMessage.success with + Message = "Successfully cleared template cache and refreshed theme asset cache" + } + else + match! data.Theme.FindById (ThemeId themeId) with + | Some theme -> + TemplateCache.invalidateTheme theme.Id + do! ThemeAssetCache.refreshTheme theme.Id data + do! addMessage ctx + { UserMessage.success with + Message = $"Successfully cleared template cache and refreshed theme asset cache for {theme.Name}" + } + | None -> + do! addMessage ctx { UserMessage.error with Message = $"No theme exists with ID {themeId}" } + return! toAdminDashboard next ctx +} + // ~~ CATEGORIES ~~ // GET /admin/categories diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs index 89fa80c..da9a226 100644 --- a/src/MyWebLog/Handlers/Routes.fs +++ b/src/MyWebLog/Handlers/Routes.fs @@ -157,6 +157,10 @@ let router : HttpHandler = choose [ ]) ] POST >=> validateCsrf >=> choose [ + subRoute "/cache" (choose [ + routef "/theme/%s/refresh" Admin.refreshThemeCache + routef "/web-log/%s/refresh" Admin.refreshWebLogCache + ]) subRoute "/category" (choose [ route "/save" >=> Admin.saveCategory routef "/%s/delete" Admin.deleteCategory diff --git a/src/admin-theme/admin-dashboard.liquid b/src/admin-theme/admin-dashboard.liquid index 1eeee40..fbede29 100644 --- a/src/admin-theme/admin-dashboard.liquid +++ b/src/admin-theme/admin-dashboard.liquid @@ -1,6 +1,6 @@ 

{{ page_title }}

-
+
Themes
@@ -22,10 +22,90 @@
+ {%- assign cache_base_url = "admin/cache/" -%} Caches -
+
- TODO +

+ myWebLog uses a few caches to ensure that it serves pages as fast as possible. Normal actions taken within the + admin area will keep these up to date; however, if changes occur outside of the system (creating a new web log + via CLI, loading an updated theme via CLI, direct data updates, etc.), these options allow for the caches to + be refreshed without requiring you to restart the application. +

+
+
+
+
+
+
Web Logs
+
+
+ These caches include the page list and categories for each web log +
+ {%- assign web_log_base_url = cache_base_url | append: "web-log/" -%} +
+ + +
+
Name
+
URL Base
+
+ {%- for web_log in web_logs %} +
+
+ {{ web_log[1] }}
+ + {%- assign refresh_url = web_log_base_url | append: web_log[0] | append: "/refresh" | relative_link -%} + Refresh + +
+
{{ web_log[2] }}
+
+ {%- endfor %} +
+
+
+
+
+
+
Themes
+
+
+ The themes template cache is loaded on demand; refresh a cache with 0 templates will still refresh the + theme asset cache +
+ {%- assign theme_base_url = cache_base_url | append: "theme/" -%} +
+ + +
+
Name
+
Cached Templates
+
+ {%- for theme in cached_themes %} + {% unless theme[0] == "admin" %} +
+
+ {{ theme[1] }}
+ + {{ theme[0] }} • + {%- assign refresh_url = theme_base_url | append: theme[0] | append: "/refresh" | relative_link -%} + Refresh + +
+
{{ theme[2] }}
+
+ {% endunless %} + {%- endfor %} +
+
+