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

Implement tag mapping

Browse Source 
- Move all admin functions to /admin URLs
- Create Liquid filters for page/post edit, category/tag link
- Update all themes to use these filters
- Add delete for pages/posts
- Move category/page functions to Admin module
This commit is contained in:
Daniel J. Summers
2022-05-21 00:07:16 -04:00
parent ea8d4b1c63
commit 0a21240984
35 changed files with 796 additions and 357 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -45,6 +45,214 @@ let dashboard : HttpHandler = requireUser >=> fun next ctx -> task {
|> viewForTheme "admin" "dashboard" next ctx
}
// -- CATEGORIES --
// GET /admin/categories
let listCategories : HttpHandler = requireUser >=> fun next ctx -> task {
return!
Hash.FromAnonymousObject {|
categories = CategoryCache.get ctx
page_title = "Categories"
csrf = csrfToken ctx
|}
|> viewForTheme "admin" "category-list" next ctx
}
// GET /admin/category/{id}/edit
let editCategory catId : HttpHandler = requireUser >=> fun next ctx -> task {
let webLogId = webLogId ctx
let conn = conn ctx
let! result = task {
match catId with
| "new" -> return Some ("Add a New Category", { Category.empty with id = CategoryId "new" })
| _ ->
match! Data.Category.findById (CategoryId catId) webLogId conn with
| Some cat -> return Some ("Edit Category", cat)
| None -> return None
}
match result with
| Some (title, cat) ->
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = EditCategoryModel.fromCategory cat
page_title = title
categories = CategoryCache.get ctx
|}
|> viewForTheme "admin" "category-edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/category/save
let saveCategory : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditCategoryModel> ()
let webLogId = webLogId ctx
let conn = conn ctx
let! category = task {
match model.categoryId with
| "new" -> return Some { Category.empty with id = CategoryId.create (); webLogId = webLogId }
| catId -> return! Data.Category.findById (CategoryId catId) webLogId conn
}
match category with
| Some cat ->
let cat =
{ cat with
name = model.name
slug = model.slug
description = if model.description = "" then None else Some model.description
parentId = if model.parentId = "" then None else Some (CategoryId model.parentId)
}
do! (match model.categoryId with "new" -> Data.Category.add | _ -> Data.Category.update) cat conn
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Category saved successfully" }
return! redirectToGet $"/admin/category/{CategoryId.toString cat.id}/edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/category/{id}/delete
let deleteCategory catId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let webLogId = webLogId ctx
let conn = conn ctx
match! Data.Category.delete (CategoryId catId) webLogId conn with
| true ->
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Category deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with message = "Category not found; cannot delete" }
return! redirectToGet "/admin/categories" next ctx
}
// -- PAGES --
// GET /admin/pages
// GET /admin/pages/page/{pageNbr}
let listPages pageNbr : HttpHandler = requireUser >=> fun next ctx -> task {
let webLog = WebLogCache.get ctx
let! pages = Data.Page.findPageOfPages webLog.id pageNbr (conn ctx)
return!
Hash.FromAnonymousObject
{| pages = pages |> List.map (DisplayPage.fromPageMinimal webLog)
page_title = "Pages"
|}
|> viewForTheme "admin" "page-list" next ctx
}
// GET /admin/page/{id}/edit
let editPage pgId : HttpHandler = requireUser >=> fun next ctx -> task {
let! result = task {
match pgId with
| "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new" })
| _ ->
match! Data.Page.findByFullId (PageId pgId) (webLogId ctx) (conn ctx) with
| Some page -> return Some ("Edit Page", page)
| None -> return None
}
match result with
| Some (title, page) ->
let model = EditPageModel.fromPage page
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = model
metadata = Array.zip model.metaNames model.metaValues
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
page_title = title
templates = templatesForTheme ctx "page"
|}
|> viewForTheme "admin" "page-edit" next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/page/{id}/permalinks
let editPagePermalinks pgId : HttpHandler = requireUser >=> fun next ctx -> task {
match! Data.Page.findByFullId (PageId pgId) (webLogId ctx) (conn ctx) with
| Some pg ->
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = ManagePermalinksModel.fromPage pg
page_title = $"Manage Prior Permalinks"
|}
|> viewForTheme "admin" "permalinks" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/page/permalinks
let savePagePermalinks : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let links = model.prior |> Array.map Permalink |> List.ofArray
match! Data.Page.updatePriorPermalinks (PageId model.id) (webLogId ctx) links (conn ctx) with
| true ->
do! addMessage ctx { UserMessage.success with message = "Page permalinks saved successfully" }
return! redirectToGet $"/admin/page/{model.id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
}
// POST /admin/page/{id}/delete
let deletePage pgId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
match! Data.Page.delete (PageId pgId) (webLogId ctx) (conn ctx) with
| true -> 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
}
open System
#nowarn "3511"
// POST /page/save
let savePage : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> ()
let webLogId = webLogId ctx
let conn = conn ctx
let now = DateTime.UtcNow
let! pg = task {
match model.pageId with
| "new" ->
return Some
{ Page.empty with
id = PageId.create ()
webLogId = webLogId
authorId = userId ctx
publishedOn = now
}
| pgId -> return! Data.Page.findByFullId (PageId pgId) webLogId conn
}
match pg with
| Some page ->
let updateList = page.showInPageList <> model.isShownInPageList
let revision = { asOf = now; text = MarkupText.parse $"{model.source}: {model.text}" }
// Detect a permalink change, and add the prior one to the prior list
let page =
match Permalink.toString page.permalink with
| "" -> page
| link when link = model.permalink -> page
| _ -> { page with priorPermalinks = page.permalink :: page.priorPermalinks }
let page =
{ page with
title = model.title
permalink = Permalink model.permalink
updatedOn = now
showInPageList = model.isShownInPageList
template = match model.template with "" -> None | tmpl -> Some tmpl
text = MarkupText.toHtml revision.text
metadata = Seq.zip model.metaNames model.metaValues
|> Seq.filter (fun it -> fst it > "")
|> Seq.map (fun it -> { name = fst it; value = snd it })
|> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}")
|> List.ofSeq
revisions = match page.revisions |> List.tryHead with
| Some r when r.text = revision.text -> page.revisions
| _ -> revision :: page.revisions
}
do! (if model.pageId = "new" then Data.Page.add else Data.Page.update) page conn
if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Page saved successfully" }
return! redirectToGet $"/admin/page/{PageId.toString page.id}/edit" next ctx
| None -> return! Error.notFound next ctx
}
// -- WEB LOG SETTINGS --
// GET /admin/settings
let settings : HttpHandler = requireUser >=> fun next ctx -> task {
let webLog = WebLogCache.get ctx
@@ -93,3 +301,64 @@ let saveSettings : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -
| None -> return! Error.notFound next ctx
}
// -- TAG MAPPINGS --
// GET /admin/tag-mappings
let tagMappings : HttpHandler = requireUser >=> fun next ctx -> task {
let! mappings = Data.TagMap.findByWebLogId (webLogId ctx) (conn ctx)
return!
Hash.FromAnonymousObject
{| csrf = csrfToken ctx
mappings = mappings
mapping_ids = mappings |> List.map (fun it -> { name = it.tag; value = TagMapId.toString it.id })
page_title = "Tag Mappings"
|}
|> viewForTheme "admin" "tag-mapping-list" next ctx
}
// GET /admin/tag-mapping/{id}/edit
let editMapping tagMapId : HttpHandler = requireUser >=> fun next ctx -> task {
let webLogId = webLogId ctx
let isNew = tagMapId = "new"
let tagMap =
if isNew then
Task.FromResult (Some { TagMap.empty with id = TagMapId "new" })
else
Data.TagMap.findById (TagMapId tagMapId) webLogId (conn ctx)
match! tagMap with
| Some tm ->
return!
Hash.FromAnonymousObject
{| csrf = csrfToken ctx
model = EditTagMapModel.fromMapping tm
page_title = if isNew then "Add Tag Mapping" else $"Mapping for {tm.tag} Tag"
|}
|> viewForTheme "admin" "tag-mapping-edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/tag-mapping/save
let saveMapping : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let webLogId = webLogId ctx
let conn = conn ctx
let! model = ctx.BindFormAsync<EditTagMapModel> ()
let tagMap =
if model.id = "new" then
Task.FromResult (Some { TagMap.empty with id = TagMapId.create (); webLogId = webLogId })
else
Data.TagMap.findById (TagMapId model.id) webLogId conn
match! tagMap with
| Some tm ->
do! Data.TagMap.save { tm with tag = model.tag.ToLower (); urlValue = model.urlValue.ToLower () } conn
do! addMessage ctx { UserMessage.success with message = "Tag mapping saved successfully" }
return! redirectToGet $"/admin/tag-mapping/{TagMapId.toString tm.id}/edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/tag-mapping/{id}/delete
let deleteMapping tagMapId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
match! Data.TagMap.delete (TagMapId tagMapId) (webLogId ctx) (conn ctx) with
| true -> do! addMessage ctx { UserMessage.success with message = "Tag mapping deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with message = "Tag mapping not found; nothing deleted" }
return! redirectToGet "/admin/tag-mappings" next ctx
}

82
src/MyWebLog/Handlers/Category.fs
View File

@@ -1,82 +0,0 @@
/// Handlers to manipulate categories
module MyWebLog.Handlers.Category
open DotLiquid
open Giraffe
open MyWebLog
// GET /categories
let all : HttpHandler = requireUser >=> fun next ctx -> task {
return!
Hash.FromAnonymousObject {|
categories = CategoryCache.get ctx
page_title = "Categories"
csrf = csrfToken ctx
|}
|> viewForTheme "admin" "category-list" next ctx
}
open MyWebLog.ViewModels
// GET /category/{id}/edit
let edit catId : HttpHandler = requireUser >=> fun next ctx -> task {
let webLogId = webLogId ctx
let conn = conn ctx
let! result = task {
match catId with
| "new" -> return Some ("Add a New Category", { Category.empty with id = CategoryId "new" })
| _ ->
match! Data.Category.findById (CategoryId catId) webLogId conn with
| Some cat -> return Some ("Edit Category", cat)
| None -> return None
}
match result with
| Some (title, cat) ->
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = EditCategoryModel.fromCategory cat
page_title = title
categories = CategoryCache.get ctx
|}
|> viewForTheme "admin" "category-edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST /category/save
let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditCategoryModel> ()
let webLogId = webLogId ctx
let conn = conn ctx
let! category = task {
match model.categoryId with
| "new" -> return Some { Category.empty with id = CategoryId.create (); webLogId = webLogId }
| catId -> return! Data.Category.findById (CategoryId catId) webLogId conn
}
match category with
| Some cat ->
let cat =
{ cat with
name = model.name
slug = model.slug
description = if model.description = "" then None else Some model.description
parentId = if model.parentId = "" then None else Some (CategoryId model.parentId)
}
do! (match model.categoryId with "new" -> Data.Category.add | _ -> Data.Category.update) cat conn
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Category saved successfully" }
return! redirectToGet $"/category/{CategoryId.toString cat.id}/edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST /category/{id}/delete
let delete catId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let webLogId = webLogId ctx
let conn = conn ctx
match! Data.Category.delete (CategoryId catId) webLogId conn with
| true ->
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Category deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with message = "Category not found; cannot delete" }
return! redirectToGet "/categories" next ctx
}

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

