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

Add user add/edit (#19)

Browse Source 
- Add makeHash function to simplify code around DotLiquid hashes
- Add context extension to determine if a user has an access level
- Add someTask function to simply Task.FromResult (Some x)
This commit is contained in:
Daniel J. Summers 2022-07-20 23:13:16 -04:00
parent 41ae1d8dad
commit 59f385122b
15 changed files with 523 additions and 292 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -402,7 +402,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
getAll [ webLogId ] (nameof Page.empty.WebLogId)
filter [ nameof Page.empty.IsInPageList, true :> obj ]
without [ nameof Page.empty.Text; nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ]
orderBy "title"
orderBy (nameof Page.empty.Title)
result; withRetryDefault conn
}
@ -725,7 +725,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByIdWithoutText themeId = rethink<Theme> {
withTable Table.Theme
get themeId
merge (fun row -> {| Templates = row[nameof Theme.empty.Templates].Without [| "Text" |] |})
merge (fun row ->
{| Templates = row[nameof Theme.empty.Templates].Without [| nameof ThemeTemplate.empty.Text |]
|})
resultOption; withRetryOptionDefault conn
}
@ -1013,11 +1015,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
withTable Table.WebLogUser
get user.Id
update [
nameof user.FirstName, user.FirstName :> obj
nameof user.Email, user.Email :> obj
nameof user.FirstName, user.FirstName
nameof user.LastName, user.LastName
nameof user.PreferredName, user.PreferredName
nameof user.PasswordHash, user.PasswordHash
nameof user.Salt, user.Salt
nameof user.Url, user.Url
nameof user.AccessLevel, user.AccessLevel
]
write; withRetryDefault; ignoreResult conn

9
src/MyWebLog.Domain/SupportTypes.fs
View File

@ -600,6 +600,15 @@ type ThemeTemplate =
Text : string
}
/// Functions to support theme templates
module ThemeTemplate =
/// An empty theme template
let empty =
{ Name = ""
Text = ""
}
/// Where uploads should be placed
type UploadDestination =

64
src/MyWebLog.Domain/ViewModels.fs
View File

@ -280,6 +280,9 @@ type EditCategoryModel =
ParentId = cat.ParentId |> Option.map CategoryId.toString |> Option.defaultValue ""
}
/// Is this a new category?
member this.IsNew = this.CategoryId = "new"
/// View model to edit a custom RSS feed
[<CLIMutable; NoComparison; NoEquality>]
@ -789,7 +792,7 @@ type EditRssModel =
Copyright = defaultArg rss.Copyright ""
}
/// Update RSS options from values in this mode
/// Update RSS options from values in this model
member this.UpdateOptions (rss : RssOptions) =
{ rss with
IsFeedEnabled = this.IsFeedEnabled
@ -825,6 +828,65 @@ type EditTagMapModel =
}
/// View model to display a user's information
[<CLIMutable; NoComparison; NoEquality>]
type EditUserModel =
{ /// The ID of the user
Id : string
/// The user's access level
AccessLevel : string
/// The user name (e-mail address)
Email : string
/// The URL of the user's personal site
Url : string
/// The user's first name
FirstName : string
/// The user's last name
LastName : string
/// The user's preferred name
PreferredName : string
/// The user's password
Password : string
/// Confirmation of the user's password
PasswordConfirm : string
}
/// Construct a displayed user from a web log user
static member fromUser (user : WebLogUser) =
{ Id = WebLogUserId.toString user.Id
AccessLevel = AccessLevel.toString user.AccessLevel
Url = defaultArg user.Url ""
Email = user.Email
FirstName = user.FirstName
LastName = user.LastName
PreferredName = user.PreferredName
Password = ""
PasswordConfirm = ""
}
/// Is this a new user?
member this.IsNew = this.Id = "new"
/// Update a user with values from this model (excludes password)
member this.UpdateUser (user : WebLogUser) =
{ user with
AccessLevel = AccessLevel.parse this.AccessLevel
Email = this.Email
Url = noneIfBlank this.Url
FirstName = this.FirstName
LastName = this.LastName
PreferredName = this.PreferredName
}
/// The model to use to allow a user to log on
[<CLIMutable; NoComparison; NoEquality>]
type LogOnModel =

5
src/MyWebLog/Caches.fs
View File

@ -51,6 +51,11 @@ module Extensions =
/// The web log for the current request
member this.WebLog = this.Items["webLog"] :?> WebLog
/// Does the current user have the requested level of access?
member this.HasAccessLevel level =
defaultArg (this.UserAccessLevel |> Option.map (AccessLevel.hasAccess level)) false
open System.Collections.Concurrent

6
src/MyWebLog/DotLiquidBespoke.fs
View File

