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

Add access restrictions to server routes (#19)

Browse Source
This commit is contained in:
Daniel J. Summers 2022-07-16 17:32:18 -04:00
parent 425223a3a8
commit eae1509d81
11 changed files with 201 additions and 155 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/MyWebLog.Data/Interfaces.fs
View File

@ -97,6 +97,9 @@ type IPostData =
/// Delete a post
abstract member delete : PostId -> WebLogId -> Task<bool>
/// Find a post by its ID (excluding revisions and prior permalinks)
abstract member findById : PostId -> WebLogId -> Task<Post option>
/// Find a post by its permalink (excluding revisions and prior permalinks)
abstract member findByPermalink : Permalink -> WebLogId -> Task<Post option>

9
src/MyWebLog.Data/RethinkDbData.fs
View File

@ -454,6 +454,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
return result.Deleted > 0UL
}
member _.findById postId webLogId =
rethink<Post> {
withTable Table.Post
get postId
without [ "priorPermalinks"; "revisions" ]
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun p -> p.webLogId) <| conn
member _.findByPermalink permalink webLogId =
rethink<Post list> {
withTable Table.Post

35
src/MyWebLog.Data/SQLite/SQLitePostData.fs
View File

@ -81,6 +81,18 @@ type SQLitePostData (conn : SqliteConnection) =
return { post with revisions = toList Map.toRevision rdr }
}
/// The SELECT statement for a post that will include episode data, if it exists
let selectPost = "SELECT p.*, e.* FROM post p LEFT JOIN post_episode e ON e.post_id = p.id"
/// Find just-the-post by its ID for the given web log (excludes category, tag, meta, revisions, and permalinks)
let findPostById postId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<Post> webLogId (fun p -> p.webLogId) Map.toPost rdr
}
/// Return a post with no revisions, prior permalinks, or text
let postWithoutText rdr =
{ Map.toPost rdr with text = "" }
@ -270,9 +282,6 @@ type SQLitePostData (conn : SqliteConnection) =
|> ignore
}
/// The SELECT statement for a post that will include episode data, if it exists
let selectPost = "SELECT p.*, e.* FROM post p LEFT JOIN post_episode e ON e.post_id = p.id"
// IMPLEMENTATION FUNCTIONS
/// Add a post
@ -303,6 +312,15 @@ type SQLitePostData (conn : SqliteConnection) =
return! count cmd
}
/// Find a post by its ID for the given web log (excluding revisions and prior permalinks
let findById postId webLogId = backgroundTask {
match! findPostById postId webLogId with
| Some post ->
let! post = appendPostCategoryTagAndMeta post
return Some post
| None -> return None
}
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink permalink webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
@ -319,17 +337,11 @@ type SQLitePostData (conn : SqliteConnection) =
/// Find a complete post by its ID for the given web log
let findFullById postId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
match Helpers.verifyWebLog<Post> webLogId (fun p -> p.webLogId) Map.toPost rdr with
match! findById postId webLogId with
| Some post ->
let! post = appendPostCategoryTagAndMeta post
let! post = appendPostRevisionsAndPermalinks post
return Some post
| None ->
return None
| None -> return None
}
/// Delete a post by its ID for the given web log
@ -562,6 +574,7 @@ type SQLitePostData (conn : SqliteConnection) =
member _.add post = add post
member _.countByStatus status webLogId = countByStatus status webLogId
member _.delete postId webLogId = delete postId webLogId
member _.findById postId webLogId = findById postId webLogId
member _.findByPermalink permalink webLogId = findByPermalink permalink webLogId
member _.findCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
member _.findFullById postId webLogId = findFullById postId webLogId

6
src/MyWebLog/Caches.fs
View File