@@ -1,127 +0,0 @@
/// Handlers to manipulate pages
module MyWebLog.Handlers.Page
open DotLiquid
open Giraffe
open MyWebLog
open MyWebLog.ViewModels
// GET /pages
// GET /pages/page/{pageNbr}
let all pageNbr : HttpHandler = requireUser >=> fun next ctx -> task {
let webLog = WebLogCache.get ctx
let! pages = Data.Page.findPageOfPages webLog.id pageNbr (conn ctx)
return!
Hash.FromAnonymousObject
{| pages = pages |> List.map (DisplayPage.fromPageMinimal webLog)
page_title = "Pages"
|}
|> viewForTheme "admin" "page-list" next ctx
}
// GET /page/{id}/edit
let edit pgId : HttpHandler = requireUser >=> fun next ctx -> task {
let! result = task {
match pgId with
| "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new" })
| _ ->
match! Data.Page.findByFullId (PageId pgId) (webLogId ctx) (conn ctx) with
| Some page -> return Some ("Edit Page", page)
| None -> return None
}
match result with
| Some (title, page) ->
let model = EditPageModel.fromPage page
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = model
metadata = Array.zip model.metaNames model.metaValues
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
page_title = title
templates = templatesForTheme ctx "page"
|}
|> viewForTheme "admin" "page-edit" next ctx
| None -> return! Error.notFound next ctx
}
// GET /page/{id}/permalinks
let editPermalinks pgId : HttpHandler = requireUser >=> fun next ctx -> task {
match! Data.Page.findByFullId (PageId pgId) (webLogId ctx) (conn ctx) with
| Some pg ->
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = ManagePermalinksModel.fromPage pg
page_title = $"Manage Prior Permalinks"
|}
|> viewForTheme "admin" "permalinks" next ctx
| None -> return! Error.notFound next ctx
}
// POST /page/permalinks
let savePermalinks : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let links = model.prior |> Array.map Permalink |> List.ofArray
match! Data.Page.updatePriorPermalinks (PageId model.id) (webLogId ctx) links (conn ctx) with
| true ->
do! addMessage ctx { UserMessage.success with message = "Page permalinks saved successfully" }
return! redirectToGet $"/page/{model.id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
}
open System
#nowarn "3511"
// POST /page/save
let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> ()
let webLogId = webLogId ctx
let conn = conn ctx
let now = DateTime.UtcNow
let! pg = task {
match model.pageId with
| "new" ->
return Some
{ Page.empty with
id = PageId.create ()
webLogId = webLogId
authorId = userId ctx
publishedOn = now
}
| pgId -> return! Data.Page.findByFullId (PageId pgId) webLogId conn
}
match pg with
| Some page ->
let updateList = page.showInPageList <> model.isShownInPageList
let revision = { asOf = now; text = MarkupText.parse $"{model.source}: {model.text}" }
// Detect a permalink change, and add the prior one to the prior list
let page =
match Permalink.toString page.permalink with
| "" -> page
| link when link = model.permalink -> page
| _ -> { page with priorPermalinks = page.permalink :: page.priorPermalinks }
let page =
{ page with
title = model.title
permalink = Permalink model.permalink
updatedOn = now
showInPageList = model.isShownInPageList
template = match model.template with "" -> None | tmpl -> Some tmpl
text = MarkupText.toHtml revision.text
metadata = Seq.zip model.metaNames model.metaValues
|> Seq.filter (fun it -> fst it > "")
|> Seq.map (fun it -> { name = fst it; value = snd it })
|> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}")
|> List.ofSeq
revisions = match page.revisions |> List.tryHead with
| Some r when r.text = revision.text -> page.revisions
| _ -> revision :: page.revisions
}
do! (if model.pageId = "new" then Data.Page.add else Data.Page.update) page conn
if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Page saved successfully" }
return! redirectToGet $"/page/{PageId.toString page.id}/edit" next ctx
| None -> return! Error.notFound next ctx
}

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

