Add access restrictions to server routes (#19)

src/MyWebLog.Data/Interfaces.fs

@@ -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>
     

src/MyWebLog.Data/RethinkDbData.fs

@@ -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

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<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 ()
+        match! findById postId webLogId with
-        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
         | Some post ->
-            let! post = appendPostCategoryTagAndMeta     post
             let! post = appendPostRevisionsAndPermalinks post
             return Some post
-        | None ->
+        | None -> return 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

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

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<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 saveCategory : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
-    let  webLog   = ctx.WebLog
     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 }
+        | "new" -> return Some { Category.empty with id = CategoryId.create (); webLogId = ctx.WebLog.id }
-        | catId -> return! data.Category.findById (CategoryId catId) 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 settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
-    let  webLog   = ctx.WebLog
     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 ctx.WebLog
-            model      = SettingsModel.fromWebLog 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 saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
-    let  webLog = ctx.WebLog
+    let  data  = ctx.Data
-    let  data   = ctx.Data
+    let! model = ctx.BindFormAsync<SettingsModel> ()
-    let! model  = ctx.BindFormAsync<SettingsModel> ()
+    match! data.WebLog.findById ctx.WebLog.id with
-    match! data.WebLog.findById webLog.id with
     | Some webLog ->
         let oldSlug = webLog.slug
         let webLog  = model.update webLog

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 editSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
-    let webLog = ctx.WebLog
     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 ->

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
 

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 all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
-    let  webLog = ctx.WebLog
+    let! pages = ctx.Data.Page.findPageOfPages ctx.WebLog.id pageNbr
-    let! pages  = ctx.Data.Page.findPageOfPages 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 delete pgId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
-    let webLog = ctx.WebLog
+    match! ctx.Data.Page.delete (PageId pgId) ctx.WebLog.id with
-    match! ctx.Data.Page.delete (PageId pgId) 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 savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
-    let  webLog = ctx.WebLog
+    let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
-    let! model  = ctx.BindFormAsync<ManagePermalinksModel> ()
+    let  pageId = PageId model.id
-    let  links  = model.prior |> Array.map Permalink |> List.ofArray
+    match! ctx.Data.Page.findById pageId ctx.WebLog.id with
-    match! ctx.Data.Page.updatePriorPermalinks (PageId model.id) webLog.id links with
+    | Some pg when canEdit pg.authorId ctx ->
-    | true ->
+        let  links = model.prior |> Array.map Permalink |> List.ofArray
-        do! addMessage ctx { UserMessage.success with message = "Page permalinks saved successfully" }
+        match! ctx.Data.Page.updatePriorPermalinks pageId ctx.WebLog.id links with
-        return! redirectToGet $"admin/page/{model.id}/permalinks" next ctx
+        | true ->
-    | false -> return! Error.notFound next ctx
+            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 editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
-    let webLog = ctx.WebLog
+    match! ctx.Data.Page.findFullById (PageId pgId) ctx.WebLog.id with
-    match! ctx.Data.Page.findFullById (PageId pgId) webLog.id with
+    | Some pg when canEdit pg.authorId ctx ->
-    | Some pg ->
         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 purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
-    let webLog = ctx.WebLog
+    let data = ctx.Data
-    let data   = ctx.Data
+    match! data.Page.findFullById (PageId pgId) ctx.WebLog.id with
-    match! data.Page.findFullById (PageId pgId) 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 save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
-    let! model  = ctx.BindFormAsync<EditPageModel> ()
+    let! model = ctx.BindFormAsync<EditPageModel> ()
-    let  webLog = ctx.WebLog
+    let  data  = ctx.Data
-    let  data   = ctx.Data
+    let  now   = DateTime.UtcNow
-    let  now    = DateTime.UtcNow
+    let! pg    = task {
-    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
 }

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  count = ctx.WebLog.postsPerPage
-    let  data   = ctx.Data
+    let  data  = ctx.Data
-    let! posts  = data.Post.findPageOfPublishedPosts webLog.id pageNbr webLog.postsPerPage
+    let! posts = data.Post.findPageOfPublishedPosts ctx.WebLog.id pageNbr count
-    let! hash   = preparePostList webLog posts PostList "" pageNbr webLog.postsPerPage ctx data
+    let! hash  = preparePostList ctx.WebLog posts PostList "" pageNbr count ctx data
-    let  title  =
+    let  title =
-        match pageNbr, webLog.defaultPage with
+        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 all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
-    let  webLog = ctx.WebLog
+    let  data  = ctx.Data
-    let  data   = ctx.Data
+    let! posts = data.Post.findPageOfPosts ctx.WebLog.id pageNbr 25
-    let! posts  = data.Post.findPageOfPosts webLog.id pageNbr 25
+    let! hash  = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 ctx data
-    let! hash   = preparePostList 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 edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
-    let  webLog = ctx.WebLog
     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) ->
+    | Some (title, post) when canEdit post.authorId ctx ->
-        let! cats      = data.Category.findAllForView webLog.id
+        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 delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
-    let webLog = ctx.WebLog
+    match! ctx.Data.Post.delete (PostId postId) ctx.WebLog.id with
-    match! ctx.Data.Post.delete (PostId postId) 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 savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
-    let  webLog = ctx.WebLog
     let! model  = ctx.BindFormAsync<ManagePermalinksModel> ()
-    let  links  = model.prior |> Array.map Permalink |> List.ofArray
+    let  postId = PostId model.id
-    match! ctx.Data.Post.updatePriorPermalinks (PostId model.id) webLog.id links with
+    match! ctx.Data.Post.findById postId ctx.WebLog.id with
-    | true ->
+    | Some post when canEdit post.authorId ctx ->
-        do! addMessage ctx { UserMessage.success with message = "Post permalinks saved successfully" }
+        let  links  = model.prior |> Array.map Permalink |> List.ofArray
-        return! redirectToGet $"admin/post/{model.id}/permalinks" next ctx
+        match! ctx.Data.Post.updatePriorPermalinks (PostId model.id) ctx.WebLog.id links with
-    | false -> return! Error.notFound next ctx
+        | 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 save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
-    let! model  = ctx.BindFormAsync<EditPostModel> ()
+    let! model = ctx.BindFormAsync<EditPostModel> ()
-    let  webLog = ctx.WebLog
+    let  data  = ctx.Data
-    let  data   = ctx.Data
+    let  now   = DateTime.UtcNow
-    let  now    = DateTime.UtcNow
+    let! pst   = task {
-    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
 }

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 ctx.WebLog DateTime.Now
-        let  localNow = WebLog.localTime 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 deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
-    let uploadId = UploadId upId
+    match! ctx.Data.Upload.delete (UploadId upId) ctx.WebLog.id with
-    let webLog   = ctx.WebLog
-    let data     = ctx.Data
-    match! data.Upload.delete uploadId 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

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<EditUserModel> ()
     if model.newPassword = model.newPasswordConfirm then
         let data = ctx.Data