First cut at cache management (#23)

This commit is contained in:
Daniel J. Summers 2022-07-24 23:55:00 -04:00
parent e103738d39
commit ff9c08842b
4 changed files with 195 additions and 21 deletions

View File

@ -80,6 +80,10 @@ module WebLogCache =
let set webLog = let set webLog =
_cache <- webLog :: (_cache |> List.filter (fun wl -> wl.Id <> webLog.Id)) _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 /// Fill the web log cache from the database
let fill (data : IData) = backgroundTask { let fill (data : IData) = backgroundTask {
let! webLogs = data.WebLog.All () let! webLogs = data.WebLog.All ()
@ -97,22 +101,30 @@ module PageListCache =
open MyWebLog.ViewModels open MyWebLog.ViewModels
/// Cache of displayed pages /// Cache of displayed pages
let private _cache = ConcurrentDictionary<string, DisplayPage[]> () let private _cache = ConcurrentDictionary<WebLogId, DisplayPage[]> ()
/// Are there pages cached for this web log? let private fillPages (webLog : WebLog) pages =
let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.UrlBase _cache[webLog.Id] <-
/// 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] <-
pages pages
|> List.map (fun pg -> DisplayPage.fromPage webLog { pg with Text = "" }) |> List.map (fun pg -> DisplayPage.fromPage webLog { pg with Text = "" })
|> Array.ofList |> 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 open MyWebLog.ViewModels
/// The cache itself /// The cache itself
let private _cache = ConcurrentDictionary<string, DisplayCategory[]> () let private _cache = ConcurrentDictionary<WebLogId, DisplayCategory[]> ()
/// Are there categories cached for this web log? /// 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 /// 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 /// Update the cache with fresh data
let update (ctx : HttpContext) = backgroundTask { let update (ctx : HttpContext) = backgroundTask {
let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.Id 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] 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 /// Invalidate all template cache entries for the given theme ID
let invalidateTheme (themeId : ThemeId) = let invalidateTheme (themeId : ThemeId) =
let keyPrefix = ThemeId.toString themeId let keyPrefix = ThemeId.toString themeId
@ -176,6 +198,10 @@ module TemplateCache =
|> List.ofSeq |> List.ofSeq
|> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ()) |> 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 /// A cache of asset names by themes
module ThemeAssetCache = module ThemeAssetCache =

View File

@ -34,12 +34,28 @@ let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
// GET /admin/dashboard/administration // GET /admin/dashboard/administration
let adminDashboard : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { let adminDashboard : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let! themes = ctx.Data.Theme.All () let! themes = ctx.Data.Theme.All ()
let! bodyTemplate = TemplateCache.get adminTheme "theme-list-body" ctx.Data let! bodyTemplate = TemplateCache.get adminTheme "theme-list-body" ctx.Data
let cachedTemplates = TemplateCache.allNames ()
let! hash = let! hash =
hashForPage "myWebLog Administration" hashForPage "myWebLog Administration"
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash "themes" (themes |> List.map (DisplayTheme.fromTheme WebLogCache.isThemeInUse) |> Array.ofList) |> 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 |> addViewContext ctx
return! return!
addToHash "theme_list" (bodyTemplate.Render hash) hash 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 /// Redirect the user to the admin dashboard
let toAdminDashboard : HttpHandler = redirectToGet "admin/dashboard/administration" 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 ~~ // ~~ CATEGORIES ~~
// GET /admin/categories // GET /admin/categories

View File

@ -157,6 +157,10 @@ let router : HttpHandler = choose [
]) ])
] ]
POST >=> validateCsrf >=> choose [ POST >=> validateCsrf >=> choose [
subRoute "/cache" (choose [
routef "/theme/%s/refresh" Admin.refreshThemeCache
routef "/web-log/%s/refresh" Admin.refreshWebLogCache
])
subRoute "/category" (choose [ subRoute "/category" (choose [
route "/save" >=> Admin.saveCategory route "/save" >=> Admin.saveCategory
routef "/%s/delete" Admin.deleteCategory routef "/%s/delete" Admin.deleteCategory

View File

@ -1,6 +1,6 @@
<h2 class="my-3">{{ page_title }}</h2> <h2 class="my-3">{{ page_title }}</h2>
<article> <article>
<fieldset class="container pb-3"> <fieldset class="container mb-3">
<legend>Themes</legend> <legend>Themes</legend>
<div class="row"> <div class="row">
<div class="col"> <div class="col">
@ -22,10 +22,90 @@
</div> </div>
</fieldset> </fieldset>
<fieldset class="container"> <fieldset class="container">
{%- assign cache_base_url = "admin/cache/" -%}
<legend>Caches</legend> <legend>Caches</legend>
<div class="row"> <div class="row pb-3">
<div class="col"> <div class="col">
TODO <p>
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.
</p>
</div>
</div>
<div class="row">
<div class="col-12 col-lg-6 pb-3">
<div class="card">
<header class="card-header text-white bg-secondary">Web Logs</header>
<div class="card-body">
<h6 class="card-subtitle text-muted pb-3">
These caches include the page list and categories for each web log
</h6>
{%- assign web_log_base_url = cache_base_url | append: "web-log/" -%}
<form method="post" class="container pb-3" hx-boost="false" hx-target="body" hx-swap="innerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<button type="submit" class="btn btn-sm btn-primary pb-2"
hx-post="{{ web_log_base_url | append: "all/refresh" | relative_link }}">
Refresh All
</button>
<div class="row mwl-table-heading">
<div class="col">Name</div>
<div class="col">URL Base</div>
</div>
{%- for web_log in web_logs %}
<div class="row mwl-table-detail">
<div class="col">
{{ web_log[1] }}<br>
<small>
{%- assign refresh_url = web_log_base_url | append: web_log[0] | append: "/refresh" | relative_link -%}
<a href="{{ refresh_url }}" hx-post="{{ refresh_url }}">Refresh</a>
</small>
</div>
<div class="col">{{ web_log[2] }}</div>
</div>
{%- endfor %}
</form>
</div>
</div>
</div>
<div class="col-12 col-lg-6 pb-3">
<div class="card">
<header class="card-header text-white bg-secondary">Themes</header>
<div class="card-body">
<h6 class="card-subtitle text-muted pb-3">
The themes template cache is loaded on demand; refresh a cache with 0 templates will still refresh the
theme asset cache
</h6>
{%- assign theme_base_url = cache_base_url | append: "theme/" -%}
<form method="post" class="container pb-3" hx-boost="false" hx-target="body" hx-swap="innerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<button type="submit" class="btn btn-sm btn-primary pb-2"
hx-post="{{ theme_base_url | append: "all/refresh" | relative_link }}">
Refresh All
</button>
<div class="row mwl-table-heading">
<div class="col-8">Name</div>
<div class="col-4">Cached Templates</div>
</div>
{%- for theme in cached_themes %}
{% unless theme[0] == "admin" %}
<div class="row mwl-table-detail">
<div class="col-8">
{{ theme[1] }}<br>
<small>
<span class="text-muted">{{ theme[0] }} &bull; </span>
{%- assign refresh_url = theme_base_url | append: theme[0] | append: "/refresh" | relative_link -%}
<a href="{{ refresh_url }}" hx-post="{{ refresh_url }}">Refresh</a>
</small>
</div>
<div class="col-4">{{ theme[2] }}</div>
</div>
{% endunless %}
{%- endfor %}
</form>
</div>
</div>
</div> </div>
</div> </div>
</fieldset> </fieldset>