danieljsummers
3a19952f39
- Fix redirect rule handling with endpoint routing (#59) - Make subtitle non-nullable string (#47)
232 lines
9.9 KiB
FSharp
232 lines
9.9 KiB
FSharp
namespace MyWebLog
|
|
|
|
open Microsoft.AspNetCore.Http
|
|
open MyWebLog.Data
|
|
|
|
/// <summary>Extension properties on HTTP context for web log</summary>
|
|
[<AutoOpen>]
|
|
module Extensions =
|
|
|
|
open System.Security.Claims
|
|
open Microsoft.AspNetCore.Antiforgery
|
|
open Microsoft.Extensions.Configuration
|
|
open Microsoft.Extensions.DependencyInjection
|
|
|
|
/// Hold variable for the configured generator string
|
|
let mutable private generatorString: string option = None
|
|
|
|
type HttpContext with
|
|
|
|
/// <summary>The anti-CSRF service</summary>
|
|
member this.AntiForgery = this.RequestServices.GetRequiredService<IAntiforgery>()
|
|
|
|
/// <summary>The cross-site request forgery token set for this request</summary>
|
|
member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this
|
|
|
|
/// <summary>The data implementation</summary>
|
|
member this.Data = this.RequestServices.GetRequiredService<IData>()
|
|
|
|
/// <summary>The generator string</summary>
|
|
member this.Generator =
|
|
match generatorString with
|
|
| Some gen -> gen
|
|
| None ->
|
|
let cfg = this.RequestServices.GetRequiredService<IConfiguration>()
|
|
generatorString <-
|
|
match Option.ofObj cfg["Generator"] with
|
|
| Some gen -> Some gen
|
|
| None -> Some "generator not configured"
|
|
generatorString.Value
|
|
|
|
/// <summary>The access level for the current user</summary>
|
|
member this.UserAccessLevel =
|
|
this.User.Claims
|
|
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.Role)
|
|
|> Option.map (fun claim -> AccessLevel.Parse claim.Value)
|
|
|
|
/// <summary>The user ID for the current request</summary>
|
|
member this.UserId =
|
|
WebLogUserId (this.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value
|
|
|
|
/// <summary>The web log for the current request</summary>
|
|
member this.WebLog = this.Items["webLog"] :?> WebLog
|
|
|
|
/// <summary>Does the current user have the required level of access?</summary>
|
|
/// <param name="level">The required level of access</param>
|
|
/// <returns>True if the user has the required access, false if not</returns>
|
|
member this.HasAccessLevel level =
|
|
defaultArg (this.UserAccessLevel |> Option.map _.HasAccess(level)) false
|
|
|
|
|
|
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 =
|
|
|
|
open System.Text.RegularExpressions
|
|
|
|
/// <summary>A redirect rule that caches compiled regular expression rules</summary>
|
|
type CachedRedirectRule =
|
|
/// <summary>A straight text match rule</summary>
|
|
| Text of string * string
|
|
/// <summary>A regular expression match rule</summary>
|
|
| RegEx of Regex * string
|
|
|
|
/// The cache of web log details
|
|
let mutable private _cache: WebLog list = []
|
|
|
|
/// Redirect rules with compiled regular expressions
|
|
let mutable private _redirectCache = ConcurrentDictionary<WebLogId, CachedRedirectRule list>()
|
|
|
|
/// <summary>Try to get the web log for the current request (longest matching URL base wins)</summary>
|
|
/// <param name="path">The path for the current request</param>
|
|
/// <returns>Some with the web log matching the URL, or None if none is found</returns>
|
|
let tryGet (path: string) =
|
|
_cache
|
|
|> List.filter (fun wl -> path.StartsWith wl.UrlBase)
|
|
|> List.sortByDescending _.UrlBase.Length
|
|
|> List.tryHead
|
|
|
|
/// <summary>Cache the web log for a particular host</summary>
|
|
/// <param name="webLog">The web log to be cached</param>
|
|
let set webLog =
|
|
_cache <- webLog :: (_cache |> List.filter (fun wl -> wl.Id <> webLog.Id))
|
|
_redirectCache[webLog.Id] <-
|
|
webLog.RedirectRules
|
|
|> List.map (fun it ->
|
|
let relUrl = Permalink >> webLog.RelativeUrl
|
|
let urlTo = if it.To.Contains "://" then it.To else relUrl it.To
|
|
if it.IsRegex then
|
|
RegEx(Regex(it.From, RegexOptions.Compiled ||| RegexOptions.IgnoreCase), urlTo)
|
|
else
|
|
Text(it.From, urlTo))
|
|
|
|
/// <summary>Get all cached web logs</summary>
|
|
/// <returns>All cached web logs</returns>
|
|
let all () =
|
|
_cache
|
|
|
|
/// <summary>Fill the web log cache from the database</summary>
|
|
/// <param name="data">The data implementation from which web logs will be retrieved</param>
|
|
let fill (data: IData) = backgroundTask {
|
|
let! webLogs = data.WebLog.All()
|
|
webLogs |> List.iter set
|
|
}
|
|
|
|
/// <summary>Get the cached redirect rules for the given web log</summary>
|
|
/// <param name="webLogId">The ID of the web log for which rules should be retrieved</param>
|
|
/// <returns>The redirect rules for the given web log ID</returns>
|
|
let redirectRules webLogId =
|
|
_redirectCache[webLogId]
|
|
|
|
/// <summary>Is the given theme in use by any web logs?</summary>
|
|
/// <param name="themeId">The ID of the theme whose use should be checked</param>
|
|
/// <returns>True if any web logs are using the given theme, false if not</returns>
|
|
let isThemeInUse themeId =
|
|
_cache |> List.exists (fun wl -> wl.ThemeId = themeId)
|
|
|
|
|
|
/// <summary>A cache of page information needed to display the page list in templates</summary>
|
|
module PageListCache =
|
|
|
|
open MyWebLog.ViewModels
|
|
|
|
/// Cache of displayed pages
|
|
let private _cache = ConcurrentDictionary<WebLogId, DisplayPage array>()
|
|
|
|
/// Fill the page list for the given web log
|
|
let private fillPages (webLog: WebLog) pages =
|
|
_cache[webLog.Id] <-
|
|
pages
|
|
|> List.map (fun pg -> DisplayPage.FromPage webLog { pg with Text = "" })
|
|
|> Array.ofList
|
|
|
|
/// <summary>Are there pages cached for this web log?</summary>
|
|
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
|
|
/// <returns>True if the current web log has any pages cached, false if not</returns>
|
|
let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id
|
|
|
|
/// <summary>Get the pages for the web log for this request</summary>
|
|
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
|
|
/// <returns>The page list for the current web log</returns>
|
|
let get (ctx: HttpContext) = _cache[ctx.WebLog.Id]
|
|
|
|
/// <summary>Refresh the pages for the given web log</summary>
|
|
/// <param name="webLog">The web log for which pages should be refreshed</param>
|
|
/// <param name="data">The data implementation from which pages should be retrieved</param>
|
|
let refresh (webLog: WebLog) (data: IData) = backgroundTask {
|
|
let! pages = data.Page.FindListed webLog.Id
|
|
fillPages webLog pages
|
|
}
|
|
|
|
/// <summary>Update the pages for the current web log</summary>
|
|
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
|
|
let update (ctx: HttpContext) =
|
|
refresh ctx.WebLog ctx.Data
|
|
|
|
|
|
/// <summary>Cache of all categories, indexed by web log</summary>
|
|
module CategoryCache =
|
|
|
|
open MyWebLog.ViewModels
|
|
|
|
/// The cache itself
|
|
let private _cache = ConcurrentDictionary<WebLogId, DisplayCategory array>()
|
|
|
|
/// <summary>Are there categories cached for this web log?</summary>
|
|
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
|
|
/// <returns>True if the current web logs has any categories cached, false if not</returns>
|
|
let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id
|
|
|
|
/// <summary>Get the categories for the web log for this request</summary>
|
|
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
|
|
/// <returns>The categories for the current web log</returns>
|
|
let get (ctx: HttpContext) = _cache[ctx.WebLog.Id]
|
|
|
|
/// <summary>Refresh the category cache for the given web log</summary>
|
|
/// <param name="webLogId">The ID of the web log for which the cache should be refreshed</param>
|
|
/// <param name="data">The data implementation from which categories should be retrieved</param>
|
|
let refresh webLogId (data: IData) = backgroundTask {
|
|
let! cats = data.Category.FindAllForView webLogId
|
|
_cache[webLogId] <- cats
|
|
}
|
|
|
|
/// <summary>Update the cache with fresh data for the current web log</summary>
|
|
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
|
|
let update (ctx: HttpContext) =
|
|
refresh ctx.WebLog.Id ctx.Data
|
|
|
|
|
|
/// <summary>A cache of asset names by themes</summary>
|
|
module ThemeAssetCache =
|
|
|
|
/// A list of asset names for each theme
|
|
let private _cache = ConcurrentDictionary<ThemeId, string list>()
|
|
|
|
/// <summary>Retrieve the assets for the given theme ID</summary>
|
|
/// <param name="themeId">The ID of the theme whose assets should be returned</param>
|
|
/// <returns>The assets for the given theme</returns>
|
|
let get themeId = _cache[themeId]
|
|
|
|
/// <summary>Refresh the list of assets for the given theme</summary>
|
|
/// <param name="themeId">The ID of the theme whose assets should be refreshed</param>
|
|
/// <param name="data">The data implementation from which assets should be retrieved</param>
|
|
let refreshTheme themeId (data: IData) = backgroundTask {
|
|
let! assets = data.ThemeAsset.FindByTheme themeId
|
|
_cache[themeId] <- assets |> List.map (fun a -> match a.Id with ThemeAssetId (_, path) -> path)
|
|
}
|
|
|
|
/// <summary>Fill the theme asset cache</summary>
|
|
/// <param name="data">The data implementation from which assets should be retrieved</param>
|
|
let fill (data: IData) = backgroundTask {
|
|
let! assets = data.ThemeAsset.All()
|
|
for asset in assets do
|
|
let (ThemeAssetId (themeId, path)) = asset.Id
|
|
if not (_cache.ContainsKey themeId) then _cache[themeId] <- []
|
|
_cache[themeId] <- path :: _cache[themeId]
|
|
}
|