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

Edit formatting for handlers

Browse Source
This commit is contained in:
Daniel J. Summers
2026-07-03 19:23:45 -04:00
parent 0de1bff190
commit 84444e4789
6 changed files with 1109 additions and 954 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/MyWebLog/Handlers/Admin.fs
+365 -302
View File
@@ -12,30 +12,34 @@ open NodaTime
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 model =
{ Posts = posts
Drafts = drafts
Pages = pages
ListedPages = listed
Categories = cats
TopLevelCategories = topCats }
return! adminPage "Dashboard" next ctx (Views.WebLog.dashboard model)
}
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 model =
{ Posts = posts
Drafts = drafts
Pages = pages
ListedPages = listed
Categories = cats
TopLevelCategories = topCats }
return! adminPage "Dashboard" next ctx (Views.WebLog.dashboard model)
}
// GET /admin/administration
let admin : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let! themes = ctx.Data.Theme.All()
return! adminPage "myWebLog Administration" next ctx (Views.Admin.dashboard themes)
}
let admin : HttpHandler =
requireAccess Administrator
>=> fun next ctx -> task {
let! themes = ctx.Data.Theme.All()
return! adminPage "myWebLog Administration" next ctx (Views.Admin.dashboard themes)
}
/// Redirect the user to the admin dashboard
let toAdminDashboard : HttpHandler = redirectToGet "admin/administration"
@@ -45,49 +49,56 @@ let toAdminDashboard : HttpHandler = redirectToGet "admin/administration"
module Cache =
// POST /admin/cache/web-log/{id}/refresh
let refreshWebLog webLogId : HttpHandler = requireAccess Administrator >=> validateCsrf >=> 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
let refreshWebLog webLogId : HttpHandler =
requireAccess Administrator
>=> validateCsrf
>=> 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 refreshTheme themeId : HttpHandler = requireAccess Administrator >=> validateCsrf >=> fun next ctx -> task {
let data = ctx.Data
if themeId = "all" then
Template.Cache.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 ->
Template.Cache.invalidateTheme theme.Id
do! ThemeAssetCache.refreshTheme theme.Id data
let refreshTheme themeId : HttpHandler =
requireAccess Administrator
>=> validateCsrf
>=> fun next ctx -> task {
let data = ctx.Data
if themeId = "all" then
Template.Cache.empty ()
do! ThemeAssetCache.fill data
do! addMessage ctx
{ UserMessage.Success with
Message = $"Successfully cleared template cache and refreshed theme asset cache for {theme.Name}" }
| None ->
do! addMessage ctx { UserMessage.Error with Message = $"No theme exists with ID {themeId}" }
return! toAdminDashboard next ctx
}
Message = "Successfully cleared template cache and refreshed theme asset cache" }
else
match! data.Theme.FindById(ThemeId themeId) with
| Some theme ->
Template.Cache.invalidateTheme theme.Id
do! ThemeAssetCache.refreshTheme theme.Id data
do! addMessage ctx
{ UserMessage.Success with
Message = $"Successfully cleared template cache and refreshed theme asset cache for {theme.Name}" }
| None ->
do! addMessage ctx { UserMessage.Error with Message = $"No theme exists with ID {themeId}" }
return! toAdminDashboard next ctx
}
/// ~~~ CATEGORIES ~~~
@@ -96,68 +107,78 @@ module Category =
open MyWebLog.Data
// GET /admin/categories
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let response = fun next ctx ->
adminPage "Categories" next ctx (Views.WebLog.categoryList (ctx.Request.Query.ContainsKey "new"))
(withHxPushUrl (ctx.WebLog.RelativeUrl (Permalink "admin/categories")) >=> response) next ctx
let all : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx ->
let response = fun next ctx ->
adminPage "Categories" next ctx (Views.WebLog.categoryList (ctx.Request.Query.ContainsKey "new"))
(withHxPushUrl (ctx.WebLog.RelativeUrl (Permalink "admin/categories")) >=> response) 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
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!
Views.WebLog.categoryEdit (EditCategoryModel.FromCategory cat)
|> adminBarePage title next ctx
| None -> return! Error.notFound next ctx
}
match result with
| Some (title, cat) ->
return!
Views.WebLog.categoryEdit (EditCategoryModel.FromCategory cat)
|> adminBarePage title next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/category/save
let save : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> 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! all next ctx
| None -> return! Error.notFound next ctx
}
let save : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> 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! all next ctx
| None -> return! Error.notFound next ctx
}
// DELETE /admin/category/{id}
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! all next ctx
}
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! all next ctx
}
/// ~~~ REDIRECT RULES ~~~
@@ -166,24 +187,28 @@ module RedirectRules =
open Microsoft.AspNetCore.Http
// GET /admin/settings/redirect-rules
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
adminPage "Redirect Rules" next ctx (Views.WebLog.redirectList ctx.WebLog.RedirectRules)
let all : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx ->
adminPage "Redirect Rules" next ctx (Views.WebLog.redirectList ctx.WebLog.RedirectRules)
// GET /admin/settings/redirect-rules/[index]
let edit idx : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let titleAndView =
if idx = -1 then
Some ("Add", Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule -1 RedirectRule.Empty))
else
let rules = ctx.WebLog.RedirectRules
if rules.Length < idx || idx < 0 then
None
let edit idx : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx ->
let titleAndView =
if idx = -1 then
Some ("Add", Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule -1 RedirectRule.Empty))
else
Some
("Edit", (Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule idx (List.item idx rules))))
match titleAndView with
| Some (title, view) -> adminBarePage $"{title} Redirect Rule" next ctx view
| None -> Error.notFound next ctx
let rules = ctx.WebLog.RedirectRules
if rules.Length < idx || idx < 0 then
None
else
Some ("Edit",
Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule idx (List.item idx rules)))
match titleAndView with
| Some (title, view) -> adminBarePage $"{title} Redirect Rule" next ctx view
| None -> Error.notFound next ctx
/// Update the web log's redirect rules in the database, the request web log, and the web log cache
let private updateRedirectRules (ctx: HttpContext) webLog = backgroundTask {
@@ -193,99 +218,119 @@ module RedirectRules =
}
// POST /admin/settings/redirect-rules/[index]
let save idx : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditRedirectRuleModel>()
let rule = model.ToRule()
let rules =
ctx.WebLog.RedirectRules
|> match idx with
| -1 when model.InsertAtTop -> List.insertAt 0 rule
| -1 -> List.insertAt ctx.WebLog.RedirectRules.Length rule
| _ -> List.removeAt idx >> List.insertAt idx rule
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = rules }
do! addMessage ctx { UserMessage.Success with Message = "Redirect rule saved successfully" }
return! all next ctx
}
let save idx : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditRedirectRuleModel>()
let rule = model.ToRule()
let rules =
ctx.WebLog.RedirectRules
|> match idx with
| -1 when model.InsertAtTop -> List.insertAt 0 rule
| -1 -> List.insertAt ctx.WebLog.RedirectRules.Length rule
| _ -> List.removeAt idx >> List.insertAt idx rule
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = rules }
do! addMessage ctx { UserMessage.Success with Message = "Redirect rule saved successfully" }
return! all next ctx
}
// POST /admin/settings/redirect-rules/[index]/up
let moveUp idx : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
if idx < 1 || idx >= ctx.WebLog.RedirectRules.Length then
return! Error.notFound next ctx
else
let toMove = List.item idx ctx.WebLog.RedirectRules
let newRules = ctx.WebLog.RedirectRules |> List.removeAt idx |> List.insertAt (idx - 1) toMove
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = newRules }
return! all next ctx
}
let moveUp idx : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> fun next ctx -> task {
if idx < 1 || idx >= ctx.WebLog.RedirectRules.Length then
return! Error.notFound next ctx
else
let toMove = List.item idx ctx.WebLog.RedirectRules
let newRules = ctx.WebLog.RedirectRules |> List.removeAt idx |> List.insertAt (idx - 1) toMove
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = newRules }
return! all next ctx
}
// POST /admin/settings/redirect-rules/[index]/down
let moveDown idx : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length - 1 then
return! Error.notFound next ctx
else
let toMove = List.item idx ctx.WebLog.RedirectRules
let newRules = ctx.WebLog.RedirectRules |> List.removeAt idx |> List.insertAt (idx + 1) toMove
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = newRules }
return! all next ctx
}
let moveDown idx : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> fun next ctx -> task {
if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length - 1 then
return! Error.notFound next ctx
else
let toMove = List.item idx ctx.WebLog.RedirectRules
let newRules = ctx.WebLog.RedirectRules |> List.removeAt idx |> List.insertAt (idx + 1) toMove
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = newRules }
return! all next ctx
}
// DELETE /admin/settings/redirect-rules/[index]
let delete idx : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length then
return! Error.notFound next ctx
else
let rules = ctx.WebLog.RedirectRules |> List.removeAt idx
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = rules }
do! addMessage ctx { UserMessage.Success with Message = "Redirect rule deleted successfully" }
return! all next ctx
}
let delete idx : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length then
return! Error.notFound next ctx
else
let rules = ctx.WebLog.RedirectRules |> List.removeAt idx
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = rules }
do! addMessage ctx { UserMessage.Success with Message = "Redirect rule deleted successfully" }
return! all next ctx
}
/// ~~~ TAG MAPPINGS ~~~
module TagMapping =
// GET /admin/settings/tag-mappings
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
return! adminBarePage "Tag Mapping List" next ctx (Views.WebLog.tagMapList mappings)
}
let all : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
return! adminBarePage "Tag Mapping List" next ctx (Views.WebLog.tagMapList mappings)
}
// 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!
Views.WebLog.tagMapEdit (EditTagMapModel.FromMapping tm)
|> adminBarePage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag") next ctx
| None -> return! Error.notFound next ctx
}
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!
Views.WebLog.tagMapEdit (EditTagMapModel.FromMapping tm)
|> adminBarePage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag") next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/settings/tag-mapping/save
let save : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> 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
}
let save : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> 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
}
// DELETE /admin/settings/tag-mapping/{id}
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
}
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 ~~~
@@ -298,16 +343,19 @@ module Theme =
open MyWebLog.Data
// GET /admin/theme/list
let all : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let! themes = ctx.Data.Theme.All ()
return!
Views.Admin.themeList (List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) themes)
|> adminBarePage "Themes" next ctx
}
let all : HttpHandler =
requireAccess Administrator
>=> fun next ctx -> task {
let! themes = ctx.Data.Theme.All ()
return!
Views.Admin.themeList (List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) themes)
|> adminBarePage "Themes" next ctx
}
// GET /admin/theme/new
let add : HttpHandler = requireAccess Administrator >=> fun next ctx ->
adminBarePage "Upload a Theme File" next ctx Views.Admin.themeUpload
let add : HttpHandler =
requireAccess Administrator
>=> fun next ctx -> adminBarePage "Upload a Theme File" next ctx Views.Admin.themeUpload
/// Update the name and version for a theme based on the version.txt file, if present
let private updateNameAndVersion (theme: Theme) (zip: ZipArchive) = backgroundTask {
@@ -383,67 +431,73 @@ module Theme =
}
// POST /admin/theme/new
let save : HttpHandler = requireAccess Administrator >=> validateCsrf >=> 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 <> ThemeId "admin" ->
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
Template.Cache.invalidateTheme themeId
// Ensure the themes directory exists
let themeDir = Path.Combine(".", "themes")
if not (Directory.Exists themeDir) then Directory.CreateDirectory themeDir |> ignore
// Save the .zip file
use file = new FileStream(Path.Combine(".", "themes", $"{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""" }
let save : HttpHandler =
requireAccess Administrator
>=> validateCsrf
>=> 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 <> ThemeId "admin" ->
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
Template.Cache.invalidateTheme themeId
// Ensure the themes directory exists
let themeDir = Path.Combine(".", "themes")
if not (Directory.Exists themeDir) then Directory.CreateDirectory themeDir |> ignore
// Save the .zip file
use file = new FileStream(Path.Combine(".", "themes", $"{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
else
do! addMessage ctx
{ UserMessage.Error with
Message = "Theme exists and overwriting was not requested; nothing saved" }
| Error message ->
do! addMessage ctx { UserMessage.Error with Message = message }
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
}
else return! RequestErrors.BAD_REQUEST "Bad request" next ctx
}
// POST /admin/theme/{id}/delete
let delete themeId : HttpHandler = requireAccess Administrator >=> validateCsrf >=> 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 = Path.Combine(".", "themes", $"{themeId}-theme.zip")
if File.Exists zippedTheme then File.Delete zippedTheme
do! addMessage ctx { UserMessage.Success with Message = $"Theme ID {themeId} deleted successfully" }
let delete themeId : HttpHandler =
requireAccess Administrator
>=> validateCsrf
>=> 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
| false -> return! Error.notFound 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 = Path.Combine(".", "themes", $"{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 ~~~
@@ -452,41 +506,50 @@ module WebLog =
open System.IO
// 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 pages =
allPages
|> List.sortBy _.Title.ToLower()
|> List.append [ { Page.Empty with Id = PageId "posts"; Title = "- First Page of Posts -" } ]
let! themes = data.Theme.All()
let uploads = [ Database; Disk ]
return!
Views.WebLog.webLogSettings
(SettingsModel.FromWebLog ctx.WebLog) themes pages uploads (EditRssModel.FromRssOptions ctx.WebLog.Rss)
|> adminPage "Web Log Settings" next ctx
}
let settings : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let data = ctx.Data
let! allPages = data.Page.All ctx.WebLog.Id
let pages =
allPages
|> List.sortBy _.Title.ToLower()
|> List.append [ { Page.Empty with Id = PageId "posts"; Title = "- First Page of Posts -" } ]
let! themes = data.Theme.All()
let uploads = [ Database; Disk ]
return!
Views.WebLog.webLogSettings
(SettingsModel.FromWebLog ctx.WebLog)
themes
pages
uploads
(EditRssModel.FromRssOptions ctx.WebLog.Rss)
|> adminPage "Web Log Settings" next ctx
}
// POST /admin/settings
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> 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
let saveSettings : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> 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
// 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))
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
}
do! addMessage ctx { UserMessage.Success with Message = "Web log settings saved successfully" }
return! redirectToGet "admin/settings" next ctx
| None -> return! Error.notFound next ctx
}
src/MyWebLog/Handlers/Feed.fs
+87 -77
View File
@@ -416,87 +416,97 @@ let generate (feedType: FeedType) postCount : HttpHandler = fun next ctx -> back
// ~~ FEED ADMINISTRATION ~~
// POST /admin/settings/rss
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditRssModel>()
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
let webLog = { webLog with Rss = model.UpdateOptions webLog.Rss }
do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog
do! addMessage ctx { UserMessage.Success with Message = "RSS settings updated successfully" }
return! redirectToGet "admin/settings#rss-settings" next ctx
| None -> return! Error.notFound next ctx
}
let saveSettings : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditRssModel>()
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
let webLog = { webLog with Rss = model.UpdateOptions webLog.Rss }
do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog
do! addMessage ctx { UserMessage.Success with Message = "RSS settings updated successfully" }
return! redirectToGet "admin/settings#rss-settings" next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/settings/rss/{id}/edit
let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let customFeed =
match feedId with
| "new" -> Some { CustomFeed.Empty with Id = CustomFeedId "new" }
| _ -> ctx.WebLog.Rss.CustomFeeds |> List.tryFind (fun f -> f.Id = CustomFeedId feedId)
match customFeed with
| Some f ->
let ratings = [
{ Name = string Yes; Value = "Yes" }
{ Name = string No; Value = "No" }
{ Name = string Clean; Value = "Clean" }
]
let mediums = [
{ Name = ""; Value = "&ndash; Unspecified &ndash;" }
{ Name = string Podcast; Value = "Podcast" }
{ Name = string Music; Value = "Music" }
{ Name = string Video; Value = "Video" }
{ Name = string Film; Value = "Film" }
{ Name = string Audiobook; Value = "Audiobook" }
{ Name = string Newsletter; Value = "Newsletter" }
{ Name = string Blog; Value = "Blog" }
]
Views.WebLog.feedEdit (EditCustomFeedModel.FromFeed f) ratings mediums
|> adminPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed""" next ctx
| None -> Error.notFound next ctx
let editCustomFeed feedId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx ->
let customFeed =
match feedId with
| "new" -> Some { CustomFeed.Empty with Id = CustomFeedId "new" }
| _ -> ctx.WebLog.Rss.CustomFeeds |> List.tryFind (fun f -> f.Id = CustomFeedId feedId)
match customFeed with
| Some f ->
let ratings = [
{ Name = string Yes; Value = "Yes" }
{ Name = string No; Value = "No" }
{ Name = string Clean; Value = "Clean" }
]
let mediums = [
{ Name = ""; Value = "&ndash; Unspecified &ndash;" }
{ Name = string Podcast; Value = "Podcast" }
{ Name = string Music; Value = "Music" }
{ Name = string Video; Value = "Video" }
{ Name = string Film; Value = "Film" }
{ Name = string Audiobook; Value = "Audiobook" }
{ Name = string Newsletter; Value = "Newsletter" }
{ Name = string Blog; Value = "Blog" }
]
Views.WebLog.feedEdit (EditCustomFeedModel.FromFeed f) ratings mediums
|> adminPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed""" next ctx
| None -> Error.notFound next ctx
// POST /admin/settings/rss/save
let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
let! model = ctx.BindFormAsync<EditCustomFeedModel>()
let theFeed =
match model.Id with
| "new" -> Some { CustomFeed.Empty with Id = CustomFeedId.Create() }
| _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> string it.Id = model.Id)
match theFeed with
| Some feed ->
let feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun it -> it.Id <> feed.Id))
let webLog = { webLog with Rss.CustomFeeds = feeds }
do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog
do! addMessage ctx
{ UserMessage.Success with
Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed""" }
return! redirectToGet $"admin/settings/rss/{feed.Id}/edit" next ctx
let saveCustomFeed : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
let! model = ctx.BindFormAsync<EditCustomFeedModel>()
let theFeed =
match model.Id with
| "new" -> Some { CustomFeed.Empty with Id = CustomFeedId.Create() }
| _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> string it.Id = model.Id)
match theFeed with
| Some feed ->
let feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> feed.Id))
let webLog = { webLog with Rss.CustomFeeds = feeds }
do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog
do! addMessage ctx
{ UserMessage.Success with
Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed""" }
return! redirectToGet $"admin/settings/rss/{feed.Id}/edit" next ctx
| None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx
}
}
// DELETE /admin/settings/rss/{id}
let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
let customId = CustomFeedId feedId
if webLog.Rss.CustomFeeds |> List.exists (fun f -> f.Id = customId) then
let webLog =
{ webLog with
Rss =
{ webLog.Rss with
CustomFeeds = webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> customId) } }
do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog
do! addMessage ctx { UserMessage.Success with Message = "Custom feed deleted successfully" }
else
do! addMessage ctx { UserMessage.Warning with Message = "Custom feed not found; no action taken" }
return! redirectToGet "admin/settings#rss-settings" next ctx
| None -> return! Error.notFound next ctx
}
let deleteCustomFeed feedId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
let customId = CustomFeedId feedId
if webLog.Rss.CustomFeeds |> List.exists (fun f -> f.Id = customId) then
let webLog =
{ webLog with
Rss =
{ webLog.Rss with
CustomFeeds = webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> customId) } }
do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog
do! addMessage ctx { UserMessage.Success with Message = "Custom feed deleted successfully" }
else
do! addMessage ctx { UserMessage.Warning with Message = "Custom feed not found; no action taken" }
return! redirectToGet "admin/settings#rss-settings" next ctx
| None -> return! Error.notFound next ctx
}
src/MyWebLog/Handlers/Page.fs
+158 -133
View File
@@ -7,98 +7,113 @@ open MyWebLog.ViewModels
// GET /admin/pages
// GET /admin/pages/page/{pageNbr}
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! pages = ctx.Data.Page.FindPageOfPages ctx.WebLog.Id pageNbr
let displayPages =
pages
|> Seq.ofList
|> Seq.truncate 25
|> Seq.map (DisplayPage.FromPageMinimal ctx.WebLog)
|> List.ofSeq
return!
Views.Page.pageList displayPages pageNbr (pages.Length > 25)
|> adminPage "Pages" next ctx
}
let all pageNbr : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let! pages = ctx.Data.Page.FindPageOfPages ctx.WebLog.Id pageNbr
let displayPages =
pages
|> Seq.ofList
|> Seq.truncate 25
|> Seq.map (DisplayPage.FromPageMinimal ctx.WebLog)
|> List.ofSeq
return!
Views.Page.pageList displayPages pageNbr (pages.Length > 25)
|> adminPage "Pages" next ctx
}
// GET /admin/page/{id}/edit
let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! result = task {
match pgId with
| "new" -> return Some ("Add a New Page", { Page.Empty with Id = PageId "new"; AuthorId = ctx.UserId })
| _ ->
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some page -> return Some ("Edit Page", page)
| None -> return None
let edit pgId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let! result = task {
match pgId with
| "new" -> return Some ("Add a New Page", { Page.Empty with Id = PageId "new"; AuthorId = ctx.UserId })
| _ ->
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some page -> return Some ("Edit Page", page)
| None -> return None
}
match result with
| Some (title, page) when canEdit page.AuthorId ctx ->
let model = EditPageModel.FromPage page
let! templates = templatesForTheme ctx "page"
return! adminPage title next ctx (Views.Page.pageEdit model templates)
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
match result with
| Some (title, page) when canEdit page.AuthorId ctx ->
let model = EditPageModel.FromPage page
let! templates = templatesForTheme ctx "page"
return! adminPage title next ctx (Views.Page.pageEdit model templates)
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// DELETE /admin/page/{id}
let delete pgId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Page.Delete (PageId pgId) ctx.WebLog.Id with
| true ->
do! PageListCache.update ctx
do! addMessage ctx { UserMessage.Success with Message = "Page deleted successfully" }
| false -> do! addMessage ctx { UserMessage.Error with Message = "Page not found; nothing deleted" }
return! all 1 next ctx
}
let delete pgId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
match! ctx.Data.Page.Delete (PageId pgId) ctx.WebLog.Id with
| true ->
do! PageListCache.update ctx
do! addMessage ctx { UserMessage.Success with Message = "Page deleted successfully" }
| false -> do! addMessage ctx { UserMessage.Error with Message = "Page not found; nothing deleted" }
return! all 1 next ctx
}
// GET /admin/page/{id}/permalinks
let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
ManagePermalinksModel.FromPage pg
|> Views.Helpers.managePermalinks
|> adminPage "Manage Prior Permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
let editPermalinks pgId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
ManagePermalinksModel.FromPage pg
|> Views.Helpers.managePermalinks
|> adminPage "Manage Prior Permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/page/permalinks
let savePermalinks : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel>()
let pageId = PageId model.Id
match! ctx.Data.Page.FindById pageId ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
let links = model.Prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Page.UpdatePriorPermalinks pageId ctx.WebLog.Id links with
| true ->
do! addMessage ctx { UserMessage.Success with Message = "Page permalinks saved successfully" }
return! redirectToGet $"admin/page/{model.Id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
let savePermalinks : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel>()
let pageId = PageId model.Id
match! ctx.Data.Page.FindById pageId ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
let links = model.Prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Page.UpdatePriorPermalinks pageId ctx.WebLog.Id links with
| true ->
do! addMessage ctx { UserMessage.Success with Message = "Page permalinks saved successfully" }
return! redirectToGet $"admin/page/{model.Id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/page/{id}/revisions
let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
ManageRevisionsModel.FromPage pg
|> Views.Helpers.manageRevisions
|> adminPage "Manage Page Revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
let editRevisions pgId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
ManageRevisionsModel.FromPage pg
|> Views.Helpers.manageRevisions
|> adminPage "Manage Page Revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// DELETE /admin/page/{id}/revisions
let purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
match! data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg ->
do! data.Page.Update { pg with Revisions = [ List.head pg.Revisions ] }
do! addMessage ctx { UserMessage.Success with Message = "Prior revisions purged successfully" }
return! editRevisions pgId next ctx
| None -> return! Error.notFound next ctx
}
let purgeRevisions pgId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let data = ctx.Data
match! data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg ->
do! data.Page.Update { pg with Revisions = [ List.head pg.Revisions ] }
do! addMessage ctx { UserMessage.Success with Message = "Prior revisions purged successfully" }
return! editRevisions pgId next ctx
| None -> return! Error.notFound next ctx
}
open Microsoft.AspNetCore.Http
@@ -112,63 +127,73 @@ let private findPageRevision pgId revDate (ctx: HttpContext) = task {
}
// GET /admin/page/{id}/revision/{revision-date}/preview
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 ->
return! adminBarePage "" next ctx (Views.Helpers.commonPreview rev)
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | _, None -> return! Error.notFound next ctx
}
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 ->
return! adminBarePage "" next ctx (Views.Helpers.commonPreview rev)
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | _, None -> return! Error.notFound next ctx
}
// POST /admin/page/{id}/revision/{revision-date}/restore
let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update
{ pg with
Revisions = { rev with AsOf = Noda.now () }
:: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) }
do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/page/{pgId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
let restoreRevision (pgId, revDate) : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update
{ pg with
Revisions = { rev with AsOf = Noda.now () }
:: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) }
do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/page/{pgId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// DELETE /admin/page/{id}/revision/{revision-date}
let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update { pg with Revisions = pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
return! adminBarePage "" next ctx (fun _ -> [])
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
let deleteRevision (pgId, revDate) : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update { pg with Revisions = pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
return! adminBarePage "" next ctx (fun _ -> [])
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/page/save
let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel>()
let data = ctx.Data
let now = Noda.now ()
let tryPage =
if model.IsNew then
{ Page.Empty with
Id = PageId.Create()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
PublishedOn = now
} |> someTask
else data.Page.FindFullById (PageId model.Id) ctx.WebLog.Id
match! tryPage with
| Some page when canEdit page.AuthorId ctx ->
let updateList = page.IsInPageList <> model.IsShownInPageList
let updatedPage = model.UpdatePage page now
do! (if model.IsNew then data.Page.Add else data.Page.Update) updatedPage
if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.Success with Message = "Page saved successfully" }
return! redirectToGet $"admin/page/{page.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
let save : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel>()
let data = ctx.Data
let now = Noda.now ()
let tryPage =
if model.IsNew then
{ Page.Empty with
Id = PageId.Create()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
PublishedOn = now
} |> someTask
else data.Page.FindFullById (PageId model.Id) ctx.WebLog.Id
match! tryPage with
| Some page when canEdit page.AuthorId ctx ->
let updateList = page.IsInPageList <> model.IsShownInPageList
let updatedPage = model.UpdatePage page now
do! (if model.IsNew then data.Page.Add else data.Page.Update) updatedPage
if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.Success with Message = "Page saved successfully" }
return! redirectToGet $"admin/page/{page.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
src/MyWebLog/Handlers/Post.fs
+263 -232
View File
@@ -97,6 +97,7 @@ let preparePostList webLog posts listType (url: string) pageNbr perPage (data: I
open Giraffe
// GET /page/{pageNbr}[/]
// (also served with pageNbr = 1 when default page is recent posts)
let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
if pageNbr <> 1 && ctx.Request.Path.Value.EndsWith "/" then
return! redirectTo true (ctx.WebLog.RelativeUrl(Permalink $"page/{pageNbr}")) next ctx
@@ -117,10 +118,6 @@ let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
|> themedView "index" next ctx
}
// GET /page/{pageNbr}/
let redirectToPageOfPosts (pageNbr: int) : HttpHandler = fun next ctx ->
redirectTo true (ctx.WebLog.RelativeUrl(Permalink $"page/{pageNbr}")) next ctx
// GET /category/{slug}/
// GET /category/{slug}/page/{pageNbr}
let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task {
@@ -255,99 +252,114 @@ let chapters (post: Post) : HttpHandler = fun next ctx ->
// GET /admin/posts
// GET /admin/posts/page/{pageNbr}
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25
let! viewCtx = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data
return! adminPage "Posts" next ctx (Post.list viewCtx.Posts)
}
let all pageNbr : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let data = ctx.Data
let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25
let! viewCtx = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data
return! adminPage "Posts" next ctx (Post.list viewCtx.Posts)
}
// GET /admin/post/{id}/edit
let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
let! result = task {
match postId with
| "new" -> return Some ("Write a New Post", { Post.Empty with Id = PostId "new" })
| _ ->
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post -> return Some ("Edit Post", post)
| None -> return None
let edit postId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let data = ctx.Data
let! result = task {
match postId with
| "new" -> return Some ("Write a New Post", { Post.Empty with Id = PostId "new" })
| _ ->
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post -> return Some ("Edit Post", post)
| None -> return None
}
match result with
| Some (title, post) when canEdit post.AuthorId ctx ->
let! templates = templatesForTheme ctx "post"
let model = EditPostModel.FromPost ctx.WebLog post
let ratings = [
{ Name = ""; Value = "&ndash; Default &ndash;" }
{ Name = string Yes; Value = "Yes" }
{ Name = string No; Value = "No" }
{ Name = string Clean; Value = "Clean" }
]
return! adminPage title next ctx (Post.postEdit model templates ratings)
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
match result with
| Some (title, post) when canEdit post.AuthorId ctx ->
let! templates = templatesForTheme ctx "post"
let model = EditPostModel.FromPost ctx.WebLog post
let ratings = [
{ Name = ""; Value = "&ndash; Default &ndash;" }
{ Name = string Yes; Value = "Yes" }
{ Name = string No; Value = "No" }
{ Name = string Clean; Value = "Clean" }
]
return! adminPage title next ctx (Post.postEdit model templates ratings)
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// DELETE /admin/post/{id}
let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Post.Delete (PostId postId) ctx.WebLog.Id with
| true -> do! addMessage ctx { UserMessage.Success with Message = "Post deleted successfully" }
| false -> do! addMessage ctx { UserMessage.Error with Message = "Post not found; nothing deleted" }
//return! redirectToGet "admin/posts" next ctx
return! all 1 next ctx
}
let delete postId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
match! ctx.Data.Post.Delete (PostId postId) ctx.WebLog.Id with
| true -> do! addMessage ctx { UserMessage.Success with Message = "Post deleted successfully" }
| false -> do! addMessage ctx { UserMessage.Error with Message = "Post not found; nothing deleted" }
//return! redirectToGet "admin/posts" next ctx
return! all 1 next ctx
}
// GET /admin/post/{id}/permalinks
let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
ManagePermalinksModel.FromPost post
|> managePermalinks
|> adminPage "Manage Prior Permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
let editPermalinks postId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
ManagePermalinksModel.FromPost post
|> managePermalinks
|> adminPage "Manage Prior Permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/post/permalinks
let savePermalinks : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel>()
let postId = PostId model.Id
match! ctx.Data.Post.FindById postId ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
let links = model.Prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Post.UpdatePriorPermalinks postId ctx.WebLog.Id links with
| true ->
do! addMessage ctx { UserMessage.Success with Message = "Post permalinks saved successfully" }
return! redirectToGet $"admin/post/{model.Id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
let savePermalinks : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel>()
let postId = PostId model.Id
match! ctx.Data.Post.FindById postId ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
let links = model.Prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Post.UpdatePriorPermalinks postId ctx.WebLog.Id links with
| true ->
do! addMessage ctx { UserMessage.Success with Message = "Post permalinks saved successfully" }
return! redirectToGet $"admin/post/{model.Id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/post/{id}/revisions
let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
ManageRevisionsModel.FromPost post
|> manageRevisions
|> adminPage "Manage Post Revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
let editRevisions postId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
ManageRevisionsModel.FromPost post
|> manageRevisions
|> adminPage "Manage Post Revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// DELETE /admin/post/{id}/revisions
let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
do! data.Post.Update { post with Revisions = [ List.head post.Revisions ] }
do! addMessage ctx { UserMessage.Success with Message = "Prior revisions purged successfully" }
return! editRevisions postId next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
let purgeRevisions postId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
do! data.Post.Update { post with Revisions = [ List.head post.Revisions ] }
do! addMessage ctx { UserMessage.Success with Message = "Prior revisions purged successfully" }
return! editRevisions postId next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
open Microsoft.AspNetCore.Http
@@ -361,165 +373,184 @@ let private findPostRevision postId revDate (ctx: HttpContext) = task {
}
// GET /admin/post/{id}/revision/{revision-date}/preview
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 ->
return! adminBarePage "" next ctx (commonPreview rev)
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | _, None -> return! Error.notFound next ctx
}
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 ->
return! adminBarePage "" next ctx (commonPreview rev)
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | _, None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/revision/{revision-date}/restore
let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update
{ post with
Revisions = { rev with AsOf = Noda.now () }
:: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) }
do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
let restoreRevision (postId, revDate) : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update
{ post with
Revisions = { rev with AsOf = Noda.now () }
:: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) }
do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// DELETE /admin/post/{id}/revision/{revision-date}
let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
return! adminBarePage "" next ctx (fun _ -> [])
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
let deleteRevision (postId, revDate) : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
return! adminBarePage "" next ctx (fun _ -> [])
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// GET /admin/post/{id}/chapters
let manageChapters postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
return!
Post.chapters false (ManageChaptersModel.Create post)
|> adminPage "Manage Chapters" next ctx
| Some _ | None -> return! Error.notFound next ctx
}
let manageChapters postId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
return!
Post.chapters false (ManageChaptersModel.Create post)
|> adminPage "Manage Chapters" next ctx
| Some _ | None -> return! Error.notFound next ctx
}
// GET /admin/post/{id}/chapter/{idx}
let editChapter (postId, index) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
let chapter =
if index = -1 then Some Chapter.Empty
else
let chapters = post.Episode.Value.Chapters.Value
if index < List.length chapters then Some chapters[index] else None
match chapter with
| Some chap ->
return!
Post.chapterEdit (EditChapterModel.FromChapter post.Id index chap)
|> adminBarePage (if index = -1 then "Add a Chapter" else "Edit Chapter") next ctx
| None -> return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}
let editChapter (postId, index) : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
let chapter =
if index = -1 then Some Chapter.Empty
else
let chapters = post.Episode.Value.Chapters.Value
if index < List.length chapters then Some chapters[index] else None
match chapter with
| Some chap ->
return!
Post.chapterEdit (EditChapterModel.FromChapter post.Id index chap)
|> adminBarePage (if index = -1 then "Add a Chapter" else "Edit Chapter") next ctx
| None -> return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/chapter/{idx}
let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
let! form = ctx.BindFormAsync<EditChapterModel>()
let chapters = post.Episode.Value.Chapters.Value
if index >= -1 && index < List.length chapters then
try
let chapter = form.ToChapter()
let existing = if index = -1 then chapters else List.removeAt index chapters
let updatedPost =
{ post with
Episode = Some
{ post.Episode.Value with
Chapters = Some (chapter :: existing |> List.sortBy _.StartTime) } }
do! data.Post.Update updatedPost
do! addMessage ctx { UserMessage.Success with Message = "Chapter saved successfully" }
return!
Post.chapterList form.AddAnother (ManageChaptersModel.Create updatedPost)
|> adminBarePage "Manage Chapters" next ctx
with
| ex -> return! Error.server ex.Message next ctx
else return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}
let saveChapter (postId, index) : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
let! form = ctx.BindFormAsync<EditChapterModel>()
let chapters = post.Episode.Value.Chapters.Value
if index >= -1 && index < List.length chapters then
try
let chapter = form.ToChapter()
let existing = if index = -1 then chapters else List.removeAt index chapters
let updatedPost =
{ post with
Episode = Some
{ post.Episode.Value with
Chapters = Some (chapter :: existing |> List.sortBy _.StartTime) } }
do! data.Post.Update updatedPost
do! addMessage ctx { UserMessage.Success with Message = "Chapter saved successfully" }
return!
Post.chapterList form.AddAnother (ManageChaptersModel.Create updatedPost)
|> adminBarePage "Manage Chapters" next ctx
with
| ex -> return! Error.server ex.Message next ctx
else return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}
// DELETE /admin/post/{id}/chapter/{idx}
let deleteChapter (postId, index) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
let chapters = post.Episode.Value.Chapters.Value
if index >= 0 && index < List.length chapters then
let updatedPost =
{ post with
Episode = Some { post.Episode.Value with Chapters = Some (List.removeAt index chapters) } }
do! data.Post.Update updatedPost
do! addMessage ctx { UserMessage.Success with Message = "Chapter deleted successfully" }
return!
Post.chapterList false (ManageChaptersModel.Create updatedPost)
|> adminPage "Manage Chapters" next ctx
else return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}
let deleteChapter (postId, index) : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
let chapters = post.Episode.Value.Chapters.Value
if index >= 0 && index < List.length chapters then
let updatedPost =
{ post with
Episode = Some { post.Episode.Value with Chapters = Some (List.removeAt index chapters) } }
do! data.Post.Update updatedPost
do! addMessage ctx { UserMessage.Success with Message = "Chapter deleted successfully" }
return!
Post.chapterList false (ManageChaptersModel.Create updatedPost)
|> adminPage "Manage Chapters" next ctx
else return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}
// POST /admin/post/save
let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel>()
let data = ctx.Data
let tryPost =
if model.IsNew then
{ Post.Empty with
Id = PostId.Create()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId }
|> someTask
else data.Post.FindFullById (PostId model.Id) ctx.WebLog.Id
match! tryPost with
| Some post when canEdit post.AuthorId ctx ->
let priorCats = post.CategoryIds
let updatedPost =
model.UpdatePost post (Noda.now ())
|> function
| post ->
if model.SetPublished then
let dt = parseToUtc (model.PubOverride.Value.ToString "o")
if model.SetUpdated then
{ post with
PublishedOn = Some dt
UpdatedOn = dt
Revisions = [ { (List.head post.Revisions) with AsOf = dt } ] }
else { post with PublishedOn = Some dt }
else post
do! (if model.IsNew then data.Post.Add else data.Post.Update) updatedPost
// If the post was published or its categories changed, refresh the category cache
if model.DoPublish
|| not (priorCats
|> List.append updatedPost.CategoryIds
|> List.distinct
|> List.length = List.length priorCats) then
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.Success with Message = "Post saved successfully" }
return! redirectToGet $"admin/post/{post.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
let save : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel>()
let data = ctx.Data
let tryPost =
if model.IsNew then
{ Post.Empty with
Id = PostId.Create()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId }
|> someTask
else data.Post.FindFullById (PostId model.Id) ctx.WebLog.Id
match! tryPost with
| Some post when canEdit post.AuthorId ctx ->
let priorCats = post.CategoryIds
let updatedPost =
model.UpdatePost post (Noda.now ())
|> function
| post ->
if model.SetPublished then
let dt = parseToUtc (model.PubOverride.Value.ToString "o")
if model.SetUpdated then
{ post with
PublishedOn = Some dt
UpdatedOn = dt
Revisions = [ { (List.head post.Revisions) with AsOf = dt } ] }
else { post with PublishedOn = Some dt }
else post
do! (if model.IsNew then data.Post.Add else data.Post.Update) updatedPost
// If the post was published or its categories changed, refresh the category cache
if model.DoPublish
|| not (priorCats
|> List.append updatedPost.CategoryIds
|> List.distinct
|> List.length = List.length priorCats) then
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.Success with Message = "Post saved successfully" }
return! redirectToGet $"admin/post/{post.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
src/MyWebLog/Handlers/Upload.fs
+93 -82
View File
@@ -90,86 +90,95 @@ open MyWebLog.ViewModels
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 {
let webLog = ctx.WebLog
let! dbUploads = ctx.Data.Upload.FindByWebLog webLog.Id
let diskUploads =
let path = Path.Combine(uploadDir, webLog.Slug)
try
Directory.EnumerateFiles(path, "*", SearchOption.AllDirectories)
|> Seq.map (fun file ->
let name = Path.GetFileName file
let create =
match File.GetCreationTime(Path.Combine(path, file)) with
| dt when dt > DateTime.UnixEpoch -> Some dt
| _ -> None
{ DisplayUpload.Id = ""
Name = name
Path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace(slash, '/')
UpdatedOn = create
Source = string Disk })
with
| :? DirectoryNotFoundException -> [] // This is fine
| ex ->
warn "Upload" ctx $"Encountered {ex.GetType().Name} listing uploads for {path}:\n{ex.Message}"
[]
return!
dbUploads
|> Seq.ofList
|> Seq.map (DisplayUpload.FromUpload webLog Database)
|> Seq.append diskUploads
|> Seq.sortByDescending (fun file -> file.UpdatedOn, file.Path)
|> Views.WebLog.uploadList
|> adminPage "Uploaded Files" next ctx
}
let list : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let webLog = ctx.WebLog
let! dbUploads = ctx.Data.Upload.FindByWebLog webLog.Id
let diskUploads =
let path = Path.Combine(uploadDir, webLog.Slug)
try
Directory.EnumerateFiles(path, "*", SearchOption.AllDirectories)
|> Seq.map (fun file ->
let name = Path.GetFileName file
let create =
match File.GetCreationTime(Path.Combine(path, file)) with
| dt when dt > DateTime.UnixEpoch -> Some dt
| _ -> None
{ DisplayUpload.Id = ""
Name = name
Path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace(slash, '/')
UpdatedOn = create
Source = string Disk })
with
| :? DirectoryNotFoundException -> [] // This is fine
| ex ->
warn "Upload" ctx $"Encountered {ex.GetType().Name} listing uploads for {path}:\n{ex.Message}"
[]
return!
dbUploads
|> Seq.ofList
|> Seq.map (DisplayUpload.FromUpload webLog Database)
|> Seq.append diskUploads
|> Seq.sortByDescending (fun file -> file.UpdatedOn, file.Path)
|> Views.WebLog.uploadList
|> adminPage "Uploaded Files" next ctx
}
// GET /admin/upload/new
let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
adminPage "Upload a File" next ctx Views.WebLog.uploadNew
let showNew : HttpHandler =
requireAccess Author
>=> fun next ctx -> adminPage "Upload a File" next ctx Views.WebLog.uploadNew
// POST /admin/upload/save
let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let upload = Seq.head ctx.Request.Form.Files
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
Path.GetExtension(upload.FileName).ToLowerInvariant())
let now = Noda.now ()
let localNow = ctx.WebLog.LocalTime now
let year = localNow.ToString "yyyy"
let month = localNow.ToString "MM"
let! form = ctx.BindFormAsync<UploadFileModel>()
let save : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let upload = Seq.head ctx.Request.Form.Files
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
Path.GetExtension(upload.FileName).ToLowerInvariant())
let now = Noda.now ()
let localNow = ctx.WebLog.LocalTime now
let year = localNow.ToString "yyyy"
let month = localNow.ToString "MM"
let! form = ctx.BindFormAsync<UploadFileModel>()
match UploadDestination.Parse form.Destination with
| Database ->
use stream = new MemoryStream()
do! upload.CopyToAsync stream
let file =
{ Id = UploadId.Create()
WebLogId = ctx.WebLog.Id
Path = Permalink $"{year}/{month}/{fileName}"
UpdatedOn = now
Data = stream.ToArray() }
do! ctx.Data.Upload.Add file
| Disk ->
let fullPath = Path.Combine(uploadDir, ctx.WebLog.Slug, year, month)
let _ = Directory.CreateDirectory fullPath
use stream = new FileStream(Path.Combine(fullPath, fileName), FileMode.Create)
do! upload.CopyToAsync stream
match UploadDestination.Parse form.Destination with
| Database ->
use stream = new MemoryStream()
do! upload.CopyToAsync stream
let file =
{ Id = UploadId.Create()
WebLogId = ctx.WebLog.Id
Path = Permalink $"{year}/{month}/{fileName}"
UpdatedOn = now
Data = stream.ToArray() }
do! ctx.Data.Upload.Add file
| Disk ->
let fullPath = Path.Combine(uploadDir, ctx.WebLog.Slug, year, month)
let _ = Directory.CreateDirectory fullPath
use stream = new FileStream(Path.Combine(fullPath, fileName), FileMode.Create)
do! upload.CopyToAsync stream
do! addMessage ctx { UserMessage.Success with Message = $"File uploaded to {form.Destination} successfully" }
return! redirectToGet "admin/uploads" next ctx
else
return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx
}
do! addMessage
ctx { UserMessage.Success with Message = $"File uploaded to {form.Destination} successfully" }
return! redirectToGet "admin/uploads" next ctx
else
return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx
}
// DELETE /admin/upload/{id}
let deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.Id with
| Ok fileName ->
do! addMessage ctx { UserMessage.Success with Message = $"{fileName} deleted successfully" }
return! list next ctx
| Error _ -> return! Error.notFound next ctx
}
let deleteFromDb upId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.Id with
| Ok fileName ->
do! addMessage ctx { UserMessage.Success with Message = $"{fileName} deleted successfully" }
return! list next ctx
| Error _ -> return! Error.notFound next ctx
}
/// Remove a directory tree if it is empty
let removeEmptyDirectories (webLog: WebLog) (filePath: string) =
@@ -183,13 +192,15 @@ let removeEmptyDirectories (webLog: WebLog) (filePath: string) =
else finished <- true
// DELETE /admin/upload/disk/{**path}
let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let filePath = urlParts |> Seq.skip 1 |> Seq.head
let path = Path.Combine(uploadDir, ctx.WebLog.Slug, filePath)
if File.Exists path then
File.Delete path
removeEmptyDirectories ctx.WebLog filePath
do! addMessage ctx { UserMessage.Success with Message = $"{filePath} deleted successfully" }
return! list next ctx
else return! Error.notFound next ctx
}
let deleteFromDisk urlParts : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let filePath = urlParts |> Seq.skip 1 |> Seq.head
let path = Path.Combine(uploadDir, ctx.WebLog.Slug, filePath)
if File.Exists path then
File.Delete path
removeEmptyDirectories ctx.WebLog filePath
do! addMessage ctx { UserMessage.Success with Message = $"{filePath} deleted successfully" }
return! list next ctx
else return! Error.notFound next ctx
}
src/MyWebLog/Handlers/User.fs
+143 -128
View File
@@ -43,38 +43,40 @@ open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies
// POST /user/log-on
let doLogOn : HttpHandler = validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel>()
let data = ctx.Data
let! tryUser = data.WebLogUser.FindByEmail (model.EmailAddress.ToLowerInvariant()) ctx.WebLog.Id
match! verifyPassword tryUser model.Password ctx with
| Ok _ ->
let user = tryUser.Value
let claims = seq {
Claim(ClaimTypes.NameIdentifier, string user.Id)
Claim(ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
Claim(ClaimTypes.GivenName, user.PreferredName)
Claim(ClaimTypes.Role, string user.AccessLevel)
}
let identity = ClaimsIdentity(claims, CookieAuthenticationDefaults.AuthenticationScheme)
let doLogOn : HttpHandler =
validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel>()
let data = ctx.Data
let! tryUser = data.WebLogUser.FindByEmail (model.EmailAddress.ToLowerInvariant()) ctx.WebLog.Id
match! verifyPassword tryUser model.Password ctx with
| Ok _ ->
let user = tryUser.Value
let claims = seq {
Claim(ClaimTypes.NameIdentifier, string user.Id)
Claim(ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
Claim(ClaimTypes.GivenName, user.PreferredName)
Claim(ClaimTypes.Role, string user.AccessLevel)
}
let identity = ClaimsIdentity(claims, CookieAuthenticationDefaults.AuthenticationScheme)
do! ctx.SignInAsync(identity.AuthenticationType, ClaimsPrincipal identity,
AuthenticationProperties(IssuedUtc = DateTimeOffset.UtcNow))
do! data.WebLogUser.SetLastSeen user.Id user.WebLogId
do! addMessage ctx
{ 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 // TODO: change to redirectToGet?
| None -> redirectToGet "admin/dashboard" next ctx
| Error msg ->
do! addMessage ctx { UserMessage.Error with Message = msg }
return! logOn model.ReturnTo next ctx
}
do! ctx.SignInAsync(identity.AuthenticationType, ClaimsPrincipal identity,
AuthenticationProperties(IssuedUtc = DateTimeOffset.UtcNow))
do! data.WebLogUser.SetLastSeen user.Id user.WebLogId
do! addMessage ctx
{ 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 // TODO: change to redirectToGet?
| None -> redirectToGet "admin/dashboard" next ctx
| Error msg ->
do! addMessage ctx { UserMessage.Error with Message = msg }
return! logOn model.ReturnTo next ctx
}
// GET /user/log-off
// POST /user/log-off
let logOff : HttpHandler = fun next ctx -> task {
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
do! addMessage ctx { UserMessage.Info with Message = "Log off successful" }
@@ -89,118 +91,131 @@ open Giraffe.Htmx
let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?"
// GET /admin/settings/users
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id
return! adminBarePage "User Administration" next ctx (Views.User.userList users)
}
let all : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id
return! adminBarePage "User Administration" next ctx (Views.User.userList users)
}
/// Show the edit user page
let private showEdit (model: EditUserModel) : HttpHandler = fun next ctx ->
adminBarePage (if model.IsNew then "Add a New User" else "Edit User") next ctx (Views.User.edit model)
// GET /admin/settings/user/{id}/edit
let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let isNew = usrId = "new"
let userId = WebLogUserId usrId
let tryUser =
if isNew then someTask { WebLogUser.Empty with Id = userId }
else ctx.Data.WebLogUser.FindById userId ctx.WebLog.Id
match! tryUser with
| Some user -> return! showEdit (EditUserModel.FromUser user) next ctx
| None -> return! Error.notFound next ctx
}
let edit usrId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let isNew = usrId = "new"
let userId = WebLogUserId usrId
let tryUser =
if isNew then someTask { WebLogUser.Empty with Id = userId }
else ctx.Data.WebLogUser.FindById userId ctx.WebLog.Id
match! tryUser with
| Some user -> return! showEdit (EditUserModel.FromUser user) next ctx
| None -> return! Error.notFound next ctx
}
// DELETE /admin/settings/user/{id}
let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLogUser.FindById (WebLogUserId userId) ctx.WebLog.Id with
| Some user ->
if user.AccessLevel = Administrator && not (ctx.HasAccessLevel Administrator) then
return! goAway next ctx
else
match! data.WebLogUser.Delete user.Id user.WebLogId with
| Ok _ ->
do! addMessage ctx
{ UserMessage.Success with
Message = $"User {user.DisplayName} deleted successfully" }
return! all next ctx
| Error msg ->
do! addMessage ctx
{ UserMessage.Error with
Message = $"User {user.DisplayName} was not deleted"
Detail = Some msg }
return! all next ctx
| None -> return! Error.notFound next ctx
}
let delete userId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLogUser.FindById (WebLogUserId userId) ctx.WebLog.Id with
| Some user ->
if user.AccessLevel = Administrator && not (ctx.HasAccessLevel Administrator) then
return! goAway next ctx
else
match! data.WebLogUser.Delete user.Id user.WebLogId with
| Ok _ ->
do! addMessage ctx
{ UserMessage.Success with Message = $"User {user.DisplayName} deleted successfully" }
return! all next ctx
| Error msg ->
do! addMessage ctx
{ UserMessage.Error with
Message = $"User {user.DisplayName} was not deleted"
Detail = Some msg }
return! all next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/my-info
let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user ->
return!
Views.User.myInfo (EditMyInfoModel.FromUser user) user
|> adminPage "Edit Your Information" next ctx
| None -> return! Error.notFound next ctx
}
let myInfo : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user ->
return!
Views.User.myInfo (EditMyInfoModel.FromUser user) user
|> adminPage "Edit Your Information" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/my-info
let saveMyInfo : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditMyInfoModel>()
let data = ctx.Data
match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user when model.NewPassword = model.NewPasswordConfirm ->
let pw = if model.NewPassword = "" then user.PasswordHash else createPasswordHash user model.NewPassword
let user =
{ user with
FirstName = model.FirstName
LastName = model.LastName
PreferredName = model.PreferredName
PasswordHash = pw }
do! data.WebLogUser.Update user
let pwMsg = if model.NewPassword = "" then "" else " and updated your password"
do! addMessage ctx { UserMessage.Success with Message = $"Saved your information{pwMsg} successfully" }
return! redirectToGet "admin/my-info" next ctx
| Some user ->
do! addMessage ctx { UserMessage.Error with Message = "Passwords did not match; no updates made" }
return!
Views.User.myInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user
|> adminPage "Edit Your Information" next ctx
| None -> return! Error.notFound next ctx
}
let saveMyInfo : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditMyInfoModel>()
let data = ctx.Data
match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user when model.NewPassword = model.NewPasswordConfirm ->
let pw = if model.NewPassword = "" then user.PasswordHash else createPasswordHash user model.NewPassword
let user =
{ user with
FirstName = model.FirstName
LastName = model.LastName
PreferredName = model.PreferredName
PasswordHash = pw }
do! data.WebLogUser.Update user
let pwMsg = if model.NewPassword = "" then "" else " and updated your password"
do! addMessage ctx { UserMessage.Success with Message = $"Saved your information{pwMsg} successfully" }
return! redirectToGet "admin/my-info" next ctx
| Some user ->
do! addMessage ctx { UserMessage.Error with Message = "Passwords did not match; no updates made" }
return!
Views.User.myInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user
|> adminPage "Edit Your Information" next ctx
| None -> return! Error.notFound next ctx
}
// User save is not statically compilable; not sure why, but we'll revisit it at some point
#nowarn "3511"
// POST /admin/settings/user/save
let save : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel>()
let data = ctx.Data
let tryUser =
if model.IsNew then
{ WebLogUser.Empty with
Id = WebLogUserId.Create()
WebLogId = ctx.WebLog.Id
CreatedOn = Noda.now () }
|> someTask
else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
match! tryUser with
| Some user when model.Password = model.PasswordConfirm ->
let updatedUser = model.UpdateUser user
if updatedUser.AccessLevel = Administrator && not (ctx.HasAccessLevel Administrator) then
return! goAway next ctx
else
let toUpdate =
if model.Password = "" then updatedUser
else { updatedUser with PasswordHash = createPasswordHash updatedUser model.Password }
do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate
do! addMessage ctx
{ UserMessage.Success with
Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully""" }
return! all next ctx
| Some _ ->
do! addMessage ctx { UserMessage.Error with Message = "The passwords did not match; nothing saved" }
return!
(withHxRetarget $"#user_{model.Id}" >=> showEdit { model with Password = ""; PasswordConfirm = "" })
next ctx
| None -> return! Error.notFound next ctx
}
let save : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel>()
let data = ctx.Data
let tryUser =
if model.IsNew then
{ WebLogUser.Empty with
Id = WebLogUserId.Create()
WebLogId = ctx.WebLog.Id
CreatedOn = Noda.now () }
|> someTask
else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
match! tryUser with
| Some user when model.Password = model.PasswordConfirm ->
let updatedUser = model.UpdateUser user
if updatedUser.AccessLevel = Administrator && not (ctx.HasAccessLevel Administrator) then
return! goAway next ctx
else
let toUpdate =
if model.Password = "" then updatedUser
else { updatedUser with PasswordHash = createPasswordHash updatedUser model.Password }
do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate
do! addMessage ctx
{ UserMessage.Success with
Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully""" }
return! all next ctx
| Some _ ->
do! addMessage ctx { UserMessage.Error with Message = "The passwords did not match; nothing saved" }
return!
(withHxRetarget $"#user_{model.Id}" >=> showEdit { model with Password = ""; PasswordConfirm = "" })
next ctx
| None -> return! Error.notFound next ctx
}