@ -230,9 +230,9 @@ let register () =
typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayCustomFeed>; typeof<DisplayPage>
typeof<DisplayRevision>; typeof<DisplayUpload>; typeof<DisplayUser>; typeof<EditCategoryModel>
typeof<EditCustomFeedModel>; typeof<EditMyInfoModel>; typeof<EditPageModel>; typeof<EditPostModel>
typeof<EditRssModel>; typeof<EditTagMapModel>; typeof<LogOnModel>; typeof<ManagePermalinksModel>
typeof<ManageRevisionsModel>; typeof<PostDisplay>; typeof<PostListItem>; typeof<SettingsModel>
typeof<UserMessage>
typeof<EditRssModel>; typeof<EditTagMapModel>; typeof<EditUserModel>; typeof<LogOnModel>
typeof<ManagePermalinksModel>; typeof<ManageRevisionsModel>; typeof<PostDisplay>; typeof<PostListItem>
typeof<SettingsModel>; typeof<UserMessage>
// Framework types
typeof<AntiforgeryTokenSet>; typeof<DateTime option>; typeof<int option>; typeof<KeyValuePair>
typeof<MetaItem list>; typeof<string list>; typeof<string option>; typeof<TagMap list>

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

@ -2,7 +2,6 @@
module MyWebLog.Handlers.Admin
open System.Threading.Tasks
open DotLiquid
open Giraffe
open MyWebLog
open MyWebLog.ViewModels
@ -19,8 +18,7 @@ let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let topCats = getCount data.Category.CountTopLevel
let! _ = Task.WhenAll (posts, drafts, pages, listed, cats, topCats)
return!
Hash.FromAnonymousObject {|
page_title = "Dashboard"
{| page_title = "Dashboard"
model =
{ Posts = posts.Result
Drafts = drafts.Result
@ -30,7 +28,7 @@ let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
TopLevelCategories = topCats.Result
}
|}
|> adminView "dashboard" next ctx
|> makeHash |> adminView "dashboard" next ctx
}
// -- CATEGORIES --
@ -38,7 +36,7 @@ let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
// GET /admin/categories
let listCategories : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! catListTemplate = TemplateCache.get "admin" "category-list-body" ctx.Data
let hash = Hash.FromAnonymousObject {|
let hash = makeHash {|
page_title = "Categories"
csrf = ctx.CsrfTokenSet
web_log = ctx.WebLog
@ -51,11 +49,10 @@ let listCategories : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
// GET /admin/categories/bare
let listCategoriesBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
Hash.FromAnonymousObject {|
categories = CategoryCache.get ctx
{| categories = CategoryCache.get ctx
csrf = ctx.CsrfTokenSet
|}
|> adminBareView "category-list-body" next ctx
|> makeHash |> adminBareView "category-list-body" next ctx
// GET /admin/category/{id}/edit
@ -70,14 +67,13 @@ let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ct
}
match result with
| Some (title, cat) ->
return!
Hash.FromAnonymousObject {|
return! {|
page_title = title
csrf = ctx.CsrfTokenSet
model = EditCategoryModel.fromCategory cat
categories = CategoryCache.get ctx
|}
|> adminBareView "category-edit" next ctx
|> makeHash |> adminBareView "category-edit" next ctx
| None -> return! Error.notFound next ctx
}
@ -86,19 +82,18 @@ let saveCategory : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
let data = ctx.Data
let! model = ctx.BindFormAsync<EditCategoryModel> ()
let category =
match model.CategoryId with
| "new" -> Task.FromResult (Some { Category.empty with Id = CategoryId.create (); WebLogId = ctx.WebLog.Id })
| catId -> data.Category.FindById (CategoryId catId) ctx.WebLog.Id
if model.IsNew then someTask { Category.empty with Id = CategoryId.create (); WebLogId = ctx.WebLog.Id }
else data.Category.FindById (CategoryId model.CategoryId) ctx.WebLog.Id
match! category with
| Some cat ->
let cat =
let updatedCat =
{ cat with
Name = model.Name
Slug = model.Slug
Description = if model.Description = "" then None else Some model.Description
ParentId = if model.ParentId = "" then None else Some (CategoryId model.ParentId)
}
do! (match model.CategoryId with "new" -> data.Category.Add | _ -> data.Category.Update) cat
do! (if model.IsNew then data.Category.Add else data.Category.Update) updatedCat
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Category saved successfully" }
return! listCategoriesBare next ctx
@ -122,7 +117,7 @@ open Microsoft.AspNetCore.Http
/// Get the hash necessary to render the tag mapping list
let private tagMappingHash (ctx : HttpContext) = task {
let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
return Hash.FromAnonymousObject {|
return makeHash {|
csrf = ctx.CsrfTokenSet
web_log = ctx.WebLog
mappings = mappings
@ -150,17 +145,16 @@ let tagMappingsBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -
let editMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let isNew = tagMapId = "new"
let tagMap =
if isNew then Task.FromResult (Some { TagMap.empty with Id = TagMapId "new" })
if isNew then someTask { TagMap.empty with Id = TagMapId "new" }
else ctx.Data.TagMap.FindById (TagMapId tagMapId) ctx.WebLog.Id
match! tagMap with
| Some tm ->
return!
Hash.FromAnonymousObject {|
return! {|
page_title = if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag"
csrf = ctx.CsrfTokenSet
model = EditTagMapModel.fromMapping tm
|}
|> adminBareView "tag-mapping-edit" next ctx
|> makeHash |> adminBareView "tag-mapping-edit" next ctx
| None -> return! Error.notFound next ctx
}
@ -169,8 +163,7 @@ let saveMapping : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta
let data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel> ()
let tagMap =
if model.IsNew then
Task.FromResult (Some { TagMap.empty with Id = TagMapId.create (); WebLogId = ctx.WebLog.Id })
if model.IsNew then someTask { TagMap.empty with Id = TagMapId.create (); WebLogId = ctx.WebLog.Id }
else data.TagMap.FindById (TagMapId model.Id) ctx.WebLog.Id
match! tagMap with
| Some tm ->
@ -198,11 +191,10 @@ open MyWebLog.Data
// GET /admin/theme/update
let themeUpdatePage : HttpHandler = requireAccess Administrator >=> fun next ctx ->
Hash.FromAnonymousObject {|
page_title = "Upload Theme"
{| page_title = "Upload Theme"
csrf = ctx.CsrfTokenSet
|}
|> adminView "upload-theme" next ctx
|> makeHash |> adminView "upload-theme" next ctx
/// Update the name and version for a theme based on the version.txt file, if present
let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = backgroundTask {
@ -311,8 +303,7 @@ let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task
let data = ctx.Data
let! allPages = data.Page.All ctx.WebLog.Id
let! themes = data.Theme.All ()
return!
Hash.FromAnonymousObject {|
return! {|
page_title = "Web Log Settings"
csrf = ctx.CsrfTokenSet
model = SettingsModel.fromWebLog ctx.WebLog
@ -333,7 +324,7 @@ let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task
KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
|]
|}
|> adminView "settings" next ctx
|> makeHash |> adminView "settings" next ctx
}
// POST /admin/settings

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

@ -414,23 +414,20 @@ let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> bac
// ~~ FEED ADMINISTRATION ~~
open DotLiquid
// GET: /admin/settings/rss
// GET /admin/settings/rss
let editSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let feeds =
ctx.WebLog.Rss.CustomFeeds
|> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx))
|> Array.ofList
Hash.FromAnonymousObject {|
page_title = "RSS Settings"
{| page_title = "RSS Settings"
csrf = ctx.CsrfTokenSet
model = EditRssModel.fromRssOptions ctx.WebLog.Rss
custom_feeds = feeds
|}
|> adminView "rss-settings" next ctx
|> makeHash |> adminView "rss-settings" next ctx
// POST: /admin/settings/rss
// POST /admin/settings/rss
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditRssModel> ()
@ -444,7 +441,7 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
| None -> return! Error.notFound next ctx
}
// GET: /admin/settings/rss/{id}/edit
// GET /admin/settings/rss/{id}/edit
let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let customFeed =
match feedId with
@ -452,8 +449,7 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
| _ -> ctx.WebLog.Rss.CustomFeeds |> List.tryFind (fun f -> f.Id = CustomFeedId feedId)
match customFeed with
| Some f ->
Hash.FromAnonymousObject {|
page_title = $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
{| page_title = $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
csrf = ctx.CsrfTokenSet
model = EditCustomFeedModel.fromFeed f
categories = CategoryCache.get ctx
@ -468,10 +464,10 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
KeyValuePair.Create (PodcastMedium.toString Blog, "Blog")
|]
|}
|> adminView "custom-feed-edit" next ctx
|> makeHash |> adminView "custom-feed-edit" next ctx
| None -> Error.notFound next ctx
// POST: /admin/settings/rss/save
// POST /admin/settings/rss/save
let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLog.FindById ctx.WebLog.Id with

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

@ -52,9 +52,14 @@ let messages (ctx : HttpContext) = task {
| None -> return [||]
}
open System.Collections.Generic
open MyWebLog
open DotLiquid
let makeHash (values : obj) =
Hash.FromAnonymousObject values
/// Add a key to the hash, returning the modified hash
// (note that the hash itself is mutated; this is only used to make it pipeable)
let addToHash key (value : obj) (hash : Hash) =
@ -74,9 +79,6 @@ let private populateHash hash ctx = task {
let! messages = messages ctx
do! commitSession ctx
let accessLevel = ctx.UserAccessLevel
let hasLevel lvl = accessLevel |> Option.map (AccessLevel.hasAccess lvl) |> Option.defaultValue false
ctx.User.Claims
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.NameIdentifier)
|> Option.map (fun claim -> claim.Value)
@ -90,10 +92,10 @@ let private populateHash hash ctx = task {
|> addToHash "generator" ctx.Generator
|> addToHash "htmx_script" htmxScript
|> addToHash "is_logged_on" ctx.User.Identity.IsAuthenticated
|> addToHash "is_author" (hasLevel Author)
|> addToHash "is_editor" (hasLevel Editor)
|> addToHash "is_web_log_admin" (hasLevel WebLogAdmin)
|> addToHash "is_administrator" (hasLevel Administrator)
|> addToHash "is_author" (ctx.HasAccessLevel Author)
|> addToHash "is_editor" (ctx.HasAccessLevel Editor)
|> addToHash "is_web_log_admin" (ctx.HasAccessLevel WebLogAdmin)
|> addToHash "is_administrator" (ctx.HasAccessLevel Administrator)
}
/// Is the request from htmx?
@ -215,25 +217,29 @@ let requireUser : HttpHandler = requiresAuthentication Error.notAuthorized
/// Require a specific level of access for a route
let requireAccess level : HttpHandler = fun next ctx -> task {
let userLevel = ctx.UserAccessLevel
if defaultArg (userLevel |> Option.map (AccessLevel.hasAccess level)) false then
return! next ctx
else
let message =
match userLevel with
| Some lvl ->
$"The page you tried to access requires {AccessLevel.toString level} privileges; your account only has {AccessLevel.toString lvl} privileges"
| None -> "The page you tried to access required you to be logged on"
do! addMessage ctx { UserMessage.warning with Message = message }
printfn "Added message to context"
do! commitSession ctx
match ctx.UserAccessLevel with
| Some userLevel when AccessLevel.hasAccess level userLevel -> return! next ctx
| Some userLevel ->
do! addMessage ctx
{ UserMessage.warning with
Message = $"The page you tried to access requires {AccessLevel.toString level} privileges"
Detail = Some $"Your account only has {AccessLevel.toString userLevel} privileges"
}
return! Error.notAuthorized next ctx
| None ->
do! addMessage ctx
{ UserMessage.warning with Message = "The page you tried to access required you to be logged on" }
return! 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
ctx.UserId = authorId || ctx.HasAccessLevel Editor
open System.Threading.Tasks
/// Create a Task with a Some result for the given object
let someTask<'T> (it : 'T) = Task.FromResult (Some it)
open System.Collections.Generic
open MyWebLog.Data

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

@ -1,7 +1,6 @@
/// Handlers to manipulate pages
module MyWebLog.Handlers.Page
open DotLiquid
open Giraffe
open MyWebLog
open MyWebLog.ViewModels
@ -10,8 +9,7 @@ open MyWebLog.ViewModels
// GET /admin/pages/page/{pageNbr}
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! pages = ctx.Data.Page.FindPageOfPages ctx.WebLog.Id pageNbr
return!
Hash.FromAnonymousObject {|
return! {|
page_title = "Pages"
csrf = ctx.CsrfTokenSet
pages = pages |> List.map (DisplayPage.fromPageMinimal ctx.WebLog)
@ -19,7 +17,7 @@ let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
prev_page = if pageNbr = 2 then "" else $"/page/{pageNbr - 1}"
next_page = $"/page/{pageNbr + 1}"
|}
|> adminView "page-list" next ctx
|> makeHash |> adminView "page-list" next ctx
}
// GET /admin/page/{id}/edit
@ -36,8 +34,7 @@ let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
| Some (title, page) when canEdit page.AuthorId ctx ->
let model = EditPageModel.fromPage page
let! templates = templatesForTheme ctx "page"
return!
Hash.FromAnonymousObject {|
return! {|
page_title = title
csrf = ctx.CsrfTokenSet
model = model
@ -45,7 +42,7 @@ let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
templates = templates
|}
|> adminView "page-edit" next ctx
|> makeHash |> adminView "page-edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
@ -64,13 +61,12 @@ let delete pgId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta
let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
Hash.FromAnonymousObject {|
return! {|
page_title = "Manage Prior Permalinks"
csrf = ctx.CsrfTokenSet
model = ManagePermalinksModel.fromPage pg
|}
|> adminView "permalinks" next ctx
|> makeHash |> adminView "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
@ -95,13 +91,12 @@ let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task
let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
Hash.FromAnonymousObject {|
return! {|
page_title = "Manage Page Revisions"
csrf = ctx.CsrfTokenSet
model = ManageRevisionsModel.fromPage ctx.WebLog pg
|}
|> adminView "revisions" next ctx
|> makeHash |> adminView "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
@ -132,11 +127,10 @@ let private findPageRevision pgId revDate (ctx : HttpContext) = task {
let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
return!
Hash.FromAnonymousObject {|
return! {|
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.Text}</div>"""
|}
|> adminBareView "" next ctx
|> makeHash |> adminBareView "" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
@ -166,34 +160,31 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
| 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! adminBareView "" next ctx (Hash.FromAnonymousObject {| content = "" |})
return! adminBareView "" next ctx (makeHash {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
open System.Threading.Tasks
// POST /admin/page/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> ()
let data = ctx.Data
let now = DateTime.UtcNow
let tryPage =
if model.IsNew then Task.FromResult (
Some
if model.IsNew then
{ Page.empty with
Id = PageId.create ()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
PublishedOn = now
})
} |> someTask
else data.Page.FindFullById (PageId model.PageId) ctx.WebLog.Id
match! tryPage with
| Some page when canEdit page.AuthorId ctx ->
let updateList = page.IsInPageList <> model.IsShownInPageList
let updatedPage = model.UpdatePage page now
do! (if model.PageId = "new" then data.Page.Add else data.Page.Update) updatedPage
do! (if model.IsNew then data.Page.Add else data.Page.Update) updatedPage
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

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

@ -35,7 +35,6 @@ type ListType =
| TagList
open System.Threading.Tasks
open DotLiquid
open MyWebLog.Data
open MyWebLog.ViewModels
@ -86,7 +85,7 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (da
OlderLink = olderLink
OlderName = olderPost |> Option.map (fun p -> p.Title)
}
return Hash.FromAnonymousObject {|
return makeHash {|
model = model
categories = CategoryCache.get ctx
tag_mappings = tagMappings
@ -197,14 +196,13 @@ let home : HttpHandler = fun next ctx -> task {
| pageId ->
match! ctx.Data.Page.FindById (PageId pageId) webLog.Id with
| Some page ->
return!
Hash.FromAnonymousObject {|
return! {|
page_title = page.Title
page = DisplayPage.fromPage webLog page
categories = CategoryCache.get ctx
is_home = true
|}
|> themedView (defaultArg page.Template "single-page") next ctx
|> makeHash |> themedView (defaultArg page.Template "single-page") next ctx
| None -> return! Error.notFound next ctx
}
@ -236,8 +234,7 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! cats = data.Category.FindAllForView ctx.WebLog.Id
let! templates = templatesForTheme ctx "post"
let model = EditPostModel.fromPost ctx.WebLog post
return!
Hash.FromAnonymousObject {|
return! {|
page_title = title
csrf = ctx.CsrfTokenSet
model = model
@ -252,7 +249,7 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
KeyValuePair.Create (ExplicitRating.toString Clean, "Clean")
|]
|}
|> adminView "post-edit" next ctx
|> makeHash |> adminView "post-edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
@ -269,13 +266,12 @@ let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
Hash.FromAnonymousObject {|
return! {|
page_title = "Manage Prior Permalinks"
csrf = ctx.CsrfTokenSet
model = ManagePermalinksModel.fromPost post
|}
|> adminView "permalinks" next ctx
|> makeHash |> adminView "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
@ -300,13 +296,12 @@ let savePermalinks : HttpHandler = requireAccess Author >=> 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 when canEdit post.AuthorId ctx ->
return!
Hash.FromAnonymousObject {|
return! {|
page_title = "Manage Post Revisions"
csrf = ctx.CsrfTokenSet
model = ManageRevisionsModel.fromPost ctx.WebLog post
|}
|> adminView "revisions" next ctx
|> makeHash |> adminView "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
@ -338,11 +333,10 @@ let private findPostRevision postId revDate (ctx : HttpContext) = task {
let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
return!
Hash.FromAnonymousObject {|
return! {|
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.Text}</div>"""
|}
|> adminBareView "" next ctx
|> makeHash |> adminBareView "" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
@ -370,7 +364,7 @@ let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fu
| 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! adminBareView "" next ctx (Hash.FromAnonymousObject {| content = "" |})
return! adminBareView "" next ctx (makeHash {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
@ -382,13 +376,12 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
let now = DateTime.UtcNow
let tryPost =
if model.IsNew then Task.FromResult (
Some
if model.IsNew then
{ Post.empty with
Id = PostId.create ()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
})
} |> someTask
else data.Post.FindFullById (PostId model.PostId) ctx.WebLog.Id
match! tryPost with
| Some post when canEdit post.AuthorId ctx ->

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

@ -8,7 +8,6 @@ open MyWebLog
/// Module to resolve routes that do not match any other known route (web blog content)
module CatchAll =
open DotLiquid
open MyWebLog.ViewModels
/// Sequence where the first returned value is the proper handler for the link
@ -30,22 +29,23 @@ module CatchAll =
match data.Post.FindByPermalink permalink webLog.Id |> await with
| Some post ->
debug (fun () -> "Found post by permalink")
let model = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 ctx data |> await
model.Add ("page_title", post.Title)
yield fun next ctx -> themedView (defaultArg post.Template "single-post") next ctx model
let hash = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 ctx data |> await
yield fun next ctx ->
addToHash "page_title" post.Title hash
|> themedView (defaultArg post.Template "single-post") next ctx
| None -> ()
// Current page
match data.Page.FindByPermalink permalink webLog.Id |> await with
| Some page ->
debug (fun () -> "Found page by permalink")
yield fun next ctx ->
Hash.FromAnonymousObject {|
{|
page_title = page.Title
page = DisplayPage.fromPage webLog page
categories = CategoryCache.get ctx
is_page = true
|}
|> themedView (defaultArg page.Template "single-page") next ctx
|> makeHash |> themedView (defaultArg page.Template "single-page") next ctx
| None -> ()
// RSS feed
match Feed.deriveFeedType ctx textLink with
@ -150,7 +150,9 @@ let router : HttpHandler = choose [
])
subRoute "/user" (choose [
route "s" >=> User.all
route "s/bare" >=> User.bare
route "/my-info" >=> User.myInfo
routef "/%s/edit" User.edit
])
]
POST >=> validateCsrf >=> choose [
@ -194,6 +196,7 @@ let router : HttpHandler = choose [
])
subRoute "/user" (choose [
route "/my-info" >=> User.saveMyInfo
route "/save" >=> User.save
])
]
])

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

@ -3,10 +3,7 @@ module MyWebLog.Handlers.Upload
open System
open System.IO
open Giraffe
open Microsoft.AspNetCore.Http
open Microsoft.Net.Http.Headers
open MyWebLog
/// Helper functions for this module
[<AutoOpen>]
@ -30,6 +27,11 @@ module private Helpers =
let uploadDir = Path.Combine ("wwwroot", "upload")
// ~~ SERVING UPLOADS ~~
open Giraffe
open Microsoft.AspNetCore.Http
/// Determine if the file has been modified since the date/time specified by the If-Modified-Since header
let checkModified since (ctx : HttpContext) : HttpHandler option =
match ctx.Request.Headers.IfModifiedSince with
@ -53,6 +55,8 @@ let sendFile updatedOn path (data : byte[]) : HttpHandler = fun next ctx ->
streamData true stream None (Some (DateTimeOffset updatedOn)) next ctx
open MyWebLog
// GET /upload/{web-log-slug}/{**path}
let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
@ -75,10 +79,9 @@ let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
return! Error.notFound next ctx
}
// ADMIN
// ~~ ADMINISTRATION ~~
open System.Text.RegularExpressions
open DotLiquid
open MyWebLog.ViewModels
/// Turn a string into a lowercase URL-safe slug
@ -116,23 +119,21 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> List.append diskUploads
|> List.sortByDescending (fun file -> file.UpdatedOn, file.Path)
return!
Hash.FromAnonymousObject {|
return! {|
page_title = "Uploaded Files"
csrf = ctx.CsrfTokenSet
files = allFiles
|}
|> adminView "upload-list" next ctx
}
|> makeHash |> adminView "upload-list" next ctx
}
// GET /admin/upload/new
let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
Hash.FromAnonymousObject {|
page_title = "Upload a File"
{| page_title = "Upload a File"
csrf = ctx.CsrfTokenSet
destination = UploadDestination.toString ctx.WebLog.Uploads
|}
|> adminView "upload-new" next ctx
|> makeHash |> adminView "upload-new" next ctx
/// Redirect to the upload list

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

@ -13,7 +13,6 @@ let hashedPassword (plainText : string) (email : string) (salt : Guid) =
use alg = new Rfc2898DeriveBytes (plainText, allSalt, 2_048)
Convert.ToBase64String (alg.GetBytes 64)
open DotLiquid
open Giraffe
open MyWebLog
open MyWebLog.ViewModels
@ -24,12 +23,11 @@ let logOn returnUrl : HttpHandler = fun next ctx ->
match returnUrl with
| Some _ -> returnUrl
| None -> if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None
Hash.FromAnonymousObject {|
page_title = "Log On"
{| page_title = "Log On"
csrf = ctx.CsrfTokenSet
model = { LogOnModel.empty with ReturnTo = returnTo }
|}
|> adminView "log-on" next ctx
|> makeHash |> adminView "log-on" next ctx
open System.Security.Claims
@ -73,22 +71,100 @@ let logOff : HttpHandler = fun next ctx -> task {
// ~~ ADMINISTRATION ~~
// GET /admin/users
let all : HttpHandler = fun next ctx -> task {
let data = ctx.Data
let! tmpl = TemplateCache.get "admin" "user-list-body" data
let! users = data.WebLogUser.FindByWebLog ctx.WebLog.Id
let hash = Hash.FromAnonymousObject {|
open System.Collections.Generic
open DotLiquid
open Giraffe.Htmx
open Microsoft.AspNetCore.Http
/// Create the hash needed to display the user list
let private userListHash (ctx : HttpContext) = task {
let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id
return makeHash {|
page_title = "User Administration"
csrf = ctx.CsrfTokenSet
web_log = ctx.WebLog
users = users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList
|}
}
// GET /admin/users
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash = userListHash ctx
let! tmpl = TemplateCache.get "admin" "user-list-body" ctx.Data
return!
addToHash "user_list" (tmpl.Render hash) hash
|> adminView "user-list" next ctx
}
// GET /admin/users/bare
let bare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash = userListHash ctx
return! adminBareView "user-list-body" next ctx hash
}
/// Show the edit user page
let private showEdit (hash : Hash) : HttpHandler = fun next ctx ->
addToHash "page_title" (if (hash["model"] :?> EditUserModel).IsNew then "Add a New User" else "Edit User") hash
|> addToHash "csrf" ctx.CsrfTokenSet
|> addToHash "access_levels"
[| KeyValuePair.Create (AccessLevel.toString Author, "Author")
KeyValuePair.Create (AccessLevel.toString Editor, "Editor")
KeyValuePair.Create (AccessLevel.toString WebLogAdmin, "Web Log Admin")
if ctx.HasAccessLevel Administrator then
KeyValuePair.Create (AccessLevel.toString Administrator, "Administrator")
|]
|> adminBareView "user-edit" next ctx
// GET /admin/user/{id}/edit
let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let isNew = usrId = "new"
let userId = WebLogUserId usrId
let tryUser =
if isNew then someTask { WebLogUser.empty with Id = userId }
else ctx.Data.WebLogUser.FindById userId ctx.WebLog.Id
match! tryUser with
| Some user -> return! showEdit (makeHash {| model = EditUserModel.fromUser user |}) next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/user/save
let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel> ()
let data = ctx.Data
let tryUser =
if model.IsNew then
{ WebLogUser.empty with
Id = WebLogUserId.create ()
WebLogId = ctx.WebLog.Id
CreatedOn = DateTime.UtcNow
} |> someTask
else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
match! tryUser with
| Some user when model.Password = model.PasswordConfirm ->
let updatedUser = model.UpdateUser user
if updatedUser.AccessLevel = Administrator && not (ctx.HasAccessLevel Administrator) then
return! RequestErrors.BAD_REQUEST "really?" next ctx
else
let updatedUser =
if model.Password = "" then updatedUser
else
let salt = Guid.NewGuid ()
{ updatedUser with PasswordHash = hashedPassword model.Password model.Email salt; Salt = salt }
do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) updatedUser
do! addMessage ctx
{ UserMessage.success with
Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully"""
}
return! bare next ctx
| Some _ ->
do! addMessage ctx { UserMessage.error with Message = "The passwords did not match; nothing saved" }
return!
(withHxRetarget $"#user_{model.Id}"
>=> showEdit (makeHash {| model = { model with Password = ""; PasswordConfirm = "" } |}))
next ctx
| None -> return! Error.notFound next ctx
}
/// Display the user "my info" page, with information possibly filled in
let private showMyInfo (user : WebLogUser) (hash : Hash) : HttpHandler = fun next ctx ->
addToHash "page_title" "Edit Your Information" hash
@ -102,7 +178,7 @@ let private showMyInfo (user : WebLogUser) (hash : Hash) : HttpHandler = fun nex
// GET /admin/user/my-info
let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user -> return! showMyInfo user (Hash.FromAnonymousObject {| model = EditMyInfoModel.fromUser user |}) next ctx
| Some user -> return! showMyInfo user (makeHash {| model = EditMyInfoModel.fromUser user |}) next ctx
| None -> return! Error.notFound next ctx
}
@ -132,8 +208,7 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
return! redirectToGet "admin/user/my-info" next ctx
| Some user ->
do! addMessage ctx { UserMessage.error with Message = "Passwords did not match; no updates made" }
return! showMyInfo user (Hash.FromAnonymousObject {|
model = { model with NewPassword = ""; NewPasswordConfirm = "" }
|}) next ctx
return! showMyInfo user (makeHash {| model = { model with NewPassword = ""; NewPasswordConfirm = "" } |})
next ctx
| None -> return! Error.notFound next ctx
}

4
src/MyWebLog/Maintenance.fs
View File

@ -305,8 +305,8 @@ module Backup =
let! uploads = data.Upload.FindByWebLogWithData webLog.Id
printfn "- Writing archive..."
let archive = {
WebLog = webLog
let archive =
{ WebLog = webLog
Users = users
Theme = Option.get theme
Assets = assets |> List.map EncodedAsset.fromAsset

95
src/admin-theme/user-edit.liquid Normal file
View File

@ -0,0 +1,95 @@
<div class="col-12">
<h5 class="my-3">{{ page_title }}</h5>
<form hx-post="{{ "admin/user/save" | relative_link }}" method="post" class="container"
hx-target="#userList" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="Id" value="{{ model.id }}">
<div class="row">
<div class="col-12 col-md-5 col-lg-3 col-xxl-2 offset-xxl-1 mb-3">
<div class="form-floating">
<select name="AccessLevel" id="accessLevel" class="form-control" required>
{%- for level in access_levels %}
<option value="{{ level[0] }}"{% if model.access_level == level[0] %} selected{% endif %}>
{{ level[1] }}
</option>
{%- endfor %}
</select>
<label for="accessLevel">Access Level</label>
</div>
</div>
<div class="col-12 col-md-7 col-lg-4 col-xxl-3 mb-3">
<div class="form-floating">
<input type="email" name="Email" id="email" class="form-control" placeholder="E-mail" required
value="{{ model.email | escape }}">
<label for="email">E-mail Address</label>
</div>
</div>
<div class="col-12 col-lg-5 mb-3">
<div class="form-floating">
<input type="text" name="Url" id="url" class="form-control" placeholder="URL"
value="{{ model.url | escape }}">
<label for="url">User&rsquo;s Personal URL</label>
</div>
</div>
</div>
<div class="row mb-3">
<div class="col-12 col-md-6 col-lg-4 col-xl-3 offset-xl-1 pb-3">
<div class="form-floating">
<input type="text" name="FirstName" id="firstName" class="form-control" placeholder="First" required
value="{{ model.first_name | escape }}">
<label for="firstName">First Name</label>
</div>
</div>
<div class="col-12 col-md-6 col-lg-4 col-xl-3 pb-3">
<div class="form-floating">
<input type="text" name="LastName" id="lastName" class="form-control" placeholder="Last" required
value="{{ model.last_name | escape }}">
<label for="lastName">Last Name</label>
</div>
</div>
<div class="col-12 col-md-6 offset-md-3 col-lg-4 offset-lg-0 col-xl-3 offset-xl-1 pb-3">
<div class="form-floating">
<input type="text" name="PreferredName" id="preferredName" class="form-control"
placeholder="Preferred" required value="{{ model.preferred_name | escape }}">
<label for="preferredName">Preferred Name</label>
</div>
</div>
</div>
<div class="row mb-3">
<div class="col-12 col-xl-10 offset-xl-1">
<fieldset class="p-2">
<legend class="ps-1">{% unless model.is_new %}Change {% endunless %}Password</legend>
{% unless model.is_new %}
<div class="row">
<div class="col">
<p class="form-text">Optional; leave blank not change the user&rsquo;s password</p>
</div>
</div>
{% endunless %}
<div class="row">
<div class="col-12 col-md-6 pb-3">
<div class="form-floating">
<input type="password" name="Password" id="password" class="form-control"
placeholder="Password"{% if model.is_new %} required{% endif %}>
<label for="password">{% unless model.is_new %}New {% endunless %}Password</label>
</div>
</div>
<div class="col-12 col-md-6 pb-3">
<div class="form-floating">
<input type="password" name="PasswordConfirm" id="passwordConfirm" class="form-control"
placeholder="Confirm"{% if model.is_new %} required{% endif %}>
<label for="passwordConfirm">Confirm{% unless model.is_new %} New{% endunless %} Password</label>
</div>
</div>
</div>
</fieldset>
</div>
</div>
<div class="row mb-3">
<div class="col text-center">
<button type="submit" class="btn btn-sm btn-primary">Save Changes</button>
<a href="{{ "admin/users/bare" | relative_link }}" class="btn btn-sm btn-secondary ms-3">Cancel</a>
</div>
</div>
</form>
</div>