From 17178c3290272d680980d92fad588a8c4166b966 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Tue, 7 Jun 2022 14:22:17 -0400 Subject: [PATCH] Add theme asset cache - Use asset cache in Liquid head/foot tags - Set 30-day cache header for theme assets --- src/MyWebLog.Data/Data.fs | 29 ++++++++++++++++++++++++++--- src/MyWebLog/Caches.fs | 24 ++++++++++++++++++++++++ src/MyWebLog/DotLiquidBespoke.fs | 2 +- src/MyWebLog/Handlers/Admin.fs | 4 +++- src/MyWebLog/Handlers/Routes.fs | 4 ++++ src/MyWebLog/Program.fs | 1 + 6 files changed, 59 insertions(+), 5 deletions(-) diff --git a/src/MyWebLog.Data/Data.fs b/src/MyWebLog.Data/Data.fs index 8f7a6ac..79c71c9 100644 --- a/src/MyWebLog.Data/Data.fs +++ b/src/MyWebLog.Data/Data.fs @@ -737,12 +737,26 @@ module Theme = /// Functions to manipulate theme assets module ThemeAsset = + open RethinkDb.Driver.Ast + + /// Match the ID by its prefix (the theme ID) + let private matchById themeId = + let keyPrefix = $"^{ThemeId.toString themeId}/" + fun (row : ReqlExpr) -> row["id"].Match keyPrefix :> obj + + /// List all theme assets (excludes data) + let all = + rethink { + withTable Table.ThemeAsset + without [ "data" ] + result; withRetryDefault + } + /// Delete all assets for a theme let deleteByTheme themeId = - let keyPrefix = $"^{ThemeId.toString themeId}/" rethink { withTable Table.ThemeAsset - filter (fun row -> row["id"].Match keyPrefix :> obj) + filter (matchById themeId) delete write; withRetryDefault; ignoreResult } @@ -755,7 +769,16 @@ module ThemeAsset = resultOption; withRetryOptionDefault } - /// Save a theme assed + /// List all assets for a theme (data excluded) + let findByThemeId (themeId : ThemeId) = + rethink { + withTable Table.ThemeAsset + filter (matchById themeId) + without [ "data" ] + result; withRetryDefault + } + + /// Save a theme asset let save (asset : ThemeAsset) = rethink { withTable Table.ThemeAsset diff --git a/src/MyWebLog/Caches.fs b/src/MyWebLog/Caches.fs index 817ee0e..dc93aa7 100644 --- a/src/MyWebLog/Caches.fs +++ b/src/MyWebLog/Caches.fs @@ -131,3 +131,27 @@ module TemplateCache = |> List.ofSeq |> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ()) + +/// A cache of asset names by themes +module ThemeAssetCache = + + /// A list of asset names for each theme + let private _cache = ConcurrentDictionary () + + /// Retrieve the assets for the given theme ID + let get themeId = _cache[themeId] + + /// Refresh the list of assets for the given theme + let refreshTheme themeId conn = backgroundTask { + let! assets = Data.ThemeAsset.findByThemeId themeId conn + _cache[themeId] <- assets |> List.map (fun a -> match a.id with ThemeAssetId (_, path) -> path) + } + + /// Fill the theme asset cache + let fill conn = backgroundTask { + let! assets = Data.ThemeAsset.all conn + for asset in assets do + let (ThemeAssetId (themeId, path)) = asset.id + if not (_cache.ContainsKey themeId) then _cache[themeId] <- [] + _cache[themeId] <- path :: _cache[themeId] + } diff --git a/src/MyWebLog/DotLiquidBespoke.fs b/src/MyWebLog/DotLiquidBespoke.fs index 95c1578..4940d7e 100644 --- a/src/MyWebLog/DotLiquidBespoke.fs +++ b/src/MyWebLog/DotLiquidBespoke.fs @@ -14,7 +14,7 @@ let webLog (ctx : Context) = /// Does an asset exist for the current theme? let assetExists fileName (webLog : WebLog) = - File.Exists (Path.Combine ("wwwroot", "themes", webLog.themePath, fileName)) + ThemeAssetCache.get (ThemeId webLog.themePath) |> List.exists (fun it -> it = fileName) /// Obtain the link from known types let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> string) = diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index e91decc..0484940 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -444,9 +444,11 @@ let updateTheme : HttpHandler = fun next ctx -> task { let themeName = themeFile.FileName.Split(".").[0].ToLowerInvariant().Replace (" ", "-") // TODO: add restriction for admin theme based on role if Regex.IsMatch (themeName, """^[a-z0-9\-]+$""") then + let conn = ctx.Conn use stream = new MemoryStream () do! themeFile.CopyToAsync stream - do! loadThemeFromZip themeName stream true ctx.Conn + do! loadThemeFromZip themeName stream true conn + do! ThemeAssetCache.refreshTheme (ThemeId themeName) conn do! addMessage ctx { UserMessage.success with message = "Theme updated successfully" } return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/dashboard")) next ctx else diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs index 4411456..59b8527 100644 --- a/src/MyWebLog/Handlers/Routes.fs +++ b/src/MyWebLog/Handlers/Routes.fs @@ -126,6 +126,10 @@ module Asset = let headers = ResponseHeaders ctx.Response.Headers headers.LastModified <- Some (DateTimeOffset asset.updatedOn) |> Option.toNullable headers.ContentType <- MediaTypeHeaderValue mimeType + headers.CacheControl <- + let hdr = CacheControlHeaderValue() + hdr.MaxAge <- Some (TimeSpan.FromDays 30) |> Option.toNullable + hdr return! setBody asset.data next ctx | None -> return! Error.notFound next ctx } diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 3516637..8e51246 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -63,6 +63,7 @@ let main args = let! conn = rethinkCfg.CreateConnectionAsync () do! Data.Startup.ensureDb rethinkCfg (loggerFac.CreateLogger (nameof Data.Startup)) conn do! WebLogCache.fill conn + do! ThemeAssetCache.fill conn return conn } |> Async.AwaitTask |> Async.RunSynchronously let _ = builder.Services.AddSingleton conn