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

WIP on module/member conversion

Browse Source 
View models complete
This commit is contained in:
Daniel J. Summers 2023-12-16 17:59:33 -05:00
parent c3d615d10a
commit 8ec84e8680
8 changed files with 453 additions and 476 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -9,7 +9,7 @@ open NodaTime
module private Helpers = module private Helpers =
/// Create a string option if a string is blank /// Create a string option if a string is blank
let noneIfBlank (it : string) = let noneIfBlank it =
match (defaultArg (Option.ofObj it) "").Trim() with "" -> None | trimmed -> Some trimmed match (defaultArg (Option.ofObj it) "").Trim() with "" -> None | trimmed -> Some trimmed
@ -19,31 +19,31 @@ module PublicHelpers =
/// If the web log is not being served from the domain root, add the path information to relative URLs in page and /// If the web log is not being served from the domain root, add the path information to relative URLs in page and
/// post text /// post text
let addBaseToRelativeUrls extra (text : string) = let addBaseToRelativeUrls extra (text: string) =
if extra = "" then text if extra = "" then text
else text.Replace("href=\"/", $"href=\"{extra}/").Replace ("src=\"/", $"src=\"{extra}/") else text.Replace("href=\"/", $"href=\"{extra}/").Replace("src=\"/", $"src=\"{extra}/")
/// The model used to display the admin dashboard /// The model used to display the admin dashboard
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type DashboardModel = { type DashboardModel = {
/// The number of published posts /// The number of published posts
Posts : int Posts: int
/// The number of post drafts /// The number of post drafts
Drafts : int Drafts: int
/// The number of pages /// The number of pages
Pages : int Pages: int
/// The number of pages in the page list /// The number of pages in the page list
ListedPages : int ListedPages: int
/// The number of categories /// The number of categories
Categories : int Categories: int
/// The top-level categories /// The top-level categories
TopLevelCategories : int TopLevelCategories: int
} }
@ -51,22 +51,22 @@ type DashboardModel = {
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type DisplayCategory = { type DisplayCategory = {
/// The ID of the category /// The ID of the category
Id : string Id: string
/// The slug for the category /// The slug for the category
Slug : string Slug: string
/// The name of the category /// The name of the category
Name : string Name: string
/// A description of the category /// A description of the category
Description : string option Description: string option
/// The parent category names for this (sub)category /// The parent category names for this (sub)category
ParentNames : string[] ParentNames: string array
/// The number of posts in this category /// The number of posts in this category
PostCount : int PostCount: int
} }
@ -83,13 +83,10 @@ type DisplayCustomFeed = {
/// Whether this custom feed is for a podcast /// Whether this custom feed is for a podcast
IsPodcast: bool IsPodcast: bool
} } with
/// Support functions for custom feed displays
module DisplayCustomFeed =
/// Create a display version from a custom feed /// Create a display version from a custom feed
let fromFeed (cats: DisplayCategory array) (feed: CustomFeed) : DisplayCustomFeed = static member FromFeed (cats: DisplayCategory array) (feed: CustomFeed) =
let source = let source =
match feed.Source with match feed.Source with
| Category (CategoryId catId) -> $"Category: {(cats |> Array.find (fun cat -> cat.Id = catId)).Name}" | Category (CategoryId catId) -> $"Category: {(cats |> Array.find (fun cat -> cat.Id = catId)).Name}"
@ -168,14 +165,11 @@ type DisplayRevision = {
/// The format of the text of the revision /// The format of the text of the revision
Format: string Format: string
} } with
/// Functions to support displaying revisions
module DisplayRevision =
/// Create a display revision from an actual revision /// Create a display revision from an actual revision
let fromRevision (webLog: WebLog) (rev : Revision) = static member FromRevision (webLog: WebLog) (rev : Revision) = {
{ AsOf = rev.AsOf.ToDateTimeUtc () AsOf = rev.AsOf.ToDateTimeUtc()
AsOfLocal = webLog.LocalTime rev.AsOf AsOfLocal = webLog.LocalTime rev.AsOf
Format = rev.Text.SourceType Format = rev.Text.SourceType
} }
@ -203,14 +197,11 @@ type DisplayTheme = {
/// Whether the theme .zip file exists on the filesystem /// Whether the theme .zip file exists on the filesystem
IsOnDisk: bool IsOnDisk: bool
} } with
/// Functions to support displaying themes
module DisplayTheme =
/// Create a display theme from a theme /// Create a display theme from a theme
let fromTheme inUseFunc (theme: Theme) = static member FromTheme inUseFunc (theme: Theme) = {
{ Id = string theme.Id Id = string theme.Id
Name = theme.Name Name = theme.Name
Version = theme.Version Version = theme.Version
TemplateCount = List.length theme.Templates TemplateCount = List.length theme.Templates
@ -236,13 +227,10 @@ type DisplayUpload = {
/// The source for this file (created from UploadDestination DU) /// The source for this file (created from UploadDestination DU)
Source: string Source: string
} } with
/// Functions to support displaying uploads
module DisplayUpload =
/// Create a display uploaded file /// Create a display uploaded file
let fromUpload (webLog: WebLog) (source: UploadDestination) (upload: Upload) = static member FromUpload (webLog: WebLog) (source: UploadDestination) (upload: Upload) =
let path = string upload.Path let path = string upload.Path
let name = Path.GetFileName path let name = Path.GetFileName path
{ Id = string upload.Id { Id = string upload.Id
@ -282,13 +270,10 @@ type DisplayUser = {
/// When the user last logged on /// When the user last logged on
LastSeenOn: Nullable<DateTime> LastSeenOn: Nullable<DateTime>
} } with
/// Functions to support displaying a user's information
module DisplayUser =
/// Construct a displayed user from a web log user /// Construct a displayed user from a web log user
let fromUser (webLog: WebLog) (user: WebLogUser) = { static member FromUser (webLog: WebLog) (user: WebLogUser) = {
Id = string user.Id Id = string user.Id
Email = user.Email Email = user.Email
FirstName = user.FirstName FirstName = user.FirstName
@ -321,8 +306,8 @@ type EditCategoryModel = {
} with } with
/// Create an edit model from an existing category /// Create an edit model from an existing category
static member fromCategory (cat: Category) = static member FromCategory (cat: Category) = {
{ CategoryId = string cat.Id CategoryId = string cat.Id
Name = cat.Name Name = cat.Name
Slug = cat.Slug Slug = cat.Slug
Description = defaultArg cat.Description "" Description = defaultArg cat.Description ""
@ -330,79 +315,80 @@ type EditCategoryModel = {
} }
/// Is this a new category? /// Is this a new category?
member this.IsNew = this.CategoryId = "new" member this.IsNew =
this.CategoryId = "new"
/// View model to edit a custom RSS feed /// View model to edit a custom RSS feed
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type EditCustomFeedModel = type EditCustomFeedModel = {
{ /// The ID of the feed being editing /// The ID of the feed being editing
Id : string Id: string
/// The type of source for this feed ("category" or "tag") /// The type of source for this feed ("category" or "tag")
SourceType : string SourceType: string
/// The category ID or tag on which this feed is based /// The category ID or tag on which this feed is based
SourceValue : string SourceValue: string
/// The relative path at which this feed is served /// The relative path at which this feed is served
Path : string Path: string
/// Whether this feed defines a podcast /// Whether this feed defines a podcast
IsPodcast : bool IsPodcast: bool
/// The title of the podcast /// The title of the podcast
Title : string Title: string
/// A subtitle for the podcast /// A subtitle for the podcast
Subtitle : string Subtitle: string
/// The number of items in the podcast feed /// The number of items in the podcast feed
ItemsInFeed : int ItemsInFeed: int
/// A summary of the podcast (iTunes field) /// A summary of the podcast (iTunes field)
Summary : string Summary: string
/// The display name of the podcast author (iTunes field) /// The display name of the podcast author (iTunes field)
DisplayedAuthor : string DisplayedAuthor: string
/// The e-mail address of the user who registered the podcast at iTunes /// The e-mail address of the user who registered the podcast at iTunes
Email : string Email: string
/// The link to the image for the podcast /// The link to the image for the podcast
ImageUrl : string ImageUrl: string
/// The category from Apple Podcasts (iTunes) under which this podcast is categorized /// The category from Apple Podcasts (iTunes) under which this podcast is categorized
AppleCategory : string AppleCategory: string
/// A further refinement of the categorization of this podcast (Apple Podcasts/iTunes field / values) /// A further refinement of the categorization of this podcast (Apple Podcasts/iTunes field / values)
AppleSubcategory : string AppleSubcategory: string
/// The explictness rating (iTunes field) /// The explictness rating (iTunes field)
Explicit : string Explicit: string
/// The default media type for files in this podcast /// The default media type for files in this podcast
DefaultMediaType : string DefaultMediaType: string
/// The base URL for relative URL media files for this podcast (optional; defaults to web log base) /// The base URL for relative URL media files for this podcast (optional; defaults to web log base)
MediaBaseUrl : string MediaBaseUrl: string
/// The URL for funding information for the podcast /// The URL for funding information for the podcast
FundingUrl : string FundingUrl: string
/// The text for the funding link /// The text for the funding link
FundingText : string FundingText: string
/// A unique identifier to follow this podcast /// A unique identifier to follow this podcast
PodcastGuid : string PodcastGuid: string
/// The medium for the content of this podcast /// The medium for the content of this podcast
Medium : string Medium: string
} } with
/// An empty custom feed model /// An empty custom feed model
static member empty = static member Empty = {
{ Id = "" Id = ""
SourceType = "category" SourceType = "category"
SourceValue = "" SourceValue = ""
Path = "" Path = ""
@ -426,14 +412,13 @@ type EditCustomFeedModel =
} }
/// Create a model from a custom feed /// Create a model from a custom feed
static member fromFeed (feed: CustomFeed) = static member FromFeed (feed: CustomFeed) =
let rss = let rss =
{ EditCustomFeedModel.empty with { EditCustomFeedModel.Empty with
Id = string feed.Id Id = string feed.Id
SourceType = match feed.Source with Category _ -> "category" | Tag _ -> "tag" SourceType = match feed.Source with Category _ -> "category" | Tag _ -> "tag"
SourceValue = match feed.Source with Category (CategoryId catId) -> catId | Tag tag -> tag SourceValue = match feed.Source with Category (CategoryId catId) -> catId | Tag tag -> tag
Path = string feed.Path Path = string feed.Path }
}
match feed.Podcast with match feed.Podcast with
| Some p -> | Some p ->
{ rss with { rss with
@ -453,12 +438,11 @@ type EditCustomFeedModel =
FundingUrl = defaultArg p.FundingUrl "" FundingUrl = defaultArg p.FundingUrl ""
FundingText = defaultArg p.FundingText "" FundingText = defaultArg p.FundingText ""
PodcastGuid = p.PodcastGuid |> Option.map _.ToString().ToLowerInvariant() |> Option.defaultValue "" PodcastGuid = p.PodcastGuid |> Option.map _.ToString().ToLowerInvariant() |> Option.defaultValue ""
Medium = p.Medium |> Option.map string |> Option.defaultValue "" Medium = p.Medium |> Option.map string |> Option.defaultValue "" }
}
| None -> rss | None -> rss
/// Update a feed with values from this model /// Update a feed with values from this model
member this.UpdateFeed (feed : CustomFeed) = member this.UpdateFeed (feed: CustomFeed) =
{ feed with { feed with
Source = if this.SourceType = "tag" then Tag this.SourceValue else Category (CategoryId this.SourceValue) Source = if this.SourceType = "tag" then Tag this.SourceValue else Category (CategoryId this.SourceValue)
Path = Permalink this.Path Path = Permalink this.Path
@ -480,35 +464,33 @@ type EditCustomFeedModel =
PodcastGuid = noneIfBlank this.PodcastGuid |> Option.map Guid.Parse PodcastGuid = noneIfBlank this.PodcastGuid |> Option.map Guid.Parse
FundingUrl = noneIfBlank this.FundingUrl FundingUrl = noneIfBlank this.FundingUrl
FundingText = noneIfBlank this.FundingText FundingText = noneIfBlank this.FundingText
Medium = noneIfBlank this.Medium |> Option.map PodcastMedium.Parse Medium = noneIfBlank this.Medium |> Option.map PodcastMedium.Parse }
}
else else
None None }
}
/// View model for a user to edit their own information /// View model for a user to edit their own information
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type EditMyInfoModel = type EditMyInfoModel = {
{ /// The user's first name /// The user's first name
FirstName : string FirstName: string
/// The user's last name /// The user's last name
LastName : string LastName: string
/// The user's preferred name /// The user's preferred name
PreferredName : string PreferredName: string
/// A new password for the user /// A new password for the user
NewPassword : string NewPassword: string
/// A new password for the user, confirmed /// A new password for the user, confirmed
NewPasswordConfirm : string NewPasswordConfirm: string
} } with
/// Create an edit model from a user /// Create an edit model from a user
static member fromUser (user : WebLogUser) = static member FromUser (user: WebLogUser) = {
{ FirstName = user.FirstName FirstName = user.FirstName
LastName = user.LastName LastName = user.LastName
PreferredName = user.PreferredName PreferredName = user.PreferredName
NewPassword = "" NewPassword = ""
@ -548,7 +530,7 @@ type EditPageModel = {
} with } with
/// Create an edit model from an existing page /// Create an edit model from an existing page
static member fromPage (page: Page) = static member FromPage (page: Page) =
let latest = let latest =
match page.Revisions |> List.sortByDescending _.AsOf |> List.tryHead with match page.Revisions |> List.sortByDescending _.AsOf |> List.tryHead with
| Some rev -> rev | Some rev -> rev
@ -566,7 +548,8 @@ type EditPageModel = {
} }
/// Whether this is a new page /// Whether this is a new page
member this.IsNew = this.PageId = "new" member this.IsNew =
this.PageId = "new"
/// Update a page with values from this model /// Update a page with values from this model
member this.UpdatePage (page: Page) now = member this.UpdatePage (page: Page) now =
@ -588,12 +571,11 @@ type EditPageModel = {
Metadata = Seq.zip this.MetaNames this.MetaValues Metadata = Seq.zip this.MetaNames this.MetaValues
|> Seq.filter (fun it -> fst it > "") |> Seq.filter (fun it -> fst it > "")
|> Seq.map (fun it -> { Name = fst it; Value = snd it }) |> Seq.map (fun it -> { Name = fst it; Value = snd it })
|> Seq.sortBy (fun it -> $"{it.Name.ToLower ()} {it.Value.ToLower ()}") |> Seq.sortBy (fun it -> $"{it.Name.ToLower()} {it.Value.ToLower()}")
|> List.ofSeq |> List.ofSeq
Revisions = match page.Revisions |> List.tryHead with Revisions = match page.Revisions |> List.tryHead with
| Some r when r.Text = revision.Text -> page.Revisions | Some r when r.Text = revision.Text -> page.Revisions
| _ -> revision :: page.Revisions | _ -> revision :: page.Revisions }
}
/// View model to edit a post /// View model to edit a post
@ -700,7 +682,7 @@ type EditPostModel = {
} with } with
/// Create an edit model from an existing past /// Create an edit model from an existing past
static member fromPost (webLog: WebLog) (post: Post) = static member FromPost (webLog: WebLog) (post: Post) =
let latest = let latest =
match post.Revisions |> List.sortByDescending _.AsOf |> List.tryHead with match post.Revisions |> List.sortByDescending _.AsOf |> List.tryHead with
| Some rev -> rev | Some rev -> rev
@ -712,7 +694,7 @@ type EditPostModel = {
Permalink = string post.Permalink Permalink = string post.Permalink
Source = latest.Text.SourceType Source = latest.Text.SourceType
Text = latest.Text.Text Text = latest.Text.Text
Tags = String.Join (", ", post.Tags) Tags = String.Join(", ", post.Tags)
Template = defaultArg post.Template "" Template = defaultArg post.Template ""
CategoryIds = post.CategoryIds |> List.map string |> Array.ofList CategoryIds = post.CategoryIds |> List.map string |> Array.ofList
Status = string post.Status Status = string post.Status
@ -743,7 +725,8 @@ type EditPostModel = {
} }
/// Whether this is a new post /// Whether this is a new post
member this.IsNew = this.PostId = "new" member this.IsNew =
this.PostId = "new"
/// Update a post with values from the submitted form /// Update a post with values from the submitted form
member this.UpdatePost (post: Post) now = member this.UpdatePost (post: Post) now =
@ -763,17 +746,17 @@ type EditPostModel = {
Text = revision.Text.AsHtml() Text = revision.Text.AsHtml()
Tags = this.Tags.Split "," Tags = this.Tags.Split ","
|> Seq.ofArray |> Seq.ofArray
|> Seq.map (fun it -> it.Trim().ToLower ()) |> Seq.map _.Trim().ToLower()
|> Seq.filter (fun it -> it <> "") |> Seq.filter (fun it -> it <> "")
|> Seq.sort |> Seq.sort
|> List.ofSeq |> List.ofSeq
Template = match this.Template.Trim () with "" -> None | tmpl -> Some tmpl Template = match this.Template.Trim() with "" -> None | tmpl -> Some tmpl
CategoryIds = this.CategoryIds |> Array.map CategoryId |> List.ofArray CategoryIds = this.CategoryIds |> Array.map CategoryId |> List.ofArray
Status = if this.DoPublish then Published else post.Status Status = if this.DoPublish then Published else post.Status
Metadata = Seq.zip this.MetaNames this.MetaValues Metadata = Seq.zip this.MetaNames this.MetaValues
|> Seq.filter (fun it -> fst it > "") |> Seq.filter (fun it -> fst it > "")
|> Seq.map (fun it -> { Name = fst it; Value = snd it }) |> Seq.map (fun it -> { Name = fst it; Value = snd it })
|> Seq.sortBy (fun it -> $"{it.Name.ToLower ()} {it.Value.ToLower ()}") |> Seq.sortBy (fun it -> $"{it.Name.ToLower()} {it.Value.ToLower()}")
|> List.ofSeq |> List.ofSeq
Revisions = match post.Revisions |> List.tryHead with Revisions = match post.Revisions |> List.tryHead with
| Some r when r.Text = revision.Text -> post.Revisions | Some r when r.Text = revision.Text -> post.Revisions
@ -805,32 +788,31 @@ type EditPostModel = {
EpisodeDescription = noneIfBlank this.EpisodeDescription EpisodeDescription = noneIfBlank this.EpisodeDescription
} }
else else
None None }
}
/// View model to add/edit a redirect rule /// View model to add/edit a redirect rule
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type EditRedirectRuleModel = type EditRedirectRuleModel = {
{ /// The ID (index) of the rule being edited /// The ID (index) of the rule being edited
RuleId : int RuleId: int
/// The "from" side of the rule /// The "from" side of the rule
From : string From: string
/// The "to" side of the rule /// The "to" side of the rule
To : string To: string
/// Whether this rule uses a regular expression /// Whether this rule uses a regular expression
IsRegex : bool IsRegex: bool
/// Whether a new rule should be inserted at the top or appended to the end (ignored for edits) /// Whether a new rule should be inserted at the top or appended to the end (ignored for edits)
InsertAtTop : bool InsertAtTop: bool
} } with
/// Create a model from an existing rule /// Create a model from an existing rule
static member fromRule idx (rule : RedirectRule) = static member FromRule idx (rule: RedirectRule) = {
{ RuleId = idx RuleId = idx
From = rule.From From = rule.From
To = rule.To To = rule.To
IsRegex = rule.IsRegex IsRegex = rule.IsRegex
@ -838,8 +820,7 @@ type EditRedirectRuleModel =
} }
/// Update a rule with the values from this model /// Update a rule with the values from this model
member this.UpdateRule (rule : RedirectRule) = member this.ToRule() = {
{ rule with
From = this.From From = this.From
To = this.To To = this.To
IsRegex = this.IsRegex IsRegex = this.IsRegex
@ -848,29 +829,29 @@ type EditRedirectRuleModel =
/// View model to edit RSS settings /// View model to edit RSS settings
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type EditRssModel = type EditRssModel = {
{ /// Whether the site feed of posts is enabled /// Whether the site feed of posts is enabled
IsFeedEnabled : bool IsFeedEnabled: bool
/// The name of the file generated for the site feed /// The name of the file generated for the site feed
FeedName : string FeedName: string
/// Override the "posts per page" setting for the site feed /// Override the "posts per page" setting for the site feed
ItemsInFeed : int ItemsInFeed: int
/// Whether feeds are enabled for all categories /// Whether feeds are enabled for all categories
IsCategoryEnabled : bool IsCategoryEnabled: bool
/// Whether feeds are enabled for all tags /// Whether feeds are enabled for all tags
IsTagEnabled : bool IsTagEnabled: bool
/// A copyright string to be placed in all feeds /// A copyright string to be placed in all feeds
Copyright : string Copyright: string
} } with
/// Create an edit model from a set of RSS options /// Create an edit model from a set of RSS options
static member fromRssOptions (rss : RssOptions) = static member FromRssOptions (rss: RssOptions) = {
{ IsFeedEnabled = rss.IsFeedEnabled IsFeedEnabled = rss.IsFeedEnabled
FeedName = rss.FeedName FeedName = rss.FeedName
ItemsInFeed = defaultArg rss.ItemsInFeed 0 ItemsInFeed = defaultArg rss.ItemsInFeed 0
IsCategoryEnabled = rss.IsCategoryEnabled IsCategoryEnabled = rss.IsCategoryEnabled
@ -879,40 +860,40 @@ type EditRssModel =
} }
/// Update RSS options from values in this model /// Update RSS options from values in this model
member this.UpdateOptions (rss : RssOptions) = member this.UpdateOptions (rss: RssOptions) =
{ rss with { rss with
IsFeedEnabled = this.IsFeedEnabled IsFeedEnabled = this.IsFeedEnabled
FeedName = this.FeedName FeedName = this.FeedName
ItemsInFeed = if this.ItemsInFeed = 0 then None else Some this.ItemsInFeed ItemsInFeed = if this.ItemsInFeed = 0 then None else Some this.ItemsInFeed
IsCategoryEnabled = this.IsCategoryEnabled IsCategoryEnabled = this.IsCategoryEnabled
IsTagEnabled = this.IsTagEnabled IsTagEnabled = this.IsTagEnabled
Copyright = noneIfBlank this.Copyright Copyright = noneIfBlank this.Copyright }
}
/// View model to edit a tag mapping /// View model to edit a tag mapping
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type EditTagMapModel = type EditTagMapModel = {
{ /// The ID of the tag mapping being edited /// The ID of the tag mapping being edited
Id : string Id: string
/// The tag being mapped to a different link value /// The tag being mapped to a different link value
Tag : string Tag: string
/// The link value for the tag /// The link value for the tag
UrlValue : string UrlValue: string
} } with
/// Whether this is a new tag mapping
member this.IsNew = this.Id = "new"
/// Create an edit model from the tag mapping /// Create an edit model from the tag mapping
static member fromMapping (tagMap : TagMap) : EditTagMapModel = static member FromMapping (tagMap: TagMap) : EditTagMapModel = {
{ Id = string tagMap.Id Id = string tagMap.Id
Tag = tagMap.Tag Tag = tagMap.Tag
UrlValue = tagMap.UrlValue UrlValue = tagMap.UrlValue
} }
/// Whether this is a new tag mapping
member this.IsNew =
this.Id = "new"
/// View model to display a user's information /// View model to display a user's information
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
@ -945,9 +926,9 @@ type EditUserModel = {
PasswordConfirm: string PasswordConfirm: string
} with } with
/// Construct a displayed user from a web log user /// Construct a user edit form from a web log user
static member fromUser (user: WebLogUser) = static member FromUser (user: WebLogUser) = {
{ Id = string user.Id Id = string user.Id
AccessLevel = string user.AccessLevel AccessLevel = string user.AccessLevel
Url = defaultArg user.Url "" Url = defaultArg user.Url ""
Email = user.Email Email = user.Email
@ -959,7 +940,8 @@ type EditUserModel = {
} }
/// Is this a new user? /// Is this a new user?
member this.IsNew = this.Id = "new" member this.IsNew =
this.Id = "new"
/// Update a user with values from this model (excludes password) /// Update a user with values from this model (excludes password)
member this.UpdateUser (user: WebLogUser) = member this.UpdateUser (user: WebLogUser) =
@ -969,14 +951,13 @@ type EditUserModel = {
Url = noneIfBlank this.Url Url = noneIfBlank this.Url
FirstName = this.FirstName FirstName = this.FirstName
LastName = this.LastName LastName = this.LastName
PreferredName = this.PreferredName PreferredName = this.PreferredName }
}
/// The model to use to allow a user to log on /// The model to use to allow a user to log on
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type LogOnModel = type LogOnModel = {
{ /// The user's e-mail address /// The user's e-mail address
EmailAddress : string EmailAddress : string
/// The user's password /// The user's password
@ -984,10 +965,10 @@ type LogOnModel =
/// Where the user should be redirected once they have logged on /// Where the user should be redirected once they have logged on
ReturnTo : string option ReturnTo : string option
} } with
/// An empty log on model /// An empty log on model
static member empty = static member Empty =
{ EmailAddress = ""; Password = ""; ReturnTo = None } { EmailAddress = ""; Password = ""; ReturnTo = None }
@ -1011,17 +992,17 @@ type ManagePermalinksModel = {
} with } with
/// Create a permalink model from a page /// Create a permalink model from a page
static member fromPage (pg: Page) = static member FromPage (page: Page) = {
{ Id = string pg.Id Id = string page.Id
Entity = "page" Entity = "page"
CurrentTitle = pg.Title CurrentTitle = page.Title
CurrentPermalink = string pg.Permalink CurrentPermalink = string page.Permalink
Prior = pg.PriorPermalinks |> List.map string |> Array.ofList Prior = page.PriorPermalinks |> List.map string |> Array.ofList
} }
/// Create a permalink model from a post /// Create a permalink model from a post
static member fromPost (post: Post) = static member FromPost (post: Post) = {
{ Id = string post.Id Id = string post.Id
Entity = "post" Entity = "post"
CurrentTitle = post.Title CurrentTitle = post.Title
CurrentPermalink = string post.Permalink CurrentPermalink = string post.Permalink
@ -1031,34 +1012,34 @@ type ManagePermalinksModel = {
/// View model to manage revisions /// View model to manage revisions
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type ManageRevisionsModel = type ManageRevisionsModel = {
{ /// The ID for the entity being edited /// The ID for the entity being edited
Id : string Id: string
/// The type of entity being edited ("page" or "post") /// The type of entity being edited ("page" or "post")
Entity : string Entity: string
/// The current title of the page or post /// The current title of the page or post
CurrentTitle : string CurrentTitle: string
/// The revisions for the page or post /// The revisions for the page or post
Revisions : DisplayRevision array Revisions: DisplayRevision array
} } with
/// Create a revision model from a page /// Create a revision model from a page
static member fromPage webLog (pg: Page) = static member FromPage webLog (page: Page) = {
{ Id = string pg.Id Id = string page.Id
Entity = "page" Entity = "page"
CurrentTitle = pg.Title CurrentTitle = page.Title
Revisions = pg.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList Revisions = page.Revisions |> List.map (DisplayRevision.FromRevision webLog) |> Array.ofList
} }
/// Create a revision model from a post /// Create a revision model from a post
static member fromPost webLog (post: Post) = static member FromPost webLog (post: Post) = {
{ Id = string post.Id Id = string post.Id
Entity = "post" Entity = "post"
CurrentTitle = post.Title CurrentTitle = post.Title
Revisions = post.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList Revisions = post.Revisions |> List.map (DisplayRevision.FromRevision webLog) |> Array.ofList
} }
@ -1103,7 +1084,7 @@ type PostListItem = {
} with } with
/// Create a post list item from a post /// Create a post list item from a post
static member fromPost (webLog: WebLog) (post: Post) = { static member FromPost (webLog: WebLog) (post: Post) = {
Id = string post.Id Id = string post.Id
AuthorId = string post.AuthorId AuthorId = string post.AuthorId
Status = string post.Status Status = string post.Status
@ -1120,28 +1101,28 @@ type PostListItem = {
/// View model for displaying posts /// View model for displaying posts
type PostDisplay = type PostDisplay = {
{ /// The posts to be displayed /// The posts to be displayed
Posts : PostListItem[] Posts: PostListItem array
/// Author ID -> name lookup /// Author ID -> name lookup
Authors : MetaItem list Authors: MetaItem list
/// A subtitle for the page /// A subtitle for the page
Subtitle : string option Subtitle: string option
/// The link to view newer (more recent) posts /// The link to view newer (more recent) posts
NewerLink : string option NewerLink: string option
/// The name of the next newer post (single-post only) /// The name of the next newer post (single-post only)
NewerName : string option NewerName: string option
/// The link to view older (less recent) posts /// The link to view older (less recent) posts
OlderLink : string option OlderLink: string option
/// The name of the next older post (single-post only) /// The name of the next older post (single-post only)
OlderName : string option OlderName: string option
} }
/// View model for editing web log settings /// View model for editing web log settings
@ -1176,8 +1157,8 @@ type SettingsModel = {
} with } with
/// Create a settings model from a web log /// Create a settings model from a web log
static member fromWebLog (webLog: WebLog) = static member FromWebLog(webLog: WebLog) = {
{ Name = webLog.Name Name = webLog.Name
Slug = webLog.Slug Slug = webLog.Slug
Subtitle = defaultArg webLog.Subtitle "" Subtitle = defaultArg webLog.Subtitle ""
DefaultPage = webLog.DefaultPage DefaultPage = webLog.DefaultPage
@ -1189,7 +1170,7 @@ type SettingsModel = {
} }
/// Update a web log with settings from the form /// Update a web log with settings from the form
member this.update (webLog : WebLog) = member this.Update(webLog: WebLog) =
{ webLog with { webLog with
Name = this.Name Name = this.Name
Slug = this.Slug Slug = this.Slug
@ -1199,53 +1180,49 @@ type SettingsModel = {
TimeZone = this.TimeZone TimeZone = this.TimeZone
ThemeId = ThemeId this.ThemeId ThemeId = ThemeId this.ThemeId
AutoHtmx = this.AutoHtmx AutoHtmx = this.AutoHtmx
Uploads = UploadDestination.Parse this.Uploads Uploads = UploadDestination.Parse this.Uploads }
}
/// View model for uploading a file /// View model for uploading a file
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type UploadFileModel = type UploadFileModel = {
{ /// The upload destination /// The upload destination
Destination : string Destination : string
} }
/// View model for uploading a theme /// View model for uploading a theme
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type UploadThemeModel = type UploadThemeModel = {
{ /// Whether the uploaded theme should overwrite an existing theme /// Whether the uploaded theme should overwrite an existing theme
DoOverwrite : bool DoOverwrite : bool
} }
/// A message displayed to the user /// A message displayed to the user
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type UserMessage = type UserMessage = {
{ /// The level of the message /// The level of the message
Level : string Level: string
/// The message /// The message
Message : string Message: string
/// Further details about the message /// Further details about the message
Detail : string option Detail: string option
} } with
/// Functions to support user messages
module UserMessage =
/// An empty user message (use one of the others for pre-filled level) /// An empty user message (use one of the others for pre-filled level)
let empty = { Level = ""; Message = ""; Detail = None } static member Empty = { Level = ""; Message = ""; Detail = None }
/// A blank success message /// A blank success message
let success = { empty with Level = "success" } static member Success = { UserMessage.Empty with Level = "success" }
/// A blank informational message /// A blank informational message
let info = { empty with Level = "primary" } static member Info = { UserMessage.Empty with Level = "primary" }
/// A blank warning message /// A blank warning message
let warning = { empty with Level = "warning" } static member Warning = { UserMessage.Empty with Level = "warning" }
/// A blank error message /// A blank error message
let error = { empty with Level = "danger" } static member Error = { UserMessage.Empty with Level = "danger" }

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

@ -44,7 +44,7 @@ module Dashboard =
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash "themes" ( |> addToHash "themes" (
themes themes
|> List.map (DisplayTheme.fromTheme WebLogCache.isThemeInUse) |> List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse)
|> Array.ofList) |> Array.ofList)
|> addToHash "cached_themes" ( |> addToHash "cached_themes" (
themes themes
@ -87,7 +87,7 @@ module Cache =
do! PageListCache.refresh webLog data do! PageListCache.refresh webLog data
do! CategoryCache.refresh webLog.Id data do! CategoryCache.refresh webLog.Id data
do! addMessage ctx do! addMessage ctx
{ UserMessage.success with Message = "Successfully refresh web log cache for all web logs" } { UserMessage.Success with Message = "Successfully refresh web log cache for all web logs" }
else else
match! data.WebLog.FindById (WebLogId webLogId) with match! data.WebLog.FindById (WebLogId webLogId) with
| Some webLog -> | Some webLog ->
@ -95,9 +95,9 @@ module Cache =
do! PageListCache.refresh webLog data do! PageListCache.refresh webLog data
do! CategoryCache.refresh webLog.Id data do! CategoryCache.refresh webLog.Id data
do! addMessage ctx do! addMessage ctx
{ UserMessage.success with Message = $"Successfully refreshed web log cache for {webLog.Name}" } { UserMessage.Success with Message = $"Successfully refreshed web log cache for {webLog.Name}" }
| None -> | None ->
do! addMessage ctx { UserMessage.error with Message = $"No web log exists with ID {webLogId}" } do! addMessage ctx { UserMessage.Error with Message = $"No web log exists with ID {webLogId}" }
return! toAdminDashboard next ctx return! toAdminDashboard next ctx
} }
@ -108,7 +108,7 @@ module Cache =
TemplateCache.empty () TemplateCache.empty ()
do! ThemeAssetCache.fill data do! ThemeAssetCache.fill data
do! addMessage ctx do! addMessage ctx
{ UserMessage.success with { UserMessage.Success with
Message = "Successfully cleared template cache and refreshed theme asset cache" Message = "Successfully cleared template cache and refreshed theme asset cache"
} }
else else
@ -117,11 +117,11 @@ module Cache =
TemplateCache.invalidateTheme theme.Id TemplateCache.invalidateTheme theme.Id
do! ThemeAssetCache.refreshTheme theme.Id data do! ThemeAssetCache.refreshTheme theme.Id data
do! addMessage ctx do! addMessage ctx
{ UserMessage.success with { UserMessage.Success with
Message = $"Successfully cleared template cache and refreshed theme asset cache for {theme.Name}" Message = $"Successfully cleared template cache and refreshed theme asset cache for {theme.Name}"
} }
| None -> | None ->
do! addMessage ctx { UserMessage.error with Message = $"No theme exists with ID {themeId}" } do! addMessage ctx { UserMessage.Error with Message = $"No theme exists with ID {themeId}" }
return! toAdminDashboard next ctx return! toAdminDashboard next ctx
} }
@ -167,7 +167,7 @@ module Category =
return! return!
hashForPage title hashForPage title
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditCategoryModel.fromCategory cat) |> addToHash ViewContext.Model (EditCategoryModel.FromCategory cat)
|> adminBareView "category-edit" next ctx |> adminBareView "category-edit" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -190,7 +190,7 @@ module Category =
} }
do! (if model.IsNew then data.Category.Add else data.Category.Update) updatedCat do! (if model.IsNew then data.Category.Add else data.Category.Update) updatedCat
do! CategoryCache.update ctx do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Category saved successfully" } do! addMessage ctx { UserMessage.Success with Message = "Category saved successfully" }
return! bare next ctx return! bare next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -207,9 +207,9 @@ module Category =
| ReassignedChildCategories -> | ReassignedChildCategories ->
Some "<em>(Its child categories were reassigned to its parent category)</em>" Some "<em>(Its child categories were reassigned to its parent category)</em>"
| _ -> None | _ -> None
do! addMessage ctx { UserMessage.success with Message = "Category deleted successfully"; Detail = detail } do! addMessage ctx { UserMessage.Success with Message = "Category deleted successfully"; Detail = detail }
| CategoryNotFound -> | CategoryNotFound ->
do! addMessage ctx { UserMessage.error with Message = "Category not found; cannot delete" } do! addMessage ctx { UserMessage.Error with Message = "Category not found; cannot delete" }
return! bare next ctx return! bare next ctx
} }
@ -233,7 +233,7 @@ module RedirectRules =
if idx = -1 then if idx = -1 then
return! return!
hashForPage "Add Redirect Rule" hashForPage "Add Redirect Rule"
|> addToHash "model" (EditRedirectRuleModel.fromRule -1 RedirectRule.Empty) |> addToHash "model" (EditRedirectRuleModel.FromRule -1 RedirectRule.Empty)
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> adminBareView "redirect-edit" next ctx |> adminBareView "redirect-edit" next ctx
else else
@ -243,7 +243,7 @@ module RedirectRules =
else else
return! return!
hashForPage "Edit Redirect Rule" hashForPage "Edit Redirect Rule"
|> addToHash "model" (EditRedirectRuleModel.fromRule idx (List.item idx rules)) |> addToHash "model" (EditRedirectRuleModel.FromRule idx (List.item idx rules))
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> adminBareView "redirect-edit" next ctx |> adminBareView "redirect-edit" next ctx
} }
@ -257,17 +257,17 @@ module RedirectRules =
// POST /admin/settings/redirect-rules/[index] // POST /admin/settings/redirect-rules/[index]
let save idx : HttpHandler = fun next ctx -> task { let save idx : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<EditRedirectRuleModel> () let! model = ctx.BindFormAsync<EditRedirectRuleModel>()
let isNew = idx = -1 let isNew = idx = -1
let rules = ctx.WebLog.RedirectRules let rules = ctx.WebLog.RedirectRules
let rule = model.UpdateRule (if isNew then RedirectRule.Empty else List.item idx rules) let rule = model.ToRule()
let newRules = let newRules =
match isNew with match isNew with
| true when model.InsertAtTop -> List.insertAt 0 rule rules | true when model.InsertAtTop -> List.insertAt 0 rule rules
| true -> List.insertAt (rules.Length) rule rules | true -> List.insertAt rules.Length rule rules
| false -> rules |> List.removeAt idx |> List.insertAt idx rule | false -> rules |> List.removeAt idx |> List.insertAt idx rule
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = newRules } do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = newRules }
do! addMessage ctx { UserMessage.success with Message = "Redirect rule saved successfully" } do! addMessage ctx { UserMessage.Success with Message = "Redirect rule saved successfully" }
return! all next ctx return! all next ctx
} }
@ -300,7 +300,7 @@ module RedirectRules =
else else
let rules = ctx.WebLog.RedirectRules |> List.removeAt idx let rules = ctx.WebLog.RedirectRules |> List.removeAt idx
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = rules } do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = rules }
do! addMessage ctx { UserMessage.success with Message = "Redirect rule deleted successfully" } do! addMessage ctx { UserMessage.Success with Message = "Redirect rule deleted successfully" }
return! all next ctx return! all next ctx
} }
@ -340,7 +340,7 @@ module TagMapping =
return! return!
hashForPage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag") hashForPage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag")
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditTagMapModel.fromMapping tm) |> addToHash ViewContext.Model (EditTagMapModel.FromMapping tm)
|> adminBareView "tag-mapping-edit" next ctx |> adminBareView "tag-mapping-edit" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -355,7 +355,7 @@ module TagMapping =
match! tagMap with match! tagMap with
| Some tm -> | Some tm ->
do! data.TagMap.Save { tm with Tag = model.Tag.ToLower(); UrlValue = model.UrlValue.ToLower() } do! data.TagMap.Save { tm with Tag = model.Tag.ToLower(); UrlValue = model.UrlValue.ToLower() }
do! addMessage ctx { UserMessage.success with Message = "Tag mapping saved successfully" } do! addMessage ctx { UserMessage.Success with Message = "Tag mapping saved successfully" }
return! all next ctx return! all next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -363,8 +363,8 @@ module TagMapping =
// POST /admin/settings/tag-mapping/{id}/delete // POST /admin/settings/tag-mapping/{id}/delete
let delete tagMapId : HttpHandler = fun next ctx -> task { let delete tagMapId : HttpHandler = fun next ctx -> task {
match! ctx.Data.TagMap.Delete (TagMapId tagMapId) ctx.WebLog.Id with match! ctx.Data.TagMap.Delete (TagMapId tagMapId) ctx.WebLog.Id with
| true -> do! addMessage ctx { UserMessage.success with Message = "Tag mapping deleted successfully" } | true -> do! addMessage ctx { UserMessage.Success with Message = "Tag mapping deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with Message = "Tag mapping not found; nothing deleted" } | false -> do! addMessage ctx { UserMessage.Error with Message = "Tag mapping not found; nothing deleted" }
return! all next ctx return! all next ctx
} }
@ -384,7 +384,7 @@ module Theme =
return! return!
hashForPage "Themes" hashForPage "Themes"
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash "themes" (themes |> List.map (DisplayTheme.fromTheme WebLogCache.isThemeInUse) |> Array.ofList) |> addToHash "themes" (themes |> List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) |> Array.ofList)
|> adminBareView "theme-list-body" next ctx |> adminBareView "theme-list-body" next ctx
} }
@ -488,21 +488,21 @@ module Theme =
use file = new FileStream($"{themeId}-theme.zip", FileMode.Create) use file = new FileStream($"{themeId}-theme.zip", FileMode.Create)
do! themeFile.CopyToAsync file do! themeFile.CopyToAsync file
do! addMessage ctx do! addMessage ctx
{ UserMessage.success with { UserMessage.Success with
Message = $"""Theme {if isNew then "add" else "updat"}ed successfully""" Message = $"""Theme {if isNew then "add" else "updat"}ed successfully"""
} }
return! toAdminDashboard next ctx return! toAdminDashboard next ctx
else else
do! addMessage ctx do! addMessage ctx
{ UserMessage.error with { UserMessage.Error with
Message = "Theme exists and overwriting was not requested; nothing saved" Message = "Theme exists and overwriting was not requested; nothing saved"
} }
return! toAdminDashboard next ctx return! toAdminDashboard next ctx
| Ok _ -> | Ok _ ->
do! addMessage ctx { UserMessage.error with Message = "You may not replace the admin theme" } do! addMessage ctx { UserMessage.Error with Message = "You may not replace the admin theme" }
return! toAdminDashboard next ctx return! toAdminDashboard next ctx
| Error message -> | Error message ->
do! addMessage ctx { UserMessage.error with Message = message } do! addMessage ctx { UserMessage.Error with Message = message }
return! toAdminDashboard next ctx return! toAdminDashboard next ctx
else return! RequestErrors.BAD_REQUEST "Bad request" next ctx else return! RequestErrors.BAD_REQUEST "Bad request" next ctx
} }
@ -512,11 +512,11 @@ module Theme =
let data = ctx.Data let data = ctx.Data
match themeId with match themeId with
| "admin" | "default" -> | "admin" | "default" ->
do! addMessage ctx { UserMessage.error with Message = $"You may not delete the {themeId} theme" } do! addMessage ctx { UserMessage.Error with Message = $"You may not delete the {themeId} theme" }
return! all next ctx return! all next ctx
| it when WebLogCache.isThemeInUse (ThemeId it) -> | it when WebLogCache.isThemeInUse (ThemeId it) ->
do! addMessage ctx do! addMessage ctx
{ UserMessage.error with { UserMessage.Error with
Message = $"You may not delete the {themeId} theme, as it is currently in use" Message = $"You may not delete the {themeId} theme, as it is currently in use"
} }
return! all next ctx return! all next ctx
@ -525,7 +525,7 @@ module Theme =
| true -> | true ->
let zippedTheme = $"{themeId}-theme.zip" let zippedTheme = $"{themeId}-theme.zip"
if File.Exists zippedTheme then File.Delete zippedTheme if File.Exists zippedTheme then File.Delete zippedTheme
do! addMessage ctx { UserMessage.success with Message = $"Theme ID {themeId} deleted successfully" } do! addMessage ctx { UserMessage.Success with Message = $"Theme ID {themeId} deleted successfully" }
return! all next ctx return! all next ctx
| false -> return! Error.notFound next ctx | false -> return! Error.notFound next ctx
} }
@ -550,7 +550,7 @@ module WebLog =
let! hash = let! hash =
hashForPage "Web Log Settings" hashForPage "Web Log Settings"
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash ViewContext.Model (SettingsModel.fromWebLog ctx.WebLog) |> addToHash ViewContext.Model (SettingsModel.FromWebLog ctx.WebLog)
|> addToHash "pages" ( |> addToHash "pages" (
seq { seq {
KeyValuePair.Create("posts", "- First Page of Posts -") KeyValuePair.Create("posts", "- First Page of Posts -")
@ -569,11 +569,11 @@ module WebLog =
KeyValuePair.Create(string Database, "Database") KeyValuePair.Create(string Database, "Database")
KeyValuePair.Create(string Disk, "Disk") KeyValuePair.Create(string Disk, "Disk")
|] |]
|> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList) |> addToHash "users" (users |> List.map (DisplayUser.FromUser ctx.WebLog) |> Array.ofList)
|> addToHash "rss_model" (EditRssModel.fromRssOptions ctx.WebLog.Rss) |> addToHash "rss_model" (EditRssModel.FromRssOptions ctx.WebLog.Rss)
|> addToHash "custom_feeds" ( |> addToHash "custom_feeds" (
ctx.WebLog.Rss.CustomFeeds ctx.WebLog.Rss.CustomFeeds
|> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx)) |> List.map (DisplayCustomFeed.FromFeed (CategoryCache.get ctx))
|> Array.ofList) |> Array.ofList)
|> addViewContext ctx |> addViewContext ctx
let! hash' = TagMapping.withTagMappings ctx hash let! hash' = TagMapping.withTagMappings ctx hash
@ -592,7 +592,7 @@ module WebLog =
match! data.WebLog.FindById ctx.WebLog.Id with match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog -> | Some webLog ->
let oldSlug = webLog.Slug let oldSlug = webLog.Slug
let webLog = model.update webLog let webLog = model.Update webLog
do! data.WebLog.UpdateSettings webLog do! data.WebLog.UpdateSettings webLog
// Update cache // Update cache
@ -604,7 +604,7 @@ module WebLog =
let oldDir = Path.Combine (uploadRoot, oldSlug) let oldDir = Path.Combine (uploadRoot, oldSlug)
if Directory.Exists oldDir then Directory.Move (oldDir, Path.Combine (uploadRoot, webLog.Slug)) if Directory.Exists oldDir then Directory.Move (oldDir, Path.Combine (uploadRoot, webLog.Slug))
do! addMessage ctx { UserMessage.success with Message = "Web log settings saved successfully" } do! addMessage ctx { UserMessage.Success with Message = "Web log settings saved successfully" }
return! redirectToGet "admin/settings" next ctx return! redirectToGet "admin/settings" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }

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

