V2 #1

Merged
danieljsummers merged 102 commits from v2 into main 2022-06-23 00:35:12 +00:00
6 changed files with 275 additions and 92 deletions
Showing only changes of commit 1cd7b06add - Show all commits

View File

@ -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 ()
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 ()
}

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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
// 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
/// The type of feed to generate
type FeedType =
| Standard
| Category of CategoryId
| Tag of string
| Custom of CustomFeed
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)
/// 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
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
// 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
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)
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 ()
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 ()
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
}
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

View File

@ -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"