@@ -34,13 +34,22 @@ let private getAuthors (webLog : WebLog) (posts : Post list) conn =
|> List.distinct
|> Data.WebLogUser.findNames webLog.id conn
/// Get all tag mappings for a list of posts as metadata items
let private getTagMappings (webLog : WebLog) (posts : Post list) =
posts
|> List.map (fun p -> p.tags)
|> List.concat
|> List.distinct
|> fun tags -> Data.TagMap.findMappingForTags tags webLog.id
open System.Threading.Tasks
open DotLiquid
open MyWebLog.ViewModels
/// Convert a list of posts into items ready to be displayed
let private preparePostList webLog posts listType url pageNbr perPage ctx conn = task {
let! authors = getAuthors webLog posts conn
let! authors = getAuthors webLog posts conn
let! tagMappings = getTagMappings webLog posts conn
let postItems =
posts
|> Seq.ofList
@@ -64,8 +73,8 @@ let private preparePostList webLog posts listType url pageNbr perPage ctx conn =
| CategoryList, _ -> Some $"category/{url}/page/{pageNbr - 1L}"
| TagList, 2L -> Some $"tag/{url}/"
| TagList, _ -> Some $"tag/{url}/page/{pageNbr - 1L}"
| AdminList, 2L -> Some "posts"
| AdminList, _ -> Some $"posts/page/{pageNbr - 1L}"
| AdminList, 2L -> Some "admin/posts"
| AdminList, _ -> Some $"admin/posts/page/{pageNbr - 1L}"
let olderLink =
match listType, List.length posts > perPage with
| SinglePost, _ -> olderPost |> Option.map (fun p -> Permalink.toString p.permalink)
@@ -73,7 +82,7 @@ let private preparePostList webLog posts listType url pageNbr perPage ctx conn =
| PostList, true -> Some $"page/{pageNbr + 1L}"
| CategoryList, true -> Some $"category/{url}/page/{pageNbr + 1L}"
| TagList, true -> Some $"tag/{url}/page/{pageNbr + 1L}"
| AdminList, true -> Some $"posts/page/{pageNbr + 1L}"
| AdminList, true -> Some $"admin/posts/page/{pageNbr + 1L}"
let model =
{ posts = postItems
authors = authors
@@ -83,7 +92,7 @@ let private preparePostList webLog posts listType url pageNbr perPage ctx conn =
olderLink = olderLink
olderName = olderPost |> Option.map (fun p -> p.title)
}
return Hash.FromAnonymousObject {| model = model; categories = CategoryCache.get ctx |}
return Hash.FromAnonymousObject {| model = model; categories = CategoryCache.get ctx; tag_mappings = tagMappings |}
}
// GET /page/{pageNbr}
@@ -139,7 +148,12 @@ let pageOfTaggedPosts : HttpHandler = fun next ctx -> task {
let conn = conn ctx
match pathAndPageNumber ctx with
| Some pageNbr, rawTag ->
let tag = HttpUtility.UrlDecode rawTag
let urlTag = HttpUtility.UrlDecode rawTag
let! tag = backgroundTask {
match! Data.TagMap.findByUrlValue urlTag webLog.id conn with
| Some m -> return m.tag
| None -> return urlTag
}
match! Data.Post.findPageOfTaggedPosts webLog.id tag pageNbr webLog.postsPerPage conn with
| posts when List.length posts > 0 ->
let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.postsPerPage ctx conn
@@ -254,7 +268,8 @@ let generateFeed : HttpHandler = fun next ctx -> backgroundTask {
let private deriveAction ctx : HttpHandler seq =
let webLog = WebLogCache.get ctx
let conn = conn ctx
let permalink = (string >> Permalink) ctx.Request.RouteValues["link"]
let textLink = string ctx.Request.RouteValues["link"]
let permalink = Permalink textLink
let await it = (Async.AwaitTask >> Async.RunSynchronously) it
seq {
// Current post
@@ -273,13 +288,22 @@ let private deriveAction ctx : HttpHandler seq =
| None -> ()
// RSS feed
// TODO: configure this via web log
if Permalink.toString permalink = "feed.xml" then yield generateFeed
if textLink = "feed.xml" then yield generateFeed
// Post differing only by trailing slash
let altLink = Permalink (if textLink.EndsWith "/" then textLink[..textLink.Length - 2] else $"{textLink}/")
match Data.Post.findByPermalink altLink webLog.id conn |> await with
| Some post -> yield redirectTo true $"/{Permalink.toString post.permalink}"
| None -> ()
// Page differing only by trailing slash
match Data.Page.findByPermalink altLink webLog.id conn |> await with
| Some page -> yield redirectTo true $"/{Permalink.toString page.permalink}"
| None -> ()
// Prior post
match Data.Post.findCurrentPermalink permalink webLog.id conn |> await with
match Data.Post.findCurrentPermalink [ permalink; altLink ] webLog.id conn |> await with
| Some link -> yield redirectTo true $"/{Permalink.toString link}"
| None -> ()
// Prior permalink
match Data.Page.findCurrentPermalink permalink webLog.id conn |> await with
match Data.Page.findCurrentPermalink [ permalink; altLink ] webLog.id conn |> await with
| Some link -> yield redirectTo true $"/{Permalink.toString link}"
| None -> ()
}
@@ -291,8 +315,8 @@ let catchAll : HttpHandler = fun next ctx -> task {
| None -> return! Error.notFound next ctx
}
// GET /posts
// GET /posts/page/{pageNbr}
// GET /admin/posts
// GET /admin/posts/page/{pageNbr}
let all pageNbr : HttpHandler = requireUser >=> fun next ctx -> task {
let webLog = WebLogCache.get ctx
let conn = conn ctx
@@ -302,7 +326,7 @@ let all pageNbr : HttpHandler = requireUser >=> fun next ctx -> task {
return! viewForTheme "admin" "post-list" next ctx hash
}
// GET /post/{id}/edit
// GET /admin/post/{id}/edit
let edit postId : HttpHandler = requireUser >=> fun next ctx -> task {
let webLog = WebLogCache.get ctx
let conn = conn ctx
@@ -328,7 +352,7 @@ let edit postId : HttpHandler = requireUser >=> fun next ctx -> task {
| None -> return! Error.notFound next ctx
}
// GET /post/{id}/permalinks
// GET /admin/post/{id}/permalinks
let editPermalinks postId : HttpHandler = requireUser >=> fun next ctx -> task {
match! Data.Post.findByFullId (PostId postId) (webLogId ctx) (conn ctx) with
| Some post ->
@@ -342,20 +366,28 @@ let editPermalinks postId : HttpHandler = requireUser >=> fun next ctx -> task {
| None -> return! Error.notFound next ctx
}
// POST /post/permalinks
// POST /admin/post/permalinks
let savePermalinks : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let links = model.prior |> Array.map Permalink |> List.ofArray
match! Data.Post.updatePriorPermalinks (PostId model.id) (webLogId ctx) links (conn ctx) with
| true ->
do! addMessage ctx { UserMessage.success with message = "Post permalinks saved successfully" }
return! redirectToGet $"/post/{model.id}/permalinks" next ctx
return! redirectToGet $"/admin/post/{model.id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/delete
let delete postId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
match! Data.Post.delete (PostId postId) (webLogId ctx) (conn ctx) with
| true -> do! addMessage ctx { UserMessage.success with message = "Post deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with message = "Post not found; nothing deleted" }
return! redirectToGet "/admin/posts" next ctx
}
#nowarn "3511"
// POST /post/save
// POST /admin/post/save
let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel> ()
let webLogId = webLogId ctx
@@ -391,6 +423,7 @@ let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
tags = model.tags.Split ","
|> Seq.ofArray
|> Seq.map (fun it -> it.Trim().ToLower ())
|> Seq.filter (fun it -> it <> "")
|> Seq.sort
|> List.ofSeq
categoryIds = model.categoryIds |> Array.map CategoryId |> List.ofArray
@@ -427,6 +460,6 @@ let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|> List.length = List.length pst.Value.categoryIds) then
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Post saved successfully" }
return! redirectToGet $"/post/{PostId.toString post.id}/edit" next ctx
return! redirectToGet $"/admin/post/{PostId.toString post.id}/edit" next ctx
| None -> return! Error.notFound next ctx
}

92
src/MyWebLog/Handlers/Routes.fs
View File

@@ -10,63 +10,65 @@ let endpoints = [
]
subRoute "/admin" [
GET [
route "" Admin.dashboard
route "/settings" Admin.settings
route "" Admin.dashboard
subRoute "/categor" [
route "ies" Admin.listCategories
routef "y/%s/edit" Admin.editCategory
]
subRoute "/page" [
route "s" (Admin.listPages 1)
routef "s/page/%d" Admin.listPages
routef "/%s/edit" Admin.editPage
routef "/%s/permalinks" Admin.editPagePermalinks
]
subRoute "/post" [
route "s" (Post.all 1)
routef "s/page/%d" Post.all
routef "/%s/edit" Post.edit
routef "/%s/permalinks" Post.editPermalinks
]
route "/settings" Admin.settings
subRoute "/tag-mapping" [
route "s" Admin.tagMappings
routef "/%s/edit" Admin.editMapping
]
route "/user/edit" User.edit
]
POST [
route "/settings" Admin.saveSettings
subRoute "/category" [
route "/save" Admin.saveCategory
routef "/%s/delete" Admin.deleteCategory
]
subRoute "/page" [
route "/save" Admin.savePage
route "/permalinks" Admin.savePagePermalinks
routef "/%s/delete" Admin.deletePage
]
subRoute "/post" [
route "/save" Post.save
route "/permalinks" Post.savePermalinks
routef "/%s/delete" Post.delete
]
route "/settings" Admin.saveSettings
subRoute "/tag-mapping" [
route "/save" Admin.saveMapping
routef "/%s/delete" Admin.deleteMapping
]
route "/user/save" User.save
]
]
subRoute "/categor" [
GET [
route "ies" Category.all
routef "y/%s/edit" Category.edit
route "y/{**slug}" Post.pageOfCategorizedPosts
]
POST [
route "y/save" Category.save
routef "y/%s/delete" Category.delete
]
]
subRoute "/page" [
GET [
routef "/%d" Post.pageOfPosts
routef "/%s/edit" Page.edit
routef "/%s/permalinks" Page.editPermalinks
route "s" (Page.all 1)
routef "s/page/%d" Page.all
]
POST [
route "/permalinks" Page.savePermalinks
route "/save" Page.save
]
]
subRoute "/post" [
GET [
routef "/%s/edit" Post.edit
routef "/%s/permalinks" Post.editPermalinks
route "s" (Post.all 1)
routef "s/page/%d" Post.all
]
POST [
route "/permalinks" Post.savePermalinks
route "/save" Post.save
]
]
subRoute "/tag" [
GET [
route "/{**slug}" Post.pageOfTaggedPosts
]
GET [
route "/category/{**slug}" Post.pageOfCategorizedPosts
routef "/page/%d" Post.pageOfPosts
route "/tag/{**slug}" Post.pageOfTaggedPosts
]
subRoute "/user" [
GET [
route "/edit" User.edit
route "/log-on" (User.logOn None)
route "/log-off" User.logOff
]
POST [
route "/log-on" User.doLogOn
route "/save" User.save
]
]
route "{**link}" Post.catchAll

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

@@ -76,14 +76,14 @@ let private showEdit (hash : Hash) : HttpHandler = fun next ctx -> task {
return! viewForTheme "admin" "user-edit" next ctx hash
}
// GET /user/edit
// GET /admin/user/edit
let edit : HttpHandler = requireUser >=> fun next ctx -> task {
match! Data.WebLogUser.findById (userId ctx) (conn ctx) with
| Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) next ctx
| None -> return! Error.notFound next ctx
}
// POST /user/save
// POST /admin/user/save
let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel> ()
if model.newPassword = model.newPasswordConfirm then
@@ -107,7 +107,7 @@ let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
do! Data.WebLogUser.update user conn
let pwMsg = if model.newPassword = "" then "" else " and updated your password"
do! addMessage ctx { UserMessage.success with message = $"Saved your information{pwMsg} successfully" }
return! redirectToGet "/user/edit" next ctx
return! redirectToGet "/admin/user/edit" next ctx
| None -> return! Error.notFound next ctx
else
do! addMessage ctx { UserMessage.error with message = "Passwords did not match; no updates made" }