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