2022-04-18 22:06:17 +00:00
|
|
|
namespace MyWebLog
|
|
|
|
|
|
|
|
open Microsoft.AspNetCore.Http
|
|
|
|
|
2022-05-22 22:24:09 +00:00
|
|
|
/// Extension properties on HTTP context for web log
|
|
|
|
[<AutoOpen>]
|
|
|
|
module Extensions =
|
|
|
|
|
|
|
|
open Microsoft.Extensions.DependencyInjection
|
|
|
|
open RethinkDb.Driver.Net
|
|
|
|
|
|
|
|
type HttpContext with
|
|
|
|
/// The web log for the current request
|
|
|
|
member this.WebLog = this.Items["webLog"] :?> WebLog
|
|
|
|
|
|
|
|
/// The RethinkDB data connection
|
|
|
|
member this.Conn = this.RequestServices.GetRequiredService<IConnection> ()
|
2022-04-18 22:06:17 +00:00
|
|
|
|
2022-05-22 22:24:09 +00:00
|
|
|
|
2022-04-18 22:06:17 +00:00
|
|
|
open System.Collections.Concurrent
|
|
|
|
|
|
|
|
/// <summary>
|
|
|
|
/// In-memory cache of web log details
|
|
|
|
/// </summary>
|
|
|
|
/// <remarks>This is filled by the middleware via the first request for each host, and can be updated via the web log
|
|
|
|
/// settings update page</remarks>
|
|
|
|
module WebLogCache =
|
2022-05-22 02:55:13 +00:00
|
|
|
|
2022-04-18 22:06:17 +00:00
|
|
|
/// The cache of web log details
|
2022-05-22 02:55:13 +00:00
|
|
|
let mutable private _cache : WebLog list = []
|
2022-04-18 22:06:17 +00:00
|
|
|
|
2022-05-22 22:24:09 +00:00
|
|
|
/// Try to get the web log for the current request (longest matching URL base wins)
|
2022-05-22 22:59:48 +00:00
|
|
|
let tryGet (path : string) =
|
2022-05-22 22:24:09 +00:00
|
|
|
_cache
|
|
|
|
|> List.filter (fun wl -> path.StartsWith wl.urlBase)
|
|
|
|
|> List.sortByDescending (fun wl -> wl.urlBase.Length)
|
|
|
|
|> List.tryHead
|
2022-04-18 22:06:17 +00:00
|
|
|
|
|
|
|
/// Cache the web log for a particular host
|
2022-05-22 02:55:13 +00:00
|
|
|
let set webLog =
|
|
|
|
_cache <- webLog :: (_cache |> List.filter (fun wl -> wl.id <> webLog.id))
|
|
|
|
|
|
|
|
/// Fill the web log cache from the database
|
|
|
|
let fill conn = backgroundTask {
|
|
|
|
let! webLogs = Data.WebLog.all conn
|
|
|
|
_cache <- webLogs
|
|
|
|
}
|
2022-04-18 22:06:17 +00:00
|
|
|
|
2022-04-28 00:01:33 +00:00
|
|
|
|
2022-04-18 22:06:17 +00:00
|
|
|
/// A cache of page information needed to display the page list in templates
|
|
|
|
module PageListCache =
|
|
|
|
|
|
|
|
open MyWebLog.ViewModels
|
|
|
|
|
|
|
|
/// Cache of displayed pages
|
|
|
|
let private _cache = ConcurrentDictionary<string, DisplayPage[]> ()
|
|
|
|
|
2022-05-22 02:55:13 +00:00
|
|
|
/// Are there pages cached for this web log?
|
2022-05-22 22:24:09 +00:00
|
|
|
let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.urlBase
|
2022-05-22 02:55:13 +00:00
|
|
|
|
2022-04-18 22:06:17 +00:00
|
|
|
/// Get the pages for the web log for this request
|
2022-05-22 22:24:09 +00:00
|
|
|
let get (ctx : HttpContext) = _cache[ctx.WebLog.urlBase]
|
2022-04-18 22:06:17 +00:00
|
|
|
|
|
|
|
/// Update the pages for the current web log
|
2022-05-22 02:55:13 +00:00
|
|
|
let update (ctx : HttpContext) = backgroundTask {
|
2022-05-22 22:24:09 +00:00
|
|
|
let webLog = ctx.WebLog
|
|
|
|
let! pages = Data.Page.findListed webLog.id ctx.Conn
|
|
|
|
_cache[webLog.urlBase] <- pages |> List.map (DisplayPage.fromPage webLog) |> Array.ofList
|
2022-04-18 22:06:17 +00:00
|
|
|
}
|
|
|
|
|
2022-04-27 02:24:17 +00:00
|
|
|
|
|
|
|
/// Cache of all categories, indexed by web log
|
|
|
|
module CategoryCache =
|
|
|
|
|
|
|
|
open MyWebLog.ViewModels
|
|
|
|
|
|
|
|
/// The cache itself
|
|
|
|
let private _cache = ConcurrentDictionary<string, DisplayCategory[]> ()
|
|
|
|
|
2022-05-22 02:55:13 +00:00
|
|
|
/// Are there categories cached for this web log?
|
2022-05-22 22:24:09 +00:00
|
|
|
let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.urlBase
|
2022-05-22 02:55:13 +00:00
|
|
|
|
2022-04-27 02:24:17 +00:00
|
|
|
/// Get the categories for the web log for this request
|
2022-05-22 22:24:09 +00:00
|
|
|
let get (ctx : HttpContext) = _cache[ctx.WebLog.urlBase]
|
2022-04-27 02:24:17 +00:00
|
|
|
|
2022-04-28 00:01:33 +00:00
|
|
|
/// Update the cache with fresh data
|
2022-05-22 02:55:13 +00:00
|
|
|
let update (ctx : HttpContext) = backgroundTask {
|
2022-05-22 22:24:09 +00:00
|
|
|
let! cats = Data.Category.findAllForView ctx.WebLog.id ctx.Conn
|
|
|
|
_cache[ctx.WebLog.urlBase] <- cats
|
2022-04-28 00:01:33 +00:00
|
|
|
}
|
2022-04-27 02:24:17 +00:00
|
|
|
|
|
|
|
|
2022-04-18 22:06:17 +00:00
|
|
|
/// Cache for parsed templates
|
|
|
|
module TemplateCache =
|
|
|
|
|
|
|
|
open DotLiquid
|
|
|
|
open System.IO
|
|
|
|
|
|
|
|
/// Cache of parsed templates
|
|
|
|
let private _cache = ConcurrentDictionary<string, Template> ()
|
|
|
|
|
|
|
|
/// Get a template for the given theme and template nate
|
2022-05-22 02:55:13 +00:00
|
|
|
let get (theme : string) (templateName : string) = backgroundTask {
|
2022-04-18 22:06:17 +00:00
|
|
|
let templatePath = $"themes/{theme}/{templateName}"
|
|
|
|
match _cache.ContainsKey templatePath with
|
|
|
|
| true -> ()
|
|
|
|
| false ->
|
|
|
|
let! file = File.ReadAllTextAsync $"{templatePath}.liquid"
|
|
|
|
_cache[templatePath] <- Template.Parse (file, SyntaxCompatibility.DotLiquid22)
|
|
|
|
return _cache[templatePath]
|
|
|
|
}
|
|
|
|
|