diff --git a/src/MyWebLog.Data/Interfaces.fs b/src/MyWebLog.Data/Interfaces.fs index 1adbd39..afa5e0c 100644 --- a/src/MyWebLog.Data/Interfaces.fs +++ b/src/MyWebLog.Data/Interfaces.fs @@ -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 /// Delete a category (also removes it from posts) - abstract member Delete : CategoryId -> WebLogId -> Task + abstract member Delete : CategoryId -> WebLogId -> Task /// Find all categories for a web log, sorted alphabetically and grouped by hierarchy abstract member FindAllForView : WebLogId -> Task diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index 0947d9d..620c10a 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -274,7 +274,21 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger + | Some cat -> + // Reassign any children to the category's parent category + let! children = rethink { + 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 return false + return if children = 0 then CategoryDeleted else ReassignedChildCategories + | None -> return CategoryNotFound } member _.Restore cats = backgroundTask { diff --git a/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs b/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs index 1133576..f14e2ec 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs @@ -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 diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index 757bb96..8dbc854 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -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 +[] +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 [] 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 diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index 1302bcc..b4ece20 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -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) = 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) = 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 () - 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 () - 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 () - 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 () - 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 () + 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 "(Its child categories were reassigned to its parent category)" + | _ -> 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 () + 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 () + 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 () + 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 + } diff --git a/src/MyWebLog/Handlers/Page.fs b/src/MyWebLog/Handlers/Page.fs index 99778fe..8869cd8 100644 --- a/src/MyWebLog/Handlers/Page.fs +++ b/src/MyWebLog/Handlers/Page.fs @@ -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 = $"""
{MarkupText.toHtml rev.Text}
""" + content = + [ """
""" + (MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text + "
" + ] + |> String.concat "" |} |> makeHash |> adminBareView "" next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs index a7ed5f2..f79bfbe 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -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 = $"""
{MarkupText.toHtml rev.Text}
""" + content = + [ """
""" + (MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text + "
" + ] + |> String.concat "" |} |> makeHash |> adminBareView "" next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs index f0a5b8d..1239c0c 100644 --- a/src/MyWebLog/Handlers/Routes.fs +++ b/src/MyWebLog/Handlers/Routes.fs @@ -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" >=> Admin.Category.save + routef "/%s/delete" Admin.Category.delete ]) route "/my-info" >=> User.saveMyInfo subRoute "/page" (choose [ @@ -178,15 +178,15 @@ let router : HttpHandler = choose [ routef "/%s/revisions/purge" Post.purgeRevisions ]) subRoute "/settings" (choose [ - route "" >=> Admin.saveSettings + route "" >=> Admin.WebLog.saveSettings subRoute "/rss" (choose [ route "" >=> Feed.saveSettings route "/save" >=> Feed.saveCustomFeed routef "/%s/delete" Feed.deleteCustomFeed ]) subRoute "/tag-mapping" (choose [ - route "/save" >=> Admin.saveMapping - routef "/%s/delete" Admin.deleteMapping + route "/save" >=> Admin.TagMapping.save + routef "/%s/delete" Admin.TagMapping.delete ]) subRoute "/user" (choose [ route "/save" >=> User.save @@ -194,8 +194,8 @@ let router : HttpHandler = choose [ ]) ]) subRoute "/theme" (choose [ - route "/new" >=> Admin.saveTheme - routef "/%s/delete" Admin.deleteTheme + route "/new" >=> Admin.Theme.save + routef "/%s/delete" Admin.Theme.delete ]) subRoute "/upload" (choose [ route "/save" >=> Upload.save diff --git a/src/MyWebLog/Handlers/Upload.fs b/src/MyWebLog/Handlers/Upload.fs index 91c53d8..3755484 100644 --- a/src/MyWebLog/Handlers/Upload.fs +++ b/src/MyWebLog/Handlers/Upload.fs @@ -85,7 +85,7 @@ open System.Text.RegularExpressions open MyWebLog.ViewModels /// Turn a string into a lowercase URL-safe slug -let makeSlug it = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 ]").Replace (it, ""), "-")).ToLowerInvariant () +let makeSlug it = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 -]").Replace (it, ""), "-")).ToLowerInvariant () // GET /admin/uploads let list : HttpHandler = requireAccess Author >=> fun next ctx -> task { diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index 6000c15..608d2b3 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -51,7 +51,10 @@ let doLogOn : HttpHandler = fun next ctx -> task { AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow)) do! data.WebLogUser.SetLastSeen user.Id user.WebLogId do! addMessage ctx - { UserMessage.success with Message = $"Logged on successfully | Welcome to {ctx.WebLog.Name}!" } + { UserMessage.success with + Message = "Log on successful" + Detail = Some $"Welcome to {ctx.WebLog.Name}!" + } return! match model.ReturnTo with | Some url -> redirectTo false url next ctx diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 2c2dccd..45bb4e5 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -137,13 +137,13 @@ let loadTheme (args : string[]) (sp : IServiceProvider) = task { match args[1].LastIndexOf Path.DirectorySeparatorChar with | -1 -> args[1] | it -> args[1][(it + 1)..] - match Handlers.Admin.getThemeIdFromFileName fileName with + match Handlers.Admin.Theme.deriveIdFromFileName fileName with | Ok themeId -> let data = sp.GetRequiredService () use stream = File.Open (args[1], FileMode.Open) use copy = new MemoryStream () do! stream.CopyToAsync copy - let! theme = Handlers.Admin.loadThemeFromZip themeId copy data + let! theme = Handlers.Admin.Theme.loadFromZip themeId copy data let fac = sp.GetRequiredService () let log = fac.CreateLogger "MyWebLog.Themes" log.LogInformation $"{theme.Name} v{theme.Version} ({ThemeId.toString theme.Id}) loaded" diff --git a/src/admin-theme/_edit-common.liquid b/src/admin-theme/_edit-common.liquid new file mode 100644 index 0000000..46f1e81 --- /dev/null +++ b/src/admin-theme/_edit-common.liquid @@ -0,0 +1,32 @@ +
+ + +
+
+ + + {%- unless model.is_new %} + {%- assign entity_url_base = "admin/" | append: entity | append: "/" | append: entity_id -%} + + Manage Permalinks + • + Manage Revisions + + {%- endunless -%} +
+
+     +
+ + + + +
+
+
+ +
diff --git a/src/admin-theme/admin-dashboard.liquid b/src/admin-theme/admin-dashboard.liquid index 65592ed..7febfc6 100644 --- a/src/admin-theme/admin-dashboard.liquid +++ b/src/admin-theme/admin-dashboard.liquid @@ -2,24 +2,20 @@
Themes -
-
- - Upload a New Theme - -
- {% include_template "_theme-list-columns" %} -
-
Theme
-
Slug
-
Templates
-
-
-
- {{ theme_list }} + + Upload a New Theme + +
+ {% include_template "_theme-list-columns" %} +
+
Theme
+
Slug
+
Templates
+
+ {{ theme_list }}
{%- assign cache_base_url = "admin/cache/" -%} @@ -27,10 +23,9 @@

- myWebLog uses a few caches to ensure that it serves pages as fast as possible. Normal actions taken within the - admin area will keep these up to date; however, if changes occur outside of the system (creating a new web log - via CLI, loading an updated theme via CLI, direct data updates, etc.), these options allow for the caches to - be refreshed without requiring you to restart the application. + myWebLog uses a few caches to ensure that it serves pages as fast as possible. + (more information)

diff --git a/src/admin-theme/category-edit.liquid b/src/admin-theme/category-edit.liquid index 2b80c5d..ee13d19 100644 --- a/src/admin-theme/category-edit.liquid +++ b/src/admin-theme/category-edit.liquid @@ -7,21 +7,21 @@
- +
-
- @@ -38,7 +38,7 @@
-
diff --git a/src/admin-theme/layout.liquid b/src/admin-theme/layout.liquid index 0d27ca8..f5f3c81 100644 --- a/src/admin-theme/layout.liquid +++ b/src/admin-theme/layout.liquid @@ -14,18 +14,6 @@ integrity="sha384-ka7Sk0Gln4gmtz2MlQnikT1wXgYsOg+OMhuP+IlRH9sENBO0LRn5q+8nbTov4+1p" crossorigin="anonymous"> {{ htmx_script }} - diff --git a/src/admin-theme/page-edit.liquid b/src/admin-theme/page-edit.liquid index 7946a64..8e156d3 100644 --- a/src/admin-theme/page-edit.liquid +++ b/src/admin-theme/page-edit.liquid @@ -6,39 +6,9 @@
-
- - -
-
- - - {%- unless model.is_new %} - - - Manage Permalinks - - • - - Manage Revisions - - - {% endunless -%} -
-
-     - - - - -
-
- -
+ {%- assign entity = "page" -%} + {%- assign entity_id = model.page_id -%} + {% include_template "_edit-common" %}
diff --git a/src/admin-theme/post-edit.liquid b/src/admin-theme/post-edit.liquid index 92f5d1d..7713749 100644 --- a/src/admin-theme/post-edit.liquid +++ b/src/admin-theme/post-edit.liquid @@ -6,41 +6,9 @@
-
- - -
-
- - - {%- unless model.is_new %} - - - Manage Permalinks - - • - - Manage Revisions - - - {% endunless -%} -
-
-     -
- - - - -
-
-
- -
+ {%- assign entity = "post" -%} + {%- assign entity_id = model.post_id -%} + {% include_template "_edit-common" %}
@@ -61,7 +29,7 @@ + {%- if model.is_episode %} checked="checked"{% endif %}> @@ -344,3 +312,4 @@
+ diff --git a/src/admin-theme/settings.liquid b/src/admin-theme/settings.liquid index 0beaa90..ab956f8 100644 --- a/src/admin-theme/settings.liquid +++ b/src/admin-theme/settings.liquid @@ -6,263 +6,241 @@

Web Log Settings -
-
-
- -
-
-
-
- - -
-
-
-
- - - - WARNING changing this value may break - links - (more) - -
-
-
-
- - -
-
-
-
- - -
-
-
-
- - -
-
-
-
- - -
-
-
-
-
-
- - -
-
-
-
- - -
- - What is this? - -
-
-
- - -
-
-
-
-
- -
+ + +
+
+
+
+ +
- +
+
+ + + + WARNING changing this value may break + links + (more) + +
+
+
+
+ + +
+
+
+
+ + +
+
+
+
+ + +
+
+
+
+ + +
+
+
+
+
+
+ + +
+
+
+
+ + +
+ + What is this? + +
+
+
+ + +
+
+
+
+
+ +
+
-
+
Users -
-
- {% include_template "_user-list-columns" %} - - Add a New User - -
-
-
User; Full Name / E-mail; Last Log On
- -
Created
-
Last Log On
-
-
- {{ user_list }} + {% include_template "_user-list-columns" %} + + Add a New User + +
+
+
User; Full Name / E-mail; Last Log On
+ +
Created
+
Last Log On
+ {{ user_list }}
RSS Settings -
-
-
- -
-
-
-
- Feeds Enabled -
- - -
-
- - -
-
- - -
-
+ + +
+
+
+
+ Feeds Enabled +
+ +
-
-
-
-
- - - Default is feed.xml -
+
+ +
-
-
- - - Set to “0” to use “Posts per Page” setting ({{ web_log.posts_per_page }}) -
-
-
-
- - - - Can be a - - Creative Commons license string - - -
-
-
-
-
- +
+ +
+
+ + +
+
+
+ + + Default is feed.xml
- -
- Custom Feeds -
-
- - Add a New Custom Feed - - {%- assign feed_count = custom_feeds | size -%} - {% if feed_count > 0 %} -
- {%- assign source_col = "col-12 col-md-6" -%} - {%- assign path_col = "col-12 col-md-6" -%} - -
-
- FeedSource -
-
Relative Path
-
- {% for feed in custom_feeds %} -
-
- {{ feed.source }} - {%- if feed.is_podcast %}   PODCAST{% endif %}
- - {%- assign feed_url = "admin/settings/rss/" | append: feed.id -%} - View Feed - • - Edit - • - {%- assign feed_del_link = feed_url | append: "/delete" | relative_link -%} - - Delete - - -
-
- Served at {{ feed.path }} - {{ feed.path }} -
-
- {% endfor %} -
- {% else %} -

No custom feeds defined

- {% endif %} +
+
+ + + Set to “0” to use “Posts per Page” setting ({{ web_log.posts_per_page }})
-
+
+
+ + + + Can be a + + Creative Commons license string + + +
+
+
+
+
+ +
+
- + +
+ Custom Feeds + + Add a New Custom Feed + + {%- assign feed_count = custom_feeds | size -%} + {%- if feed_count > 0 %} +
+ {%- assign source_col = "col-12 col-md-6" -%} + {%- assign path_col = "col-12 col-md-6" -%} + +
+
+ FeedSource +
+
Relative Path
+
+ {% for feed in custom_feeds %} +
+
+ {{ feed.source }} + {%- if feed.is_podcast %}   PODCAST{% endif %}
+ + {%- assign feed_url = "admin/settings/rss/" | append: feed.id -%} + View Feed + • + Edit + • + {%- assign feed_del_link = feed_url | append: "/delete" | relative_link -%} + + Delete + + +
+
+ Served at {{ feed.path }} + {{ feed.path }} +
+
+ {%- endfor %} +
+ {%- else %} +

No custom feeds defined

+ {%- endif %} +
Tag Mappings -
-
- - Add a New Tag Mapping - - {{ tag_mapping_list }} -
-
+ + Add a New Tag Mapping + + {{ tag_mapping_list }}
diff --git a/src/admin-theme/upload-list.liquid b/src/admin-theme/upload-list.liquid index cedc570..7c95eaa 100644 --- a/src/admin-theme/upload-list.liquid +++ b/src/admin-theme/upload-list.liquid @@ -20,7 +20,7 @@
{%- capture badge_class -%} - {%- if file.source == "disk" %}secondary{% else %}primary{% endif -%} + {%- if file.source == "Disk" %}secondary{% else %}primary{% endif -%} {%- endcapture -%} {%- assign path_and_name = file.path | append: file.name -%} {%- assign blog_rel = upload_path | append: path_and_name -%} @@ -49,7 +49,7 @@ {% if is_web_log_admin %} • {%- capture delete_url -%} - {%- if file.source == "disk" -%} + {%- if file.source == "Disk" -%} admin/upload/delete/{{ path_and_name }} {%- else -%} admin/upload/{{ file.id }}/delete diff --git a/src/admin-theme/upload-new.liquid b/src/admin-theme/upload-new.liquid index 2dce611..917e942 100644 --- a/src/admin-theme/upload-new.liquid +++ b/src/admin-theme/upload-new.liquid @@ -13,11 +13,11 @@
Destination
- + - +
diff --git a/src/default-theme/index.liquid b/src/default-theme/index.liquid index dac2eb5..2d6f39f 100644 --- a/src/default-theme/index.liquid +++ b/src/default-theme/index.liquid @@ -2,52 +2,59 @@

{{ page_title }}

{%- if subtitle %}

{{ subtitle }}

{% endif -%} {% endif %} -
- {% for post in model.posts %} -
-

- - {{ post.title }} - -

-

- Published on {{ post.published_on | date: "MMMM d, yyyy" }} - at {{ post.published_on | date: "h:mmtt" | downcase }} - by {{ model.authors | value: post.author_id }} -

- {{ post.text }} - {%- assign category_count = post.category_ids | size -%} - {%- assign tag_count = post.tags | size -%} - {% if category_count > 0 or tag_count > 0 %} -
-

- {%- if category_count > 0 -%} - Categorized under: - {% for cat in post.category_ids -%} - {%- assign this_cat = categories | where: "Id", cat | first -%} - {{ this_cat.name }}{% unless forloop.last %}, {% endunless %} - {%- assign cat_names = this_cat.name | concat: cat_names -%} - {%- endfor -%} - {%- assign cat_names = "" -%} -
- {% endif -%} - {%- if tag_count > 0 %} - Tagged: {{ post.tags | join: ", " }} - {% endif -%} -

-
+{%- assign post_count = model.posts | size -%} +{%- if post_count > 0 %} +
+ {%- for post in model.posts %} +
+

+ + {{ post.title }} + +

+

+ Published on {{ post.published_on | date: "MMMM d, yyyy" }} + at {{ post.published_on | date: "h:mmtt" | downcase }} + by {{ model.authors | value: post.author_id }} +

+ {{ post.text }} + {%- assign category_count = post.category_ids | size -%} + {%- assign tag_count = post.tags | size -%} + {% if category_count > 0 or tag_count > 0 %} +
+

+ {%- if category_count > 0 -%} + Categorized under: + {% for cat in post.category_ids -%} + {%- assign this_cat = categories | where: "Id", cat | first -%} + {{ this_cat.name }}{% unless forloop.last %}, {% endunless %} + {%- assign cat_names = this_cat.name | concat: cat_names -%} + {%- endfor -%} + {%- assign cat_names = "" -%} +
+ {% endif -%} + {%- if tag_count > 0 %} + Tagged: {{ post.tags | join: ", " }} + {% endif -%} +

+
+ {% endif %} +
+
+ {% endfor %} +
+
- {% endfor %} -
- + {% if model.older_link -%} +
  • Older Posts »
    • + {%- endif -%} + + +{%- else %} +
    +

    No posts found

    +
    +{%- endif %} diff --git a/src/default-theme/layout.liquid b/src/default-theme/layout.liquid index 9e6760b..f48d325 100644 --- a/src/default-theme/layout.liquid +++ b/src/default-theme/layout.liquid @@ -3,8 +3,8 @@ - + {{ page_title | strip_html }}{% if page_title %} « {% endif %}{{ web_log.name | strip_html }} {% page_head -%} @@ -55,8 +55,8 @@ myWebLog
    -