Convert all but regex routes to endpoints (#59)

This commit is contained in:
2026-07-03 12:53:24 -04:00
parent be094fb07e
commit 38a06b53f4
8 changed files with 148 additions and 156 deletions
+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 ->