bit-badger/myWebLog
1
0
Fork 0
Code Issues 4 Pull Requests Packages Projects Releases 11 Activity

First cut at cache management (#23)

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

58
src/MyWebLog/Caches.fs
View File

@@ -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<string, DisplayPage[]> ()
let private _cache = ConcurrentDictionary<WebLogId, DisplayPage[]> ()
/// 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<string, DisplayCategory[]> ()
let private _cache = ConcurrentDictionary<WebLogId, DisplayCategory[]> ()
/// 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

68
src/MyWebLog/Handlers/Admin.fs
View File

@@ -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

4
src/MyWebLog/Handlers/Routes.fs
View File

@@ -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