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

Reassign child cats when deleting parent cat (#27)

Browse Source 
- Create common page/post edit field template (#25)
- Fix relative URL adjustment throughout
- Fix upload name sanitization regex
- Create modules within Admin handler module
- Enable/disable podcast episode fields on page load
- Fix upload destination casing in templates
- Tweak default theme to show no posts found on index template
- Update Bootstrap to 5.1.3 in default theme
This commit is contained in:
Daniel J. Summers 2022-07-28 20:36:02 -04:00
parent 6b49793fbb
commit 33698bd182
22 changed files with 926 additions and 898 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/MyWebLog.Data/Interfaces.fs
View File

@ -5,6 +5,16 @@ open System.Threading.Tasks
open MyWebLog
open MyWebLog.ViewModels
/// The result of a category deletion attempt
type CategoryDeleteResult =
/// The category was deleted successfully
| CategoryDeleted
/// The category was deleted successfully, and its children were reassigned to its parent
| ReassignedChildCategories
/// The category was not found, so no effort was made to delete it
| CategoryNotFound
/// Data functions to support manipulating categories
type ICategoryData =
@ -18,7 +28,7 @@ type ICategoryData =
abstract member CountTopLevel : WebLogId -> Task<int>
/// Delete a category (also removes it from posts)
abstract member Delete : CategoryId -> WebLogId -> Task<bool>
abstract member Delete : CategoryId -> WebLogId -> Task<CategoryDeleteResult>
/// Find all categories for a web log, sorted alphabetically and grouped by hierarchy
abstract member FindAllForView : WebLogId -> Task<DisplayCategory[]>

20
src/MyWebLog.Data/RethinkDbData.fs
View File

@ -274,7 +274,21 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member this.Delete catId webLogId = backgroundTask {
match! this.FindById catId webLogId with
| Some _ ->
| Some cat ->
// Reassign any children to the category's parent category
let! children = rethink<int> {
withTable Table.Category
filter (nameof Category.empty.ParentId) catId
count
result; withRetryDefault conn
}
if children > 0 then
do! rethink {
withTable Table.Category
filter (nameof Category.empty.ParentId) catId
update [ nameof Category.empty.ParentId, cat.ParentId :> obj ]
write; withRetryDefault; ignoreResult conn
}
// Delete the category off all posts where it is assigned
do! rethink {
withTable Table.Post
@ -291,8 +305,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
delete
write; withRetryDefault; ignoreResult conn
}
return true
| None -> return false
return if children = 0 then CategoryDeleted else ReassignedChildCategories
| None -> return CategoryNotFound
}
member _.Restore cats = backgroundTask {

16
src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs
View File

@ -122,13 +122,23 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Delete a category
let delete catId webLogId = backgroundTask {
match! findById catId webLogId with
| Some _ ->
| Some cat ->
use cmd = conn.CreateCommand ()
// Reassign any children to the category's parent category
cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE parent_id = @parentId"
cmd.Parameters.AddWithValue ("@parentId", CategoryId.toString catId) |> ignore
let! children = count cmd
if children > 0 then
cmd.CommandText <- "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId"
cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
|> ignore
do! write cmd
// Delete the category off all posts where it is assigned
cmd.CommandText <- """
DELETE FROM post_category
WHERE category_id = @id
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)"""
cmd.Parameters.Clear ()
let catIdParameter = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
do! write cmd
@ -137,8 +147,8 @@ type SQLiteCategoryData (conn : SqliteConnection) =
cmd.Parameters.Clear ()
cmd.Parameters.Add catIdParameter |> ignore
do! write cmd
return true
| None -> return false
return if children = 0 then CategoryDeleted else ReassignedChildCategories
| None -> return CategoryNotFound
}
/// Restore categories from a backup

15
src/MyWebLog.Domain/ViewModels.fs
View File

@ -12,6 +12,17 @@ module private Helpers =
match (defaultArg (Option.ofObj it) "").Trim () with "" -> None | trimmed -> Some trimmed
/// Helper functions that are needed outside this file
[<AutoOpen>]
module PublicHelpers =
/// If the web log is not being served from the domain root, add the path information to relative URLs in page and
/// post text
let addBaseToRelativeUrls extra (text : string) =
if extra = "" then text
else text.Replace("href=\"/", $"href=\"{extra}/").Replace ("src=\"/", $"src=\"{extra}/")
/// The model used to display the admin dashboard
[<NoComparison; NoEquality>]
type DashboardModel =
@ -147,7 +158,7 @@ type DisplayPage =
UpdatedOn = page.UpdatedOn
IsInPageList = page.IsInPageList
IsDefault = pageId = webLog.DefaultPage
Text = if extra = "" then page.Text else page.Text.Replace ("href=\"/", $"href=\"{extra}/")
Text = addBaseToRelativeUrls extra page.Text
Metadata = page.Metadata
}
@ -1061,7 +1072,7 @@ type PostListItem =
Permalink = Permalink.toString post.Permalink
PublishedOn = post.PublishedOn |> Option.map inTZ |> Option.toNullable
UpdatedOn = inTZ post.UpdatedOn
Text = if extra = "" then post.Text else post.Text.Replace ("href=\"/", $"href=\"{extra}/")
Text = addBaseToRelativeUrls extra post.Text
CategoryIds = post.CategoryIds |> List.map CategoryId.toString
Tags = post.Tags
Episode = post.Episode

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

@ -6,484 +6,513 @@ open Giraffe
open MyWebLog
open MyWebLog.ViewModels
// ~~ DASHBOARDS ~~
// GET /admin/dashboard
let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let getCount (f : WebLogId -> Task<int>) = f ctx.WebLog.Id
let data = ctx.Data
let posts = getCount (data.Post.CountByStatus Published)
let drafts = getCount (data.Post.CountByStatus Draft)
let pages = getCount data.Page.CountAll
let listed = getCount data.Page.CountListed
let cats = getCount data.Category.CountAll
let topCats = getCount data.Category.CountTopLevel
let! _ = Task.WhenAll (posts, drafts, pages, listed, cats, topCats)
return!
hashForPage "Dashboard"
|> addToHash ViewContext.Model {
Posts = posts.Result
Drafts = drafts.Result
Pages = pages.Result
ListedPages = listed.Result
Categories = cats.Result
TopLevelCategories = topCats.Result
}
|> adminView "dashboard" next ctx
}
// GET /admin/administration
let adminDashboard : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
match! TemplateCache.get adminTheme "theme-list-body" ctx.Data with
| Ok bodyTemplate ->
let! themes = ctx.Data.Theme.All ()
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
/// ~~ DASHBOARDS ~~
module Dashboard =
// GET /admin/dashboard
let user : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let getCount (f : WebLogId -> Task<int>) = f ctx.WebLog.Id
let data = ctx.Data
let posts = getCount (data.Post.CountByStatus Published)
let drafts = getCount (data.Post.CountByStatus Draft)
let pages = getCount data.Page.CountAll
let listed = getCount data.Page.CountListed
let cats = getCount data.Category.CountAll
let topCats = getCount data.Category.CountTopLevel
let! _ = Task.WhenAll (posts, drafts, pages, listed, cats, topCats)
return!
addToHash "theme_list" (bodyTemplate.Render hash) hash
|> adminView "admin-dashboard" next ctx
| Error message -> return! Error.server message next ctx
}
hashForPage "Dashboard"
|> addToHash ViewContext.Model {
Posts = posts.Result
Drafts = drafts.Result
Pages = pages.Result
ListedPages = listed.Result
Categories = cats.Result
TopLevelCategories = topCats.Result
}
|> adminView "dashboard" next ctx
}
// GET /admin/administration
let admin : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
match! TemplateCache.get adminTheme "theme-list-body" ctx.Data with
| Ok bodyTemplate ->
let! themes = ctx.Data.Theme.All ()
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
|> adminView "admin-dashboard" next ctx
| Error message -> return! Error.server message next ctx
}
/// Redirect the user to the admin dashboard
let toAdminDashboard : HttpHandler = redirectToGet "admin/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
/// ~~ CACHES ~~
module Cache =
// POST /admin/cache/web-log/{id}/refresh
let refreshWebLog 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 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
}
{ 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
// POST /admin/cache/theme/{id}/refresh
let refreshTheme 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 for {theme.Name}"
Message = "Successfully cleared template cache and refreshed theme asset cache"
}
| None ->
do! addMessage ctx { UserMessage.error with Message = $"No theme exists with ID {themeId}" }
return! toAdminDashboard next ctx
}
// ~~ CATEGORIES ~~
// GET /admin/categories
let listCategories : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! TemplateCache.get adminTheme "category-list-body" ctx.Data with
| Ok catListTemplate ->
let! hash =
hashForPage "Categories"
|> withAntiCsrf ctx
|> addViewContext ctx
return!
addToHash "category_list" (catListTemplate.Render hash) hash
|> adminView "category-list" next ctx
| Error message -> return! Error.server message next ctx
}
// GET /admin/categories/bare
let listCategoriesBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
hashForPage "Categories"
|> withAntiCsrf ctx
|> adminBareView "category-list-body" next ctx
// GET /admin/category/{id}/edit
let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! result = task {
match catId with
| "new" -> return Some ("Add a New Category", { Category.empty with Id = CategoryId "new" })
| _ ->
match! ctx.Data.Category.FindById (CategoryId catId) ctx.WebLog.Id with
| Some cat -> return Some ("Edit Category", cat)
| None -> return None
}
match result with
| Some (title, cat) ->
return!
hashForPage title
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditCategoryModel.fromCategory cat)
|> adminBareView "category-edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/category/save
let saveCategory : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditCategoryModel> ()
let category =
if model.IsNew then someTask { Category.empty with Id = CategoryId.create (); WebLogId = ctx.WebLog.Id }
else data.Category.FindById (CategoryId model.CategoryId) ctx.WebLog.Id
match! category with
| Some cat ->
let updatedCat =
{ cat with
Name = model.Name
Slug = model.Slug
Description = if model.Description = "" then None else Some model.Description
ParentId = if model.ParentId = "" then None else Some (CategoryId model.ParentId)
}
do! (if model.IsNew then data.Category.Add else data.Category.Update) updatedCat
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Category saved successfully" }
return! listCategoriesBare next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/category/{id}/delete
let deleteCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Category.Delete (CategoryId catId) ctx.WebLog.Id with
| true ->
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Category deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with Message = "Category not found; cannot delete" }
return! listCategoriesBare next ctx
}
open Microsoft.AspNetCore.Http
// ~~ TAG MAPPINGS ~~
/// Add tag mappings to the given hash
let private withTagMappings (ctx : HttpContext) hash = task {
let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
return
addToHash "mappings" mappings hash
|> addToHash "mapping_ids" (mappings |> List.map (fun it -> { Name = it.Tag; Value = TagMapId.toString it.Id }))
}
// GET /admin/settings/tag-mappings
let tagMappings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash =
hashForPage ""
|> withAntiCsrf ctx
|> withTagMappings ctx
return! adminBareView "tag-mapping-list-body" next ctx hash
}
// GET /admin/settings/tag-mapping/{id}/edit
let editMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let isNew = tagMapId = "new"
let tagMap =
if isNew then someTask { TagMap.empty with Id = TagMapId "new" }
else ctx.Data.TagMap.FindById (TagMapId tagMapId) ctx.WebLog.Id
match! tagMap with
| Some tm ->
return!
hashForPage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag")
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditTagMapModel.fromMapping tm)
|> adminBareView "tag-mapping-edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/settings/tag-mapping/save
let saveMapping : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel> ()
let tagMap =
if model.IsNew then someTask { TagMap.empty with Id = TagMapId.create (); WebLogId = ctx.WebLog.Id }
else data.TagMap.FindById (TagMapId model.Id) ctx.WebLog.Id
match! tagMap with
| Some tm ->
do! data.TagMap.Save { tm with Tag = model.Tag.ToLower (); UrlValue = model.UrlValue.ToLower () }
do! addMessage ctx { UserMessage.success with Message = "Tag mapping saved successfully" }
return! tagMappings next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/settings/tag-mapping/{id}/delete
let deleteMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.TagMap.Delete (TagMapId tagMapId) ctx.WebLog.Id with
| true -> do! addMessage ctx { UserMessage.success with Message = "Tag mapping deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with Message = "Tag mapping not found; nothing deleted" }
return! tagMappings next ctx
}
// ~~ THEMES ~~
open System
open System.IO
open System.IO.Compression
open System.Text.RegularExpressions
open MyWebLog.Data
// GET /admin/theme/list
let listThemes : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let! themes = ctx.Data.Theme.All ()
return!
hashForPage "Themes"
|> withAntiCsrf ctx
|> addToHash "themes" (themes |> List.map (DisplayTheme.fromTheme WebLogCache.isThemeInUse) |> Array.ofList)
|> adminBareView "theme-list-body" next ctx
}
// GET /admin/theme/new
let addTheme : HttpHandler = requireAccess Administrator >=> fun next ctx ->
hashForPage "Upload a Theme File"
|> withAntiCsrf ctx
|> adminBareView "theme-upload" next ctx
/// Update the name and version for a theme based on the version.txt file, if present
let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = backgroundTask {
let now () = DateTime.UtcNow.ToString "yyyyMMdd.HHmm"
match zip.Entries |> Seq.filter (fun it -> it.FullName = "version.txt") |> Seq.tryHead with
| Some versionItem ->
use versionFile = new StreamReader(versionItem.Open ())
let! versionText = versionFile.ReadToEndAsync ()
let parts = versionText.Trim().Replace("\r", "").Split "\n"
let displayName = if parts[0] > "" then parts[0] else ThemeId.toString theme.Id
let version = if parts.Length > 1 && parts[1] > "" then parts[1] else now ()
return { theme with Name = displayName; Version = version }
| None -> return { theme with Name = ThemeId.toString theme.Id; Version = now () }
}
/// Update the theme with all templates from the ZIP archive
let private updateTemplates (theme : Theme) (zip : ZipArchive) = backgroundTask {
let tasks =
zip.Entries
|> Seq.filter (fun it -> it.Name.EndsWith ".liquid")
|> Seq.map (fun templateItem -> backgroundTask {
use templateFile = new StreamReader (templateItem.Open ())
let! template = templateFile.ReadToEndAsync ()
return { Name = templateItem.Name.Replace (".liquid", ""); Text = template }
})
let! templates = Task.WhenAll tasks
return
templates
|> Array.fold (fun t template ->
{ t with Templates = template :: (t.Templates |> List.filter (fun it -> it.Name <> template.Name)) })
theme
}
/// Update theme assets from the ZIP archive
let private updateAssets themeId (zip : ZipArchive) (data : IData) = backgroundTask {
for asset in zip.Entries |> Seq.filter (fun it -> it.FullName.StartsWith "wwwroot") do
let assetName = asset.FullName.Replace ("wwwroot/", "")
if assetName <> "" && not (assetName.EndsWith "/") then
use stream = new MemoryStream ()
do! asset.Open().CopyToAsync stream
do! data.ThemeAsset.Save
{ Id = ThemeAssetId (themeId, assetName)
UpdatedOn = asset.LastWriteTime.DateTime
Data = stream.ToArray ()
}
}
/// Get the theme name from the file name given
let getThemeIdFromFileName (fileName : string) =
let themeName = fileName.Split(".").[0].ToLowerInvariant().Replace (" ", "-")
if themeName.EndsWith "-theme" then
if Regex.IsMatch (themeName, """^[a-z0-9\-]+$""") then
Ok (ThemeId (themeName.Substring (0, themeName.Length - 6)))
else Error $"Theme ID {fileName} is invalid"
else Error "Theme .zip file name must end in \"-theme.zip\""
/// Load a theme from the given stream, which should contain a ZIP archive
let loadThemeFromZip themeId file (data : IData) = backgroundTask {
let! isNew, theme = backgroundTask {
match! data.Theme.FindById themeId with
| Some t -> return false, t
| None -> return true, { Theme.empty with Id = themeId }
}
use zip = new ZipArchive (file, ZipArchiveMode.Read)
let! theme = updateNameAndVersion theme zip
if not isNew then do! data.ThemeAsset.DeleteByTheme theme.Id
let! theme = updateTemplates { theme with Templates = [] } zip
do! data.Theme.Save theme
do! updateAssets themeId zip data
return theme
}
// POST /admin/theme/new
let saveTheme : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let themeFile = Seq.head ctx.Request.Form.Files
match getThemeIdFromFileName themeFile.FileName with
| Ok themeId when themeId <> adminTheme ->
let data = ctx.Data
let! exists = data.Theme.Exists themeId
let isNew = not exists
let! model = ctx.BindFormAsync<UploadThemeModel> ()
if isNew || model.DoOverwrite then
// Load the theme to the database
use stream = new MemoryStream ()
do! themeFile.CopyToAsync stream
let! _ = loadThemeFromZip themeId stream data
do! ThemeAssetCache.refreshTheme themeId data
TemplateCache.invalidateTheme themeId
// Save the .zip file
use file = new FileStream ($"{ThemeId.toString themeId}-theme.zip", FileMode.Create)
do! themeFile.CopyToAsync file
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 = $"""Theme {if isNew then "add" else "updat"}ed successfully"""
Message = $"Successfully cleared template cache and refreshed theme asset cache for {theme.Name}"
}
return! toAdminDashboard next ctx
else
do! addMessage ctx
{ UserMessage.error with
Message = "Theme exists and overwriting was not requested; nothing saved"
}
return! toAdminDashboard next ctx
| Ok _ ->
do! addMessage ctx { UserMessage.error with Message = "You may not replace the admin theme" }
return! toAdminDashboard next ctx
| Error message ->
do! addMessage ctx { UserMessage.error with Message = message }
return! toAdminDashboard next ctx
else return! RequestErrors.BAD_REQUEST "Bad request" next ctx
}
| None ->
do! addMessage ctx { UserMessage.error with Message = $"No theme exists with ID {themeId}" }
return! toAdminDashboard next ctx
}
// POST /admin/theme/{id}/delete
let deleteTheme themeId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let data = ctx.Data
match themeId with
| "admin" | "default" ->
do! addMessage ctx { UserMessage.error with Message = $"You may not delete the {themeId} theme" }
return! listThemes next ctx
| it when WebLogCache.isThemeInUse (ThemeId it) ->
do! addMessage ctx
{ UserMessage.error with
Message = $"You may not delete the {themeId} theme, as it is currently in use"
}
return! listThemes next ctx
| _ ->
match! data.Theme.Delete (ThemeId themeId) with
| true ->
let zippedTheme = $"{themeId}-theme.zip"
if File.Exists zippedTheme then File.Delete zippedTheme
do! addMessage ctx { UserMessage.success with Message = $"Theme ID {themeId} deleted successfully" }
return! listThemes next ctx
| false -> return! Error.notFound next ctx
}
// ~~ WEB LOG SETTINGS ~~
open System.Collections.Generic
// GET /admin/settings
let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
match! TemplateCache.get adminTheme "user-list-body" data with
| Ok userTemplate ->
match! TemplateCache.get adminTheme "tag-mapping-list-body" ctx.Data with
| Ok tagMapTemplate ->
let! allPages = data.Page.All ctx.WebLog.Id
let! themes = data.Theme.All ()
let! users = data.WebLogUser.FindByWebLog ctx.WebLog.Id
let! hash =
hashForPage "Web Log Settings"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (SettingsModel.fromWebLog ctx.WebLog)
|> addToHash "pages" (
seq {
KeyValuePair.Create ("posts", "- First Page of Posts -")
yield! allPages
|> List.sortBy (fun p -> p.Title.ToLower ())
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.Id, p.Title))
}
|> Array.ofSeq)
|> addToHash "themes" (
themes
|> Seq.ofList
|> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.Id, $"{it.Name} (v{it.Version})"))
|> Array.ofSeq)
|> addToHash "upload_values" [|
KeyValuePair.Create (UploadDestination.toString Database, "Database")
KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
|]
|> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList)
|> addToHash "rss_model" (EditRssModel.fromRssOptions ctx.WebLog.Rss)
|> addToHash "custom_feeds" (
ctx.WebLog.Rss.CustomFeeds
|> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx))
|> Array.ofList)
|> addViewContext ctx
let! hash' = withTagMappings ctx hash
return!
addToHash "user_list" (userTemplate.Render hash') hash'
|> addToHash "tag_mapping_list" (tagMapTemplate.Render hash')
|> adminView "settings" next ctx
| Error message -> return! Error.server message next ctx
| Error message -> return! Error.server message next ctx
}
// POST /admin/settings
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<SettingsModel> ()
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
let oldSlug = webLog.Slug
let webLog = model.update webLog
do! data.WebLog.UpdateSettings webLog
// Update cache
WebLogCache.set webLog
if oldSlug <> webLog.Slug then
// Rename disk directory if it exists
let uploadRoot = Path.Combine ("wwwroot", "upload")
let oldDir = Path.Combine (uploadRoot, oldSlug)
if Directory.Exists oldDir then Directory.Move (oldDir, Path.Combine (uploadRoot, webLog.Slug))
/// ~~ CATEGORIES ~~
module Category =
do! addMessage ctx { UserMessage.success with Message = "Web log settings saved successfully" }
return! redirectToGet "admin/settings" next ctx
| None -> return! Error.notFound next ctx
}
open MyWebLog.Data
// GET /admin/categories
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! TemplateCache.get adminTheme "category-list-body" ctx.Data with
| Ok catListTemplate ->
let! hash =
hashForPage "Categories"
|> withAntiCsrf ctx
|> addViewContext ctx
return!
addToHash "category_list" (catListTemplate.Render hash) hash
|> adminView "category-list" next ctx
| Error message -> return! Error.server message next ctx
}
// GET /admin/categories/bare
let bare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
hashForPage "Categories"
|> withAntiCsrf ctx
|> adminBareView "category-list-body" next ctx
// GET /admin/category/{id}/edit
let edit catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! result = task {
match catId with
| "new" -> return Some ("Add a New Category", { Category.empty with Id = CategoryId "new" })
| _ ->
match! ctx.Data.Category.FindById (CategoryId catId) ctx.WebLog.Id with
| Some cat -> return Some ("Edit Category", cat)
| None -> return None
}
match result with
| Some (title, cat) ->
return!
hashForPage title
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditCategoryModel.fromCategory cat)
|> adminBareView "category-edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/category/save
let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditCategoryModel> ()
let category =
if model.IsNew then someTask { Category.empty with Id = CategoryId.create (); WebLogId = ctx.WebLog.Id }
else data.Category.FindById (CategoryId model.CategoryId) ctx.WebLog.Id
match! category with
| Some cat ->
let updatedCat =
{ cat with
Name = model.Name
Slug = model.Slug
Description = if model.Description = "" then None else Some model.Description
ParentId = if model.ParentId = "" then None else Some (CategoryId model.ParentId)
}
do! (if model.IsNew then data.Category.Add else data.Category.Update) updatedCat
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Category saved successfully" }
return! bare next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/category/{id}/delete
let delete catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! result = ctx.Data.Category.Delete (CategoryId catId) ctx.WebLog.Id
match result with
| CategoryDeleted
| ReassignedChildCategories ->
do! CategoryCache.update ctx
let detail =
match result with
| ReassignedChildCategories ->
Some "<em>(Its child categories were reassigned to its parent category)</em>"
| _ -> None
do! addMessage ctx { UserMessage.success with Message = "Category deleted successfully"; Detail = detail }
| CategoryNotFound ->
do! addMessage ctx { UserMessage.error with Message = "Category not found; cannot delete" }
return! bare next ctx
}
/// ~~ TAG MAPPINGS ~~
module TagMapping =
open Microsoft.AspNetCore.Http
/// Add tag mappings to the given hash
let withTagMappings (ctx : HttpContext) hash = task {
let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
return
addToHash "mappings" mappings hash
|> addToHash "mapping_ids" (
mappings
|> List.map (fun it -> { Name = it.Tag; Value = TagMapId.toString it.Id }))
}
// GET /admin/settings/tag-mappings
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash =
hashForPage ""
|> withAntiCsrf ctx
|> withTagMappings ctx
return! adminBareView "tag-mapping-list-body" next ctx hash
}
// GET /admin/settings/tag-mapping/{id}/edit
let edit tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let isNew = tagMapId = "new"
let tagMap =
if isNew then someTask { TagMap.empty with Id = TagMapId "new" }
else ctx.Data.TagMap.FindById (TagMapId tagMapId) ctx.WebLog.Id
match! tagMap with
| Some tm ->
return!
hashForPage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag")
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditTagMapModel.fromMapping tm)
|> adminBareView "tag-mapping-edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/settings/tag-mapping/save
let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel> ()
let tagMap =
if model.IsNew then someTask { TagMap.empty with Id = TagMapId.create (); WebLogId = ctx.WebLog.Id }
else data.TagMap.FindById (TagMapId model.Id) ctx.WebLog.Id
match! tagMap with
| Some tm ->
do! data.TagMap.Save { tm with Tag = model.Tag.ToLower (); UrlValue = model.UrlValue.ToLower () }
do! addMessage ctx { UserMessage.success with Message = "Tag mapping saved successfully" }
return! all next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/settings/tag-mapping/{id}/delete
let delete tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.TagMap.Delete (TagMapId tagMapId) ctx.WebLog.Id with
| true -> do! addMessage ctx { UserMessage.success with Message = "Tag mapping deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with Message = "Tag mapping not found; nothing deleted" }
return! all next ctx
}
/// ~~ THEMES ~~
module Theme =
open System
open System.IO
open System.IO.Compression
open System.Text.RegularExpressions
open MyWebLog.Data
// GET /admin/theme/list
let all : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let! themes = ctx.Data.Theme.All ()
return!
hashForPage "Themes"
|> withAntiCsrf ctx
|> addToHash "themes" (themes |> List.map (DisplayTheme.fromTheme WebLogCache.isThemeInUse) |> Array.ofList)
|> adminBareView "theme-list-body" next ctx
}
// GET /admin/theme/new
let add : HttpHandler = requireAccess Administrator >=> fun next ctx ->
hashForPage "Upload a Theme File"
|> withAntiCsrf ctx
|> adminBareView "theme-upload" next ctx
/// Update the name and version for a theme based on the version.txt file, if present
let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = backgroundTask {
let now () = DateTime.UtcNow.ToString "yyyyMMdd.HHmm"
match zip.Entries |> Seq.filter (fun it -> it.FullName = "version.txt") |> Seq.tryHead with
| Some versionItem ->
use versionFile = new StreamReader(versionItem.Open ())
let! versionText = versionFile.ReadToEndAsync ()
let parts = versionText.Trim().Replace("\r", "").Split "\n"
let displayName = if parts[0] > "" then parts[0] else ThemeId.toString theme.Id
let version = if parts.Length > 1 && parts[1] > "" then parts[1] else now ()
return { theme with Name = displayName; Version = version }
| None -> return { theme with Name = ThemeId.toString theme.Id; Version = now () }
}
/// Update the theme with all templates from the ZIP archive
let private updateTemplates (theme : Theme) (zip : ZipArchive) = backgroundTask {
let tasks =
zip.Entries
|> Seq.filter (fun it -> it.Name.EndsWith ".liquid")
|> Seq.map (fun templateItem -> backgroundTask {
use templateFile = new StreamReader (templateItem.Open ())
let! template = templateFile.ReadToEndAsync ()
return { Name = templateItem.Name.Replace (".liquid", ""); Text = template }
})
let! templates = Task.WhenAll tasks
return
templates
|> Array.fold (fun t template ->
{ t with Templates = template :: (t.Templates |> List.filter (fun it -> it.Name <> template.Name)) })
theme
}
/// Update theme assets from the ZIP archive
let private updateAssets themeId (zip : ZipArchive) (data : IData) = backgroundTask {
for asset in zip.Entries |> Seq.filter (fun it -> it.FullName.StartsWith "wwwroot") do
let assetName = asset.FullName.Replace ("wwwroot/", "")
if assetName <> "" && not (assetName.EndsWith "/") then
use stream = new MemoryStream ()
do! asset.Open().CopyToAsync stream
do! data.ThemeAsset.Save
{ Id = ThemeAssetId (themeId, assetName)
UpdatedOn = asset.LastWriteTime.DateTime
Data = stream.ToArray ()
}
}
/// Derive the theme ID from the file name given
let deriveIdFromFileName (fileName : string) =
let themeName = fileName.Split(".").[0].ToLowerInvariant().Replace (" ", "-")
if themeName.EndsWith "-theme" then
if Regex.IsMatch (themeName, """^[a-z0-9\-]+$""") then
Ok (ThemeId (themeName.Substring (0, themeName.Length - 6)))
else Error $"Theme ID {fileName} is invalid"
else Error "Theme .zip file name must end in \"-theme.zip\""
/// Load a theme from the given stream, which should contain a ZIP archive
let loadFromZip themeId file (data : IData) = backgroundTask {
let! isNew, theme = backgroundTask {
match! data.Theme.FindById themeId with
| Some t -> return false, t
| None -> return true, { Theme.empty with Id = themeId }
}
use zip = new ZipArchive (file, ZipArchiveMode.Read)
let! theme = updateNameAndVersion theme zip
if not isNew then do! data.ThemeAsset.DeleteByTheme theme.Id
let! theme = updateTemplates { theme with Templates = [] } zip
do! data.Theme.Save theme
do! updateAssets themeId zip data
return theme
}
// POST /admin/theme/new
let save : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let themeFile = Seq.head ctx.Request.Form.Files
match deriveIdFromFileName themeFile.FileName with
| Ok themeId when themeId <> adminTheme ->
let data = ctx.Data
let! exists = data.Theme.Exists themeId
let isNew = not exists
let! model = ctx.BindFormAsync<UploadThemeModel> ()
if isNew || model.DoOverwrite then
// Load the theme to the database
use stream = new MemoryStream ()
do! themeFile.CopyToAsync stream
let! _ = loadFromZip themeId stream data
do! ThemeAssetCache.refreshTheme themeId data
TemplateCache.invalidateTheme themeId
// Save the .zip file
use file = new FileStream ($"{ThemeId.toString themeId}-theme.zip", FileMode.Create)
do! themeFile.CopyToAsync file
do! addMessage ctx
{ UserMessage.success with
Message = $"""Theme {if isNew then "add" else "updat"}ed successfully"""
}
return! toAdminDashboard next ctx
else
do! addMessage ctx
{ UserMessage.error with
Message = "Theme exists and overwriting was not requested; nothing saved"
}
return! toAdminDashboard next ctx
| Ok _ ->
do! addMessage ctx { UserMessage.error with Message = "You may not replace the admin theme" }
return! toAdminDashboard next ctx
| Error message ->
do! addMessage ctx { UserMessage.error with Message = message }
return! toAdminDashboard next ctx
else return! RequestErrors.BAD_REQUEST "Bad request" next ctx
}
// POST /admin/theme/{id}/delete
let delete themeId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let data = ctx.Data
match themeId with
| "admin" | "default" ->
do! addMessage ctx { UserMessage.error with Message = $"You may not delete the {themeId} theme" }
return! all next ctx
| it when WebLogCache.isThemeInUse (ThemeId it) ->
do! addMessage ctx
{ UserMessage.error with
Message = $"You may not delete the {themeId} theme, as it is currently in use"
}
return! all next ctx
| _ ->
match! data.Theme.Delete (ThemeId themeId) with
| true ->
let zippedTheme = $"{themeId}-theme.zip"
if File.Exists zippedTheme then File.Delete zippedTheme
do! addMessage ctx { UserMessage.success with Message = $"Theme ID {themeId} deleted successfully" }
return! all next ctx
| false -> return! Error.notFound next ctx
}
/// ~~ WEB LOG SETTINGS ~~
module WebLog =
open System.Collections.Generic
open System.IO
// GET /admin/settings
let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
match! TemplateCache.get adminTheme "user-list-body" data with
| Ok userTemplate ->
match! TemplateCache.get adminTheme "tag-mapping-list-body" ctx.Data with
| Ok tagMapTemplate ->
let! allPages = data.Page.All ctx.WebLog.Id
let! themes = data.Theme.All ()
let! users = data.WebLogUser.FindByWebLog ctx.WebLog.Id
let! hash =
hashForPage "Web Log Settings"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (SettingsModel.fromWebLog ctx.WebLog)
|> addToHash "pages" (
seq {
KeyValuePair.Create ("posts", "- First Page of Posts -")
yield! allPages
|> List.sortBy (fun p -> p.Title.ToLower ())
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.Id, p.Title))
}
|> Array.ofSeq)
|> addToHash "themes" (
themes
|> Seq.ofList
|> Seq.map (fun it ->
KeyValuePair.Create (ThemeId.toString it.Id, $"{it.Name} (v{it.Version})"))
|> Array.ofSeq)
|> addToHash "upload_values" [|
KeyValuePair.Create (UploadDestination.toString Database, "Database")
KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
|]
|> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList)
|> addToHash "rss_model" (EditRssModel.fromRssOptions ctx.WebLog.Rss)
|> addToHash "custom_feeds" (
ctx.WebLog.Rss.CustomFeeds
|> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx))
|> Array.ofList)
|> addViewContext ctx
let! hash' = TagMapping.withTagMappings ctx hash
return!
addToHash "user_list" (userTemplate.Render hash') hash'
|> addToHash "tag_mapping_list" (tagMapTemplate.Render hash')
|> adminView "settings" next ctx
| Error message -> return! Error.server message next ctx
| Error message -> return! Error.server message next ctx
}
// POST /admin/settings
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<SettingsModel> ()
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
let oldSlug = webLog.Slug
let webLog = model.update webLog
do! data.WebLog.UpdateSettings webLog
// Update cache
WebLogCache.set webLog
if oldSlug <> webLog.Slug then
// Rename disk directory if it exists
let uploadRoot = Path.Combine ("wwwroot", "upload")
let oldDir = Path.Combine (uploadRoot, oldSlug)
if Directory.Exists oldDir then Directory.Move (oldDir, Path.Combine (uploadRoot, webLog.Slug))
do! addMessage ctx { UserMessage.success with Message = "Web log settings saved successfully" }
return! redirectToGet "admin/settings" next ctx
| None -> return! Error.notFound next ctx
}

