From eae1509d818783ed072f6bdcde3a42207441feff Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sat, 16 Jul 2022 17:32:18 -0400 Subject: [PATCH] Add access restrictions to server routes (#19) --- src/MyWebLog.Data/Interfaces.fs | 3 + src/MyWebLog.Data/RethinkDbData.fs | 9 ++ src/MyWebLog.Data/SQLite/SQLitePostData.fs | 35 ++++--- src/MyWebLog/Caches.fs | 6 ++ src/MyWebLog/Handlers/Admin.fs | 48 +++++---- src/MyWebLog/Handlers/Feed.fs | 15 ++- src/MyWebLog/Handlers/Helpers.fs | 10 ++ src/MyWebLog/Handlers/Page.fs | 96 +++++++++--------- src/MyWebLog/Handlers/Post.fs | 108 +++++++++++---------- src/MyWebLog/Handlers/Upload.fs | 22 ++--- src/MyWebLog/Handlers/User.fs | 4 +- 11 files changed, 201 insertions(+), 155 deletions(-) diff --git a/src/MyWebLog.Data/Interfaces.fs b/src/MyWebLog.Data/Interfaces.fs index 4977ea6..d20c41a 100644 --- a/src/MyWebLog.Data/Interfaces.fs +++ b/src/MyWebLog.Data/Interfaces.fs @@ -97,6 +97,9 @@ type IPostData = /// Delete a post abstract member delete : PostId -> WebLogId -> Task + /// Find a post by its ID (excluding revisions and prior permalinks) + abstract member findById : PostId -> WebLogId -> Task + /// Find a post by its permalink (excluding revisions and prior permalinks) abstract member findByPermalink : Permalink -> WebLogId -> Task diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index 58dc53e..af36791 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -454,6 +454,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger 0UL } + member _.findById postId webLogId = + rethink { + withTable Table.Post + get postId + without [ "priorPermalinks"; "revisions" ] + resultOption; withRetryOptionDefault + } + |> verifyWebLog webLogId (fun p -> p.webLogId) <| conn + member _.findByPermalink permalink webLogId = rethink { withTable Table.Post diff --git a/src/MyWebLog.Data/SQLite/SQLitePostData.fs b/src/MyWebLog.Data/SQLite/SQLitePostData.fs index a9e7718..fac16c0 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePostData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePostData.fs @@ -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 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 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 diff --git a/src/MyWebLog/Caches.fs b/src/MyWebLog/Caches.fs index ff50f08..88dce01 100644 --- a/src/MyWebLog/Caches.fs +++ b/src/MyWebLog/Caches.fs @@ -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 diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index 1d4de67..0aad0db 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -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) = 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 () 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 () 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 () - match! data.WebLog.findById webLog.id with +let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { + let data = ctx.Data + let! model = ctx.BindFormAsync () + match! data.WebLog.findById ctx.WebLog.id with | Some webLog -> let oldSlug = webLog.slug let webLog = model.update webLog diff --git a/src/MyWebLog/Handlers/Feed.fs b/src/MyWebLog/Handlers/Feed.fs index e6fd088..23fc381 100644 --- a/src/MyWebLog/Handlers/Feed.fs +++ b/src/MyWebLog/Handlers/Feed.fs @@ -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 () 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 -> diff --git a/src/MyWebLog/Handlers/Helpers.fs b/src/MyWebLog/Handlers/Helpers.fs index 6cd6115..313cf3d 100644 --- a/src/MyWebLog/Handlers/Helpers.fs +++ b/src/MyWebLog/Handlers/Helpers.fs @@ -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 diff --git a/src/MyWebLog/Handlers/Page.fs b/src/MyWebLog/Handlers/Page.fs index 867a86e..23f622a 100644 --- a/src/MyWebLog/Handlers/Page.fs +++ b/src/MyWebLog/Handlers/Page.fs @@ -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 () - 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 () + 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 = $"""
{MarkupText.toHtml rev.text}
""" |} |> 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 () - 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 () + 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 } diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs index 2465e7e..cc506d8 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -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} « 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 () - 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 = $"""
{MarkupText.toHtml rev.text}
""" |} |> 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 () - 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 () + 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 } diff --git a/src/MyWebLog/Handlers/Upload.fs b/src/MyWebLog/Handlers/Upload.fs index 1cec558..91eeefc 100644 --- a/src/MyWebLog/Handlers/Upload.fs +++ b/src/MyWebLog/Handlers/Upload.fs @@ -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 () @@ -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 diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index e762ac2..3702dc5 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -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 () if model.newPassword = model.newPasswordConfirm then let data = ctx.Data