Add access restrictions to server routes (#19)

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

View File

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

View File

@ -454,6 +454,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
return result.Deleted > 0UL 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 = member _.findByPermalink permalink webLogId =
rethink<Post list> { rethink<Post list> {
withTable Table.Post withTable Table.Post

View File

@ -81,6 +81,18 @@ type SQLitePostData (conn : SqliteConnection) =
return { post with revisions = toList Map.toRevision rdr } 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 /// Return a post with no revisions, prior permalinks, or text
let postWithoutText rdr = let postWithoutText rdr =
{ Map.toPost rdr with text = "" } { Map.toPost rdr with text = "" }
@ -270,9 +282,6 @@ type SQLitePostData (conn : SqliteConnection) =
|> ignore |> 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 // IMPLEMENTATION FUNCTIONS
/// Add a post /// Add a post
@ -303,6 +312,15 @@ type SQLitePostData (conn : SqliteConnection) =
return! count cmd 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) /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink permalink webLogId = backgroundTask { let findByPermalink permalink webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
@ -319,17 +337,11 @@ type SQLitePostData (conn : SqliteConnection) =
/// Find a complete post by its ID for the given web log /// Find a complete post by its ID for the given web log
let findFullById postId webLogId = backgroundTask { 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 -> | Some post ->
let! post = appendPostCategoryTagAndMeta post
let! post = appendPostRevisionsAndPermalinks post let! post = appendPostRevisionsAndPermalinks post
return Some post return Some post
| None -> | None -> return None
return None
} }
/// Delete a post by its ID for the given web log /// 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 _.add post = add post
member _.countByStatus status webLogId = countByStatus status webLogId member _.countByStatus status webLogId = countByStatus status webLogId
member _.delete postId webLogId = delete postId webLogId member _.delete postId webLogId = delete postId webLogId
member _.findById postId webLogId = findById postId webLogId
member _.findByPermalink permalink webLogId = findByPermalink permalink webLogId member _.findByPermalink permalink webLogId = findByPermalink permalink webLogId
member _.findCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId member _.findCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
member _.findFullById postId webLogId = findFullById postId webLogId member _.findFullById postId webLogId = findFullById postId webLogId

View File

@ -38,6 +38,12 @@ module Extensions =
| None -> Some "generator not configured" | None -> Some "generator not configured"
generatorString.Value 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 /// The user ID for the current request
member this.UserId = member this.UserId =
WebLogUserId (this.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value WebLogUserId (this.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value

View File

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

View File

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

View File

@ -149,6 +149,16 @@ let validateCsrf : HttpHandler = fun next ctx -> task {
/// Require a user to be logged on /// Require a user to be logged on
let requireUser : HttpHandler = requiresAuthentication Error.notAuthorized 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 System.Collections.Generic
open MyWebLog.Data open MyWebLog.Data

View File

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

View File

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

View File

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

View File

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