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<CustomFeedSource> ()
+    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<ExplicitRating> ()
+    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<MarkupText> ()
     override _.WriteJson (writer : JsonWriter, value : MarkupText, _ : JsonSerializer) =
@@ -75,15 +89,17 @@ open Microsoft.FSharpLu.Json
 let all () : JsonConverter seq =
     seq {
         // Our converters
-        CategoryIdConverter   ()
+        CategoryIdConverter       ()
-        CommentIdConverter    ()
+        CommentIdConverter        ()
-        MarkupTextConverter   ()
+        CustomFeedSourceConverter ()
-        PermalinkConverter    ()
+        ExplicitRatingConverter   ()
-        PageIdConverter       ()
+        MarkupTextConverter       ()
-        PostIdConverter       ()
+        PermalinkConverter        ()
-        TagMapIdConverter     ()
+        PageIdConverter           ()
-        WebLogIdConverter     ()
+        PostIdConverter           ()
-        WebLogUserIdConverter ()
+        TagMapIdConverter         ()
+        WebLogIdConverter         ()
+        WebLogUserIdConverter     ()
         // Handles DUs with no associated data, as well as option fields
         CompactUnionJsonConverter ()
     }

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)

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

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
 

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
+    /// The type of feed to generate
-open System.ServiceModel.Syndication
+    type FeedType =
-open System.Text.RegularExpressions
+        | Standard
-open System.Xml
+        | 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
+        match Feed.deriveFeedType ctx webLog textLink with
-        if textLink = "/feed.xml" then yield generateFeed
+        | 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

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"