@ -38,6 +38,12 @@ module Extensions =
| None -> Some "generator not configured"
generatorString.Value
/// The access level for the current user
member this.UserAccessLevel =
this.User.Claims
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.Role)
|> Option.map (fun claim -> AccessLevel.parse claim.Value)
/// The user ID for the current request
member this.UserId =
WebLogUserId (this.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value

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

@ -8,7 +8,7 @@ open MyWebLog
open MyWebLog.ViewModels
// GET /admin
let dashboard : HttpHandler = fun next ctx -> task {
let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let webLogId = ctx.WebLog.id
let data = ctx.Data
let getCount (f : WebLogId -> Task<int>) = f webLogId
@ -36,7 +36,7 @@ let dashboard : HttpHandler = fun next ctx -> task {
// -- CATEGORIES --
// GET /admin/categories
let listCategories : HttpHandler = fun next ctx -> task {
let listCategories : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! catListTemplate = TemplateCache.get "admin" "category-list-body" ctx.Data
let hash = Hash.FromAnonymousObject {|
page_title = "Categories"
@ -49,7 +49,7 @@ let listCategories : HttpHandler = fun next ctx -> task {
}
// GET /admin/categories/bare
let listCategoriesBare : HttpHandler = fun next ctx -> task {
let listCategoriesBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
return!
Hash.FromAnonymousObject {|
categories = CategoryCache.get ctx
@ -60,7 +60,7 @@ let listCategoriesBare : HttpHandler = fun next ctx -> task {
// GET /admin/category/{id}/edit
let editCategory catId : HttpHandler = fun next ctx -> task {
let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! result = task {
match catId with
| "new" -> return Some ("Add a New Category", { Category.empty with id = CategoryId "new" })
@ -83,14 +83,13 @@ let editCategory catId : HttpHandler = fun next ctx -> task {
}
// POST /admin/category/save
let saveCategory : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let saveCategory : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditCategoryModel> ()
let! category = task {
match model.categoryId with
| "new" -> return Some { Category.empty with id = CategoryId.create (); webLogId = webLog.id }
| catId -> return! data.Category.findById (CategoryId catId) webLog.id
| "new" -> return Some { Category.empty with id = CategoryId.create (); webLogId = ctx.WebLog.id }
| catId -> return! data.Category.findById (CategoryId catId) ctx.WebLog.id
}
match category with
| Some cat ->
@ -109,7 +108,7 @@ let saveCategory : HttpHandler = fun next ctx -> task {
}
// POST /admin/category/{id}/delete
let deleteCategory catId : HttpHandler = fun next ctx -> task {
let deleteCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Category.delete (CategoryId catId) ctx.WebLog.id with
| true ->
do! CategoryCache.update ctx
@ -134,7 +133,7 @@ let private tagMappingHash (ctx : HttpContext) = task {
}
// GET /admin/settings/tag-mappings
let tagMappings : HttpHandler = fun next ctx -> task {
let tagMappings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash = tagMappingHash ctx
let! listTemplate = TemplateCache.get "admin" "tag-mapping-list-body" ctx.Data
@ -145,13 +144,13 @@ let tagMappings : HttpHandler = fun next ctx -> task {
}
// GET /admin/settings/tag-mappings/bare
let tagMappingsBare : HttpHandler = fun next ctx -> task {
let tagMappingsBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash = tagMappingHash ctx
return! bareForTheme "admin" "tag-mapping-list-body" next ctx hash
}
// GET /admin/settings/tag-mapping/{id}/edit
let editMapping tagMapId : HttpHandler = fun next ctx -> task {
let editMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let isNew = tagMapId = "new"
let tagMap =
if isNew then
@ -171,7 +170,7 @@ let editMapping tagMapId : HttpHandler = fun next ctx -> task {
}
// POST /admin/settings/tag-mapping/save
let saveMapping : HttpHandler = fun next ctx -> task {
let saveMapping : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel> ()
let tagMap =
@ -188,7 +187,7 @@ let saveMapping : HttpHandler = fun next ctx -> task {
}
// POST /admin/settings/tag-mapping/{id}/delete
let deleteMapping tagMapId : HttpHandler = fun next ctx -> task {
let deleteMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.TagMap.delete (TagMapId tagMapId) ctx.WebLog.id with
| true -> do! addMessage ctx { UserMessage.success with message = "Tag mapping deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with message = "Tag mapping not found; nothing deleted" }
@ -204,7 +203,7 @@ open System.Text.RegularExpressions
open MyWebLog.Data
// GET /admin/theme/update
let themeUpdatePage : HttpHandler = fun next ctx -> task {
let themeUpdatePage : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
return!
Hash.FromAnonymousObject {|
page_title = "Upload Theme"
@ -291,7 +290,7 @@ let loadThemeFromZip themeName file clean (data : IData) = backgroundTask {
}
// POST /admin/theme/update
let updateTheme : HttpHandler = fun next ctx -> task {
let updateTheme : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let themeFile = Seq.head ctx.Request.Form.Files
match getThemeName themeFile.FileName with
@ -319,17 +318,15 @@ let updateTheme : HttpHandler = fun next ctx -> task {
open System.Collections.Generic
// GET /admin/settings
let settings : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! allPages = data.Page.all webLog.id
let! allPages = data.Page.all ctx.WebLog.id
let! themes = data.Theme.all ()
return!
Hash.FromAnonymousObject {|
page_title = "Web Log Settings"
csrf = ctx.CsrfTokenSet
web_log = webLog
model = SettingsModel.fromWebLog webLog
model = SettingsModel.fromWebLog ctx.WebLog
pages = seq
{ KeyValuePair.Create ("posts", "- First Page of Posts -")
yield! allPages
@ -351,11 +348,10 @@ let settings : HttpHandler = fun next ctx -> task {
}
// POST /admin/settings
let saveSettings : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let data = ctx.Data
let! model = ctx.BindFormAsync<SettingsModel> ()
match! data.WebLog.findById webLog.id with
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<SettingsModel> ()
match! data.WebLog.findById ctx.WebLog.id with
| Some webLog ->
let oldSlug = webLog.slug
let webLog = model.update webLog

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

@ -417,23 +417,22 @@ let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> bac
open DotLiquid
// GET: /admin/settings/rss
let editSettings : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let editSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let feeds =
webLog.rss.customFeeds
ctx.WebLog.rss.customFeeds
|> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx))
|> Array.ofList
return! Hash.FromAnonymousObject {|
page_title = "RSS Settings"
csrf = ctx.CsrfTokenSet
model = EditRssModel.fromRssOptions webLog.rss
model = EditRssModel.fromRssOptions ctx.WebLog.rss
custom_feeds = feeds
|}
|> viewForTheme "admin" "rss-settings" next ctx
}
// POST: /admin/settings/rss
let saveSettings : HttpHandler = fun next ctx -> task {
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditRssModel> ()
match! data.WebLog.findById ctx.WebLog.id with
@ -447,7 +446,7 @@ let saveSettings : HttpHandler = fun next ctx -> task {
}
// GET: /admin/settings/rss/{id}/edit
let editCustomFeed feedId : HttpHandler = fun next ctx -> task {
let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let customFeed =
match feedId with
| "new" -> Some { CustomFeed.empty with id = CustomFeedId "new" }
@ -475,7 +474,7 @@ let editCustomFeed feedId : HttpHandler = fun next ctx -> task {
}
// POST: /admin/settings/rss/save
let saveCustomFeed : HttpHandler = fun next ctx -> task {
let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLog.findById ctx.WebLog.id with
| Some webLog ->
@ -500,7 +499,7 @@ let saveCustomFeed : HttpHandler = fun next ctx -> task {
}
// POST /admin/settings/rss/{id}/delete
let deleteCustomFeed feedId : HttpHandler = fun next ctx -> task {
let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLog.findById ctx.WebLog.id with
| Some webLog ->

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

@ -149,6 +149,16 @@ let validateCsrf : HttpHandler = fun next ctx -> task {
/// Require a user to be logged on
let requireUser : HttpHandler = requiresAuthentication Error.notAuthorized
/// Require a specific level of access for a route
let requireAccess level : HttpHandler = fun next ctx ->
if defaultArg (ctx.UserAccessLevel |> Option.map (AccessLevel.hasAccess level)) false then next ctx
else Error.notAuthorized next ctx
/// Determine if a user is authorized to edit a page or post, given the author
let canEdit authorId (ctx : HttpContext) =
if ctx.UserId = authorId then true
else defaultArg (ctx.UserAccessLevel |> Option.map (AccessLevel.hasAccess Editor)) false
open System.Collections.Generic
open MyWebLog.Data

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

@ -8,14 +8,13 @@ open MyWebLog.ViewModels
// GET /admin/pages
// GET /admin/pages/page/{pageNbr}
let all pageNbr : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let! pages = ctx.Data.Page.findPageOfPages webLog.id pageNbr
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! pages = ctx.Data.Page.findPageOfPages ctx.WebLog.id pageNbr
return!
Hash.FromAnonymousObject {|
page_title = "Pages"
csrf = ctx.CsrfTokenSet
pages = pages |> List.map (DisplayPage.fromPageMinimal webLog)
pages = pages |> List.map (DisplayPage.fromPageMinimal ctx.WebLog)
page_nbr = pageNbr
prev_page = if pageNbr = 2 then "" else $"/page/{pageNbr - 1}"
next_page = $"/page/{pageNbr + 1}"
@ -24,17 +23,17 @@ let all pageNbr : HttpHandler = fun next ctx -> task {
}
// GET /admin/page/{id}/edit
let edit pgId : HttpHandler = fun next ctx -> task {
let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! result = task {
match pgId with
| "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new" })
| "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new"; authorId = ctx.UserId })
| _ ->
match! ctx.Data.Page.findFullById (PageId pgId) ctx.WebLog.id with
| Some page -> return Some ("Edit Page", page)
| None -> return None
}
match result with
| Some (title, page) ->
| Some (title, page) when canEdit page.authorId ctx ->
let model = EditPageModel.fromPage page
let! templates = templatesForTheme ctx "page"
return!
@ -47,13 +46,13 @@ let edit pgId : HttpHandler = fun next ctx -> task {
templates = templates
|}
|> viewForTheme "admin" "page-edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/page/{id}/delete
let delete pgId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
match! ctx.Data.Page.delete (PageId pgId) webLog.id with
let delete pgId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Page.delete (PageId pgId) ctx.WebLog.id with
| true ->
do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Page deleted successfully" }
@ -62,9 +61,9 @@ let delete pgId : HttpHandler = fun next ctx -> task {
}
// GET /admin/page/{id}/permalinks
let editPermalinks pgId : HttpHandler = fun next ctx -> task {
let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Page.findFullById (PageId pgId) ctx.WebLog.id with
| Some pg ->
| Some pg when canEdit pg.authorId ctx ->
return!
Hash.FromAnonymousObject {|
page_title = "Manage Prior Permalinks"
@ -72,41 +71,45 @@ let editPermalinks pgId : HttpHandler = fun next ctx -> task {
model = ManagePermalinksModel.fromPage pg
|}
|> viewForTheme "admin" "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/page/permalinks
let savePermalinks : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let links = model.prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Page.updatePriorPermalinks (PageId model.id) webLog.id links with
| true ->
do! addMessage ctx { UserMessage.success with message = "Page permalinks saved successfully" }
return! redirectToGet $"admin/page/{model.id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let pageId = PageId model.id
match! ctx.Data.Page.findById pageId ctx.WebLog.id with
| Some pg when canEdit pg.authorId ctx ->
let links = model.prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Page.updatePriorPermalinks pageId ctx.WebLog.id links with
| true ->
do! addMessage ctx { UserMessage.success with message = "Page permalinks saved successfully" }
return! redirectToGet $"admin/page/{model.id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/page/{id}/revisions
let editRevisions pgId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
match! ctx.Data.Page.findFullById (PageId pgId) webLog.id with
| Some pg ->
let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Page.findFullById (PageId pgId) ctx.WebLog.id with
| Some pg when canEdit pg.authorId ctx ->
return!
Hash.FromAnonymousObject {|
page_title = "Manage Page Revisions"
csrf = ctx.CsrfTokenSet
model = ManageRevisionsModel.fromPage webLog pg
model = ManageRevisionsModel.fromPage ctx.WebLog pg
|}
|> viewForTheme "admin" "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/page/{id}/revisions/purge
let purgeRevisions pgId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let data = ctx.Data
match! data.Page.findFullById (PageId pgId) webLog.id with
let purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
match! data.Page.findFullById (PageId pgId) ctx.WebLog.id with
| Some pg ->
do! data.Page.update { pg with revisions = [ List.head pg.revisions ] }
do! addMessage ctx { UserMessage.success with message = "Prior revisions purged successfully" }
@ -126,14 +129,15 @@ let private findPageRevision pgId revDate (ctx : HttpContext) = task {
}
// GET /admin/page/{id}/revision/{revision-date}/preview
let previewRevision (pgId, revDate) : HttpHandler = fun next ctx -> task {
let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some _, Some rev ->
| Some pg, Some rev when canEdit pg.authorId ctx ->
return!
Hash.FromAnonymousObject {|
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.text}</div>"""
|}
|> bareForTheme "admin" "" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
@ -141,9 +145,9 @@ let previewRevision (pgId, revDate) : HttpHandler = fun next ctx -> task {
open System
// POST /admin/page/{id}/revision/{revision-date}/restore
let restoreRevision (pgId, revDate) : HttpHandler = fun next ctx -> task {
let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev ->
| Some pg, Some rev when canEdit pg.authorId ctx ->
do! ctx.Data.Page.update
{ pg with
revisions = { rev with asOf = DateTime.UtcNow }
@ -151,17 +155,19 @@ let restoreRevision (pgId, revDate) : HttpHandler = fun next ctx -> task {
}
do! addMessage ctx { UserMessage.success with message = "Revision restored successfully" }
return! redirectToGet $"admin/page/{pgId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/page/{id}/revision/{revision-date}/delete
let deleteRevision (pgId, revDate) : HttpHandler = fun next ctx -> task {
let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev ->
| Some pg, Some rev when canEdit pg.authorId ctx ->
do! ctx.Data.Page.update { pg with revisions = pg.revisions |> List.filter (fun r -> r.asOf <> rev.asOf) }
do! addMessage ctx { UserMessage.success with message = "Revision deleted successfully" }
return! bareForTheme "admin" "" next ctx (Hash.FromAnonymousObject {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
@ -169,25 +175,24 @@ let deleteRevision (pgId, revDate) : HttpHandler = fun next ctx -> task {
#nowarn "3511"
// POST /admin/page/save
let save : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> ()
let webLog = ctx.WebLog
let data = ctx.Data
let now = DateTime.UtcNow
let! pg = task {
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> ()
let data = ctx.Data
let now = DateTime.UtcNow
let! pg = task {
match model.pageId with
| "new" ->
return Some
{ Page.empty with
id = PageId.create ()
webLogId = webLog.id
webLogId = ctx.WebLog.id
authorId = ctx.UserId
publishedOn = now
}
| pgId -> return! data.Page.findFullById (PageId pgId) webLog.id
| pgId -> return! data.Page.findFullById (PageId pgId) ctx.WebLog.id
}
match pg with
| Some page ->
| Some page when canEdit page.authorId ctx ->
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
@ -217,5 +222,6 @@ let save : HttpHandler = fun next ctx -> task {
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
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}

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

@ -99,17 +99,17 @@ open Giraffe
// GET /page/{pageNbr}
let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let data = ctx.Data
let! posts = data.Post.findPageOfPublishedPosts webLog.id pageNbr webLog.postsPerPage
let! hash = preparePostList webLog posts PostList "" pageNbr webLog.postsPerPage ctx data
let title =
match pageNbr, webLog.defaultPage with
let count = ctx.WebLog.postsPerPage
let data = ctx.Data
let! posts = data.Post.findPageOfPublishedPosts ctx.WebLog.id pageNbr count
let! hash = preparePostList ctx.WebLog posts PostList "" pageNbr count ctx data
let title =
match pageNbr, ctx.WebLog.defaultPage with
| 1, "posts" -> None
| _, "posts" -> Some $"Page {pageNbr}"
| _, _ -> Some $"Page {pageNbr} &laquo; Posts"
match title with Some ttl -> hash.Add ("page_title", ttl) | None -> ()
if pageNbr = 1 && webLog.defaultPage = "posts" then hash.Add ("is_home", true)
if pageNbr = 1 && ctx.WebLog.defaultPage = "posts" then hash.Add ("is_home", true)
return! themedView "index" next ctx hash
}
@ -209,33 +209,31 @@ let home : HttpHandler = fun next ctx -> task {
// GET /admin/posts
// GET /admin/posts/page/{pageNbr}
let all pageNbr : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let data = ctx.Data
let! posts = data.Post.findPageOfPosts webLog.id pageNbr 25
let! hash = preparePostList webLog posts AdminList "" pageNbr 25 ctx data
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
let! posts = data.Post.findPageOfPosts ctx.WebLog.id pageNbr 25
let! hash = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 ctx data
hash.Add ("page_title", "Posts")
hash.Add ("csrf", ctx.CsrfTokenSet)
return! viewForTheme "admin" "post-list" next ctx hash
}
// GET /admin/post/{id}/edit
let edit postId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
let! result = task {
match postId with
| "new" -> return Some ("Write a New Post", { Post.empty with id = PostId "new" })
| _ ->
match! data.Post.findFullById (PostId postId) webLog.id with
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) ->
let! cats = data.Category.findAllForView webLog.id
| Some (title, post) when canEdit post.authorId ctx ->
let! cats = data.Category.findAllForView ctx.WebLog.id
let! templates = templatesForTheme ctx "post"
let model = EditPostModel.fromPost webLog post
let model = EditPostModel.fromPost ctx.WebLog post
return!
Hash.FromAnonymousObject {|
page_title = title
@ -253,22 +251,22 @@ let edit postId : HttpHandler = fun next ctx -> task {
|]
|}
|> viewForTheme "admin" "post-edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/delete
let delete postId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
match! ctx.Data.Post.delete (PostId postId) webLog.id with
let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Post.delete (PostId postId) ctx.WebLog.id with
| true -> do! addMessage ctx { UserMessage.success with message = "Post deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with message = "Post not found; nothing deleted" }
return! redirectToGet "admin/posts" next ctx
}
// GET /admin/post/{id}/permalinks
let editPermalinks postId : HttpHandler = fun next ctx -> task {
let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with
| Some post ->
| Some post when canEdit post.authorId ctx ->
return!
Hash.FromAnonymousObject {|
page_title = "Manage Prior Permalinks"
@ -276,25 +274,30 @@ let editPermalinks postId : HttpHandler = fun next ctx -> task {
model = ManagePermalinksModel.fromPost post
|}
|> viewForTheme "admin" "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/post/permalinks
let savePermalinks : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let links = model.prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Post.updatePriorPermalinks (PostId model.id) webLog.id links with
| true ->
do! addMessage ctx { UserMessage.success with message = "Post permalinks saved successfully" }
return! redirectToGet $"admin/post/{model.id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
let postId = PostId model.id
match! ctx.Data.Post.findById postId ctx.WebLog.id with
| Some post when canEdit post.authorId ctx ->
let links = model.prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Post.updatePriorPermalinks (PostId model.id) ctx.WebLog.id links with
| true ->
do! addMessage ctx { UserMessage.success with message = "Post permalinks saved successfully" }
return! redirectToGet $"admin/post/{model.id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/post/{id}/revisions
let editRevisions postId : HttpHandler = fun next ctx -> task {
let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with
| Some post ->
| Some post when canEdit post.authorId ctx ->
return!
Hash.FromAnonymousObject {|
page_title = "Manage Post Revisions"
@ -302,17 +305,19 @@ let editRevisions postId : HttpHandler = fun next ctx -> task {
model = ManageRevisionsModel.fromPost ctx.WebLog post
|}
|> viewForTheme "admin" "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/post/{id}/revisions/purge
let purgeRevisions postId : HttpHandler = fun next ctx -> task {
let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.findFullById (PostId postId) ctx.WebLog.id with
| Some post ->
| Some post when canEdit post.authorId ctx ->
do! data.Post.update { post with revisions = [ List.head post.revisions ] }
do! addMessage ctx { UserMessage.success with message = "Prior revisions purged successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
@ -328,22 +333,23 @@ let private findPostRevision postId revDate (ctx : HttpContext) = task {
}
// GET /admin/post/{id}/revision/{revision-date}/preview
let previewRevision (postId, revDate) : HttpHandler = fun next ctx -> task {
let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some _, Some rev ->
| Some post, Some rev when canEdit post.authorId ctx ->
return!
Hash.FromAnonymousObject {|
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.text}</div>"""
|}
|> bareForTheme "admin" "" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/revision/{revision-date}/restore
let restoreRevision (postId, revDate) : HttpHandler = fun next ctx -> task {
let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev ->
| Some post, Some rev when canEdit post.authorId ctx ->
do! ctx.Data.Post.update
{ post with
revisions = { rev with asOf = DateTime.UtcNow }
@ -351,17 +357,19 @@ let restoreRevision (postId, revDate) : HttpHandler = fun next ctx -> task {
}
do! addMessage ctx { UserMessage.success with message = "Revision restored successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/revision/{revision-date}/delete
let deleteRevision (postId, revDate) : HttpHandler = fun next ctx -> task {
let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev ->
| Some post, Some rev when canEdit post.authorId ctx ->
do! ctx.Data.Post.update { post with revisions = post.revisions |> List.filter (fun r -> r.asOf <> rev.asOf) }
do! addMessage ctx { UserMessage.success with message = "Revision deleted successfully" }
return! bareForTheme "admin" "" next ctx (Hash.FromAnonymousObject {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
@ -369,24 +377,23 @@ let deleteRevision (postId, revDate) : HttpHandler = fun next ctx -> task {
#nowarn "3511"
// POST /admin/post/save
let save : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel> ()
let webLog = ctx.WebLog
let data = ctx.Data
let now = DateTime.UtcNow
let! pst = task {
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel> ()
let data = ctx.Data
let now = DateTime.UtcNow
let! pst = task {
match model.postId with
| "new" ->
return Some
{ Post.empty with
id = PostId.create ()
webLogId = webLog.id
webLogId = ctx.WebLog.id
authorId = ctx.UserId
}
| postId -> return! data.Post.findFullById (PostId postId) webLog.id
| postId -> return! data.Post.findFullById (PostId postId) ctx.WebLog.id
}
match pst with
| Some post ->
| Some post when canEdit post.authorId ctx ->
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 post =
@ -418,5 +425,6 @@ let save : HttpHandler = fun next ctx -> task {
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Post saved successfully" }
return! redirectToGet $"admin/post/{PostId.toString post.id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}

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

@ -85,7 +85,7 @@ open MyWebLog.ViewModels
let makeSlug it = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 ]").Replace (it, ""), "-")).ToLowerInvariant ()
// GET /admin/uploads
let list : HttpHandler = fun next ctx -> task {
let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let webLog = ctx.WebLog
let! dbUploads = ctx.Data.Upload.findByWebLog webLog.id
let diskUploads =
@ -126,7 +126,7 @@ let list : HttpHandler = fun next ctx -> task {
}
// GET /admin/upload/new
let showNew : HttpHandler = fun next ctx -> task {
let showNew : HttpHandler = requireAccess Author >=> fun next ctx -> task {
return!
Hash.FromAnonymousObject {|
page_title = "Upload a File"
@ -141,13 +141,12 @@ let showUploads : HttpHandler =
redirectToGet "admin/uploads"
// POST /admin/upload/save
let save : HttpHandler = fun next ctx -> task {
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let upload = Seq.head ctx.Request.Form.Files
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
Path.GetExtension(upload.FileName).ToLowerInvariant ())
let webLog = ctx.WebLog
let localNow = WebLog.localTime webLog DateTime.Now
let localNow = WebLog.localTime ctx.WebLog DateTime.Now
let year = localNow.ToString "yyyy"
let month = localNow.ToString "MM"
let! form = ctx.BindFormAsync<UploadFileModel> ()
@ -158,14 +157,14 @@ let save : HttpHandler = fun next ctx -> task {
do! upload.CopyToAsync stream
let file =
{ id = UploadId.create ()
webLogId = webLog.id
webLogId = ctx.WebLog.id
path = Permalink $"{year}/{month}/{fileName}"
updatedOn = DateTime.UtcNow
data = stream.ToArray ()
}
do! ctx.Data.Upload.add file
| Disk ->
let fullPath = Path.Combine (uploadDir, webLog.slug, year, month)
let fullPath = Path.Combine (uploadDir, ctx.WebLog.slug, year, month)
let _ = Directory.CreateDirectory fullPath
use stream = new FileStream (Path.Combine (fullPath, fileName), FileMode.Create)
do! upload.CopyToAsync stream
@ -177,11 +176,8 @@ let save : HttpHandler = fun next ctx -> task {
}
// POST /admin/upload/{id}/delete
let deleteFromDb upId : HttpHandler = fun next ctx -> task {
let uploadId = UploadId upId
let webLog = ctx.WebLog
let data = ctx.Data
match! data.Upload.delete uploadId webLog.id with
let deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Upload.delete (UploadId upId) ctx.WebLog.id with
| Ok fileName ->
do! addMessage ctx { UserMessage.success with message = $"{fileName} deleted successfully" }
return! showUploads next ctx
@ -201,7 +197,7 @@ let removeEmptyDirectories (webLog : WebLog) (filePath : string) =
finished <- true
// POST /admin/upload/delete/{**path}
let deleteFromDisk urlParts : HttpHandler = fun next ctx -> task {
let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let filePath = urlParts |> Seq.skip 1 |> Seq.head
let path = Path.Combine (uploadDir, ctx.WebLog.slug, filePath)
if File.Exists path then

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

@ -76,14 +76,14 @@ let private showEdit (hash : Hash) : HttpHandler = fun next ctx -> task {
}
// GET /admin/user/edit
let edit : HttpHandler = fun next ctx -> task {
let edit : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.WebLogUser.findById ctx.UserId ctx.WebLog.id with
| Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/user/save
let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel> ()
if model.newPassword = model.newPasswordConfirm then
let data = ctx.Data