513 lines
22 KiB
FSharp
513 lines
22 KiB
FSharp
/// Functions to support generating RSS feeds
|
|
module MyWebLog.Handlers.Feed
|
|
|
|
open System
|
|
open System.IO
|
|
open System.Net
|
|
open System.ServiceModel.Syndication
|
|
open System.Text.RegularExpressions
|
|
open System.Xml
|
|
open Giraffe
|
|
open Microsoft.AspNetCore.Http
|
|
open MyWebLog
|
|
open MyWebLog.ViewModels
|
|
|
|
// ~~ FEED GENERATION ~~
|
|
|
|
/// The type of feed to generate
|
|
type FeedType =
|
|
| StandardFeed of string
|
|
| CategoryFeed of CategoryId * string
|
|
| TagFeed of string * string
|
|
| Custom of CustomFeed * string
|
|
|
|
/// Derive the type of RSS feed requested
|
|
let deriveFeedType (ctx: HttpContext) feedPath : (FeedType * int) option =
|
|
let webLog = ctx.WebLog
|
|
let debug = debug "Feed" ctx
|
|
let name = $"/{webLog.Rss.FeedName}"
|
|
let postCount = defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage
|
|
debug (fun () -> $"Considering potential feed for {feedPath} (configured feed name {name})")
|
|
// Standard feed
|
|
match webLog.Rss.IsFeedEnabled && feedPath = name with
|
|
| true ->
|
|
debug (fun () -> "Found standard feed")
|
|
Some(StandardFeed feedPath, postCount)
|
|
| false ->
|
|
// Category and tag feeds are handled by defined routes; check for custom feed
|
|
match webLog.Rss.CustomFeeds
|
|
|> List.tryFind (fun it -> feedPath.EndsWith(string it.Path)) with
|
|
| Some feed ->
|
|
debug (fun () -> "Found custom feed")
|
|
Some(Custom(feed, feedPath), feed.Podcast |> Option.map _.ItemsInFeed |> Option.defaultValue postCount)
|
|
| None ->
|
|
debug (fun () -> "No matching feed found")
|
|
None
|
|
|
|
/// Determine the function to retrieve posts for the given feed
|
|
let private getFeedPosts ctx feedType =
|
|
let childIds (catId: CategoryId) =
|
|
let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = string catId)
|
|
getCategoryIds cat.Slug ctx
|
|
let data = ctx.Data
|
|
match feedType with
|
|
| StandardFeed _ -> data.Post.FindPageOfPublishedPosts ctx.WebLog.Id 1
|
|
| CategoryFeed (catId, _) -> data.Post.FindPageOfCategorizedPosts ctx.WebLog.Id (childIds catId) 1
|
|
| TagFeed (tag, _) -> data.Post.FindPageOfTaggedPosts ctx.WebLog.Id tag 1
|
|
| Custom (feed, _) ->
|
|
match feed.Source with
|
|
| Category catId -> data.Post.FindPageOfCategorizedPosts ctx.WebLog.Id (childIds catId) 1
|
|
| Tag tag -> data.Post.FindPageOfTaggedPosts ctx.WebLog.Id tag 1
|
|
|
|
/// Strip HTML from a string
|
|
let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace(text, "<(.|\n)*?>", "")
|
|
|
|
/// XML namespaces for building RSS feeds
|
|
[<RequireQualifiedAccess>]
|
|
module private Namespace =
|
|
|
|
/// Enables encoded (HTML) content
|
|
let content = "http://purl.org/rss/1.0/modules/content/"
|
|
|
|
/// The dc XML namespace
|
|
let dc = "http://purl.org/dc/elements/1.1/"
|
|
|
|
/// iTunes elements
|
|
let iTunes = "http://www.itunes.com/dtds/podcast-1.0.dtd"
|
|
|
|
/// 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
|
|
let private toFeedItem (webLog: WebLog) (authors: MetaItem list) (cats: DisplayCategory array) (tagMaps: TagMap list)
|
|
(post: Post) =
|
|
let plainText =
|
|
let endingP = post.Text.IndexOf "</p>"
|
|
stripHtml <| if endingP >= 0 then post.Text[..(endingP - 1)] else post.Text
|
|
let item = SyndicationItem(
|
|
Id = webLog.AbsoluteUrl post.Permalink,
|
|
Title = TextSyndicationContent.CreateHtmlContent post.Title,
|
|
PublishDate = post.PublishedOn.Value.ToDateTimeOffset(),
|
|
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset(),
|
|
Content = TextSyndicationContent.CreatePlaintextContent plainText)
|
|
item.AddPermalink (Uri item.Id)
|
|
|
|
let xmlDoc = XmlDocument()
|
|
|
|
let encoded =
|
|
let txt =
|
|
post.Text
|
|
.Replace("src=\"/", $"src=\"{webLog.UrlBase}/")
|
|
.Replace("href=\"/", $"href=\"{webLog.UrlBase}/")
|
|
let it = xmlDoc.CreateElement("content", "encoded", Namespace.content)
|
|
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 ->
|
|
let cat = cats |> Array.find (fun c -> c.Id = string catId)
|
|
SyndicationCategory(cat.Name, webLog.AbsoluteUrl(Permalink $"category/{cat.Slug}/"), cat.Name))
|
|
post.Tags
|
|
|> List.map (fun tag ->
|
|
let urlTag =
|
|
match tagMaps |> List.tryFind (fun tm -> tm.Tag = tag) with
|
|
| Some tm -> tm.UrlValue
|
|
| None -> tag.Replace (" ", "+")
|
|
SyndicationCategory(tag, webLog.AbsoluteUrl(Permalink $"tag/{urlTag}/"), $"{tag} (tag)"))
|
|
]
|
|
|> List.concat
|
|
|> List.iter item.Categories.Add
|
|
item
|
|
|
|
/// Convert non-absolute URLs to an absolute URL for this web log
|
|
let toAbsolute (webLog: WebLog) (link: string) =
|
|
if link.StartsWith "http" then link else webLog.AbsoluteUrl(Permalink link)
|
|
|
|
/// Add episode information to a podcast feed item
|
|
let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Episode) (post: Post)
|
|
(item: SyndicationItem) =
|
|
let epMediaUrl =
|
|
match episode.Media with
|
|
| link when link.StartsWith "http" -> link
|
|
| link when Option.isSome podcast.MediaBaseUrl -> $"{podcast.MediaBaseUrl.Value}{link}"
|
|
| link -> webLog.AbsoluteUrl(Permalink link)
|
|
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"
|
|
it.SetAttribute("url", epMediaUrl)
|
|
it.SetAttribute("length", string episode.Length)
|
|
epMediaType |> Option.iter (fun typ -> it.SetAttribute("type", typ))
|
|
it
|
|
let image =
|
|
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)
|
|
item.ElementExtensions.Add("author", Namespace.iTunes, podcast.DisplayedAuthor)
|
|
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 _, _ ->
|
|
Some $"{webLog.AbsoluteUrl post.Permalink}?chapters", Some JSON_CHAPTERS
|
|
| None, Some chapters ->
|
|
let typ =
|
|
match episode.ChapterType with
|
|
| Some mime -> Some mime
|
|
| None when chapters.EndsWith ".json" -> Some JSON_CHAPTERS
|
|
| None -> None
|
|
Some (toAbsolute webLog chapters), typ
|
|
| None, None -> None, None
|
|
|
|
match chapterUrl with
|
|
| Some url ->
|
|
let elt = xmlDoc.CreateElement("podcast", "chapters", Namespace.podcast)
|
|
elt.SetAttribute("url", url)
|
|
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
|
|
let elt = xmlDoc.CreateElement("podcast", "transcript", Namespace.podcast)
|
|
elt.SetAttribute("url", url)
|
|
elt.SetAttribute("type", Option.get episode.TranscriptType)
|
|
episode.TranscriptLang |> Option.iter (fun it -> elt.SetAttribute("language", it))
|
|
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
|
|
| Some desc ->
|
|
let elt = xmlDoc.CreateElement("podcast", "season", Namespace.podcast)
|
|
elt.SetAttribute("name", desc)
|
|
elt.InnerText <- string season
|
|
item.ElementExtensions.Add elt
|
|
| None -> item.ElementExtensions.Add("season", Namespace.podcast, string season)
|
|
| None -> ()
|
|
|
|
match episode.EpisodeNumber with
|
|
| Some epNumber ->
|
|
match episode.EpisodeDescription with
|
|
| Some desc ->
|
|
let elt = xmlDoc.CreateElement("podcast", "episode", Namespace.podcast)
|
|
elt.SetAttribute("name", desc)
|
|
elt.InnerText <- string epNumber
|
|
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..])
|
|
|> List.sortBy fst
|
|
|> List.iter (fun chap ->
|
|
let chapter = xmlDoc.CreateElement("psc", "chapter", Namespace.psc)
|
|
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)
|
|
|
|
/// Add items to the top of the feed required for podcasts
|
|
let private addPodcast (webLog: WebLog) (rssFeed: SyndicationFeed) (feed: CustomFeed) =
|
|
let addChild (doc: XmlDocument) ns prefix name value (elt: XmlElement) =
|
|
let child =
|
|
if ns = "" then doc.CreateElement name else doc.CreateElement(prefix, name, ns)
|
|
|> elt.AppendChild
|
|
child.InnerText <- value
|
|
elt
|
|
|
|
let podcast = Option.get feed.Podcast
|
|
let feedUrl = webLog.AbsoluteUrl feed.Path
|
|
let imageUrl =
|
|
match podcast.ImageUrl with
|
|
| link when link.StartsWith "http" -> link
|
|
| _ -> webLog.AbsoluteUrl (Permalink podcast.ImageUrl)
|
|
|
|
let xmlDoc = XmlDocument()
|
|
|
|
[ "dc", Namespace.dc
|
|
"itunes", Namespace.iTunes
|
|
"podcast", Namespace.podcast
|
|
"psc", Namespace.psc
|
|
"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)
|
|
podcast.AppleSubcategory
|
|
|> Option.iter (fun subCat ->
|
|
let subCatElt = xmlDoc.CreateElement("itunes", "category", Namespace.iTunes)
|
|
subCatElt.SetAttribute("text", subCat)
|
|
it.AppendChild subCatElt |> ignore)
|
|
it
|
|
let image =
|
|
[ "title", podcast.Title
|
|
"url", imageUrl
|
|
"link", feedUrl
|
|
]
|
|
|> List.fold (fun elt (name, value) -> addChild xmlDoc "" "" name value elt) (xmlDoc.CreateElement "image")
|
|
let iTunesImage =
|
|
let it = xmlDoc.CreateElement("itunes", "image", Namespace.iTunes)
|
|
it.SetAttribute("href", imageUrl)
|
|
it
|
|
let owner =
|
|
[ "name", podcast.DisplayedAuthor
|
|
"email", podcast.Email
|
|
]
|
|
|> List.fold (fun elt (name, value) -> addChild xmlDoc Namespace.iTunes "itunes" name value elt)
|
|
(xmlDoc.CreateElement("itunes", "owner", Namespace.iTunes))
|
|
let rawVoice =
|
|
let it = xmlDoc.CreateElement("rawvoice", "subscribe", Namespace.rawVoice)
|
|
it.SetAttribute("feed", feedUrl)
|
|
it.SetAttribute("itunes", "")
|
|
it
|
|
|
|
rssFeed.ElementExtensions.Add image
|
|
rssFeed.ElementExtensions.Add owner
|
|
rssFeed.ElementExtensions.Add categorization
|
|
rssFeed.ElementExtensions.Add iTunesImage
|
|
rssFeed.ElementExtensions.Add rawVoice
|
|
rssFeed.ElementExtensions.Add("summary", Namespace.iTunes, podcast.Summary)
|
|
rssFeed.ElementExtensions.Add("author", Namespace.iTunes, podcast.DisplayedAuthor)
|
|
rssFeed.ElementExtensions.Add("explicit", Namespace.iTunes, string podcast.Explicit)
|
|
podcast.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add("subtitle", Namespace.iTunes, sub))
|
|
podcast.FundingUrl
|
|
|> Option.iter (fun url ->
|
|
let funding = xmlDoc.CreateElement("podcast", "funding", Namespace.podcast)
|
|
funding.SetAttribute("url", toAbsolute webLog url)
|
|
funding.InnerText <- defaultArg podcast.FundingText "Support This Podcast"
|
|
rssFeed.ElementExtensions.Add funding)
|
|
podcast.PodcastGuid
|
|
|> Option.iter (fun guid ->
|
|
rssFeed.ElementExtensions.Add("guid", Namespace.podcast, guid.ToString().ToLowerInvariant()))
|
|
podcast.Medium |> Option.iter (fun med -> rssFeed.ElementExtensions.Add("medium", Namespace.podcast, string med))
|
|
|
|
/// Get the feed's self reference and non-feed link
|
|
let private selfAndLink webLog feedType ctx =
|
|
let withoutFeed (it: string) = Permalink(it.Replace($"/{webLog.Rss.FeedName}", ""))
|
|
match feedType with
|
|
| StandardFeed path
|
|
| CategoryFeed (_, path)
|
|
| TagFeed (_, path) -> Permalink path[1..], withoutFeed path
|
|
| Custom (feed, _) ->
|
|
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(" ", "+")}/"""
|
|
|
|
/// Set the title and description of the feed based on its source
|
|
let private setTitleAndDescription feedType (webLog: WebLog) (cats: DisplayCategory[]) (feed: SyndicationFeed) =
|
|
let cleanText opt def = TextSyndicationContent(stripHtml (defaultArg opt def))
|
|
match feedType with
|
|
| StandardFeed _ ->
|
|
feed.Title <- cleanText None webLog.Name
|
|
feed.Description <- cleanText webLog.Subtitle webLog.Name
|
|
| CategoryFeed (CategoryId catId, _) ->
|
|
let cat = cats |> Array.find (fun it -> it.Id = catId)
|
|
feed.Title <- cleanText None $"""{webLog.Name} - "{stripHtml cat.Name}" Category"""
|
|
feed.Description <- cleanText cat.Description $"""Posts categorized under "{cat.Name}" """
|
|
| TagFeed (tag, _) ->
|
|
feed.Title <- cleanText None $"""{webLog.Name} - "{tag}" Tag"""
|
|
feed.Description <- cleanText None $"""Posts with the "{tag}" tag"""
|
|
| Custom (custom, _) ->
|
|
match custom.Podcast with
|
|
| Some podcast ->
|
|
feed.Title <- cleanText None podcast.Title
|
|
feed.Description <- cleanText podcast.Subtitle podcast.Title
|
|
| None ->
|
|
match custom.Source with
|
|
| Category (CategoryId catId) ->
|
|
let cat = cats |> Array.find (fun it -> it.Id = catId)
|
|
feed.Title <- cleanText None $"""{webLog.Name} - "{stripHtml cat.Name}" Category"""
|
|
feed.Description <- cleanText cat.Description $"""Posts categorized under "{cat.Name}" """
|
|
| 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
|
|
let createFeed (feedType: FeedType) posts : HttpHandler = fun next ctx -> backgroundTask {
|
|
let webLog = ctx.WebLog
|
|
let data = ctx.Data
|
|
let! authors = getAuthors webLog posts data
|
|
let! tagMaps = getTagMappings webLog posts data
|
|
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
|
|
| Some feed, Some episode -> addEpisode webLog (Option.get feed.Podcast) episode post item
|
|
| Some _, _ ->
|
|
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
|
|
}
|
|
|
|
// GET {any-prescribed-feed}
|
|
let generate (feedType: FeedType) postCount : HttpHandler = fun next ctx -> backgroundTask {
|
|
match! getFeedPosts ctx feedType postCount with
|
|
| posts when List.length posts > 0 -> return! createFeed feedType posts next ctx
|
|
| _ -> return! Error.notFound next ctx
|
|
}
|
|
|
|
// ~~ FEED ADMINISTRATION ~~
|
|
|
|
// POST /admin/settings/rss
|
|
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
|
|
| Some webLog ->
|
|
let webLog = { webLog with Rss = model.UpdateOptions webLog.Rss }
|
|
do! data.WebLog.UpdateRssOptions webLog
|
|
WebLogCache.set webLog
|
|
do! addMessage ctx { UserMessage.Success with Message = "RSS settings updated successfully" }
|
|
return! redirectToGet "admin/settings#rss-settings" next ctx
|
|
| None -> return! Error.notFound next ctx
|
|
}
|
|
|
|
// GET /admin/settings/rss/{id}/edit
|
|
let editCustomFeed feedId : HttpHandler =
|
|
requireAccess WebLogAdmin
|
|
>=> fun next ctx ->
|
|
let customFeed =
|
|
match feedId with
|
|
| "new" -> Some { CustomFeed.Empty with Id = CustomFeedId "new" }
|
|
| _ -> ctx.WebLog.Rss.CustomFeeds |> List.tryFind (fun f -> f.Id = CustomFeedId feedId)
|
|
match customFeed with
|
|
| Some f ->
|
|
let ratings = [
|
|
{ Name = string Yes; Value = "Yes" }
|
|
{ Name = string No; Value = "No" }
|
|
{ Name = string Clean; Value = "Clean" }
|
|
]
|
|
let mediums = [
|
|
{ Name = ""; Value = "– Unspecified –" }
|
|
{ Name = string Podcast; Value = "Podcast" }
|
|
{ Name = string Music; Value = "Music" }
|
|
{ Name = string Video; Value = "Video" }
|
|
{ Name = string Film; Value = "Film" }
|
|
{ Name = string Audiobook; Value = "Audiobook" }
|
|
{ Name = string Newsletter; Value = "Newsletter" }
|
|
{ Name = string Blog; Value = "Blog" }
|
|
]
|
|
Views.WebLog.feedEdit (EditCustomFeedModel.FromFeed f) ratings mediums
|
|
|> adminPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed""" next ctx
|
|
| None -> Error.notFound next ctx
|
|
|
|
// POST /admin/settings/rss/save
|
|
let saveCustomFeed : HttpHandler =
|
|
requireAccess WebLogAdmin
|
|
>=> validateCsrf
|
|
>=> fun next ctx -> task {
|
|
let data = ctx.Data
|
|
match! data.WebLog.FindById ctx.WebLog.Id with
|
|
| Some webLog ->
|
|
let! model = ctx.BindFormAsync<EditCustomFeedModel>()
|
|
let theFeed =
|
|
match model.Id with
|
|
| "new" -> Some { CustomFeed.Empty with Id = CustomFeedId.Create() }
|
|
| _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> string it.Id = model.Id)
|
|
match theFeed with
|
|
| Some feed ->
|
|
let feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> feed.Id))
|
|
let webLog = { webLog with Rss.CustomFeeds = feeds }
|
|
do! data.WebLog.UpdateRssOptions webLog
|
|
WebLogCache.set webLog
|
|
do! addMessage ctx
|
|
{ UserMessage.Success with
|
|
Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed""" }
|
|
return! redirectToGet $"admin/settings/rss/{feed.Id}/edit" next ctx
|
|
| None -> return! Error.notFound next ctx
|
|
| None -> return! Error.notFound next ctx
|
|
}
|
|
|
|
// DELETE /admin/settings/rss/{id}
|
|
let deleteCustomFeed feedId : HttpHandler =
|
|
requireAccess WebLogAdmin
|
|
>=> fun next ctx -> task {
|
|
let data = ctx.Data
|
|
match! data.WebLog.FindById ctx.WebLog.Id with
|
|
| Some webLog ->
|
|
let customId = CustomFeedId feedId
|
|
if webLog.Rss.CustomFeeds |> List.exists (fun f -> f.Id = customId) then
|
|
let webLog =
|
|
{ webLog with
|
|
Rss =
|
|
{ webLog.Rss with
|
|
CustomFeeds = webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> customId) } }
|
|
do! data.WebLog.UpdateRssOptions webLog
|
|
WebLogCache.set webLog
|
|
do! addMessage ctx { UserMessage.Success with Message = "Custom feed deleted successfully" }
|
|
else
|
|
do! addMessage ctx { UserMessage.Warning with Message = "Custom feed not found; no action taken" }
|
|
return! redirectToGet "admin/settings#rss-settings" next ctx
|
|
| None -> return! Error.notFound next ctx
|
|
}
|