@ -418,7 +418,7 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
let webLog = { webLog with Rss = model.UpdateOptions webLog.Rss } let webLog = { webLog with Rss = model.UpdateOptions webLog.Rss }
do! data.WebLog.UpdateRssOptions webLog do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog WebLogCache.set webLog
do! addMessage ctx { UserMessage.success with Message = "RSS settings updated successfully" } do! addMessage ctx { UserMessage.Success with Message = "RSS settings updated successfully" }
return! redirectToGet "admin/settings#rss-settings" next ctx return! redirectToGet "admin/settings#rss-settings" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -433,7 +433,7 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
| Some f -> | Some f ->
hashForPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed""" hashForPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditCustomFeedModel.fromFeed f) |> addToHash ViewContext.Model (EditCustomFeedModel.FromFeed f)
|> addToHash "medium_values" [| |> addToHash "medium_values" [|
KeyValuePair.Create("", "&ndash; Unspecified &ndash;") KeyValuePair.Create("", "&ndash; Unspecified &ndash;")
KeyValuePair.Create(string Podcast, "Podcast") KeyValuePair.Create(string Podcast, "Podcast")
@ -464,7 +464,7 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
do! data.WebLog.UpdateRssOptions webLog do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog WebLogCache.set webLog
do! addMessage ctx { do! addMessage ctx {
UserMessage.success with UserMessage.Success with
Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed""" Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed"""
} }
return! redirectToGet $"admin/settings/rss/{feed.Id}/edit" next ctx return! redirectToGet $"admin/settings/rss/{feed.Id}/edit" next ctx
@ -488,9 +488,9 @@ let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun ne
} }
do! data.WebLog.UpdateRssOptions webLog do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog WebLogCache.set webLog
do! addMessage ctx { UserMessage.success with Message = "Custom feed deleted successfully" } do! addMessage ctx { UserMessage.Success with Message = "Custom feed deleted successfully" }
else else
do! addMessage ctx { UserMessage.warning with Message = "Custom feed not found; no action taken" } do! addMessage ctx { UserMessage.Warning with Message = "Custom feed not found; no action taken" }
return! redirectToGet "admin/settings#rss-settings" next ctx return! redirectToGet "admin/settings#rss-settings" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }

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

@ -252,7 +252,7 @@ module Error =
else else
if isHtmx ctx then if isHtmx ctx then
let messages = [| let messages = [|
{ UserMessage.error with { UserMessage.Error with
Message = $"You are not authorized to access the URL {ctx.Request.Path.Value}" Message = $"You are not authorized to access the URL {ctx.Request.Path.Value}"
} }
|] |]
@ -264,7 +264,7 @@ module Error =
handleContext (fun ctx -> handleContext (fun ctx ->
if isHtmx ctx then if isHtmx ctx then
let messages = [| let messages = [|
{ UserMessage.error with Message = $"The URL {ctx.Request.Path.Value} was not found" } { UserMessage.Error with Message = $"The URL {ctx.Request.Path.Value} was not found" }
|] |]
RequestErrors.notFound (messagesToHeaders messages) earlyReturn ctx RequestErrors.notFound (messagesToHeaders messages) earlyReturn ctx
else RequestErrors.NOT_FOUND "Not found" earlyReturn ctx) else RequestErrors.NOT_FOUND "Not found" earlyReturn ctx)
@ -272,7 +272,7 @@ module Error =
let server message : HttpHandler = let server message : HttpHandler =
handleContext (fun ctx -> handleContext (fun ctx ->
if isHtmx ctx then if isHtmx ctx then
let messages = [| { UserMessage.error with Message = message } |] let messages = [| { UserMessage.Error with Message = message } |]
ServerErrors.internalError (messagesToHeaders messages) earlyReturn ctx ServerErrors.internalError (messagesToHeaders messages) earlyReturn ctx
else ServerErrors.INTERNAL_ERROR message earlyReturn ctx) else ServerErrors.INTERNAL_ERROR message earlyReturn ctx)
@ -351,14 +351,14 @@ let requireAccess level : HttpHandler = fun next ctx -> task {
| Some userLevel when userLevel.HasAccess level -> return! next ctx | Some userLevel when userLevel.HasAccess level -> return! next ctx
| Some userLevel -> | Some userLevel ->
do! addMessage ctx do! addMessage ctx
{ UserMessage.warning with { UserMessage.Warning with
Message = $"The page you tried to access requires {level} privileges" Message = $"The page you tried to access requires {level} privileges"
Detail = Some $"Your account only has {userLevel} privileges" Detail = Some $"Your account only has {userLevel} privileges"
} }
return! Error.notAuthorized next ctx return! Error.notAuthorized next ctx
| None -> | None ->
do! addMessage ctx do! addMessage ctx
{ UserMessage.warning with Message = "The page you tried to access required you to be logged on" } { UserMessage.Warning with Message = "The page you tried to access required you to be logged on" }
return! Error.notAuthorized next ctx return! Error.notAuthorized next ctx
} }

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

@ -36,7 +36,7 @@ let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
} }
match result with match result with
| Some (title, page) when canEdit page.AuthorId ctx -> | Some (title, page) when canEdit page.AuthorId ctx ->
let model = EditPageModel.fromPage page let model = EditPageModel.FromPage page
let! templates = templatesForTheme ctx "page" let! templates = templatesForTheme ctx "page"
return! return!
hashForPage title hashForPage title
@ -56,8 +56,8 @@ let delete pgId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta
match! ctx.Data.Page.Delete (PageId pgId) ctx.WebLog.Id with match! ctx.Data.Page.Delete (PageId pgId) ctx.WebLog.Id with
| true -> | true ->
do! PageListCache.update ctx do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Page deleted successfully" } do! addMessage ctx { UserMessage.Success with Message = "Page deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with Message = "Page not found; nothing deleted" } | false -> do! addMessage ctx { UserMessage.Error with Message = "Page not found; nothing deleted" }
return! redirectToGet "admin/pages" next ctx return! redirectToGet "admin/pages" next ctx
} }
@ -68,7 +68,7 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
return! return!
hashForPage "Manage Prior Permalinks" hashForPage "Manage Prior Permalinks"
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManagePermalinksModel.fromPage pg) |> addToHash ViewContext.Model (ManagePermalinksModel.FromPage pg)
|> adminView "permalinks" next ctx |> adminView "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@ -83,7 +83,7 @@ let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task
let links = model.Prior |> Array.map Permalink |> List.ofArray let links = model.Prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Page.UpdatePriorPermalinks pageId ctx.WebLog.Id links with match! ctx.Data.Page.UpdatePriorPermalinks pageId ctx.WebLog.Id links with
| true -> | true ->
do! addMessage ctx { UserMessage.success with Message = "Page permalinks saved successfully" } do! addMessage ctx { UserMessage.Success with Message = "Page permalinks saved successfully" }
return! redirectToGet $"admin/page/{model.Id}/permalinks" next ctx return! redirectToGet $"admin/page/{model.Id}/permalinks" next ctx
| false -> return! Error.notFound next ctx | false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
@ -97,7 +97,7 @@ let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
return! return!
hashForPage "Manage Page Revisions" hashForPage "Manage Page Revisions"
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManageRevisionsModel.fromPage ctx.WebLog pg) |> addToHash ViewContext.Model (ManageRevisionsModel.FromPage ctx.WebLog pg)
|> adminView "revisions" next ctx |> adminView "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@ -109,7 +109,7 @@ let purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
match! data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with match! data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg -> | Some pg ->
do! data.Page.Update { pg with Revisions = [ List.head pg.Revisions ] } do! data.Page.Update { pg with Revisions = [ List.head pg.Revisions ] }
do! addMessage ctx { UserMessage.success with Message = "Prior revisions purged successfully" } do! addMessage ctx { UserMessage.Success with Message = "Prior revisions purged successfully" }
return! redirectToGet $"admin/page/{pgId}/revisions" next ctx return! redirectToGet $"admin/page/{pgId}/revisions" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -152,7 +152,7 @@ let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
Revisions = { rev with AsOf = Noda.now () } Revisions = { rev with AsOf = Noda.now () }
:: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) :: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
} }
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" } do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/page/{pgId}/revisions" next ctx return! redirectToGet $"admin/page/{pgId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | None, _
@ -164,7 +164,7 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
match! findPageRevision pgId revDate ctx with match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx -> | Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update { pg with Revisions = pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) } do! ctx.Data.Page.Update { pg with Revisions = pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
do! addMessage ctx { UserMessage.success with Message = "Revision deleted successfully" } do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
return! adminBareView "" next ctx (makeHash {| content = "" |}) return! adminBareView "" next ctx (makeHash {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | None, _
@ -191,7 +191,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let updatedPage = model.UpdatePage page now let updatedPage = model.UpdatePage page now
do! (if model.IsNew 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 if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Page saved successfully" } do! addMessage ctx { UserMessage.Success with Message = "Page saved successfully" }
return! redirectToGet $"admin/page/{page.Id}/edit" next ctx return! redirectToGet $"admin/page/{page.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx

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

@ -47,7 +47,7 @@ let preparePostList webLog posts listType (url: string) pageNbr perPage (data: I
posts posts
|> Seq.ofList |> Seq.ofList
|> Seq.truncate perPage |> Seq.truncate perPage
|> Seq.map (PostListItem.fromPost webLog) |> Seq.map (PostListItem.FromPost webLog)
|> Array.ofSeq |> Array.ofSeq
let! olderPost, newerPost = let! olderPost, newerPost =
match listType with match listType with
@ -232,7 +232,7 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match result with match result with
| Some (title, post) when canEdit post.AuthorId ctx -> | Some (title, post) when canEdit post.AuthorId ctx ->
let! templates = templatesForTheme ctx "post" let! templates = templatesForTheme ctx "post"
let model = EditPostModel.fromPost ctx.WebLog post let model = EditPostModel.FromPost ctx.WebLog post
return! return!
hashForPage title hashForPage title
|> withAntiCsrf ctx |> withAntiCsrf ctx
@ -255,8 +255,8 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
// POST /admin/post/{id}/delete // POST /admin/post/{id}/delete
let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Post.Delete (PostId postId) ctx.WebLog.Id with match! ctx.Data.Post.Delete (PostId postId) ctx.WebLog.Id with
| true -> do! addMessage ctx { UserMessage.success with Message = "Post deleted successfully" } | true -> do! addMessage ctx { UserMessage.Success with Message = "Post deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with Message = "Post not found; nothing deleted" } | false -> do! addMessage ctx { UserMessage.Error with Message = "Post not found; nothing deleted" }
return! redirectToGet "admin/posts" next ctx return! redirectToGet "admin/posts" next ctx
} }
@ -267,7 +267,7 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx
return! return!
hashForPage "Manage Prior Permalinks" hashForPage "Manage Prior Permalinks"
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManagePermalinksModel.fromPost post) |> addToHash ViewContext.Model (ManagePermalinksModel.FromPost post)
|> adminView "permalinks" next ctx |> adminView "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@ -282,7 +282,7 @@ let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task
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 match! ctx.Data.Post.UpdatePriorPermalinks postId ctx.WebLog.Id links with
| true -> | true ->
do! addMessage ctx { UserMessage.success with Message = "Post permalinks saved successfully" } do! addMessage ctx { UserMessage.Success with Message = "Post permalinks saved successfully" }
return! redirectToGet $"admin/post/{model.Id}/permalinks" next ctx return! redirectToGet $"admin/post/{model.Id}/permalinks" next ctx
| false -> return! Error.notFound next ctx | false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
@ -296,7 +296,7 @@ let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -
return! return!
hashForPage "Manage Post Revisions" hashForPage "Manage Post Revisions"
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManageRevisionsModel.fromPost ctx.WebLog post) |> addToHash ViewContext.Model (ManageRevisionsModel.FromPost ctx.WebLog post)
|> adminView "revisions" next ctx |> adminView "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@ -308,7 +308,7 @@ let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx -> | Some post when canEdit post.AuthorId ctx ->
do! data.Post.Update { post with Revisions = [ List.head post.Revisions ] } do! data.Post.Update { post with Revisions = [ List.head post.Revisions ] }
do! addMessage ctx { UserMessage.success with Message = "Prior revisions purged successfully" } do! addMessage ctx { UserMessage.Success with Message = "Prior revisions purged successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@ -352,7 +352,7 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
Revisions = { rev with AsOf = Noda.now () } Revisions = { rev with AsOf = Noda.now () }
:: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) :: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
} }
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" } do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | None, _
@ -364,7 +364,7 @@ let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fu
match! findPostRevision postId revDate ctx with match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx -> | Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) } do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
do! addMessage ctx { UserMessage.success with Message = "Revision deleted successfully" } do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
return! adminBareView "" next ctx (makeHash {| content = "" |}) return! adminBareView "" next ctx (makeHash {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | None, _
@ -408,7 +408,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> List.distinct |> List.distinct
|> List.length = List.length priorCats) then |> List.length = List.length priorCats) then
do! CategoryCache.update ctx do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Post saved successfully" } do! addMessage ctx { UserMessage.Success with Message = "Post saved successfully" }
return! redirectToGet $"admin/post/{post.Id}/edit" next ctx return! redirectToGet $"admin/post/{post.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx

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

@ -117,7 +117,7 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
[] []
let allFiles = let allFiles =
dbUploads dbUploads
|> List.map (DisplayUpload.fromUpload webLog Database) |> List.map (DisplayUpload.FromUpload webLog Database)
|> List.append diskUploads |> List.append diskUploads
|> List.sortByDescending (fun file -> file.UpdatedOn, file.Path) |> List.sortByDescending (fun file -> file.UpdatedOn, file.Path)
return! return!
@ -169,7 +169,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
use stream = new FileStream(Path.Combine(fullPath, fileName), FileMode.Create) use stream = new FileStream(Path.Combine(fullPath, fileName), FileMode.Create)
do! upload.CopyToAsync stream do! upload.CopyToAsync stream
do! addMessage ctx { UserMessage.success with Message = $"File uploaded to {form.Destination} successfully" } do! addMessage ctx { UserMessage.Success with Message = $"File uploaded to {form.Destination} successfully" }
return! showUploads next ctx return! showUploads next ctx
else else
return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx
@ -179,7 +179,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.Id with match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.Id with
| Ok fileName -> | Ok fileName ->
do! addMessage ctx { UserMessage.success with Message = $"{fileName} deleted successfully" } do! addMessage ctx { UserMessage.Success with Message = $"{fileName} deleted successfully" }
return! showUploads next ctx return! showUploads next ctx
| Error _ -> return! Error.notFound next ctx | Error _ -> return! Error.notFound next ctx
} }
@ -202,7 +202,7 @@ let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun ne
if File.Exists path then if File.Exists path then
File.Delete path File.Delete path
removeEmptyDirectories ctx.WebLog filePath removeEmptyDirectories ctx.WebLog filePath
do! addMessage ctx { UserMessage.success with Message = $"{filePath} deleted successfully" } do! addMessage ctx { UserMessage.Success with Message = $"{filePath} deleted successfully" }
return! showUploads next ctx return! showUploads next ctx
else return! Error.notFound next ctx else return! Error.notFound next ctx
} }

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

@ -38,7 +38,7 @@ let logOn returnUrl : HttpHandler = fun next ctx ->
| None -> if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None | None -> if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None
hashForPage "Log On" hashForPage "Log On"
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash ViewContext.Model { LogOnModel.empty with ReturnTo = returnTo } |> addToHash ViewContext.Model { LogOnModel.Empty with ReturnTo = returnTo }
|> adminView "log-on" next ctx |> adminView "log-on" next ctx
@ -66,7 +66,7 @@ let doLogOn : HttpHandler = fun next ctx -> task {
AuthenticationProperties(IssuedUtc = DateTimeOffset.UtcNow)) AuthenticationProperties(IssuedUtc = DateTimeOffset.UtcNow))
do! data.WebLogUser.SetLastSeen user.Id user.WebLogId do! data.WebLogUser.SetLastSeen user.Id user.WebLogId
do! addMessage ctx do! addMessage ctx
{ UserMessage.success with { UserMessage.Success with
Message = "Log on successful" Message = "Log on successful"
Detail = Some $"Welcome to {ctx.WebLog.Name}!" Detail = Some $"Welcome to {ctx.WebLog.Name}!"
} }
@ -75,14 +75,14 @@ let doLogOn : HttpHandler = fun next ctx -> task {
| Some url -> redirectTo false url next ctx | Some url -> redirectTo false url next ctx
| None -> redirectToGet "admin/dashboard" next ctx | None -> redirectToGet "admin/dashboard" next ctx
| Error msg -> | Error msg ->
do! addMessage ctx { UserMessage.error with Message = msg } do! addMessage ctx { UserMessage.Error with Message = msg }
return! logOn model.ReturnTo next ctx return! logOn model.ReturnTo next ctx
} }
// GET /user/log-off // GET /user/log-off
let logOff : HttpHandler = fun next ctx -> task { let logOff : HttpHandler = fun next ctx -> task {
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
do! addMessage ctx { UserMessage.info with Message = "Log off successful" } do! addMessage ctx { UserMessage.Info with Message = "Log off successful" }
return! redirectToGet "" next ctx return! redirectToGet "" next ctx
} }
@ -100,7 +100,7 @@ let all : HttpHandler = fun next ctx -> task {
return! return!
hashForPage "User Administration" hashForPage "User Administration"
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList) |> addToHash "users" (users |> List.map (DisplayUser.FromUser ctx.WebLog) |> Array.ofList)
|> adminBareView "user-list-body" next ctx |> adminBareView "user-list-body" next ctx
} }
@ -125,7 +125,7 @@ let edit usrId : HttpHandler = fun next ctx -> task {
if isNew then someTask { WebLogUser.Empty with Id = userId } if isNew then someTask { WebLogUser.Empty with Id = userId }
else ctx.Data.WebLogUser.FindById userId ctx.WebLog.Id else ctx.Data.WebLogUser.FindById userId ctx.WebLog.Id
match! tryUser with match! tryUser with
| Some user -> return! showEdit (EditUserModel.fromUser user) next ctx | Some user -> return! showEdit (EditUserModel.FromUser user) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -140,13 +140,13 @@ let delete userId : HttpHandler = fun next ctx -> task {
match! data.WebLogUser.Delete user.Id user.WebLogId with match! data.WebLogUser.Delete user.Id user.WebLogId with
| Ok _ -> | Ok _ ->
do! addMessage ctx do! addMessage ctx
{ UserMessage.success with { UserMessage.Success with
Message = $"User {user.DisplayName} deleted successfully" Message = $"User {user.DisplayName} deleted successfully"
} }
return! all next ctx return! all next ctx
| Error msg -> | Error msg ->
do! addMessage ctx do! addMessage ctx
{ UserMessage.error with { UserMessage.Error with
Message = $"User {user.DisplayName} was not deleted" Message = $"User {user.DisplayName} was not deleted"
Detail = Some msg Detail = Some msg
} }
@ -168,7 +168,7 @@ let private showMyInfo (model: EditMyInfoModel) (user: WebLogUser) : HttpHandler
// GET /admin/my-info // GET /admin/my-info
let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task { let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user -> return! showMyInfo (EditMyInfoModel.fromUser user) user next ctx | Some user -> return! showMyInfo (EditMyInfoModel.FromUser user) user next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -188,10 +188,10 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
} }
do! data.WebLogUser.Update user do! data.WebLogUser.Update user
let pwMsg = if model.NewPassword = "" then "" else " and updated your password" let pwMsg = if model.NewPassword = "" then "" else " and updated your password"
do! addMessage ctx { UserMessage.success with Message = $"Saved your information{pwMsg} successfully" } do! addMessage ctx { UserMessage.Success with Message = $"Saved your information{pwMsg} successfully" }
return! redirectToGet "admin/my-info" next ctx return! redirectToGet "admin/my-info" next ctx
| Some user -> | Some user ->
do! addMessage ctx { UserMessage.error with Message = "Passwords did not match; no updates made" } do! addMessage ctx { UserMessage.Error with Message = "Passwords did not match; no updates made" }
return! showMyInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user next ctx return! showMyInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -222,12 +222,12 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
else { updatedUser with PasswordHash = createPasswordHash updatedUser model.Password } else { updatedUser with PasswordHash = createPasswordHash updatedUser model.Password }
do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate
do! addMessage ctx do! addMessage ctx
{ UserMessage.success with { UserMessage.Success with
Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully""" Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully"""
} }
return! all next ctx return! all next ctx
| Some _ -> | Some _ ->
do! addMessage ctx { UserMessage.error with Message = "The passwords did not match; nothing saved" } do! addMessage ctx { UserMessage.Error with Message = "The passwords did not match; nothing saved" }
return! return!
(withHxRetarget $"#user_{model.Id}" >=> showEdit { model with Password = ""; PasswordConfirm = "" }) (withHxRetarget $"#user_{model.Id}" >=> showEdit { model with Password = ""; PasswordConfirm = "" })
next ctx next ctx