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

WIP on module/member conversion

Browse Source 
View models complete
This commit is contained in:
Daniel J. Summers 2023-12-16 17:59:33 -05:00
parent c3d615d10a
commit 8ec84e8680
8 changed files with 453 additions and 476 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

File diff suppressed because it is too large Load Diff

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

@ -44,7 +44,7 @@ module Dashboard =
|> withAntiCsrf ctx
|> addToHash "themes" (
themes
|> List.map (DisplayTheme.fromTheme WebLogCache.isThemeInUse)
|> List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse)
|> Array.ofList)
|> addToHash "cached_themes" (
themes
@ -87,7 +87,7 @@ module Cache =
do! PageListCache.refresh webLog data
do! CategoryCache.refresh webLog.Id data
do! addMessage ctx
{ UserMessage.success with Message = "Successfully refresh web log cache for all web logs" }
{ UserMessage.Success with Message = "Successfully refresh web log cache for all web logs" }
else
match! data.WebLog.FindById (WebLogId webLogId) with
| Some webLog ->
@ -95,9 +95,9 @@ module Cache =
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}" }
{ 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}" }
do! addMessage ctx { UserMessage.Error with Message = $"No web log exists with ID {webLogId}" }
return! toAdminDashboard next ctx
}
@ -108,7 +108,7 @@ module Cache =
TemplateCache.empty ()
do! ThemeAssetCache.fill data
do! addMessage ctx
{ UserMessage.success with
{ UserMessage.Success with
Message = "Successfully cleared template cache and refreshed theme asset cache"
}
else
@ -117,11 +117,11 @@ module Cache =
TemplateCache.invalidateTheme theme.Id
do! ThemeAssetCache.refreshTheme theme.Id data
do! addMessage ctx
{ UserMessage.success with
{ 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}" }
do! addMessage ctx { UserMessage.Error with Message = $"No theme exists with ID {themeId}" }
return! toAdminDashboard next ctx
}
@ -167,7 +167,7 @@ module Category =
return!
hashForPage title
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditCategoryModel.fromCategory cat)
|> addToHash ViewContext.Model (EditCategoryModel.FromCategory cat)
|> adminBareView "category-edit" next ctx
| None -> return! Error.notFound next ctx
}
@ -190,7 +190,7 @@ module Category =
}
do! (if model.IsNew then data.Category.Add else data.Category.Update) updatedCat
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Category saved successfully" }
do! addMessage ctx { UserMessage.Success with Message = "Category saved successfully" }
return! bare next ctx
| None -> return! Error.notFound next ctx
}
@ -207,9 +207,9 @@ module Category =
| ReassignedChildCategories ->
Some "<em>(Its child categories were reassigned to its parent category)</em>"
| _ -> None
do! addMessage ctx { UserMessage.success with Message = "Category deleted successfully"; Detail = detail }
do! addMessage ctx { UserMessage.Success with Message = "Category deleted successfully"; Detail = detail }
| CategoryNotFound ->
do! addMessage ctx { UserMessage.error with Message = "Category not found; cannot delete" }
do! addMessage ctx { UserMessage.Error with Message = "Category not found; cannot delete" }
return! bare next ctx
}
@ -233,7 +233,7 @@ module RedirectRules =
if idx = -1 then
return!
hashForPage "Add Redirect Rule"
|> addToHash "model" (EditRedirectRuleModel.fromRule -1 RedirectRule.Empty)
|> addToHash "model" (EditRedirectRuleModel.FromRule -1 RedirectRule.Empty)
|> withAntiCsrf ctx
|> adminBareView "redirect-edit" next ctx
else
@ -243,7 +243,7 @@ module RedirectRules =
else
return!
hashForPage "Edit Redirect Rule"
|> addToHash "model" (EditRedirectRuleModel.fromRule idx (List.item idx rules))
|> addToHash "model" (EditRedirectRuleModel.FromRule idx (List.item idx rules))
|> withAntiCsrf ctx
|> adminBareView "redirect-edit" next ctx
}
@ -257,17 +257,17 @@ module RedirectRules =
// POST /admin/settings/redirect-rules/[index]
let save idx : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<EditRedirectRuleModel> ()
let! model = ctx.BindFormAsync<EditRedirectRuleModel>()
let isNew = idx = -1
let rules = ctx.WebLog.RedirectRules
let rule = model.UpdateRule (if isNew then RedirectRule.Empty else List.item idx rules)
let rule = model.ToRule()
let newRules =
match isNew with
| true when model.InsertAtTop -> List.insertAt 0 rule rules
| true -> List.insertAt (rules.Length) rule rules
| true -> List.insertAt rules.Length rule rules
| false -> rules |> List.removeAt idx |> List.insertAt idx rule
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = newRules }
do! addMessage ctx { UserMessage.success with Message = "Redirect rule saved successfully" }
do! addMessage ctx { UserMessage.Success with Message = "Redirect rule saved successfully" }
return! all next ctx
}
@ -300,7 +300,7 @@ module RedirectRules =
else
let rules = ctx.WebLog.RedirectRules |> List.removeAt idx
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = rules }
do! addMessage ctx { UserMessage.success with Message = "Redirect rule deleted successfully" }
do! addMessage ctx { UserMessage.Success with Message = "Redirect rule deleted successfully" }
return! all next ctx
}
@ -340,7 +340,7 @@ module TagMapping =
return!
hashForPage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag")
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditTagMapModel.fromMapping tm)
|> addToHash ViewContext.Model (EditTagMapModel.FromMapping tm)
|> adminBareView "tag-mapping-edit" next ctx
| None -> return! Error.notFound next ctx
}
@ -355,7 +355,7 @@ module TagMapping =
match! tagMap with
| Some tm ->
do! data.TagMap.Save { tm with Tag = model.Tag.ToLower(); UrlValue = model.UrlValue.ToLower() }
do! addMessage ctx { UserMessage.success with Message = "Tag mapping saved successfully" }
do! addMessage ctx { UserMessage.Success with Message = "Tag mapping saved successfully" }
return! all next ctx
| None -> return! Error.notFound next ctx
}
@ -363,8 +363,8 @@ module TagMapping =
// POST /admin/settings/tag-mapping/{id}/delete
let delete tagMapId : HttpHandler = fun next ctx -> task {
match! ctx.Data.TagMap.Delete (TagMapId tagMapId) ctx.WebLog.Id with
| true -> do! addMessage ctx { UserMessage.success with Message = "Tag mapping deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with Message = "Tag mapping not found; nothing deleted" }
| 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
}
@ -384,7 +384,7 @@ module Theme =
return!
hashForPage "Themes"
|> withAntiCsrf ctx
|> addToHash "themes" (themes |> List.map (DisplayTheme.fromTheme WebLogCache.isThemeInUse) |> Array.ofList)
|> addToHash "themes" (themes |> List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) |> Array.ofList)
|> adminBareView "theme-list-body" next ctx
}
@ -488,21 +488,21 @@ module Theme =
use file = new FileStream($"{themeId}-theme.zip", FileMode.Create)
do! themeFile.CopyToAsync file
do! addMessage ctx
{ UserMessage.success with
{ UserMessage.Success with
Message = $"""Theme {if isNew then "add" else "updat"}ed successfully"""
}
return! toAdminDashboard next ctx
else
do! addMessage ctx
{ UserMessage.error with
{ 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" }
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 }
do! addMessage ctx { UserMessage.Error with Message = message }
return! toAdminDashboard next ctx
else return! RequestErrors.BAD_REQUEST "Bad request" next ctx
}
@ -512,11 +512,11 @@ module Theme =
let data = ctx.Data
match themeId with
| "admin" | "default" ->
do! addMessage ctx { UserMessage.error with Message = $"You may not delete the {themeId} theme" }
do! addMessage ctx { UserMessage.Error with Message = $"You may not delete the {themeId} theme" }
return! all next ctx
| it when WebLogCache.isThemeInUse (ThemeId it) ->
do! addMessage ctx
{ UserMessage.error with
{ UserMessage.Error with
Message = $"You may not delete the {themeId} theme, as it is currently in use"
}
return! all next ctx
@ -525,7 +525,7 @@ module Theme =
| true ->
let zippedTheme = $"{themeId}-theme.zip"
if File.Exists zippedTheme then File.Delete zippedTheme
do! addMessage ctx { UserMessage.success with Message = $"Theme ID {themeId} deleted successfully" }
do! addMessage ctx { UserMessage.Success with Message = $"Theme ID {themeId} deleted successfully" }
return! all next ctx
| false -> return! Error.notFound next ctx
}
@ -550,7 +550,7 @@ module WebLog =
let! hash =
hashForPage "Web Log Settings"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (SettingsModel.fromWebLog ctx.WebLog)
|> addToHash ViewContext.Model (SettingsModel.FromWebLog ctx.WebLog)
|> addToHash "pages" (
seq {
KeyValuePair.Create("posts", "- First Page of Posts -")
@ -569,11 +569,11 @@ module WebLog =
KeyValuePair.Create(string Database, "Database")
KeyValuePair.Create(string Disk, "Disk")
|]
|> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList)
|> addToHash "rss_model" (EditRssModel.fromRssOptions ctx.WebLog.Rss)
|> addToHash "users" (users |> List.map (DisplayUser.FromUser ctx.WebLog) |> Array.ofList)
|> addToHash "rss_model" (EditRssModel.FromRssOptions ctx.WebLog.Rss)
|> addToHash "custom_feeds" (
ctx.WebLog.Rss.CustomFeeds
|> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx))
|> List.map (DisplayCustomFeed.FromFeed (CategoryCache.get ctx))
|> Array.ofList)
|> addViewContext ctx
let! hash' = TagMapping.withTagMappings ctx hash
@ -592,7 +592,7 @@ module WebLog =
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
let oldSlug = webLog.Slug
let webLog = model.update webLog
let webLog = model.Update webLog
do! data.WebLog.UpdateSettings webLog
// Update cache
@ -604,7 +604,7 @@ module WebLog =
let oldDir = Path.Combine (uploadRoot, oldSlug)
if Directory.Exists oldDir then Directory.Move (oldDir, Path.Combine (uploadRoot, webLog.Slug))
do! addMessage ctx { UserMessage.success with Message = "Web log settings saved successfully" }
do! addMessage ctx { UserMessage.Success with Message = "Web log settings saved successfully" }
return! redirectToGet "admin/settings" next ctx
| None -> return! Error.notFound next ctx
}

