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

Add user created and last seen on (#19)

Browse Source 
- Updated view models / interfaces per F# naming guidelines
This commit is contained in:
Daniel J. Summers
2022-07-17 23:10:30 -04:00
parent e0a03bfca9
commit 5fb3a73dcf
39 changed files with 1234 additions and 1203 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -9,25 +9,25 @@ open MyWebLog.ViewModels
// GET /admin
let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let webLogId = ctx.WebLog.id
let data = ctx.Data
let getCount (f : WebLogId -> Task<int>) = f webLogId
let! posts = data.Post.countByStatus Published |> getCount
let! drafts = data.Post.countByStatus Draft |> getCount
let! pages = data.Page.countAll |> getCount
let! listed = data.Page.countListed |> getCount
let! cats = data.Category.countAll |> getCount
let! topCats = data.Category.countTopLevel |> getCount
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!
Hash.FromAnonymousObject {|
page_title = "Dashboard"
model =
{ posts = posts
drafts = drafts
pages = pages
listedPages = listed
categories = cats
topLevelCategories = topCats
{ Posts = posts.Result
Drafts = drafts.Result
Pages = pages.Result
ListedPages = listed.Result
Categories = cats.Result
TopLevelCategories = topCats.Result
}
|}
|> viewForTheme "admin" "dashboard" next ctx
@@ -49,14 +49,12 @@ let listCategories : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
}
// GET /admin/categories/bare
let listCategoriesBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
return!
Hash.FromAnonymousObject {|
categories = CategoryCache.get ctx
csrf = ctx.CsrfTokenSet
|}
|> bareForTheme "admin" "category-list-body" next ctx
}
let listCategoriesBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
Hash.FromAnonymousObject {|
categories = CategoryCache.get ctx
csrf = ctx.CsrfTokenSet
|}
|> bareForTheme "admin" "category-list-body" next ctx
// GET /admin/category/{id}/edit
@@ -65,7 +63,7 @@ let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ct
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
match! ctx.Data.Category.FindById (CategoryId catId) ctx.WebLog.id with
| Some cat -> return Some ("Edit Category", cat)
| None -> return None
}
@@ -86,34 +84,33 @@ let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ct
let saveCategory : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditCategoryModel> ()
let! category = task {
match model.categoryId with
| "new" -> return Some { Category.empty with id = CategoryId.create (); webLogId = ctx.WebLog.id }
| catId -> return! data.Category.findById (CategoryId catId) ctx.WebLog.id
}
match category with
let category =
match model.CategoryId with
| "new" -> Task.FromResult (Some { Category.empty with id = CategoryId.create (); webLogId = ctx.WebLog.id })
| catId -> data.Category.FindById (CategoryId catId) ctx.WebLog.id
match! category with
| Some cat ->
let cat =
{ 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)
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! (match model.categoryId with "new" -> data.Category.add | _ -> data.Category.update) cat
do! (match model.CategoryId with "new" -> data.Category.Add | _ -> data.Category.Update) cat
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Category saved successfully" }
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
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" }
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
}
@@ -123,7 +120,7 @@ open Microsoft.AspNetCore.Http
/// Get the hash necessary to render the tag mapping list
let private tagMappingHash (ctx : HttpContext) = task {
let! mappings = ctx.Data.TagMap.findByWebLog ctx.WebLog.id
let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.id
return Hash.FromAnonymousObject {|
csrf = ctx.CsrfTokenSet
web_log = ctx.WebLog
@@ -136,11 +133,10 @@ let private tagMappingHash (ctx : HttpContext) = task {
let tagMappings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash = tagMappingHash ctx
let! listTemplate = TemplateCache.get "admin" "tag-mapping-list-body" ctx.Data
hash.Add ("tag_mapping_list", listTemplate.Render hash)
hash.Add ("page_title", "Tag Mappings")
return! viewForTheme "admin" "tag-mapping-list" next ctx hash
return!
addToHash "tag_mapping_list" (listTemplate.Render hash) hash
|> addToHash "page_title" "Tag Mappings"
|> viewForTheme "admin" "tag-mapping-list" next ctx
}
// GET /admin/settings/tag-mappings/bare
@@ -153,10 +149,8 @@ let tagMappingsBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -
let editMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let isNew = tagMapId = "new"
let tagMap =
if isNew then
Task.FromResult (Some { TagMap.empty with id = TagMapId "new" })
else
ctx.Data.TagMap.findById (TagMapId tagMapId) ctx.WebLog.id
if isNew then Task.FromResult (Some { TagMap.empty with id = TagMapId "new" })
else ctx.Data.TagMap.FindById (TagMapId tagMapId) ctx.WebLog.id
match! tagMap with
| Some tm ->
return!
@@ -174,23 +168,22 @@ let saveMapping : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta
let data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel> ()
let tagMap =
if model.id = "new" then
if model.IsNew then
Task.FromResult (Some { TagMap.empty with id = TagMapId.create (); webLogId = ctx.WebLog.id })
else
data.TagMap.findById (TagMapId model.id) 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" }
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! tagMappingsBare 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" }
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! tagMappingsBare next ctx
}
@@ -203,14 +196,12 @@ open System.Text.RegularExpressions
open MyWebLog.Data
// GET /admin/theme/update
let themeUpdatePage : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
return!
Hash.FromAnonymousObject {|
page_title = "Upload Theme"
csrf = ctx.CsrfTokenSet
|}
|> viewForTheme "admin" "upload-theme" next ctx
}
let themeUpdatePage : HttpHandler = requireAccess Administrator >=> fun next ctx ->
Hash.FromAnonymousObject {|
page_title = "Upload Theme"
csrf = ctx.CsrfTokenSet
|}
|> viewForTheme "admin" "upload-theme" 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 {
@@ -223,17 +214,15 @@ let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = background
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 () }
| None -> return { theme with name = ThemeId.toString theme.id; version = now () }
}
/// Delete all theme assets, and remove templates from theme
let private checkForCleanLoad (theme : Theme) cleanLoad (data : IData) = backgroundTask {
if cleanLoad then
do! data.ThemeAsset.deleteByTheme theme.id
do! data.ThemeAsset.DeleteByTheme theme.id
return { theme with templates = [] }
else
return theme
else return theme
}
/// Update the theme with all templates from the ZIP archive
@@ -261,7 +250,7 @@ let private updateAssets themeId (zip : ZipArchive) (data : IData) = backgroundT
if assetName <> "" && not (assetName.EndsWith "/") then
use stream = new MemoryStream ()
do! asset.Open().CopyToAsync stream
do! data.ThemeAsset.save
do! data.ThemeAsset.Save
{ id = ThemeAssetId (themeId, assetName)
updatedOn = asset.LastWriteTime.DateTime
data = stream.ToArray ()
@@ -278,14 +267,14 @@ let loadThemeFromZip themeName file clean (data : IData) = backgroundTask {
use zip = new ZipArchive (file, ZipArchiveMode.Read)
let themeId = ThemeId themeName
let! theme = backgroundTask {
match! data.Theme.findById themeId with
match! data.Theme.FindById themeId with
| Some t -> return t
| None -> return { Theme.empty with id = themeId }
}
let! theme = updateNameAndVersion theme zip
let! theme = checkForCleanLoad theme clean data
let! theme = updateTemplates theme zip
do! data.Theme.save theme
do! data.Theme.Save theme
do! updateAssets themeId zip data
}
@@ -301,16 +290,15 @@ let updateTheme : HttpHandler = requireAccess Administrator >=> fun next ctx ->
do! loadThemeFromZip themeName stream true data
do! ThemeAssetCache.refreshTheme (ThemeId themeName) data
TemplateCache.invalidateTheme themeName
do! addMessage ctx { UserMessage.success with message = "Theme updated successfully" }
do! addMessage ctx { UserMessage.success with Message = "Theme updated successfully" }
return! redirectToGet "admin/dashboard" next ctx
| Ok _ ->
do! addMessage ctx { UserMessage.error with message = "You may not replace the admin theme" }
do! addMessage ctx { UserMessage.error with Message = "You may not replace the admin theme" }
return! redirectToGet "admin/theme/update" next ctx
| Error message ->
do! addMessage ctx { UserMessage.error with message = message }
do! addMessage ctx { UserMessage.error with Message = message }
return! redirectToGet "admin/theme/update" next ctx
else
return! RequestErrors.BAD_REQUEST "Bad request" next ctx
else return! RequestErrors.BAD_REQUEST "Bad request" next ctx
}
// -- WEB LOG SETTINGS --
@@ -320,8 +308,8 @@ open System.Collections.Generic
// GET /admin/settings
let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! allPages = data.Page.all ctx.WebLog.id
let! themes = data.Theme.all ()
let! allPages = data.Page.All ctx.WebLog.id
let! themes = data.Theme.All ()
return!
Hash.FromAnonymousObject {|
page_title = "Web Log Settings"
@@ -351,11 +339,11 @@ let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task
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
match! data.WebLog.FindById ctx.WebLog.id with
| Some webLog ->
let oldSlug = webLog.slug
let webLog = model.update webLog
do! data.WebLog.updateSettings webLog
do! data.WebLog.UpdateSettings webLog
// Update cache
WebLogCache.set webLog
@@ -366,7 +354,7 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
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" }
do! addMessage ctx { UserMessage.success with Message = "Web log settings saved successfully" }
return! redirectToGet "admin/settings" next ctx
| None -> return! Error.notFound next ctx
}