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

Convert all but regex routes to endpoints (#59)

Browse Source
This commit is contained in:
Daniel J. Summers
2026-07-03 12:53:24 -04:00
parent be094fb07e
commit 38a06b53f4
8 changed files with 148 additions and 156 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/MyWebLog/Handlers/Admin.fs
+12 -12
View File
@@ -45,7 +45,7 @@ let toAdminDashboard : HttpHandler = redirectToGet "admin/administration"
module Cache =
// POST /admin/cache/web-log/{id}/refresh
let refreshWebLog webLogId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let refreshWebLog webLogId : HttpHandler = requireAccess Administrator >=> validateCsrf >=> fun next ctx -> task {
let data = ctx.Data
if webLogId = "all" then
do! WebLogCache.fill data
@@ -68,7 +68,7 @@ module Cache =
}
// POST /admin/cache/theme/{id}/refresh
let refreshTheme themeId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let refreshTheme themeId : HttpHandler = requireAccess Administrator >=> validateCsrf >=> fun next ctx -> task {
let data = ctx.Data
if themeId = "all" then
Template.Cache.empty ()
@@ -120,7 +120,7 @@ module Category =
}
// POST /admin/category/save
let save : HttpHandler = fun next ctx -> task {
let save : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditCategoryModel>()
let category =
@@ -193,7 +193,7 @@ module RedirectRules =
}
// POST /admin/settings/redirect-rules/[index]
let save idx : HttpHandler = fun next ctx -> task {
let save idx : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditRedirectRuleModel>()
let rule = model.ToRule()
let rules =
@@ -208,7 +208,7 @@ module RedirectRules =
}
// POST /admin/settings/redirect-rules/[index]/up
let moveUp idx : HttpHandler = fun next ctx -> task {
let moveUp idx : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
if idx < 1 || idx >= ctx.WebLog.RedirectRules.Length then
return! Error.notFound next ctx
else
@@ -219,7 +219,7 @@ module RedirectRules =
}
// POST /admin/settings/redirect-rules/[index]/down
let moveDown idx : HttpHandler = fun next ctx -> task {
let moveDown idx : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length - 1 then
return! Error.notFound next ctx
else
@@ -230,7 +230,7 @@ module RedirectRules =
}
// DELETE /admin/settings/redirect-rules/[index]
let delete idx : HttpHandler = fun next ctx -> task {
let delete idx : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length then
return! Error.notFound next ctx
else
@@ -265,7 +265,7 @@ module TagMapping =
}
// POST /admin/settings/tag-mapping/save
let save : HttpHandler = fun next ctx -> task {
let save : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel>()
let tagMap =
@@ -280,7 +280,7 @@ module TagMapping =
}
// DELETE /admin/settings/tag-mapping/{id}
let delete tagMapId : HttpHandler = fun next ctx -> task {
let delete tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.TagMap.Delete (TagMapId tagMapId) ctx.WebLog.Id with
| true -> do! addMessage ctx { UserMessage.Success with Message = "Tag mapping deleted successfully" }
| false -> do! addMessage ctx { UserMessage.Error with Message = "Tag mapping not found; nothing deleted" }
@@ -383,7 +383,7 @@ module Theme =
}
// POST /admin/theme/new
let save : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let save : HttpHandler = requireAccess Administrator >=> validateCsrf >=> fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let themeFile = Seq.head ctx.Request.Form.Files
match deriveIdFromFileName themeFile.FileName with
@@ -424,7 +424,7 @@ module Theme =
}
// POST /admin/theme/{id}/delete
let delete themeId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let delete themeId : HttpHandler = requireAccess Administrator >=> validateCsrf >=> fun next ctx -> task {
let data = ctx.Data
match themeId with
| "admin" | "default" ->
@@ -468,7 +468,7 @@ module WebLog =
}
// POST /admin/settings
let saveSettings : HttpHandler = fun next ctx -> task {
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<SettingsModel>()
match! data.WebLog.FindById ctx.WebLog.Id with
src/MyWebLog/Handlers/Feed.fs
+37 -37
View File
@@ -64,8 +64,8 @@ let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace(text, "<(.|\
/// XML namespaces for building RSS feeds
[<RequireQualifiedAccess>]
module private Namespace =
module private Namespace =
/// Enables encoded (HTML) content
let content = "http://purl.org/rss/1.0/modules/content/"
@@ -77,14 +77,14 @@ module private Namespace =
/// Podcast Index (AKA "podcasting 2.0")
let podcast = "https://podcastindex.org/namespace/1.0"
/// Enables chapters
let psc = "http://podlove.org/simple-chapters/"
/// Enables another "subscribe" option
let rawVoice = "http://www.rawvoice.com/rawvoiceRssModule/"
/// Create a feed item from the given post
/// Create a feed item from the given post
let private toFeedItem (webLog: WebLog) (authors: MetaItem list) (cats: DisplayCategory array) (tagMaps: TagMap list)
(post: Post) =
let plainText =
@@ -97,9 +97,9 @@ let private toFeedItem (webLog: WebLog) (authors: MetaItem list) (cats: DisplayC
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset(),
Content = TextSyndicationContent.CreatePlaintextContent plainText)
item.AddPermalink (Uri item.Id)
let xmlDoc = XmlDocument()
let encoded =
let txt =
post.Text
@@ -109,7 +109,7 @@ let private toFeedItem (webLog: WebLog) (authors: MetaItem list) (cats: DisplayC
let _ = it.AppendChild(xmlDoc.CreateCDataSection txt)
it
item.ElementExtensions.Add encoded
item.Authors.Add(SyndicationPerson(Name = (authors |> List.find (fun a -> a.Name = string post.AuthorId)).Value))
[ post.CategoryIds
|> List.map (fun catId ->
@@ -142,7 +142,7 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis
let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
let epImageUrl = defaultArg episode.ImageUrl (string podcast.ImageUrl) |> toAbsolute webLog
let epExplicit = string (defaultArg episode.Explicit podcast.Explicit)
let xmlDoc = XmlDocument()
let enclosure =
let it = xmlDoc.CreateElement "enclosure"
@@ -154,7 +154,7 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis
let it = xmlDoc.CreateElement("itunes", "image", Namespace.iTunes)
it.SetAttribute("href", epImageUrl)
it
item.ElementExtensions.Add enclosure
item.ElementExtensions.Add image
item.ElementExtensions.Add("creator", Namespace.dc, podcast.DisplayedAuthor)
@@ -162,7 +162,7 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis
item.ElementExtensions.Add("explicit", Namespace.iTunes, epExplicit)
episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add("subtitle", Namespace.iTunes, it))
episode.FormatDuration() |> Option.iter (fun it -> item.ElementExtensions.Add("duration", Namespace.iTunes, it))
let chapterUrl, chapterMimeType =
match episode.Chapters, episode.ChapterFile with
| Some _, _ ->
@@ -175,7 +175,7 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis
| None -> None
Some (toAbsolute webLog chapters), typ
| None, None -> None, None
match chapterUrl with
| Some url ->
let elt = xmlDoc.CreateElement("podcast", "chapters", Namespace.podcast)
@@ -183,7 +183,7 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis
chapterMimeType |> Option.iter (fun it -> elt.SetAttribute("type", it))
item.ElementExtensions.Add elt
| None -> ()
match episode.TranscriptUrl with
| Some transcript ->
let url = toAbsolute webLog transcript
@@ -194,7 +194,7 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis
if defaultArg episode.TranscriptCaptions false then elt.SetAttribute("rel", "captions")
item.ElementExtensions.Add elt
| None -> ()
match episode.SeasonNumber with
| Some season ->
match episode.SeasonDescription with
@@ -205,7 +205,7 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis
item.ElementExtensions.Add elt
| None -> item.ElementExtensions.Add("season", Namespace.podcast, string season)
| None -> ()
match episode.EpisodeNumber with
| Some epNumber ->
match episode.EpisodeDescription with
@@ -216,12 +216,12 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis
item.ElementExtensions.Add elt
| None -> item.ElementExtensions.Add("episode", Namespace.podcast, string epNumber)
| None -> ()
if post.Metadata |> List.exists (fun it -> it.Name = "chapter") then
try
let chapters = xmlDoc.CreateElement("psc", "chapters", Namespace.psc)
chapters.SetAttribute("version", "1.2")
post.Metadata
|> List.filter (fun it -> it.Name = "chapter")
|> List.map (fun it -> TimeSpan.Parse(it.Value.Split(" ")[0]), it.Value[it.Value.IndexOf(" ") + 1..])
@@ -231,11 +231,11 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis
chapter.SetAttribute("start", (fst chap).ToString "hh:mm:ss")
chapter.SetAttribute("title", snd chap)
chapters.AppendChild chapter |> ignore)
item.ElementExtensions.Add chapters
with _ -> ()
item
/// Add a namespace to the feed
let private addNamespace (feed: SyndicationFeed) alias nsUrl =
feed.AttributeExtensions.Add(XmlQualifiedName(alias, "http://www.w3.org/2000/xmlns/"), nsUrl)
@@ -248,16 +248,16 @@ let private addPodcast (webLog: WebLog) (rssFeed: SyndicationFeed) (feed: Custom
|> elt.AppendChild
child.InnerText <- value
elt
let podcast = Option.get feed.Podcast
let feedUrl = webLog.AbsoluteUrl feed.Path
let imageUrl =
match podcast.ImageUrl with
| Permalink link when link.StartsWith "http" -> link
| Permalink _ -> webLog.AbsoluteUrl podcast.ImageUrl
let xmlDoc = XmlDocument()
[ "dc", Namespace.dc
"itunes", Namespace.iTunes
"podcast", Namespace.podcast
@@ -265,7 +265,7 @@ let private addPodcast (webLog: WebLog) (rssFeed: SyndicationFeed) (feed: Custom
"rawvoice", Namespace.rawVoice
]
|> List.iter (fun (alias, nsUrl) -> addNamespace rssFeed alias nsUrl)
let categorization =
let it = xmlDoc.CreateElement("itunes", "category", Namespace.iTunes)
it.SetAttribute("text", podcast.AppleCategory)
@@ -275,7 +275,7 @@ let private addPodcast (webLog: WebLog) (rssFeed: SyndicationFeed) (feed: Custom
subCatElt.SetAttribute("text", subCat)
it.AppendChild subCatElt |> ignore)
it
let image =
let image =
[ "title", podcast.Title
"url", imageUrl
"link", feedUrl
@@ -296,7 +296,7 @@ let private addPodcast (webLog: WebLog) (rssFeed: SyndicationFeed) (feed: Custom
it.SetAttribute("feed", feedUrl)
it.SetAttribute("itunes", "")
it
rssFeed.ElementExtensions.Add image
rssFeed.ElementExtensions.Add owner
rssFeed.ElementExtensions.Add categorization
@@ -328,7 +328,7 @@ let private selfAndLink webLog feedType ctx =
match feed.Source with
| Category (CategoryId catId) ->
feed.Path, Permalink $"category/{(CategoryCache.get ctx |> Array.find (fun c -> c.Id = catId)).Slug}"
| Tag tag -> feed.Path, Permalink $"""tag/{tag.Replace(" ", "+")}/"""
| Tag tag -> feed.Path, Permalink $"""tag/{tag.Replace(" ", "+")}/"""
/// Set the title and description of the feed based on its source
let private setTitleAndDescription feedType (webLog: WebLog) (cats: DisplayCategory[]) (feed: SyndicationFeed) =
@@ -358,8 +358,8 @@ let private setTitleAndDescription feedType (webLog: WebLog) (cats: DisplayCateg
| Tag tag ->
feed.Title <- cleanText None $"""{webLog.Name} - "{tag}" Tag"""
feed.Description <- cleanText None $"""Posts with the "{tag}" tag"""
/// Create a feed with a known non-zero-length list of posts
/// Create a feed with a known non-zero-length list of posts
let createFeed (feedType: FeedType) posts : HttpHandler = fun next ctx -> backgroundTask {
let webLog = ctx.WebLog
let data = ctx.Data
@@ -368,7 +368,7 @@ let createFeed (feedType: FeedType) posts : HttpHandler = fun next ctx -> backgr
let cats = CategoryCache.get ctx
let podcast = match feedType with Custom (feed, _) when Option.isSome feed.Podcast -> Some feed | _ -> None
let self, link = selfAndLink webLog feedType ctx
let toItem post =
let item = toFeedItem webLog authors cats tagMaps post
match podcast, post.Episode with
@@ -377,32 +377,32 @@ let createFeed (feedType: FeedType) posts : HttpHandler = fun next ctx -> backgr
warn "Feed" ctx $"[{webLog.Name} {self}] \"{stripHtml post.Title}\" has no media"
item
| _ -> item
let feed = SyndicationFeed()
addNamespace feed "content" Namespace.content
setTitleAndDescription feedType webLog cats feed
feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset()
feed.Generator <- ctx.Generator
feed.Items <- posts |> Seq.ofList |> Seq.map toItem
feed.Language <- "en"
feed.Id <- webLog.AbsoluteUrl link
webLog.Rss.Copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy)
feed.Links.Add(SyndicationLink(Uri(webLog.AbsoluteUrl self), "self", "", "application/rss+xml", 0L))
feed.ElementExtensions.Add("link", "", webLog.AbsoluteUrl link)
podcast |> Option.iter (addPodcast webLog feed)
use mem = new MemoryStream()
use xml = XmlWriter.Create mem
feed.SaveAsRss20 xml
xml.Close()
let _ = mem.Seek(0L, SeekOrigin.Begin)
let rdr = new StreamReader(mem)
let! output = rdr.ReadToEndAsync()
return! (setHttpHeader "Content-Type" "text/xml" >=> setStatusCode 200 >=> setBodyFromString output) next ctx
}
@@ -416,7 +416,7 @@ let generate (feedType: FeedType) postCount : HttpHandler = fun next ctx -> back
// ~~ FEED ADMINISTRATION ~~
// POST /admin/settings/rss
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditRssModel>()
match! data.WebLog.FindById ctx.WebLog.Id with
@@ -457,7 +457,7 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
| None -> Error.notFound next ctx
// POST /admin/settings/rss/save
let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
src/MyWebLog/Handlers/Page.fs
+3 -3
View File
@@ -62,7 +62,7 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
}
// POST /admin/page/permalinks
let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let savePermalinks : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel>()
let pageId = PageId model.Id
match! ctx.Data.Page.FindById pageId ctx.WebLog.Id with
@@ -121,7 +121,7 @@ let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
}
// POST /admin/page/{id}/revision/{revision-date}/restore
let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update
@@ -148,7 +148,7 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
}
// POST /admin/page/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel>()
let data = ctx.Data
let now = Noda.now ()
src/MyWebLog/Handlers/Post.fs
+5 -5
View File
@@ -98,7 +98,7 @@ open Giraffe
// GET /page/{pageNbr}[/]
let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
if ctx.Request.Path.Value.EndsWith "/" then
if pageNbr <> 1 && ctx.Request.Path.Value.EndsWith "/" then
return! redirectTo true (ctx.WebLog.RelativeUrl(Permalink $"page/{pageNbr}")) next ctx
else
let count = ctx.WebLog.PostsPerPage
@@ -310,7 +310,7 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx
}
// POST /admin/post/permalinks
let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let savePermalinks : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel>()
let postId = PostId model.Id
match! ctx.Data.Post.FindById postId ctx.WebLog.Id with
@@ -370,7 +370,7 @@ let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
}
// POST /admin/post/{id}/revision/{revision-date}/restore
let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update
@@ -431,7 +431,7 @@ let editChapter (postId, index) : HttpHandler = requireAccess Author >=> fun nex
}
// POST /admin/post/{id}/chapter/{idx}
let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post
@@ -483,7 +483,7 @@ let deleteChapter (postId, index) : HttpHandler = requireAccess Author >=> fun n
}
// POST /admin/post/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel>()
let data = ctx.Data
let tryPost =
src/MyWebLog/Handlers/Routes.fs
+73 -82
View File
@@ -20,6 +20,7 @@ module CatchAll =
let await it = (Async.AwaitTask >> Async.RunSynchronously) it
seq {
// Static file
// TODO: static file middleware may take care of this now that we're setting the path base
debug (fun () -> $"Considering URL {textLink}")
let staticFileName =
[ ctx.GetWebHostEnvironment().ContentRootPath
@@ -113,91 +114,21 @@ module Asset =
}
/// The primary myWebLog router
let router : HttpHandler = choose [
subRoute "/admin" (requireUser >=> choose [
POST >=> validateCsrf >=> choose [
subRoute "/cache" (choose [
routef "/theme/%s/refresh" Admin.Cache.refreshTheme
routef "/web-log/%s/refresh" Admin.Cache.refreshWebLog
])
subRoute "/category" (requireAccess WebLogAdmin >=> choose [
route "/save" >=> Admin.Category.save
routef "/%s/delete" Admin.Category.delete
])
route "/my-info" >=> User.saveMyInfo
subRoute "/page" (choose [
route "/save" >=> Page.save
route "/permalinks" >=> Page.savePermalinks
routef "/%s/revision/%s/restore" Page.restoreRevision
])
subRoute "/post" (choose [
route "/save" >=> Post.save
route "/permalinks" >=> Post.savePermalinks
routef "/%s/chapter/%i" Post.saveChapter
routef "/%s/revision/%s/restore" Post.restoreRevision
])
subRoute "/settings" (requireAccess WebLogAdmin >=> choose [
route "" >=> Admin.WebLog.saveSettings
subRoute "/rss" (choose [
route "" >=> Feed.saveSettings
route "/save" >=> Feed.saveCustomFeed
])
subRoute "/redirect-rules" (choose [
routef "/%i" Admin.RedirectRules.save
routef "/%i/up" Admin.RedirectRules.moveUp
routef "/%i/down" Admin.RedirectRules.moveDown
])
route "/tag-mapping/save" >=> Admin.TagMapping.save
route "/user/save" >=> User.save
])
subRoute "/theme" (choose [
route "/new" >=> Admin.Theme.save
routef "/%s/delete" Admin.Theme.delete
])
route "/upload/save" >=> Upload.save
]
DELETE >=> choose [
routef "/category/%s" Admin.Category.delete
subRoute "/page" (choose [
routef "/%s" Page.delete
routef "/%s/revision/%s" Page.deleteRevision
routef "/%s/revisions" Page.purgeRevisions
])
subRoute "/post" (choose [
routef "/%s" Post.delete
routef "/%s/chapter/%i" Post.deleteChapter
routef "/%s/revision/%s" Post.deleteRevision
routef "/%s/revisions" Post.purgeRevisions
])
subRoute "/settings" (requireAccess WebLogAdmin >=> choose [
routef "/redirect-rules/%i" Admin.RedirectRules.delete
routef "/rss/%s" Feed.deleteCustomFeed
routef "/tag-mapping/%s" Admin.TagMapping.delete
routef "/user/%s" User.delete
])
subRoute "/upload" (requireAccess WebLogAdmin >=> choose [
routexp "/disk/(.*)" Upload.deleteFromDisk
routef "/%s" Upload.deleteFromDb
])
]
])
GET_HEAD >=> routexp "/category/(.*)" Post.pageOfCategorizedPosts
GET_HEAD >=> routexp "/tag/(.*)" Post.pageOfTaggedPosts
GET_HEAD >=> routexp "/themes/(.*)" Asset.serve
GET_HEAD >=> routexp "/upload/(.*)" Upload.serve
subRoute "/user" (choose [
POST >=> validateCsrf >=> choose [
route "/log-on" >=> User.doLogOn
]
])
GET_HEAD >=> CatchAll.route
//Error.notFound
/// Router to deal with regex routes and routes served by pages, posts, and feeds
let regexRouter: HttpHandler = choose [
DELETE >=> routexp "/admin/upload/disk/(.*)" Upload.deleteFromDisk
GET_HEAD >=> choose [
routexp "/category/(.*)" Post.pageOfCategorizedPosts
routexp "/tag/(.*)" Post.pageOfTaggedPosts
routexp "/themes/(.*)" Asset.serve
routexp "/upload/(.*)" Upload.serve
CatchAll.route
]
]
open Giraffe.EndpointRouting
/// Endpoint-routed handler to deal with sub-routes
/// The primary myWebLog routes / endpoints
let endpoints = [
GET_HEAD [ route "/" Post.home ]
subRoute "/admin" [
@@ -252,13 +183,73 @@ let endpoints = [
route "/new" Upload.showNew
]
]
POST [
subRoute "/cache" [
routef "/theme/%s/refresh" Admin.Cache.refreshTheme
routef "/web-log/%s/refresh" Admin.Cache.refreshWebLog
]
route "/category/save" Admin.Category.save
route "/my-info" User.saveMyInfo
subRoute "/page" [
route "/save" Page.save
route "/permalinks" Page.savePermalinks
routef "/%s/revision/%s/restore" Page.restoreRevision
]
subRoute "/post" [
route "/save" Post.save
route "/permalinks" Post.savePermalinks
routef "/%s/chapter/%i" Post.saveChapter
routef "/%s/revision/%s/restore" Post.restoreRevision
]
subRoute "/settings" [
route "" Admin.WebLog.saveSettings
subRoute "/rss" [
route "" Feed.saveSettings
route "/save" Feed.saveCustomFeed
]
subRoute "/redirect-rules" [
routef "/%i" Admin.RedirectRules.save
routef "/%i/up" Admin.RedirectRules.moveUp
routef "/%i/down" Admin.RedirectRules.moveDown
]
route "/tag-mapping/save" Admin.TagMapping.save
route "/user/save" User.save
]
subRoute "/theme" [
route "/new" Admin.Theme.save
routef "/%s/delete" Admin.Theme.delete
]
route "/upload/save" Upload.save
]
DELETE [
routef "/category/%s" Admin.Category.delete
subRoute "/page" [
routef "/%s" Page.delete
routef "/%s/revision/%s" Page.deleteRevision
routef "/%s/revisions" Page.purgeRevisions
]
subRoute "/post" [
routef "/%s" Post.delete
routef "/%s/chapter/%i" Post.deleteChapter
routef "/%s/revision/%s" Post.deleteRevision
routef "/%s/revisions" Post.purgeRevisions
]
subRoute "/settings" [
routef "/redirect-rules/%i" Admin.RedirectRules.delete
routef "/rss/%s" Feed.deleteCustomFeed
routef "/tag-mapping/%s" Admin.TagMapping.delete
routef "/user/%s" User.delete
]
routef "/upload/%s" Upload.deleteFromDb
]
]
subRoute "/user" [
GET_HEAD [ route "/log-on" (User.logOn None) ]
POST [
route "/log-off" User.logOff
route "/log-on" User.doLogOn
]
]
GET_HEAD [ routef "/page/%i" Post.pageOfPosts ]
route "{**url}" router
route "{**url}" regexRouter
]
src/MyWebLog/Handlers/Upload.fs
+10 -10
View File
@@ -8,9 +8,9 @@ open Microsoft.Net.Http.Headers
/// Helper functions for this module
[<AutoOpen>]
module private Helpers =
open Microsoft.AspNetCore.StaticFiles
/// A MIME type mapper instance to use when serving files from the database
let mimeMap = FileExtensionContentTypeProvider()
@@ -19,10 +19,10 @@ module private Helpers =
let hdr = CacheControlHeaderValue()
hdr.MaxAge <- Some (TimeSpan.FromDays 30) |> Option.toNullable
hdr
/// Shorthand for the directory separator
let slash = Path.DirectorySeparatorChar
/// The base directory where uploads are stored, relative to the executable
let uploadDir = Path.Combine("wwwroot", "upload")
@@ -128,7 +128,7 @@ let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
adminPage "Upload a File" next ctx Views.WebLog.uploadNew
// POST /admin/upload/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let upload = Seq.head ctx.Request.Form.Files
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
@@ -138,7 +138,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let year = localNow.ToString "yyyy"
let month = localNow.ToString "MM"
let! form = ctx.BindFormAsync<UploadFileModel>()
match UploadDestination.Parse form.Destination with
| Database ->
use stream = new MemoryStream()
@@ -155,7 +155,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let _ = Directory.CreateDirectory fullPath
use stream = new FileStream(Path.Combine(fullPath, fileName), FileMode.Create)
do! upload.CopyToAsync stream
do! addMessage ctx { UserMessage.Success with Message = $"File uploaded to {form.Destination} successfully" }
return! redirectToGet "admin/uploads" next ctx
else
@@ -163,7 +163,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
}
// DELETE /admin/upload/{id}
let deleteFromDb upId : HttpHandler = 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
| Ok fileName ->
do! addMessage ctx { UserMessage.Success with Message = $"{fileName} deleted successfully" }
@@ -181,9 +181,9 @@ let removeEmptyDirectories (webLog: WebLog) (filePath: string) =
Directory.Delete fullPath
path <- String.Join(slash, path.Split slash |> Array.rev |> Array.skip 1 |> Array.rev)
else finished <- true
// DELETE /admin/upload/disk/{**path}
let deleteFromDisk urlParts : HttpHandler = fun next ctx -> task {
let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let filePath = urlParts |> Seq.skip 1 |> Seq.head
let path = Path.Combine(uploadDir, ctx.WebLog.Slug, filePath)
if File.Exists path then
src/MyWebLog/Handlers/User.fs
+4 -4
View File
@@ -43,7 +43,7 @@ open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies
// POST /user/log-on
let doLogOn : HttpHandler = fun next ctx -> task {
let doLogOn : HttpHandler = validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel>()
let data = ctx.Data
let! tryUser = data.WebLogUser.FindByEmail (model.EmailAddress.ToLowerInvariant()) ctx.WebLog.Id
@@ -111,7 +111,7 @@ let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> tas
}
// DELETE /admin/settings/user/{id}
let delete userId : HttpHandler = fun next ctx -> task {
let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLogUser.FindById (WebLogUserId userId) ctx.WebLog.Id with
| Some user ->
@@ -144,7 +144,7 @@ let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
}
// POST /admin/my-info
let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let saveMyInfo : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditMyInfoModel>()
let data = ctx.Data
match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
@@ -172,7 +172,7 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
#nowarn "3511"
// POST /admin/settings/user/save
let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let save : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel>()
let data = ctx.Data
let tryUser =
src/MyWebLog/Program.fs
+4 -3
View File
@@ -22,7 +22,7 @@ type WebLogMiddleware(next: RequestDelegate, log: ILogger<WebLogMiddleware>) =
if CategoryCache.exists ctx then () else do! CategoryCache.update ctx
if webLog.ExtraPath <> "" then
ctx.Request.PathBase <- PathString(webLog.ExtraPath)
ctx.Request.Path <- PathString(ctx.Request.Path.Value[webLog.ExtraPath.Length ..])
ctx.Request.Path <- PathString(ctx.Request.Path.Value[webLog.ExtraPath.Length ..])
return! next.Invoke ctx
| None ->
if isDebug then log.LogDebug $"No resolved web log for {path}"
@@ -235,15 +235,16 @@ let main args =
let _ = app.UseForwardedHeaders()
(app.Services.GetRequiredService<IConfiguration>().GetSection "CanonicalDomains").Value
|> (isNull >> not)
|> isNotNull
|> function true -> app.UseCanonicalDomains() |> ignore | false -> ()
let _ = app.UseCookiePolicy(CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
let _ = app.UseMiddleware<WebLogMiddleware>()
let _ = app.UseMiddleware<RedirectRuleMiddleware>()
let _ = app.UseAuthentication()
let _ = app.UseStaticFiles()
let _ = app.UseRouting()
let _ = app.UseStaticFiles()
//let _ = app.MapStaticAssets()
let _ = app.UseSession()
let _ = app.UseGiraffe Handlers.Routes.endpoints