10
src/MyWebLog/Handlers/Feed.fs
View File

@ -418,7 +418,7 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
let webLog = { webLog with Rss = model.UpdateOptions webLog.Rss }
do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog
do! addMessage ctx { UserMessage.success with Message = "RSS settings updated successfully" }
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
}
@ -433,7 +433,7 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
| Some f ->
hashForPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditCustomFeedModel.fromFeed f)
|> addToHash ViewContext.Model (EditCustomFeedModel.FromFeed f)
|> addToHash "medium_values" [|
KeyValuePair.Create("", "&ndash; Unspecified &ndash;")
KeyValuePair.Create(string Podcast, "Podcast")
@ -464,7 +464,7 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog
do! addMessage ctx {
UserMessage.success with
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
@ -488,9 +488,9 @@ let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun ne
}
do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog
do! addMessage ctx { UserMessage.success with Message = "Custom feed deleted successfully" }
do! addMessage ctx { UserMessage.Success with Message = "Custom feed deleted successfully" }
else
do! addMessage ctx { UserMessage.warning with Message = "Custom feed not found; no action taken" }
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
}

10
src/MyWebLog/Handlers/Helpers.fs
View File

@ -252,7 +252,7 @@ module Error =
else
if isHtmx ctx then
let messages = [|
{ UserMessage.error with
{ UserMessage.Error with
Message = $"You are not authorized to access the URL {ctx.Request.Path.Value}"
}
|]
@ -264,7 +264,7 @@ module Error =
handleContext (fun ctx ->
if isHtmx ctx then
let messages = [|
{ UserMessage.error with Message = $"The URL {ctx.Request.Path.Value} was not found" }
{ UserMessage.Error with Message = $"The URL {ctx.Request.Path.Value} was not found" }
|]
RequestErrors.notFound (messagesToHeaders messages) earlyReturn ctx
else RequestErrors.NOT_FOUND "Not found" earlyReturn ctx)
@ -272,7 +272,7 @@ module Error =
let server message : HttpHandler =
handleContext (fun ctx ->
if isHtmx ctx then
let messages = [| { UserMessage.error with Message = message } |]
let messages = [| { UserMessage.Error with Message = message } |]
ServerErrors.internalError (messagesToHeaders messages) earlyReturn ctx
else ServerErrors.INTERNAL_ERROR message earlyReturn ctx)
@ -351,14 +351,14 @@ let requireAccess level : HttpHandler = fun next ctx -> task {
| Some userLevel when userLevel.HasAccess level -> return! next ctx
| Some userLevel ->
do! addMessage ctx
{ UserMessage.warning with
{ UserMessage.Warning with
Message = $"The page you tried to access requires {level} privileges"
Detail = Some $"Your account only has {userLevel} privileges"
}
return! Error.notAuthorized next ctx
| None ->
do! addMessage ctx
{ UserMessage.warning with Message = "The page you tried to access required you to be logged on" }
{ UserMessage.Warning with Message = "The page you tried to access required you to be logged on" }
return! Error.notAuthorized next ctx
}

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

@ -36,7 +36,7 @@ let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
}
match result with
| Some (title, page) when canEdit page.AuthorId ctx ->
let model = EditPageModel.fromPage page
let model = EditPageModel.FromPage page
let! templates = templatesForTheme ctx "page"
return!
hashForPage title
@ -56,8 +56,8 @@ let delete pgId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta
match! ctx.Data.Page.Delete (PageId pgId) ctx.WebLog.Id with
| true ->
do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Page deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with Message = "Page not found; nothing deleted" }
do! addMessage ctx { UserMessage.Success with Message = "Page deleted successfully" }
| false -> do! addMessage ctx { UserMessage.Error with Message = "Page not found; nothing deleted" }
return! redirectToGet "admin/pages" next ctx
}
@ -68,7 +68,7 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
return!
hashForPage "Manage Prior Permalinks"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManagePermalinksModel.fromPage pg)
|> addToHash ViewContext.Model (ManagePermalinksModel.FromPage pg)
|> adminView "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
@ -83,7 +83,7 @@ let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task
let links = model.Prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Page.UpdatePriorPermalinks pageId ctx.WebLog.Id links with
| true ->
do! addMessage ctx { UserMessage.success with Message = "Page permalinks saved successfully" }
do! addMessage ctx { UserMessage.Success with Message = "Page permalinks saved successfully" }
return! redirectToGet $"admin/page/{model.Id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx
@ -97,7 +97,7 @@ let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
return!
hashForPage "Manage Page Revisions"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManageRevisionsModel.fromPage ctx.WebLog pg)
|> addToHash ViewContext.Model (ManageRevisionsModel.FromPage ctx.WebLog pg)
|> adminView "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
@ -109,7 +109,7 @@ let purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
match! data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg ->
do! data.Page.Update { pg with Revisions = [ List.head pg.Revisions ] }
do! addMessage ctx { UserMessage.success with Message = "Prior revisions purged successfully" }
do! addMessage ctx { UserMessage.Success with Message = "Prior revisions purged successfully" }
return! redirectToGet $"admin/page/{pgId}/revisions" next ctx
| None -> return! Error.notFound next ctx
}
@ -152,7 +152,7 @@ let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
Revisions = { rev with AsOf = Noda.now () }
:: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
}
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/page/{pgId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
@ -164,7 +164,7 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update { pg with Revisions = pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
do! addMessage ctx { UserMessage.success with Message = "Revision deleted successfully" }
do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
return! adminBareView "" next ctx (makeHash {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
@ -191,7 +191,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let updatedPage = model.UpdatePage page now
do! (if model.IsNew then data.Page.Add else data.Page.Update) updatedPage
if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Page saved successfully" }
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

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

@ -47,7 +47,7 @@ let preparePostList webLog posts listType (url: string) pageNbr perPage (data: I
posts
|> Seq.ofList
|> Seq.truncate perPage
|> Seq.map (PostListItem.fromPost webLog)
|> Seq.map (PostListItem.FromPost webLog)
|> Array.ofSeq
let! olderPost, newerPost =
match listType with
@ -232,7 +232,7 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match result with
| Some (title, post) when canEdit post.AuthorId ctx ->
let! templates = templatesForTheme ctx "post"
let model = EditPostModel.fromPost ctx.WebLog post
let model = EditPostModel.FromPost ctx.WebLog post
return!
hashForPage title
|> withAntiCsrf ctx
@ -255,8 +255,8 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
// POST /admin/post/{id}/delete
let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Post.Delete (PostId postId) ctx.WebLog.Id with
| true -> do! addMessage ctx { UserMessage.success with Message = "Post deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with Message = "Post not found; nothing deleted" }
| true -> do! addMessage ctx { UserMessage.Success with Message = "Post deleted successfully" }
| false -> do! addMessage ctx { UserMessage.Error with Message = "Post not found; nothing deleted" }
return! redirectToGet "admin/posts" next ctx
}
@ -267,7 +267,7 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx
return!
hashForPage "Manage Prior Permalinks"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManagePermalinksModel.fromPost post)
|> addToHash ViewContext.Model (ManagePermalinksModel.FromPost post)
|> adminView "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
@ -282,7 +282,7 @@ let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task
let links = model.Prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Post.UpdatePriorPermalinks postId ctx.WebLog.Id links with
| true ->
do! addMessage ctx { UserMessage.success with Message = "Post permalinks saved successfully" }
do! addMessage ctx { UserMessage.Success with Message = "Post permalinks saved successfully" }
return! redirectToGet $"admin/post/{model.Id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx
@ -296,7 +296,7 @@ let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -
return!
hashForPage "Manage Post Revisions"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManageRevisionsModel.fromPost ctx.WebLog post)
|> addToHash ViewContext.Model (ManageRevisionsModel.FromPost ctx.WebLog post)
|> adminView "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
@ -308,7 +308,7 @@ let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
do! data.Post.Update { post with Revisions = [ List.head post.Revisions ] }
do! addMessage ctx { UserMessage.success with Message = "Prior revisions purged successfully" }
do! addMessage ctx { UserMessage.Success with Message = "Prior revisions purged successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
@ -352,7 +352,7 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
Revisions = { rev with AsOf = Noda.now () }
:: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
}
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
@ -364,7 +364,7 @@ let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fu
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
do! addMessage ctx { UserMessage.success with Message = "Revision deleted successfully" }
do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
return! adminBareView "" next ctx (makeHash {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
@ -408,7 +408,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> List.distinct
|> List.length = List.length priorCats) then
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Post saved successfully" }
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

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

@ -117,7 +117,7 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
[]
let allFiles =
dbUploads
|> List.map (DisplayUpload.fromUpload webLog Database)
|> List.map (DisplayUpload.FromUpload webLog Database)
|> List.append diskUploads
|> List.sortByDescending (fun file -> file.UpdatedOn, file.Path)
return!
@ -169,7 +169,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
use stream = new FileStream(Path.Combine(fullPath, fileName), FileMode.Create)
do! upload.CopyToAsync stream
do! addMessage ctx { UserMessage.success with Message = $"File uploaded to {form.Destination} successfully" }
do! addMessage ctx { UserMessage.Success with Message = $"File uploaded to {form.Destination} successfully" }
return! showUploads next ctx
else
return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx
@ -179,7 +179,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.Id with
| Ok fileName ->
do! addMessage ctx { UserMessage.success with Message = $"{fileName} deleted successfully" }
do! addMessage ctx { UserMessage.Success with Message = $"{fileName} deleted successfully" }
return! showUploads next ctx
| Error _ -> return! Error.notFound next ctx
}
@ -202,7 +202,7 @@ let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun ne
if File.Exists path then
File.Delete path
removeEmptyDirectories ctx.WebLog filePath
do! addMessage ctx { UserMessage.success with Message = $"{filePath} deleted successfully" }
do! addMessage ctx { UserMessage.Success with Message = $"{filePath} deleted successfully" }
return! showUploads next ctx
else return! Error.notFound next ctx
}

26
src/MyWebLog/Handlers/User.fs
View File

@ -38,7 +38,7 @@ let logOn returnUrl : HttpHandler = fun next ctx ->
| None -> if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None
hashForPage "Log On"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model { LogOnModel.empty with ReturnTo = returnTo }
|> addToHash ViewContext.Model { LogOnModel.Empty with ReturnTo = returnTo }
|> adminView "log-on" next ctx
@ -66,7 +66,7 @@ let doLogOn : HttpHandler = fun next ctx -> task {
AuthenticationProperties(IssuedUtc = DateTimeOffset.UtcNow))
do! data.WebLogUser.SetLastSeen user.Id user.WebLogId
do! addMessage ctx
{ UserMessage.success with
{ UserMessage.Success with
Message = "Log on successful"
Detail = Some $"Welcome to {ctx.WebLog.Name}!"
}
@ -75,14 +75,14 @@ let doLogOn : HttpHandler = fun next ctx -> task {
| Some url -> redirectTo false url next ctx
| None -> redirectToGet "admin/dashboard" next ctx
| Error msg ->
do! addMessage ctx { UserMessage.error with Message = msg }
do! addMessage ctx { UserMessage.Error with Message = msg }
return! logOn model.ReturnTo next ctx
}
// GET /user/log-off
let logOff : HttpHandler = fun next ctx -> task {
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
do! addMessage ctx { UserMessage.info with Message = "Log off successful" }
do! addMessage ctx { UserMessage.Info with Message = "Log off successful" }
return! redirectToGet "" next ctx
}
@ -100,7 +100,7 @@ let all : HttpHandler = fun next ctx -> task {
return!
hashForPage "User Administration"
|> withAntiCsrf ctx
|> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList)
|> addToHash "users" (users |> List.map (DisplayUser.FromUser ctx.WebLog) |> Array.ofList)
|> adminBareView "user-list-body" next ctx
}
@ -125,7 +125,7 @@ let edit usrId : HttpHandler = fun next ctx -> task {
if isNew then someTask { WebLogUser.Empty with Id = userId }
else ctx.Data.WebLogUser.FindById userId ctx.WebLog.Id
match! tryUser with
| Some user -> return! showEdit (EditUserModel.fromUser user) next ctx
| Some user -> return! showEdit (EditUserModel.FromUser user) next ctx
| None -> return! Error.notFound next ctx
}
@ -140,13 +140,13 @@ let delete userId : HttpHandler = fun next ctx -> task {
match! data.WebLogUser.Delete user.Id user.WebLogId with
| Ok _ ->
do! addMessage ctx
{ UserMessage.success with
{ UserMessage.Success with
Message = $"User {user.DisplayName} deleted successfully"
}
return! all next ctx
| Error msg ->
do! addMessage ctx
{ UserMessage.error with
{ UserMessage.Error with
Message = $"User {user.DisplayName} was not deleted"
Detail = Some msg
}
@ -168,7 +168,7 @@ let private showMyInfo (model: EditMyInfoModel) (user: WebLogUser) : HttpHandler
// GET /admin/my-info
let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user -> return! showMyInfo (EditMyInfoModel.fromUser user) user next ctx
| Some user -> return! showMyInfo (EditMyInfoModel.FromUser user) user next ctx
| None -> return! Error.notFound next ctx
}
@ -188,10 +188,10 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
}
do! data.WebLogUser.Update user
let pwMsg = if model.NewPassword = "" then "" else " and updated your password"
do! addMessage ctx { UserMessage.success with Message = $"Saved your information{pwMsg} successfully" }
do! addMessage ctx { UserMessage.Success with Message = $"Saved your information{pwMsg} successfully" }
return! redirectToGet "admin/my-info" next ctx
| Some user ->
do! addMessage ctx { UserMessage.error with Message = "Passwords did not match; no updates made" }
do! addMessage ctx { UserMessage.Error with Message = "Passwords did not match; no updates made" }
return! showMyInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user next ctx
| None -> return! Error.notFound next ctx
}
@ -222,12 +222,12 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
else { updatedUser with PasswordHash = createPasswordHash updatedUser model.Password }
do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate
do! addMessage ctx
{ UserMessage.success with
{ UserMessage.Success with
Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully"""
}
return! all next ctx
| Some _ ->
do! addMessage ctx { UserMessage.error with Message = "The passwords did not match; nothing saved" }
do! addMessage ctx { UserMessage.Error with Message = "The passwords did not match; nothing saved" }
return!
(withHxRetarget $"#user_{model.Id}" >=> showEdit { model with Password = ""; PasswordConfirm = "" })
next ctx