8
src/MyWebLog/Handlers/Page.fs
View File

@ -124,8 +124,14 @@ let private findPageRevision pgId revDate (ctx : HttpContext) = task {
let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
let _, extra = WebLog.hostAndPath ctx.WebLog
return! {|
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.Text}</div>"""
content =
[ """<div class="mwl-revision-preview mb-3">"""
(MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text
"</div>"
]
|> String.concat ""
|}
|> makeHash |> adminBareView "" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx

8
src/MyWebLog/Handlers/Post.fs
View File

@ -329,8 +329,14 @@ let private findPostRevision postId revDate (ctx : HttpContext) = task {
let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
let _, extra = WebLog.hostAndPath ctx.WebLog
return! {|
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.Text}</div>"""
content =
[ """<div class="mwl-revision-preview mb-3">"""
(MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text
"</div>"
]
|> String.concat ""
|}
|> makeHash |> adminBareView "" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx

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

@ -106,13 +106,13 @@ let router : HttpHandler = choose [
]
subRoute "/admin" (requireUser >=> choose [
GET_HEAD >=> choose [
route "/administration" >=> Admin.adminDashboard
route "/administration" >=> Admin.Dashboard.admin
subRoute "/categor" (choose [
route "ies" >=> Admin.listCategories
route "ies/bare" >=> Admin.listCategoriesBare
routef "y/%s/edit" Admin.editCategory
route "ies" >=> Admin.Category.all
route "ies/bare" >=> Admin.Category.bare
routef "y/%s/edit" Admin.Category.edit
])
route "/dashboard" >=> Admin.dashboard
route "/dashboard" >=> Admin.Dashboard.user
route "/my-info" >=> User.myInfo
subRoute "/page" (choose [
route "s" >=> Page.all 1
@ -131,20 +131,20 @@ let router : HttpHandler = choose [
routef "/%s/revisions" Post.editRevisions
])
subRoute "/settings" (choose [
route "" >=> Admin.settings
route "" >=> Admin.WebLog.settings
routef "/rss/%s/edit" Feed.editCustomFeed
subRoute "/user" (choose [
route "s" >=> User.all
routef "/%s/edit" User.edit
])
subRoute "/tag-mapping" (choose [
route "s" >=> Admin.tagMappings
routef "/%s/edit" Admin.editMapping
route "s" >=> Admin.TagMapping.all
routef "/%s/edit" Admin.TagMapping.edit
])
])
subRoute "/theme" (choose [
route "/list" >=> Admin.listThemes
route "/new" >=> Admin.addTheme
route "/list" >=> Admin.Theme.all
route "/new" >=> Admin.Theme.add
])
subRoute "/upload" (choose [
route "s" >=> Upload.list
@ -153,12 +153,12 @@ let router : HttpHandler = choose [
]
POST >=> validateCsrf >=> choose [
subRoute "/cache" (choose [
routef "/theme/%s/refresh" Admin.refreshThemeCache
routef "/web-log/%s/refresh" Admin.refreshWebLogCache
routef "/theme/%s/refresh" Admin.Cache.refreshTheme
routef "/web-log/%s/refresh" Admin.Cache.refreshWebLog
])
subRoute "/category" (choose [
route "/save" >=> Admin.saveCategory
routef "/%s/delete" Admin.deleteCategory
route "/save" >=> A