Add user add/edit (#19)
- 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:
parent
41ae1d8dad
commit
59f385122b
|
@ -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
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -279,6 +279,9 @@ type EditCategoryModel =
|
|||
Description = defaultArg cat.Description ""
|
||||
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
|
||||
|
@ -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 =
|
||||
|
|
|
@ -50,6 +50,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
|
||||
|
|
|
@ -227,12 +227,12 @@ let register () =
|
|||
typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>; typeof<MetaItem>; typeof<Page>
|
||||
typeof<RssOptions>; typeof<TagMap>; typeof<UploadDestination>; typeof<WebLog>
|
||||
// View models
|
||||
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<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<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>
|
||||
|
|
|
@ -2,7 +2,6 @@
|
|||
module MyWebLog.Handlers.Admin
|
||||
|
||||
open System.Threading.Tasks
|
||||
open DotLiquid
|
||||
open Giraffe
|
||||
open MyWebLog
|
||||
open MyWebLog.ViewModels
|
||||
|
@ -19,18 +18,17 @@ 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
|
||||
Pages = pages.Result
|
||||
ListedPages = listed.Result
|
||||
Categories = cats.Result
|
||||
TopLevelCategories = topCats.Result
|
||||
{ Posts = posts.Result
|
||||
Drafts = drafts.Result
|
||||
Pages = pages.Result
|
||||
ListedPages = listed.Result
|
||||
Categories = cats.Result
|
||||
TopLevelCategories = topCats.Result
|
||||
}
|
||||
|}
|
||||
|> adminView "dashboard" next ctx
|
||||
|> makeHash |> adminView "dashboard" next ctx
|
||||
}
|
||||
|
||||
// -- CATEGORIES --
|
||||
|
@ -38,24 +36,23 @@ 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
|
||||
categories = CategoryCache.get ctx
|
||||
|}
|
||||
return!
|
||||
addToHash "category_list" (catListTemplate.Render hash) hash
|
||||
|> adminView "category-list" next ctx
|
||||
addToHash "category_list" (catListTemplate.Render hash) hash
|
||||
|> adminView "category-list" 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 {|
|
||||
page_title = title
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = EditCategoryModel.fromCategory cat
|
||||
categories = CategoryCache.get ctx
|
||||
|}
|
||||
|> adminBareView "category-edit" next ctx
|
||||
return! {|
|
||||
page_title = title
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = EditCategoryModel.fromCategory cat
|
||||
categories = CategoryCache.get 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 {|
|
||||
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
|
||||
return! {|
|
||||
page_title = if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = EditTagMapModel.fromMapping tm
|
||||
|}
|
||||
|> 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,29 +303,28 @@ 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 {|
|
||||
page_title = "Web Log Settings"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = SettingsModel.fromWebLog ctx.WebLog
|
||||
pages = seq
|
||||
{ KeyValuePair.Create ("posts", "- First Page of Posts -")
|
||||
yield! allPages
|
||||
|> List.sortBy (fun p -> p.Title.ToLower ())
|
||||
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.Id, p.Title))
|
||||
}
|
||||
|> Array.ofSeq
|
||||
themes =
|
||||
themes
|
||||
|> Seq.ofList
|
||||
|> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.Id, $"{it.Name} (v{it.Version})"))
|
||||
|> Array.ofSeq
|
||||
upload_values = [|
|
||||
KeyValuePair.Create (UploadDestination.toString Database, "Database")
|
||||
KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
|
||||
|]
|
||||
|}
|
||||
|> adminView "settings" next ctx
|
||||
return! {|
|
||||
page_title = "Web Log Settings"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = SettingsModel.fromWebLog ctx.WebLog
|
||||
pages = seq
|
||||
{ KeyValuePair.Create ("posts", "- First Page of Posts -")
|
||||
yield! allPages
|
||||
|> List.sortBy (fun p -> p.Title.ToLower ())
|
||||
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.Id, p.Title))
|
||||
}
|
||||
|> Array.ofSeq
|
||||
themes =
|
||||
themes
|
||||
|> Seq.ofList
|
||||
|> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.Id, $"{it.Name} (v{it.Version})"))
|
||||
|> Array.ofSeq
|
||||
upload_values = [|
|
||||
KeyValuePair.Create (UploadDestination.toString Database, "Database")
|
||||
KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
|
||||
|]
|
||||
|}
|
||||
|> makeHash |> adminView "settings" next ctx
|
||||
}
|
||||
|
||||
// POST /admin/settings
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
/// Handlers to manipulate pages
|
||||
module MyWebLog.Handlers.Page
|
||||
|
||||
open DotLiquid
|
||||
open Giraffe
|
||||
open MyWebLog
|
||||
open MyWebLog.ViewModels
|
||||
|
@ -10,16 +9,15 @@ 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 {|
|
||||
page_title = "Pages"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
pages = pages |> List.map (DisplayPage.fromPageMinimal ctx.WebLog)
|
||||
page_nbr = pageNbr
|
||||
prev_page = if pageNbr = 2 then "" else $"/page/{pageNbr - 1}"
|
||||
next_page = $"/page/{pageNbr + 1}"
|
||||
|}
|
||||
|> adminView "page-list" next ctx
|
||||
return! {|
|
||||
page_title = "Pages"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
pages = pages |> List.map (DisplayPage.fromPageMinimal ctx.WebLog)
|
||||
page_nbr = pageNbr
|
||||
prev_page = if pageNbr = 2 then "" else $"/page/{pageNbr - 1}"
|
||||
next_page = $"/page/{pageNbr + 1}"
|
||||
|}
|
||||
|> makeHash |> adminView "page-list" next ctx
|
||||
}
|
||||
|
||||
// GET /admin/page/{id}/edit
|
||||
|
@ -36,16 +34,15 @@ 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 {|
|
||||
page_title = title
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = model
|
||||
metadata = Array.zip model.MetaNames model.MetaValues
|
||||
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
|
||||
templates = templates
|
||||
|}
|
||||
|> adminView "page-edit" next ctx
|
||||
return! {|
|
||||
page_title = title
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = model
|
||||
metadata = Array.zip model.MetaNames model.MetaValues
|
||||
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
|
||||
templates = templates
|
||||
|}
|
||||
|> makeHash |> adminView "page-edit" next ctx
|
||||
| Some _ -> return! Error.notAuthorized next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
@ -64,20 +61,19 @@ 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 {|
|
||||
page_title = "Manage Prior Permalinks"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = ManagePermalinksModel.fromPage pg
|
||||
|}
|
||||
|> adminView "permalinks" next ctx
|
||||
return! {|
|
||||
page_title = "Manage Prior Permalinks"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = ManagePermalinksModel.fromPage pg
|
||||
|}
|
||||
|> makeHash |> adminView "permalinks" next ctx
|
||||
| Some _ -> return! Error.notAuthorized next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// POST /admin/page/permalinks
|
||||
let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||
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 ->
|
||||
|
@ -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 {|
|
||||
page_title = "Manage Page Revisions"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = ManageRevisionsModel.fromPage ctx.WebLog pg
|
||||
|}
|
||||
|> adminView "revisions" next ctx
|
||||
return! {|
|
||||
page_title = "Manage Page Revisions"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = ManageRevisionsModel.fromPage ctx.WebLog pg
|
||||
|}
|
||||
|> 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 {|
|
||||
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.Text}</div>"""
|
||||
|}
|
||||
|> adminBareView "" next ctx
|
||||
return! {|
|
||||
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.Text}</div>"""
|
||||
|}
|
||||
|> 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
|
||||
{ Page.empty with
|
||||
Id = PageId.create ()
|
||||
WebLogId = ctx.WebLog.Id
|
||||
AuthorId = ctx.UserId
|
||||
PublishedOn = now
|
||||
})
|
||||
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,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 {|
|
||||
page_title = page.Title
|
||||
page = DisplayPage.fromPage webLog page
|
||||
categories = CategoryCache.get ctx
|
||||
is_home = true
|
||||
|}
|
||||
|> themedView (defaultArg page.Template "single-page") next ctx
|
||||
return! {|
|
||||
page_title = page.Title
|
||||
page = DisplayPage.fromPage webLog page
|
||||
categories = CategoryCache.get ctx
|
||||
is_home = true
|
||||
|}
|
||||
|> makeHash |> themedView (defaultArg page.Template "single-page") next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
|
@ -236,23 +234,22 @@ 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 {|
|
||||
page_title = title
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = model
|
||||
metadata = Array.zip model.MetaNames model.MetaValues
|
||||
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
|
||||
templates = templates
|
||||
categories = cats
|
||||
explicit_values = [|
|
||||
KeyValuePair.Create ("", "– Default –")
|
||||
KeyValuePair.Create (ExplicitRating.toString Yes, "Yes")
|
||||
KeyValuePair.Create (ExplicitRating.toString No, "No")
|
||||
KeyValuePair.Create (ExplicitRating.toString Clean, "Clean")
|
||||
|]
|
||||
|}
|
||||
|> adminView "post-edit" next ctx
|
||||
return! {|
|
||||
page_title = title
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = model
|
||||
metadata = Array.zip model.MetaNames model.MetaValues
|
||||
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
|
||||
templates = templates
|
||||
categories = cats
|
||||
explicit_values = [|
|
||||
KeyValuePair.Create ("", "– Default –")
|
||||
KeyValuePair.Create (ExplicitRating.toString Yes, "Yes")
|
||||
KeyValuePair.Create (ExplicitRating.toString No, "No")
|
||||
KeyValuePair.Create (ExplicitRating.toString Clean, "Clean")
|
||||
|]
|
||||
|}
|
||||
|> 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 {|
|
||||
page_title = "Manage Prior Permalinks"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = ManagePermalinksModel.fromPost post
|
||||
|}
|
||||
|> adminView "permalinks" next ctx
|
||||
return! {|
|
||||
page_title = "Manage Prior Permalinks"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = ManagePermalinksModel.fromPost post
|
||||
|}
|
||||
|> makeHash |> adminView "permalinks" next ctx
|
||||
| Some _ -> return! Error.notAuthorized next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
@ -286,7 +282,7 @@ let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task
|
|||
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 ctx.WebLog.Id links with
|
||||
| true ->
|
||||
do! addMessage ctx { UserMessage.success with Message = "Post permalinks saved successfully" }
|
||||
|
@ -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 {|
|
||||
page_title = "Manage Post Revisions"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = ManageRevisionsModel.fromPost ctx.WebLog post
|
||||
|}
|
||||
|> adminView "revisions" next ctx
|
||||
return! {|
|
||||
page_title = "Manage Post Revisions"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = ManageRevisionsModel.fromPost ctx.WebLog post
|
||||
|}
|
||||
|> 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 {|
|
||||
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.Text}</div>"""
|
||||
|}
|
||||
|> adminBareView "" next ctx
|
||||
return! {|
|
||||
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.Text}</div>"""
|
||||
|}
|
||||
|> 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
|
||||
{ Post.empty with
|
||||
Id = PostId.create ()
|
||||
WebLogId = ctx.WebLog.Id
|
||||
AuthorId = ctx.UserId
|
||||
})
|
||||
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 ->
|
||||
|
|
|
@ -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
|
||||
|
@ -149,8 +149,10 @@ let router : HttpHandler = choose [
|
|||
route "/new" >=> Upload.showNew
|
||||
])
|
||||
subRoute "/user" (choose [
|
||||
route "s" >=> User.all
|
||||
route "/my-info" >=> User.myInfo
|
||||
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
|
||||
])
|
||||
]
|
||||
])
|
||||
|
|
|
@ -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
|
||||
|
@ -98,11 +101,11 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
|||
match File.GetCreationTime (Path.Combine (path, file)) with
|
||||
| dt when dt > DateTime.UnixEpoch -> Some dt
|
||||
| _ -> None
|
||||
{ DisplayUpload.Id = ""
|
||||
Name = name
|
||||
Path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace (slash, '/')
|
||||
UpdatedOn = create
|
||||
Source = UploadDestination.toString Disk
|
||||
{ DisplayUpload.Id = ""
|
||||
Name = name
|
||||
Path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace (slash, '/')
|
||||
UpdatedOn = create
|
||||
Source = UploadDestination.toString Disk
|
||||
})
|
||||
|> List.ofSeq
|
||||
with
|
||||
|
@ -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 {|
|
||||
page_title = "Uploaded Files"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
files = allFiles
|
||||
|}
|
||||
|> adminView "upload-list" next ctx
|
||||
}
|
||||
return! {|
|
||||
page_title = "Uploaded Files"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
files = allFiles
|
||||
|}
|
||||
|> 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
|
||||
|
@ -155,11 +156,11 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
|||
use stream = new MemoryStream ()
|
||||
do! upload.CopyToAsync stream
|
||||
let file =
|
||||
{ Id = UploadId.create ()
|
||||
WebLogId = ctx.WebLog.Id
|
||||
Path = Permalink $"{year}/{month}/{fileName}"
|
||||
UpdatedOn = DateTime.UtcNow
|
||||
Data = stream.ToArray ()
|
||||
{ Id = UploadId.create ()
|
||||
WebLogId = ctx.WebLog.Id
|
||||
Path = Permalink $"{year}/{month}/{fileName}"
|
||||
UpdatedOn = DateTime.UtcNow
|
||||
Data = stream.ToArray ()
|
||||
}
|
||||
do! ctx.Data.Upload.Add file
|
||||
| Disk ->
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -171,16 +171,16 @@ module Backup =
|
|||
|
||||
/// Create an encoded theme asset from the original theme asset
|
||||
static member fromAsset (asset : ThemeAsset) =
|
||||
{ Id = asset.Id
|
||||
UpdatedOn = asset.UpdatedOn
|
||||
Data = Convert.ToBase64String asset.Data
|
||||
{ Id = asset.Id
|
||||
UpdatedOn = asset.UpdatedOn
|
||||
Data = Convert.ToBase64String asset.Data
|
||||
}
|
||||
|
||||
/// Create a theme asset from an encoded theme asset
|
||||
static member toAsset (encoded : EncodedAsset) : ThemeAsset =
|
||||
{ Id = encoded.Id
|
||||
UpdatedOn = encoded.UpdatedOn
|
||||
Data = Convert.FromBase64String encoded.Data
|
||||
{ Id = encoded.Id
|
||||
UpdatedOn = encoded.UpdatedOn
|
||||
Data = Convert.FromBase64String encoded.Data
|
||||
}
|
||||
|
||||
/// An uploaded file, with the data base-64 encoded
|
||||
|
@ -203,20 +203,20 @@ module Backup =
|
|||
|
||||
/// Create an encoded uploaded file from the original uploaded file
|
||||
static member fromUpload (upload : Upload) : EncodedUpload =
|
||||
{ Id = upload.Id
|
||||
WebLogId = upload.WebLogId
|
||||
Path = upload.Path
|
||||
UpdatedOn = upload.UpdatedOn
|
||||
Data = Convert.ToBase64String upload.Data
|
||||
{ Id = upload.Id
|
||||
WebLogId = upload.WebLogId
|
||||
Path = upload.Path
|
||||
UpdatedOn = upload.UpdatedOn
|
||||
Data = Convert.ToBase64String upload.Data
|
||||
}
|
||||
|
||||
/// Create an uploaded file from an encoded uploaded file
|
||||
static member toUpload (encoded : EncodedUpload) : Upload =
|
||||
{ Id = encoded.Id
|
||||
WebLogId = encoded.WebLogId
|
||||
Path = encoded.Path
|
||||
UpdatedOn = encoded.UpdatedOn
|
||||
Data = Convert.FromBase64String encoded.Data
|
||||
{ Id = encoded.Id
|
||||
WebLogId = encoded.WebLogId
|
||||
Path = encoded.Path
|
||||
UpdatedOn = encoded.UpdatedOn
|
||||
Data = Convert.FromBase64String encoded.Data
|
||||
}
|
||||
|
||||
/// A unified archive for a web log
|
||||
|
@ -305,17 +305,17 @@ module Backup =
|
|||
let! uploads = data.Upload.FindByWebLogWithData webLog.Id
|
||||
|
||||
printfn "- Writing archive..."
|
||||
let archive = {
|
||||
WebLog = webLog
|
||||
Users = users
|
||||
Theme = Option.get theme
|
||||
Assets = assets |> List.map EncodedAsset.fromAsset
|
||||
Categories = categories
|
||||
TagMappings = tagMaps
|
||||
Pages = pages |> List.map (fun p -> { p with Revisions = List.truncate 1 p.Revisions })
|
||||
Posts = posts |> List.map (fun p -> { p with Revisions = List.truncate 1 p.Revisions })
|
||||
Uploads = uploads |> List.map EncodedUpload.fromUpload
|
||||
}
|
||||
let archive =
|
||||
{ WebLog = webLog
|
||||
Users = users
|
||||
Theme = Option.get theme
|
||||
Assets = assets |> List.map EncodedAsset.fromAsset
|
||||
Categories = categories
|
||||
TagMappings = tagMaps
|
||||
Pages = pages |> List.map (fun p -> { p with Revisions = List.truncate 1 p.Revisions })
|
||||
Posts = posts |> List.map (fun p -> { p with Revisions = List.truncate 1 p.Revisions })
|
||||
Uploads = uploads |> List.map EncodedUpload.fromUpload
|
||||
}
|
||||
|
||||
// Write the structure to the backup file
|
||||
if File.Exists fileName then File.Delete fileName
|
||||
|
|
95
src/admin-theme/user-edit.liquid
Normal file
95
src/admin-theme/user-edit.liquid
Normal 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’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’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>
|
Loading…
Reference in New Issue
Block a user