diff --git a/src/MyWebLog.Data/Converters.fs b/src/MyWebLog.Data/Converters.fs index e3a4e7c..49a08c0 100644 --- a/src/MyWebLog.Data/Converters.fs +++ b/src/MyWebLog.Data/Converters.fs @@ -20,6 +20,20 @@ type CommentIdConverter () = override _.ReadJson (reader : JsonReader, _ : Type, _ : CommentId, _ : bool, _ : JsonSerializer) = (string >> CommentId) reader.Value +type CustomFeedSourceConverter () = + inherit JsonConverter () + override _.WriteJson (writer : JsonWriter, value : CustomFeedSource, _ : JsonSerializer) = + writer.WriteValue (CustomFeedSource.toString value) + override _.ReadJson (reader : JsonReader, _ : Type, _ : CustomFeedSource, _ : bool, _ : JsonSerializer) = + (string >> CustomFeedSource.parse) reader.Value + +type ExplicitRatingConverter () = + inherit JsonConverter () + override _.WriteJson (writer : JsonWriter, value : ExplicitRating, _ : JsonSerializer) = + writer.WriteValue (ExplicitRating.toString value) + override _.ReadJson (reader : JsonReader, _ : Type, _ : ExplicitRating, _ : bool, _ : JsonSerializer) = + (string >> ExplicitRating.parse) reader.Value + type MarkupTextConverter () = inherit JsonConverter () override _.WriteJson (writer : JsonWriter, value : MarkupText, _ : JsonSerializer) = @@ -75,15 +89,17 @@ open Microsoft.FSharpLu.Json let all () : JsonConverter seq = seq { // Our converters - CategoryIdConverter () - CommentIdConverter () - MarkupTextConverter () - PermalinkConverter () - PageIdConverter () - PostIdConverter () - TagMapIdConverter () - WebLogIdConverter () - WebLogUserIdConverter () + CategoryIdConverter () + CommentIdConverter () + CustomFeedSourceConverter () + ExplicitRatingConverter () + MarkupTextConverter () + PermalinkConverter () + PageIdConverter () + PostIdConverter () + TagMapIdConverter () + WebLogIdConverter () + WebLogUserIdConverter () // Handles DUs with no associated data, as well as option fields CompactUnionJsonConverter () } diff --git a/src/MyWebLog.Data/Data.fs b/src/MyWebLog.Data/Data.fs index daa94ad..1715a17 100644 --- a/src/MyWebLog.Data/Data.fs +++ b/src/MyWebLog.Data/Data.fs @@ -77,7 +77,7 @@ module Startup = log.LogInformation $"Creating index {table}.permalink..." do! rethink { withTable table - indexCreate "permalink" (fun row -> r.Array (row["webLogId"], row["permalink"]) :> obj) + indexCreate "permalink" (fun row -> r.Array (row["webLogId"], row["permalink"].Downcase ()) :> obj) write; withRetryOnce; ignoreResult conn } // Prior permalinks are searched when a post or page permalink do not match the current URL @@ -85,7 +85,7 @@ module Startup = log.LogInformation $"Creating index {table}.priorPermalinks..." do! rethink { withTable table - indexCreate "priorPermalinks" [ Multi ] + indexCreate "priorPermalinks" (fun row -> row["priorPermalinks"].Downcase () :> obj) [ Multi ] write; withRetryOnce; ignoreResult conn } // Post needs indexes by category and tag (used for counting and retrieving posts) diff --git a/src/MyWebLog.Domain/DataTypes.fs b/src/MyWebLog.Domain/DataTypes.fs index 60c4b72..a8e8089 100644 --- a/src/MyWebLog.Domain/DataTypes.fs +++ b/src/MyWebLog.Domain/DataTypes.fs @@ -272,12 +272,15 @@ type WebLog = /// The time zone in which dates/times should be displayed timeZone : string + + /// The RSS options for this web log + rss : RssOptions } /// Functions to support web logs module WebLog = - /// An empty set of web logs + /// An empty web log let empty = { id = WebLogId.empty name = "" @@ -287,6 +290,7 @@ module WebLog = themePath = "default" urlBase = "" timeZone = "" + rss = RssOptions.empty } /// Get the host (including scheme) and extra path from the URL base diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index cad55bd..cb607e2 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -187,6 +187,133 @@ module PostId = let create () = PostId (newId ()) +/// The source for a custom feed +type CustomFeedSource = + /// A feed based on a particular category + | Category of CategoryId + /// A feed based on a particular tag + | Tag of string + +/// Functions to support feed sources +module CustomFeedSource = + /// Create a string version of a feed source + let toString : CustomFeedSource -> string = + function + | Category (CategoryId catId) -> $"category:{catId}" + | Tag tag -> $"tag:{tag}" + + /// Parse a feed source from its string version + let parse : string -> CustomFeedSource = + let value (it : string) = it.Split(":").[1] + function + | source when source.StartsWith "category:" -> (value >> CategoryId >> Category) source + | source when source.StartsWith "tag:" -> (value >> Tag) source + | source -> invalidArg "feedSource" $"{source} is not a valid feed source" + + +/// Valid values for the iTunes explicit rating +type ExplicitRating = + | Yes + | No + | Clean + +/// Functions to support iTunes explicit ratings +module ExplicitRating = + /// Convert an explicit rating to a string + let toString : ExplicitRating -> string = + function + | Yes -> "yes" + | No -> "no" + | Clean -> "clean" + + /// Parse a string into an explicit rating + let parse : string -> ExplicitRating = + function + | "yes" -> Yes + | "no" -> No + | "clean" -> Clean + | x -> raise (invalidArg "rating" $"{x} is not a valid explicit rating") + + +/// Options for a feed that describes a podcast +type PodcastOptions = + { /// The title of the podcast + title : string + + /// A subtitle for the podcast + subtitle : string option + + /// The number of items in the podcast feed + itemsInFeed : int + + /// A summary of the podcast (iTunes field) + summary : string + + /// The display name of the podcast author (iTunes field) + displayedAuthor : string + + /// The e-mail address of the user who registered the podcast at iTunes + email : string + + /// The category from iTunes under which this podcast is categorized + iTunesCategory : string + + /// A further refinement of the categorization of this podcast (iTunes field / values) + iTunesSubcategory : string + + /// The explictness rating (iTunes field) + explicit : ExplicitRating + } + + +/// A custom feed +type CustomFeed = + { /// The source for the custom feed + source : CustomFeedSource + + /// The path for the custom feed + path : Permalink + + /// Podcast options, if the feed defines a podcast + podcast : PodcastOptions option + } + + +/// Really Simple Syndication (RSS) options for this web log +type RssOptions = + { /// Whether the site feed of posts is enabled + feedEnabled : bool + + /// The name of the file generated for the site feed + feedName : string + + /// Override the "posts per page" setting for the site feed + itemsInFeed : int option + + /// Whether feeds are enabled for all categories + categoryEnabled : bool + + /// Whether feeds are enabled for all tags + tagEnabled : bool + + /// Custom feeds for this web log + customFeeds: CustomFeed list + } + +/// Functions to support RSS options +module RssOptions = + + /// An empty set of RSS options + let empty = + { feedEnabled = true + feedName = "feed.xml" + itemsInFeed = None + categoryEnabled = true + tagEnabled = true + customFeeds = [] + } + + /// An identifier for a tag mapping type TagMapId = TagMapId of string diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs index 7d13df9..7167802 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -195,84 +195,119 @@ let home : HttpHandler = fun next ctx -> task { | None -> return! Error.notFound next ctx } +/// Functions to support generating RSS feeds +module Feed = + + open System.IO + open System.ServiceModel.Syndication + open System.Text.RegularExpressions + open System.Xml -open System.IO -open System.ServiceModel.Syndication -open System.Text.RegularExpressions -open System.Xml + /// The type of feed to generate + type FeedType = + | Standard + | Category of CategoryId + | Tag of string + | Custom of CustomFeed + + /// Derive the type of RSS feed requested + let deriveFeedType ctx webLog feedPath : (FeedType * int) option = + let name = $"/{webLog.rss.feedName}" + let postCount = defaultArg webLog.rss.itemsInFeed webLog.postsPerPage + // Standard feed + match webLog.rss.feedEnabled && feedPath = name with + | true -> Some (Standard, postCount) + | false -> + // Category feed + match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.slug = feedPath.Replace (name, "")) with + | Some cat -> Some (Category (CategoryId cat.id), postCount) + | None -> + // Tag feed + match feedPath.StartsWith "/tag/" with + | true -> Some (Tag (feedPath.Replace("/tag/", "").Replace(name, "")), postCount) + | false -> + // Custom feed + match webLog.rss.customFeeds + |> List.tryFind (fun it -> (Permalink.toString it.path).EndsWith feedPath) with + | Some feed -> + Some (Custom feed, + feed.podcast |> Option.map (fun p -> p.itemsInFeed) |> Option.defaultValue postCount) + | None -> + // No feed + None + + // GET {any-prescribed-feed} + let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> backgroundTask { + // TODO: stopped here; use feed type and count in the below function + let webLog = ctx.WebLog + let conn = ctx.Conn + let! posts = Data.Post.findPageOfPublishedPosts webLog.id 1 postCount conn + let! authors = getAuthors webLog posts conn + let! tagMaps = getTagMappings webLog posts conn + let cats = CategoryCache.get ctx + + let toItem (post : Post) = + let plainText = + Regex.Replace (post.text, "<(.|\n)*?>", "") + |> function + | txt when txt.Length < 255 -> txt + | txt -> $"{txt.Substring (0, 252)}..." + let item = SyndicationItem ( + Id = WebLog.absoluteUrl webLog post.permalink, + Title = TextSyndicationContent.CreateHtmlContent post.title, + PublishDate = DateTimeOffset post.publishedOn.Value, + LastUpdatedTime = DateTimeOffset post.updatedOn, + Content = TextSyndicationContent.CreatePlaintextContent plainText) + item.AddPermalink (Uri item.Id) + + let encoded = + post.text.Replace("src=\"/", $"src=\"{webLog.urlBase}/").Replace ("href=\"/", $"href=\"{webLog.urlBase}/") + item.ElementExtensions.Add ("encoded", "http://purl.org/rss/1.0/modules/content/", encoded) + item.Authors.Add (SyndicationPerson ( + Name = (authors |> List.find (fun a -> a.name = WebLogUserId.toString post.authorId)).value)) + [ post.categoryIds + |> List.map (fun catId -> + let cat = cats |> Array.find (fun c -> c.id = CategoryId.toString catId) + SyndicationCategory (cat.name, WebLog.absoluteUrl webLog (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 webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)")) + ] + |> List.concat + |> List.iter item.Categories.Add + item + + + let feed = SyndicationFeed () + feed.Title <- TextSyndicationContent webLog.name + feed.Description <- TextSyndicationContent <| defaultArg webLog.subtitle webLog.name + feed.LastUpdatedTime <- DateTimeOffset <| (List.head posts).updatedOn + feed.Generator <- generator ctx + feed.Items <- posts |> Seq.ofList |> Seq.map toItem + feed.Language <- "en" + feed.Id <- webLog.urlBase + + feed.Links.Add (SyndicationLink (Uri $"{webLog.urlBase}/feed.xml", "self", "", "application/rss+xml", 0L)) + feed.AttributeExtensions.Add + (XmlQualifiedName ("content", "http://www.w3.org/2000/xmlns/"), "http://purl.org/rss/1.0/modules/content/") + feed.ElementExtensions.Add ("link", "", webLog.urlBase) + + 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 /feed.xml -// (Routing handled by catch-all handler for future configurability) -let generateFeed : HttpHandler = fun next ctx -> backgroundTask { - let webLog = ctx.WebLog - let conn = ctx.Conn - // TODO: hard-coded number of items - let! posts = Data.Post.findPageOfPublishedPosts webLog.id 1 10 conn - let! authors = getAuthors webLog posts conn - let! tagMaps = getTagMappings webLog posts conn - let cats = CategoryCache.get ctx - - let toItem (post : Post) = - let plainText = - Regex.Replace (post.text, "<(.|\n)*?>", "") - |> function - | txt when txt.Length < 255 -> txt - | txt -> $"{txt.Substring (0, 252)}..." - let item = SyndicationItem ( - Id = WebLog.absoluteUrl webLog post.permalink, - Title = TextSyndicationContent.CreateHtmlContent post.title, - PublishDate = DateTimeOffset post.publishedOn.Value, - LastUpdatedTime = DateTimeOffset post.updatedOn, - Content = TextSyndicationContent.CreatePlaintextContent plainText) - item.AddPermalink (Uri item.Id) - - let encoded = - post.text.Replace("src=\"/", $"src=\"{webLog.urlBase}/").Replace ("href=\"/", $"href=\"{webLog.urlBase}/") - item.ElementExtensions.Add ("encoded", "http://purl.org/rss/1.0/modules/content/", encoded) - item.Authors.Add (SyndicationPerson ( - Name = (authors |> List.find (fun a -> a.name = WebLogUserId.toString post.authorId)).value)) - [ post.categoryIds - |> List.map (fun catId -> - let cat = cats |> Array.find (fun c -> c.id = CategoryId.toString catId) - SyndicationCategory (cat.name, WebLog.absoluteUrl webLog (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 webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)")) - ] - |> List.concat - |> List.iter item.Categories.Add - item - - - let feed = SyndicationFeed () - feed.Title <- TextSyndicationContent webLog.name - feed.Description <- TextSyndicationContent <| defaultArg webLog.subtitle webLog.name - feed.LastUpdatedTime <- DateTimeOffset <| (List.head posts).updatedOn - feed.Generator <- generator ctx - feed.Items <- posts |> Seq.ofList |> Seq.map toItem - feed.Language <- "en" - feed.Id <- webLog.urlBase - - feed.Links.Add (SyndicationLink (Uri $"{webLog.urlBase}/feed.xml", "self", "", "application/rss+xml", 0L)) - feed.AttributeExtensions.Add - (XmlQualifiedName ("content", "http://www.w3.org/2000/xmlns/"), "http://purl.org/rss/1.0/modules/content/") - feed.ElementExtensions.Add ("link", "", webLog.urlBase) - - 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 -} /// Sequence where the first returned value is the proper handler for the link let private deriveAction (ctx : HttpContext) : HttpHandler seq = @@ -281,7 +316,7 @@ let private deriveAction (ctx : HttpContext) : HttpHandler seq = let textLink = let _, extra = WebLog.hostAndPath webLog let url = string ctx.Request.Path - if extra = "" then url else url.Substring extra.Length + (if extra = "" then url else url.Substring extra.Length).ToLowerInvariant () let await it = (Async.AwaitTask >> Async.RunSynchronously) it seq { debug "Post" ctx (fun () -> $"Considering URL {textLink}") @@ -303,8 +338,9 @@ let private deriveAction (ctx : HttpContext) : HttpHandler seq = |> themedView (defaultArg page.template "single-page") next ctx | None -> () // RSS feed - // TODO: configure this via web log - if textLink = "/feed.xml" then yield generateFeed + match Feed.deriveFeedType ctx webLog textLink with + | Some (feedType, postCount) -> yield Feed.generate feedType postCount + | None -> () // Post differing only by trailing slash let altLink = Permalink (if textLink.EndsWith "/" then textLink[..textLink.Length - 2] else $"{textLink}/") match Data.Post.findByPermalink altLink webLog.id conn |> await with diff --git a/src/MyWebLog/appsettings.json b/src/MyWebLog/appsettings.json index cd32ad5..9f0e53e 100644 --- a/src/MyWebLog/appsettings.json +++ b/src/MyWebLog/appsettings.json @@ -3,7 +3,7 @@ "hostname": "data02.bitbadger.solutions", "database": "myWebLog_dev" }, - "Generator": "myWebLog 2.0-alpha14", + "Generator": "myWebLog 2.0-alpha15", "Logging": { "LogLevel": { "MyWebLog.Handlers": "Debug"