bit-badger/myWebLog
1
0
Fork 0
Code Issues 4 Pull Requests Packages Projects Releases 11 Activity

WIP on module/member conversion

Browse Source
This commit is contained in:
Daniel J. Summers 2023-12-14 23:49:38 -05:00
parent ec2d43acde
commit 7071d606f1
19 changed files with 250 additions and 255 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
src/MyWebLog.Data/Converters.fs
View File

@ -9,20 +9,27 @@ module Json =
open Newtonsoft.Json open Newtonsoft.Json
type CategoryIdConverter () = type CategoryIdConverter() =
inherit JsonConverter<CategoryId> () inherit JsonConverter<CategoryId>()
override _.WriteJson (writer : JsonWriter, value : CategoryId, _ : JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: CategoryId, _: JsonSerializer) =
writer.WriteValue (CategoryId.toString value) writer.WriteValue value.Value
override _.ReadJson (reader : JsonReader, _ : Type, _ : CategoryId, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: CategoryId, _: bool, _: JsonSerializer) =
(string >> CategoryId) reader.Value (string >> CategoryId) reader.Value
type CommentIdConverter () = type CommentIdConverter() =
inherit JsonConverter<CommentId> () inherit JsonConverter<CommentId>()
override _.WriteJson (writer : JsonWriter, value : CommentId, _ : JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: CommentId, _: JsonSerializer) =
writer.WriteValue (CommentId.toString value) writer.WriteValue value.Value
override _.ReadJson (reader : JsonReader, _ : Type, _ : CommentId, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: CommentId, _: bool, _: JsonSerializer) =
(string >> CommentId) reader.Value (string >> CommentId) reader.Value
type CommentStatusConverter() =
inherit JsonConverter<CommentStatus>()
override _.WriteJson(writer: JsonWriter, value: CommentStatus, _: JsonSerializer) =
writer.WriteValue value.Value
override _.ReadJson(reader: JsonReader, _: Type, _: CommentStatus, _: bool, _: JsonSerializer) =
(string >> CommentStatus.Parse) reader.Value
type CustomFeedIdConverter () = type CustomFeedIdConverter () =
inherit JsonConverter<CustomFeedId> () inherit JsonConverter<CustomFeedId> ()
override _.WriteJson (writer : JsonWriter, value : CustomFeedId, _ : JsonSerializer) = override _.WriteJson (writer : JsonWriter, value : CustomFeedId, _ : JsonSerializer) =
@ -37,12 +44,12 @@ module Json =
override _.ReadJson (reader : JsonReader, _ : Type, _ : CustomFeedSource, _ : bool, _ : JsonSerializer) = override _.ReadJson (reader : JsonReader, _ : Type, _ : CustomFeedSource, _ : bool, _ : JsonSerializer) =
(string >> CustomFeedSource.parse) reader.Value (string >> CustomFeedSource.parse) reader.Value
type ExplicitRatingConverter () = type ExplicitRatingConverter() =
inherit JsonConverter<ExplicitRating> () inherit JsonConverter<ExplicitRating>()
override _.WriteJson (writer : JsonWriter, value : ExplicitRating, _ : JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: ExplicitRating, _: JsonSerializer) =
writer.WriteValue (ExplicitRating.toString value) writer.WriteValue value.Value
override _.ReadJson (reader : JsonReader, _ : Type, _ : ExplicitRating, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: ExplicitRating, _: bool, _: JsonSerializer) =
(string >> ExplicitRating.parse) reader.Value (string >> ExplicitRating.Parse) reader.Value
type MarkupTextConverter () = type MarkupTextConverter () =
inherit JsonConverter<MarkupText> () inherit JsonConverter<MarkupText> ()
@ -128,27 +135,28 @@ module Json =
/// Configure a serializer to use these converters /// Configure a serializer to use these converters
let configure (ser : JsonSerializer) = let configure (ser : JsonSerializer) =
// Our converters // Our converters
[ CategoryIdConverter () :> JsonConverter [ CategoryIdConverter() :> JsonConverter
CommentIdConverter () CommentIdConverter()
CustomFeedIdConverter () CommentStatusConverter()
CustomFeedSourceConverter () CustomFeedIdConverter()
ExplicitRatingConverter () CustomFeedSourceConverter()
MarkupTextConverter () ExplicitRatingConverter()
PermalinkConverter () MarkupTextConverter()
PageIdConverter () PermalinkConverter()
PodcastMediumConverter () PageIdConverter()
PostIdConverter () PodcastMediumConverter()
TagMapIdConverter () PostIdConverter()
ThemeAssetIdConverter () TagMapIdConverter()
ThemeIdConverter () ThemeAssetIdConverter()
UploadIdConverter () ThemeIdConverter()
WebLogIdConverter () UploadIdConverter()
WebLogUserIdConverter () WebLogIdConverter()
WebLogUserIdConverter()
] |> List.iter ser.Converters.Add ] |> List.iter ser.Converters.Add
// NodaTime // NodaTime
let _ = ser.ConfigureForNodaTime DateTimeZoneProviders.Tzdb let _ = ser.ConfigureForNodaTime DateTimeZoneProviders.Tzdb
// Handles DUs with no associated data, as well as option fields // Handles DUs with no associated data, as well as option fields
ser.Converters.Add (CompactUnionJsonConverter ()) ser.Converters.Add(CompactUnionJsonConverter())
ser.NullValueHandling <- NullValueHandling.Ignore ser.NullValueHandling <- NullValueHandling.Ignore
ser.MissingMemberHandling <- MissingMemberHandling.Ignore ser.MissingMemberHandling <- MissingMemberHandling.Ignore
ser ser

12
src/MyWebLog.Data/Postgres/PostgresCategoryData.fs
View File

@ -65,7 +65,7 @@ type PostgresCategoryData (log : ILogger) =
/// Find a category by its ID for the given web log /// Find a category by its ID for the given web log
let findById catId webLogId = let findById catId webLogId =
log.LogTrace "Category.findById" log.LogTrace "Category.findById"
Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId CategoryId.toString webLogId Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId (_.Value) webLogId
/// Find all categories for the given web log /// Find all categories for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
@ -74,7 +74,7 @@ type PostgresCategoryData (log : ILogger) =
/// Create parameters for a category insert / update /// Create parameters for a category insert / update
let catParameters (cat : Category) = let catParameters (cat : Category) =
Query.docParameters (CategoryId.toString cat.Id) cat Query.docParameters cat.Id.Value cat
/// Delete a category /// Delete a category
let delete catId webLogId = backgroundTask { let delete catId webLogId = backgroundTask {
@ -82,7 +82,7 @@ type PostgresCategoryData (log : ILogger) =
match! findById catId webLogId with match! findById catId webLogId with
| Some cat -> | Some cat ->
// Reassign any children to the category's parent category // Reassign any children to the category's parent category
let! children = Find.byContains<Category> Table.Category {| ParentId = CategoryId.toString catId |} let! children = Find.byContains<Category> Table.Category {| ParentId = catId.Value |}
let hasChildren = not (List.isEmpty children) let hasChildren = not (List.isEmpty children)
if hasChildren then if hasChildren then
let! _ = let! _ =
@ -91,7 +91,7 @@ type PostgresCategoryData (log : ILogger) =
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.Update.partialById Table.Category, Query.Update.partialById Table.Category,
children |> List.map (fun child -> [ children |> List.map (fun child -> [
"@id", Sql.string (CategoryId.toString child.Id) "@id", Sql.string child.Id.Value
"@data", Query.jsonbDocParam {| ParentId = cat.ParentId |} "@data", Query.jsonbDocParam {| ParentId = cat.ParentId |}
]) ])
] ]
@ -99,7 +99,7 @@ type PostgresCategoryData (log : ILogger) =
// Delete the category off all posts where it is assigned // Delete the category off all posts where it is assigned
let! posts = let! posts =
Custom.list $"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.empty.CategoryIds}' @> @id" Custom.list $"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.empty.CategoryIds}' @> @id"
[ "@id", Query.jsonbDocParam [| CategoryId.toString catId |] ] fromData<Post> [ "@id", Query.jsonbDocParam [| catId.Value |] ] fromData<Post>
if not (List.isEmpty posts) then if not (List.isEmpty posts) then
let! _ = let! _ =
Configuration.dataSource () Configuration.dataSource ()
@ -114,7 +114,7 @@ type PostgresCategoryData (log : ILogger) =
] ]
() ()
// Delete the category itself // Delete the category itself
do! Delete.byId Table.Category (CategoryId.toString catId) do! Delete.byId Table.Category catId.Value
return if hasChildren then ReassignedChildCategories else CategoryDeleted return if hasChildren then ReassignedChildCategories else CategoryDeleted
| None -> return CategoryNotFound | None -> return CategoryNotFound
} }

2
src/MyWebLog.Data/Postgres/PostgresPostData.fs
View File

@ -106,7 +106,7 @@ type PostgresPostData (log : ILogger) =
/// Get a page of categorized posts for the given web log (excludes revisions) /// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
log.LogTrace "Post.findPageOfCategorizedPosts" log.LogTrace "Post.findPageOfCategorizedPosts"
let catSql, catParam = arrayContains (nameof Post.empty.CategoryIds) CategoryId.toString categoryIds let catSql, catParam = arrayContains (nameof Post.empty.CategoryIds) (_.Value) categoryIds
Custom.list Custom.list
$"{selectWithCriteria Table.Post} $"{selectWithCriteria Table.Post}
AND {catSql} AND {catSql}

2
src/MyWebLog.Data/SQLite/Helpers.fs
View File

@ -362,7 +362,7 @@ module Map =
PreferredName = getString "preferred_name" rdr PreferredName = getString "preferred_name" rdr
PasswordHash = getString "password_hash" rdr PasswordHash = getString "password_hash" rdr
Url = tryString "url" rdr Url = tryString "url" rdr
AccessLevel = getString "access_level" rdr |> AccessLevel.parse AccessLevel = getString "access_level" rdr |> AccessLevel.Parse
CreatedOn = getInstant "created_on" rdr CreatedOn = getInstant "created_on" rdr
LastSeenOn = tryInstant "last_seen_on" rdr LastSeenOn = tryInstant "last_seen_on" rdr
} }

14
src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs
View File

@ -10,12 +10,12 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Add parameters for category INSERT or UPDATE statements /// Add parameters for category INSERT or UPDATE statements
let addCategoryParameters (cmd : SqliteCommand) (cat : Category) = let addCategoryParameters (cmd : SqliteCommand) (cat : Category) =
[ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.Id) [ cmd.Parameters.AddWithValue ("@id", cat.Id.Value)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId)
cmd.Parameters.AddWithValue ("@name", cat.Name) cmd.Parameters.AddWithValue ("@name", cat.Name)
cmd.Parameters.AddWithValue ("@slug", cat.Slug) cmd.Parameters.AddWithValue ("@slug", cat.Slug)
cmd.Parameters.AddWithValue ("@description", maybe cat.Description) cmd.Parameters.AddWithValue ("@description", maybe cat.Description)
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map CategoryId.toString)) cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map _.Value))
] |> ignore ] |> ignore
/// Add a category /// Add a category
@ -101,10 +101,10 @@ type SQLiteCategoryData (conn : SqliteConnection) =
|> Array.ofSeq |> Array.ofSeq
} }
/// Find a category by its ID for the given web log /// Find a category by its ID for the given web log
let findById catId webLogId = backgroundTask { let findById (catId: CategoryId) webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM category WHERE id = @id" cmd.CommandText <- "SELECT * FROM category WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) |> ignore cmd.Parameters.AddWithValue ("@id", catId.Value) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<Category> webLogId (fun c -> c.WebLogId) Map.toCategory rdr return Helpers.verifyWebLog<Category> webLogId (fun c -> c.WebLogId) Map.toCategory rdr
} }
@ -125,11 +125,11 @@ type SQLiteCategoryData (conn : SqliteConnection) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
// Reassign any children to the category's parent category // Reassign any children to the category's parent category
cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE parent_id = @parentId" cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE parent_id = @parentId"
cmd.Parameters.AddWithValue ("@parentId", CategoryId.toString catId) |> ignore cmd.Parameters.AddWithValue ("@parentId", catId.Value) |> ignore
let! children = count cmd let! children = count cmd
if children > 0 then if children > 0 then
cmd.CommandText <- "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId" cmd.CommandText <- "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId"
cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map CategoryId.toString)) cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map _.Value))
|> ignore |> ignore
do! write cmd do! write cmd
// Delete the category off all posts where it is assigned, and the category itself // Delete the category off all posts where it is assigned, and the category itself
@ -139,7 +139,7 @@ type SQLiteCategoryData (conn : SqliteConnection) =
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId); AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId);
DELETE FROM category WHERE id = @id" DELETE FROM category WHERE id = @id"
cmd.Parameters.Clear () cmd.Parameters.Clear ()
let _ = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) let _ = cmd.Parameters.AddWithValue ("@id", catId.Value)
addWebLogId cmd webLogId addWebLogId cmd webLogId
do! write cmd do! write cmd
return if children = 0 then CategoryDeleted else ReassignedChildCategories return if children = 0 then CategoryDeleted else ReassignedChildCategories

8
src/MyWebLog.Data/SQLite/SQLitePostData.fs
View File

@ -83,7 +83,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
/// Update a post's assigned categories /// Update a post's assigned categories
let updatePostCategories postId oldCats newCats = backgroundTask { let updatePostCategories postId oldCats newCats = backgroundTask {
let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString let toDelete, toAdd = Utils.diffLists<CategoryId, string> oldCats newCats _.Value
if List.isEmpty toDelete && List.isEmpty toAdd then if List.isEmpty toDelete && List.isEmpty toAdd then
return () return ()
else else
@ -91,8 +91,8 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.Add ("@categoryId", SqliteType.Text) cmd.Parameters.Add ("@categoryId", SqliteType.Text)
] |> ignore ] |> ignore
let runCmd catId = backgroundTask { let runCmd (catId: CategoryId) = backgroundTask {
cmd.Parameters["@categoryId"].Value <- CategoryId.toString catId cmd.Parameters["@categoryId"].Value <- catId.Value
do! write cmd do! write cmd
} }
cmd.CommandText <- "DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId" cmd.CommandText <- "DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId"
@ -301,7 +301,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
/// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks) /// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask { let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
let catSql, catParams = inClause "AND pc.category_id" "catId" CategoryId.toString categoryIds let catSql, catParams = inClause "AND pc.category_id" "catId" (_.Value) categoryIds
cmd.CommandText <- $" cmd.CommandText <- $"
{selectPost} {selectPost}
INNER JOIN post_category pc ON pc.post_id = p.id INNER JOIN post_category pc ON pc.post_id = p.id

2
src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs
View File

@ -19,7 +19,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName) cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName)
cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash) cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash)
cmd.Parameters.AddWithValue ("@url", maybe user.Url) cmd.Parameters.AddWithValue ("@url", maybe user.Url)
cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel) cmd.Parameters.AddWithValue ("@accessLevel", user.AccessLevel.Value)
cmd.Parameters.AddWithValue ("@createdOn", instantParam user.CreatedOn) cmd.Parameters.AddWithValue ("@createdOn", instantParam user.CreatedOn)
cmd.Parameters.AddWithValue ("@lastSeenOn", maybeInstant user.LastSeenOn) cmd.Parameters.AddWithValue ("@lastSeenOn", maybeInstant user.LastSeenOn)
] |> ignore ] |> ignore

4
src/MyWebLog.Data/SQLiteData.fs
View File

@ -188,7 +188,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
ImageUrl = Map.getString "image_url" podcastRdr |> Permalink ImageUrl = Map.getString "image_url" podcastRdr |> Permalink
AppleCategory = Map.getString "apple_category" podcastRdr AppleCategory = Map.getString "apple_category" podcastRdr
AppleSubcategory = Map.tryString "apple_subcategory" podcastRdr AppleSubcategory = Map.tryString "apple_subcategory" podcastRdr
Explicit = Map.getString "explicit" podcastRdr |> ExplicitRating.parse Explicit = Map.getString "explicit" podcastRdr |> ExplicitRating.Parse
DefaultMediaType = Map.tryString "default_media_type" podcastRdr DefaultMediaType = Map.tryString "default_media_type" podcastRdr
MediaBaseUrl = Map.tryString "media_base_url" podcastRdr MediaBaseUrl = Map.tryString "media_base_url" podcastRdr
PodcastGuid = Map.tryGuid "podcast_guid" podcastRdr PodcastGuid = Map.tryGuid "podcast_guid" podcastRdr
@ -220,7 +220,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
ImageUrl = Map.tryString "image_url" epRdr ImageUrl = Map.tryString "image_url" epRdr
Subtitle = Map.tryString "subtitle" epRdr Subtitle = Map.tryString "subtitle" epRdr
Explicit = Map.tryString "explicit" epRdr Explicit = Map.tryString "explicit" epRdr
|> Option.map ExplicitRating.parse |> Option.map ExplicitRating.Parse
Chapters = Map.tryString "chapters" epRdr Chapters = Map.tryString "chapters" epRdr
|> Option.map (Utils.deserialize<Chapter list> ser) |> Option.map (Utils.deserialize<Chapter list> ser)
ChapterFile = Map.tryString "chapter_file" epRdr ChapterFile = Map.tryString "chapter_file" epRdr

16
src/MyWebLog.Data/Utils.fs
View File

@ -12,7 +12,7 @@ let currentDbVersion = "v2.1"
let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq { let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq {
for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do
let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug
{ Id = CategoryId.toString cat.Id { Id = cat.Id.Value
Slug = fullSlug Slug = fullSlug
Name = cat.Name Name = cat.Name
Description = cat.Description Description = cat.Description
@ -24,7 +24,7 @@ let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames =
} }
/// Get lists of items removed from and added to the given lists /// Get lists of items removed from and added to the given lists
let diffLists<'T, 'U when 'U : equality> oldItems newItems (f : 'T -> 'U) = let diffLists<'T, 'U when 'U: equality> oldItems newItems (f: 'T -> 'U) =
let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other)) let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other))
List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems
@ -38,21 +38,21 @@ let diffPermalinks oldLinks newLinks =
/// Find the revisions added and removed /// Find the revisions added and removed
let diffRevisions oldRevs newRevs = let diffRevisions oldRevs newRevs =
diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.ToUnixTimeTicks ()}|{MarkupText.toString rev.Text}") diffLists oldRevs newRevs (fun (rev: Revision) -> $"{rev.AsOf.ToUnixTimeTicks()}|{MarkupText.toString rev.Text}")
open MyWebLog.Converters open MyWebLog.Converters
open Newtonsoft.Json open Newtonsoft.Json
/// Serialize an object to JSON /// Serialize an object to JSON
let serialize<'T> ser (item : 'T) = let serialize<'T> ser (item: 'T) =
JsonConvert.SerializeObject (item, Json.settings ser) JsonConvert.SerializeObject(item, Json.settings ser)
/// Deserialize a JSON string /// Deserialize a JSON string
let deserialize<'T> (ser : JsonSerializer) value = let deserialize<'T> (ser: JsonSerializer) value =
JsonConvert.DeserializeObject<'T> (value, Json.settings ser) JsonConvert.DeserializeObject<'T>(value, Json.settings ser)
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
/// Log a migration step /// Log a migration step
let logMigrationStep<'T> (log : ILogger<'T>) migration message = let logMigrationStep<'T> (log: ILogger<'T>) migration message =
log.LogInformation $"Migrating %s{migration}: %s{message}" log.LogInformation $"Migrating %s{migration}: %s{message}"

6
src/MyWebLog.Domain/DataTypes.fs
View File

@ -31,7 +31,7 @@ module Category =
/// An empty category /// An empty category
let empty = { let empty = {
Id = CategoryId.empty Id = CategoryId.Empty
WebLogId = WebLogId.empty WebLogId = WebLogId.empty
Name = "" Name = ""
Slug = "" Slug = ""
@ -76,7 +76,7 @@ module Comment =
/// An empty comment /// An empty comment
let empty = { let empty = {
Id = CommentId.empty Id = CommentId.Empty
PostId = PostId.empty PostId = PostId.empty
InReplyToId = None InReplyToId = None
Name = "" Name = ""
@ -485,4 +485,4 @@ module WebLogUser =
/// Does a user have the required access level? /// Does a user have the required access level?
let hasAccess level user = let hasAccess level user =
AccessLevel.hasAccess level user.AccessLevel user.AccessLevel.HasAccess level

207
src/MyWebLog.Domain/SupportTypes.fs
View File

@ -10,20 +10,20 @@ module private Helpers =
/// Create a new ID (short GUID) /// Create a new ID (short GUID)
// https://www.madskristensen.net/blog/A-shorter-and-URL-friendly-GUID // https://www.madskristensen.net/blog/A-shorter-and-URL-friendly-GUID
let newId () = let newId () =
Convert.ToBase64String(Guid.NewGuid().ToByteArray ()).Replace('/', '_').Replace('+', '-')[..22] Convert.ToBase64String(Guid.NewGuid().ToByteArray()).Replace('/', '_').Replace('+', '-')[..22]
/// Functions to support NodaTime manipulation /// Functions to support NodaTime manipulation
module Noda = module Noda =
/// The clock to use when getting "now" (will make mutable for testing) /// The clock to use when getting "now" (will make mutable for testing)
let clock : IClock = SystemClock.Instance let clock: IClock = SystemClock.Instance
/// The Unix epoch /// The Unix epoch
let epoch = Instant.FromUnixTimeSeconds 0L let epoch = Instant.FromUnixTimeSeconds 0L
/// Truncate an instant to remove fractional seconds /// Truncate an instant to remove fractional seconds
let toSecondsPrecision (value : Instant) = let toSecondsPrecision (value: Instant) =
Instant.FromUnixTimeSeconds(value.ToUnixTimeSeconds()) Instant.FromUnixTimeSeconds(value.ToUnixTimeSeconds())
/// The current Instant, with fractional seconds truncated /// The current Instant, with fractional seconds truncated
@ -31,11 +31,12 @@ module Noda =
clock.GetCurrentInstant >> toSecondsPrecision clock.GetCurrentInstant >> toSecondsPrecision
/// Convert a date/time to an Instant with whole seconds /// Convert a date/time to an Instant with whole seconds
let fromDateTime (dt : DateTime) = let fromDateTime (dt: DateTime) =
Instant.FromDateTimeUtc(DateTime(dt.Ticks, DateTimeKind.Utc)) |> toSecondsPrecision Instant.FromDateTimeUtc(DateTime(dt.Ticks, DateTimeKind.Utc)) |> toSecondsPrecision
/// A user's access level /// A user's access level
[<Struct>]
type AccessLevel = type AccessLevel =
/// The user may create and publish posts and edit the ones they have created /// The user may create and publish posts and edit the ones they have created
| Author | Author
@ -46,73 +47,72 @@ type AccessLevel =
/// The user may manage themes (which affects all web logs for an installation) /// The user may manage themes (which affects all web logs for an installation)
| Administrator | Administrator
/// Functions to support access levels /// Parse an access level from its string representation
module AccessLevel = static member Parse =
/// Weightings for access levels
let private weights =
[ Author, 10
Editor, 20
WebLogAdmin, 30
Administrator, 40
]
|> Map.ofList
/// Convert an access level to its string representation
let toString =
function function
| Author -> "Author" | "Author" -> Author
| Editor -> "Editor" | "Editor" -> Editor
| WebLogAdmin -> "WebLogAdmin" | "WebLogAdmin" -> WebLogAdmin
| "Administrator" -> Administrator
| it -> invalidArg "level" $"{it} is not a valid access level"
/// The string representation of this access level
member this.Value =
match this with
| Author -> "Author"
| Editor -> "Editor"
| WebLogAdmin -> "WebLogAdmin"
| Administrator -> "Administrator" | Administrator -> "Administrator"
/// Parse an access level from its string representation
let parse it =
match it with
| "Author" -> Author
| "Editor" -> Editor
| "WebLogAdmin" -> WebLogAdmin
| "Administrator" -> Administrator
| _ -> invalidOp $"{it} is not a valid access level"
/// Does a given access level allow an action that requires a certain access level? /// Does a given access level allow an action that requires a certain access level?
let hasAccess needed held = member this.HasAccess(needed: AccessLevel) =
weights[needed] <= weights[held] // TODO: Move this to user where it seems to belong better...
let weights =
[ Author, 10
Editor, 20
WebLogAdmin, 30
Administrator, 40
]
|> Map.ofList
weights[needed] <= weights[this]
/// An identifier for a category /// An identifier for a category
type CategoryId = CategoryId of string [<Struct>]
type CategoryId =
/// Functions to support category IDs | CategoryId of string
module CategoryId =
/// An empty category ID /// An empty category ID
let empty = CategoryId "" static member Empty = CategoryId ""
/// Convert a category ID to a string
let toString = function CategoryId ci -> ci
/// Create a new category ID /// Create a new category ID
let create = newId >> CategoryId static member Create =
newId >> CategoryId
/// The string representation of this category ID
member this.Value =
match this with CategoryId it -> it
/// An identifier for a comment /// An identifier for a comment
type CommentId = CommentId of string [<Struct>]
type CommentId =
/// Functions to support comment IDs | CommentId of string
module CommentId =
/// An empty comment ID /// An empty comment ID
let empty = CommentId "" static member Empty = CommentId ""
/// Convert a comment ID to a string
let toString = function CommentId ci -> ci
/// Create a new comment ID /// Create a new comment ID
let create = newId >> CommentId static member Create =
newId >> CommentId
/// The string representation of this comment ID
member this.Value =
match this with CommentId it -> it
/// Statuses for post comments /// Statuses for post comments
[<Struct>]
type CommentStatus = type CommentStatus =
/// The comment is approved /// The comment is approved
| Approved | Approved
@ -121,77 +121,71 @@ type CommentStatus =
/// The comment was unsolicited and unwelcome /// The comment was unsolicited and unwelcome
| Spam | Spam
/// Functions to support post comment statuses /// Parse a string into a comment status
module CommentStatus = static member Parse =
function
| "Approved" -> Approved
| "Pending" -> Pending
| "Spam" -> Spam
| it -> invalidArg "status" $"{it} is not a valid comment status"
/// Convert a comment status to a string /// Convert a comment status to a string
let toString = function Approved -> "Approved" | Pending -> "Pending" | Spam -> "Spam" member this.Value =
match this with Approved -> "Approved" | Pending -> "Pending" | Spam -> "Spam"
/// Parse a string into a comment status
let parse value =
match value with
| "Approved" -> Approved
| "Pending" -> Pending
| "Spam" -> Spam
| it -> invalidArg "status" $"{it} is not a valid comment status"
/// Valid values for the iTunes explicit rating /// Valid values for the iTunes explicit rating
[<Struct>]
type ExplicitRating = type ExplicitRating =
| Yes | Yes
| No | No
| Clean | 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 /// Parse a string into an explicit rating
let parse : string -> ExplicitRating = static member Parse =
function function
| "yes" -> Yes | "yes" -> Yes
| "no" -> No | "no" -> No
| "clean" -> Clean | "clean" -> Clean
| x -> invalidArg "rating" $"{x} is not a valid explicit rating" | it -> invalidArg "rating" $"{it} is not a valid explicit rating"
/// The string value of this rating
member this.Value =
match this with Yes -> "yes" | No -> "no" | Clean -> "clean"
/// A location (specified by Podcast Index) /// A location (specified by Podcast Index)
type Location = { type Location = {
/// The name of the location (free-form text) /// The name of the location (free-form text)
Name : string Name: string
/// A geographic coordinate string (RFC 5870) /// A geographic coordinate string (RFC 5870)
Geo : string option Geo: string option
/// An OpenStreetMap query /// An OpenStreetMap query
Osm : string option Osm: string option
} }
/// A chapter in a podcast episode /// A chapter in a podcast episode
type Chapter = { type Chapter = {
/// The start time for the chapter /// The start time for the chapter
StartTime : Duration StartTime: Duration
/// The title for this chapter /// The title for this chapter
Title : string option Title: string option
/// A URL for an image for this chapter /// A URL for an image for this chapter
ImageUrl : string option ImageUrl: string option
/// Whether this chapter is hidden /// Whether this chapter is hidden
IsHidden : bool option IsHidden: bool option
/// The episode end time for the chapter /// The episode end time for the chapter
EndTime : Duration option EndTime: Duration option
/// A location that applies to a chapter /// A location that applies to a chapter
Location : Location option Location: Location option
} }
@ -200,65 +194,62 @@ open NodaTime.Text
/// A podcast episode /// A podcast episode
type Episode = { type Episode = {
/// The URL to the media file for the episode (may be permalink) /// The URL to the media file for the episode (may be permalink)
Media : string Media: string
/// The length of the media file, in bytes /// The length of the media file, in bytes
Length : int64 Length: int64
/// The duration of the episode /// The duration of the episode
Duration : Duration option Duration: Duration option
/// The media type of the file (overrides podcast default if present) /// The media type of the file (overrides podcast default if present)
MediaType : string option MediaType: string option
/// The URL to the image file for this episode (overrides podcast image if present, may be permalink) /// The URL to the image file for this episode (overrides podcast image if present, may be permalink)
ImageUrl : string option ImageUrl: string option
/// A subtitle for this episode /// A subtitle for this episode
Subtitle : string option Subtitle: string option
/// This episode's explicit rating (overrides podcast rating if present) /// This episode's explicit rating (overrides podcast rating if present)
Explicit : ExplicitRating option Explicit: ExplicitRating option
/// Chapters for this episode /// Chapters for this episode
Chapters : Chapter list option Chapters: Chapter list option
/// A link to a chapter file /// A link to a chapter file
ChapterFile : string option ChapterFile: string option
/// The MIME type for the chapter file /// The MIME type for the chapter file
ChapterType : string option ChapterType: string option
/// The URL for the transcript of the episode (may be permalink) /// The URL for the transcript of the episode (may be permalink)
TranscriptUrl : string option TranscriptUrl: string option
/// The MIME type of the transcript /// The MIME type of the transcript
TranscriptType : string option TranscriptType: string option
/// The language in which the transcript is written /// The language in which the transcript is written
TranscriptLang : string option TranscriptLang: string option
/// If true, the transcript will be declared (in the feed) to be a captions file /// If true, the transcript will be declared (in the feed) to be a captions file
TranscriptCaptions : bool option TranscriptCaptions: bool option
/// The season number (for serialized podcasts) /// The season number (for serialized podcasts)
SeasonNumber : int option SeasonNumber: int option
/// A description of the season /// A description of the season
SeasonDescription : string option SeasonDescription: string option
/// The episode number /// The episode number
EpisodeNumber : double option EpisodeNumber: double option
/// A description of the episode /// A description of the episode
EpisodeDescription : string option EpisodeDescription: string option
} } with
/// Functions to support episodes
module Episode =
/// An empty episode /// An empty episode
let empty = { static member Empty = {
Media = "" Media = ""
Length = 0L Length = 0L
Duration = None Duration = None
@ -280,8 +271,8 @@ module Episode =
} }
/// Format a duration for an episode /// Format a duration for an episode
let formatDuration ep = member this.FormatDuration() =
ep.Duration |> Option.map (DurationPattern.CreateWithInvariantCulture("H:mm:ss").Format) this.Duration |> Option.map (DurationPattern.CreateWithInvariantCulture("H:mm:ss").Format)
open Markdig open Markdig

34
src/MyWebLog.Domain/ViewModels.fs
View File

@ -305,7 +305,7 @@ module DisplayUser =
LastName = user.LastName LastName = user.LastName
PreferredName = user.PreferredName PreferredName = user.PreferredName
Url = defaultArg user.Url "" Url = defaultArg user.Url ""
AccessLevel = AccessLevel.toString user.AccessLevel AccessLevel = user.AccessLevel.Value
CreatedOn = WebLog.localTime webLog user.CreatedOn CreatedOn = WebLog.localTime webLog user.CreatedOn
LastSeenOn = user.LastSeenOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable LastSeenOn = user.LastSeenOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable
} }
@ -332,11 +332,11 @@ type EditCategoryModel =
/// Create an edit model from an existing category /// Create an edit model from an existing category
static member fromCategory (cat : Category) = static member fromCategory (cat : Category) =
{ CategoryId = CategoryId.toString cat.Id { CategoryId = cat.Id.Value
Name = cat.Name Name = cat.Name
Slug = cat.Slug Slug = cat.Slug
Description = defaultArg cat.Description "" Description = defaultArg cat.Description ""
ParentId = cat.ParentId |> Option.map CategoryId.toString |> Option.defaultValue "" ParentId = cat.ParentId |> Option.map _.Value |> Option.defaultValue ""
} }
/// Is this a new category? /// Is this a new category?
@ -457,7 +457,7 @@ type EditCustomFeedModel =
ImageUrl = Permalink.toString p.ImageUrl ImageUrl = Permalink.toString p.ImageUrl
AppleCategory = p.AppleCategory AppleCategory = p.AppleCategory
AppleSubcategory = defaultArg p.AppleSubcategory "" AppleSubcategory = defaultArg p.AppleSubcategory ""
Explicit = ExplicitRating.toString p.Explicit Explicit = p.Explicit.Value
DefaultMediaType = defaultArg p.DefaultMediaType "" DefaultMediaType = defaultArg p.DefaultMediaType ""
MediaBaseUrl = defaultArg p.MediaBaseUrl "" MediaBaseUrl = defaultArg p.MediaBaseUrl ""
FundingUrl = defaultArg p.FundingUrl "" FundingUrl = defaultArg p.FundingUrl ""
@ -486,7 +486,7 @@ type EditCustomFeedModel =
ImageUrl = Permalink this.ImageUrl ImageUrl = Permalink this.ImageUrl
AppleCategory = this.AppleCategory AppleCategory = this.AppleCategory
AppleSubcategory = noneIfBlank this.AppleSubcategory AppleSubcategory = noneIfBlank this.AppleSubcategory
Explicit = ExplicitRating.parse this.Explicit Explicit = ExplicitRating.Parse this.Explicit
DefaultMediaType = noneIfBlank this.DefaultMediaType DefaultMediaType = noneIfBlank this.DefaultMediaType
MediaBaseUrl = noneIfBlank this.MediaBaseUrl MediaBaseUrl = noneIfBlank this.MediaBaseUrl
PodcastGuid = noneIfBlank this.PodcastGuid |> Option.map Guid.Parse PodcastGuid = noneIfBlank this.PodcastGuid |> Option.map Guid.Parse
@ -714,11 +714,11 @@ type EditPostModel =
/// Create an edit model from an existing past /// Create an edit model from an existing past
static member fromPost webLog (post : Post) = static member fromPost webLog (post : Post) =
let latest = let latest =
match post.Revisions |> List.sortByDescending (fun r -> r.AsOf) |> List.tryHead with match post.Revisions |> List.sortByDescending (_.AsOf) |> List.tryHead with
| Some rev -> rev | Some rev -> rev
| None -> Revision.empty | None -> Revision.empty
let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.empty ] } else post let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.empty ] } else post
let episode = defaultArg post.Episode Episode.empty let episode = defaultArg post.Episode Episode.Empty
{ PostId = PostId.toString post.Id { PostId = PostId.toString post.Id
Title = post.Title Title = post.Title
Permalink = Permalink.toString post.Permalink Permalink = Permalink.toString post.Permalink
@ -726,22 +726,22 @@ type EditPostModel =
Text = MarkupText.text latest.Text Text = MarkupText.text latest.Text
Tags = String.Join (", ", post.Tags) Tags = String.Join (", ", post.Tags)
Template = defaultArg post.Template "" Template = defaultArg post.Template ""
CategoryIds = post.CategoryIds |> List.map CategoryId.toString |> Array.ofList CategoryIds = post.CategoryIds |> List.map (_.Value) |> Array.ofList
Status = PostStatus.toString post.Status Status = PostStatus.toString post.Status
DoPublish = false DoPublish = false
MetaNames = post.Metadata |> List.map (fun m -> m.Name) |> Array.ofList MetaNames = post.Metadata |> List.map (_.Name) |> Array.ofList
MetaValues = post.Metadata |> List.map (fun m -> m.Value) |> Array.ofList MetaValues = post.Metadata |> List.map (_.Value) |> Array.ofList
SetPublished = false SetPublished = false
PubOverride = post.PublishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable PubOverride = post.PublishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable
SetUpdated = false SetUpdated = false
IsEpisode = Option.isSome post.Episode IsEpisode = Option.isSome post.Episode
Media = episode.Media Media = episode.Media
Length = episode.Length Length = episode.Length
Duration = defaultArg (Episode.formatDuration episode) "" Duration = defaultArg (episode.FormatDuration()) ""
MediaType = defaultArg episode.MediaType "" MediaType = defaultArg episode.MediaType ""
ImageUrl = defaultArg episode.ImageUrl "" ImageUrl = defaultArg episode.ImageUrl ""
Subtitle = defaultArg episode.Subtitle "" Subtitle = defaultArg episode.Subtitle ""
Explicit = defaultArg (episode.Explicit |> Option.map ExplicitRating.toString) "" Explicit = defaultArg (episode.Explicit |> Option.map (_.Value)) ""
ChapterFile = defaultArg episode.ChapterFile "" ChapterFile = defaultArg episode.ChapterFile ""
ChapterType = defaultArg episode.ChapterType "" ChapterType = defaultArg episode.ChapterType ""
TranscriptUrl = defaultArg episode.TranscriptUrl "" TranscriptUrl = defaultArg episode.TranscriptUrl ""
@ -800,7 +800,7 @@ type EditPostModel =
MediaType = noneIfBlank this.MediaType MediaType = noneIfBlank this.MediaType
ImageUrl = noneIfBlank this.ImageUrl ImageUrl = noneIfBlank this.ImageUrl
Subtitle = noneIfBlank this.Subtitle Subtitle = noneIfBlank this.Subtitle
Explicit = noneIfBlank this.Explicit |> Option.map ExplicitRating.parse Explicit = noneIfBlank this.Explicit |> Option.map ExplicitRating.Parse
Chapters = match post.Episode with Some e -> e.Chapters | None -> None Chapters = match post.Episode with Some e -> e.Chapters | None -> None
ChapterFile = noneIfBlank this.ChapterFile ChapterFile = noneIfBlank this.ChapterFile
ChapterType = noneIfBlank this.ChapterType ChapterType = noneIfBlank this.ChapterType
@ -960,7 +960,7 @@ type EditUserModel =
/// Construct a displayed user from a web log user /// Construct a displayed user from a web log user
static member fromUser (user : WebLogUser) = static member fromUser (user : WebLogUser) =
{ Id = WebLogUserId.toString user.Id { Id = WebLogUserId.toString user.Id
AccessLevel = AccessLevel.toString user.AccessLevel AccessLevel = user.AccessLevel.Value
Url = defaultArg user.Url "" Url = defaultArg user.Url ""
Email = user.Email Email = user.Email
FirstName = user.FirstName FirstName = user.FirstName
@ -974,9 +974,9 @@ type EditUserModel =
member this.IsNew = this.Id = "new" member this.IsNew = this.Id = "new"
/// Update a user with values from this model (excludes password) /// Update a user with values from this model (excludes password)
member this.UpdateUser (user : WebLogUser) = member this.UpdateUser (user: WebLogUser) =
{ user with { user with
AccessLevel = AccessLevel.parse this.AccessLevel AccessLevel = AccessLevel.Parse this.AccessLevel
Email = this.Email Email = this.Email
Url = noneIfBlank this.Url Url = noneIfBlank this.Url
FirstName = this.FirstName FirstName = this.FirstName
@ -1126,7 +1126,7 @@ type PostListItem =
PublishedOn = post.PublishedOn |> Option.map inTZ |> Option.toNullable PublishedOn = post.PublishedOn |> Option.map inTZ |> Option.toNullable
UpdatedOn = inTZ post.UpdatedOn UpdatedOn = inTZ post.UpdatedOn
Text = addBaseToRelativeUrls extra post.Text Text = addBaseToRelativeUrls extra post.Text
CategoryIds = post.CategoryIds |> List.map CategoryId.toString CategoryIds = post.CategoryIds |> List.map _.Value
Tags = post.Tags Tags = post.Tags
Episode = post.Episode Episode = post.Episode
Metadata = post.Metadata Metadata = post.Metadata

4
src/MyWebLog/Caches.fs
View File

@ -42,7 +42,7 @@ module Extensions =
member this.UserAccessLevel = member this.UserAccessLevel =
this.User.Claims this.User.Claims
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.Role) |> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.Role)
|> Option.map (fun claim -> AccessLevel.parse claim.Value) |> Option.map (fun claim -> AccessLevel.Parse claim.Value)
/// The user ID for the current request /// The user ID for the current request
member this.UserId = member this.UserId =
@ -53,7 +53,7 @@ module Extensions =
/// Does the current user have the requested level of access? /// Does the current user have the requested level of access?
member this.HasAccessLevel level = member this.HasAccessLevel level =
defaultArg (this.UserAccessLevel |> Option.map (AccessLevel.hasAccess level)) false defaultArg (this.UserAccessLevel |> Option.map (fun it -> it.HasAccess level)) false
open System.Collections.Concurrent open System.Collections.Concurrent

2
src/MyWebLog/Handlers/Admin.fs
View File

@ -177,7 +177,7 @@ module Category =
let data = ctx.Data let data = ctx.Data
let! model = ctx.BindFormAsync<EditCategoryModel> () let! model = ctx.BindFormAsync<EditCategoryModel> ()
let category = let category =
if model.IsNew then someTask { Category.empty with Id = CategoryId.create (); WebLogId = ctx.WebLog.Id } if model.IsNew then someTask { Category.empty with Id = CategoryId.Create(); WebLogId = ctx.WebLog.Id }
else data.Category.FindById (CategoryId model.CategoryId) ctx.WebLog.Id else data.Category.FindById (CategoryId model.CategoryId) ctx.WebLog.Id
match! category with match! category with
| Some cat -> | Some cat ->

87
src/MyWebLog/Handlers/Feed.fs
View File

@ -48,8 +48,8 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
/// Determine the function to retrieve posts for the given feed /// Determine the function to retrieve posts for the given feed
let private getFeedPosts ctx feedType = let private getFeedPosts ctx feedType =
let childIds catId = let childIds (catId: CategoryId) =
let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = CategoryId.toString catId) let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = catId.Value)
getCategoryIds cat.Slug ctx getCategoryIds cat.Slug ctx
let data = ctx.Data let data = ctx.Data
match feedType with match feedType with
@ -116,7 +116,7 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[
Name = (authors |> List.find (fun a -> a.Name = WebLogUserId.toString post.AuthorId)).Value)) Name = (authors |> List.find (fun a -> a.Name = WebLogUserId.toString post.AuthorId)).Value))
[ post.CategoryIds [ post.CategoryIds
|> List.map (fun catId -> |> List.map (fun catId ->
let cat = cats |> Array.find (fun c -> c.Id = CategoryId.toString catId) let cat = cats |> Array.find (fun c -> c.Id = catId.Value)
SyndicationCategory (cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name)) SyndicationCategory (cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name))
post.Tags post.Tags
|> List.map (fun tag -> |> List.map (fun tag ->
@ -143,28 +143,27 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
| link -> WebLog.absoluteUrl webLog (Permalink link) | link -> WebLog.absoluteUrl webLog (Permalink link)
let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
let epImageUrl = defaultArg episode.ImageUrl (Permalink.toString podcast.ImageUrl) |> toAbsolute webLog let epImageUrl = defaultArg episode.ImageUrl (Permalink.toString podcast.ImageUrl) |> toAbsolute webLog
let epExplicit = defaultArg episode.Explicit podcast.Explicit |> ExplicitRating.toString let epExplicit = (defaultArg episode.Explicit podcast.Explicit).Value
let xmlDoc = XmlDocument () let xmlDoc = XmlDocument()
let enclosure = let enclosure =
let it = xmlDoc.CreateElement "enclosure" let it = xmlDoc.CreateElement "enclosure"
it.SetAttribute ("url", epMediaUrl) it.SetAttribute("url", epMediaUrl)
it.SetAttribute ("length", string episode.Length) it.SetAttribute("length", string episode.Length)
epMediaType |> Option.iter (fun typ -> it.SetAttribute ("type", typ)) epMediaType |> Option.iter (fun typ -> it.SetAttribute("type", typ))
it it
let image = let image =
let it = xmlDoc.CreateElement ("itunes", "image", Namespace.iTunes) let it = xmlDoc.CreateElement("itunes", "image", Namespace.iTunes)
it.SetAttribute ("href", epImageUrl) it.SetAttribute("href", epImageUrl)
it it
item.ElementExtensions.Add enclosure item.ElementExtensions.Add enclosure
item.ElementExtensions.Add image item.ElementExtensions.Add image
item.ElementExtensions.Add ("creator", Namespace.dc, podcast.DisplayedAuthor) item.ElementExtensions.Add("creator", Namespace.dc, podcast.DisplayedAuthor)
item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor) item.ElementExtensions.Add("author", Namespace.iTunes, podcast.DisplayedAuthor)
item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit) item.ElementExtensions.Add("explicit", Namespace.iTunes, epExplicit)
episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it)) episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add("subtitle", Namespace.iTunes, it))
Episode.formatDuration episode episode.FormatDuration() |> Option.iter (fun it -> item.ElementExtensions.Add("duration", Namespace.iTunes, it))
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it))
match episode.ChapterFile with match episode.ChapterFile with
| Some chapters -> | Some chapters ->
@ -174,21 +173,20 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
| Some mime -> Some mime | Some mime -> Some mime
| None when chapters.EndsWith ".json" -> Some "application/json+chapters" | None when chapters.EndsWith ".json" -> Some "application/json+chapters"
| None -> None | None -> None
let elt = xmlDoc.CreateElement ("podcast", "chapters", Namespace.podcast) let elt = xmlDoc.CreateElement("podcast", "chapters", Namespace.podcast)
elt.SetAttribute ("url", url) elt.SetAttribute("url", url)
typ |> Option.iter (fun it -> elt.SetAttribute ("type", it)) typ |> Option.iter (fun it -> elt.SetAttribute("type", it))
item.ElementExtensions.Add elt item.ElementExtensions.Add elt
| None -> () | None -> ()
match episode.TranscriptUrl with match episode.TranscriptUrl with
| Some transcript -> | Some transcript ->
let url = toAbsolute webLog transcript let url = toAbsolute webLog transcript
let elt = xmlDoc.CreateElement ("podcast", "transcript", Namespace.podcast) let elt = xmlDoc.CreateElement("podcast", "transcript", Namespace.podcast)
elt.SetAttribute ("url", url) elt.SetAttribute("url", url)
elt.SetAttribute ("type", Option.get episode.TranscriptType) elt.SetAttribute("type", Option.get episode.TranscriptType)
episode.TranscriptLang |> Option.iter (fun it -> elt.SetAttribute ("language", it)) episode.TranscriptLang |> Option.iter (fun it -> elt.SetAttribute("language", it))
if defaultArg episode.TranscriptCaptions false then if defaultArg episode.TranscriptCaptions false then elt.SetAttribute("rel", "captions")
elt.SetAttribute ("rel", "captions")
item.ElementExtensions.Add elt item.ElementExtensions.Add elt
| None -> () | None -> ()
@ -196,38 +194,37 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
| Some season -> | Some season ->
match episode.SeasonDescription with match episode.SeasonDescription with
| Some desc -> | Some desc ->
let elt = xmlDoc.CreateElement ("podcast", "season", Namespace.podcast) let elt = xmlDoc.CreateElement("podcast", "season", Namespace.podcast)
elt.SetAttribute ("name", desc) elt.SetAttribute("name", desc)
elt.InnerText <- string season elt.InnerText <- string season
item.ElementExtensions.Add elt item.ElementExtensions.Add elt
| None -> item.ElementExtensions.Add ("season", Namespace.podcast, string season) | None -> item.ElementExtensions.Add("season", Namespace.podcast, string season)
| None -> () | None -> ()
match episode.EpisodeNumber with match episode.EpisodeNumber with
| Some epNumber -> | Some epNumber ->
match episode.EpisodeDescription with match episode.EpisodeDescription with
| Some desc -> | Some desc ->
let elt = xmlDoc.CreateElement ("podcast", "episode", Namespace.podcast) let elt = xmlDoc.CreateElement("podcast", "episode", Namespace.podcast)
elt.SetAttribute ("name", desc) elt.SetAttribute("name", desc)
elt.InnerText <- string epNumber elt.InnerText <- string epNumber
item.ElementExtensions.Add elt item.ElementExtensions.Add elt
| None -> item.ElementExtensions.Add ("episode", Namespace.podcast, string epNumber) | None -> item.ElementExtensions.Add("episode", Namespace.podcast, string epNumber)
| None -> () | None -> ()
if post.Metadata |> List.exists (fun it -> it.Name = "chapter") then if post.Metadata |> List.exists (fun it -> it.Name = "chapter") then
try try
let chapters = xmlDoc.CreateElement ("psc", "chapters", Namespace.psc) let chapters = xmlDoc.CreateElement("psc", "chapters", Namespace.psc)
chapters.SetAttribute ("version", "1.2") chapters.SetAttribute("version", "1.2")
post.Metadata post.Metadata
|> List.filter (fun it -> it.Name = "chapter") |> List.filter (fun it -> it.Name = "chapter")
|> List.map (fun it -> |> List.map (fun it -> TimeSpan.Parse(it.Value.Split(" ")[0]), it.Value[it.Value.IndexOf(" ") + 1..])
TimeSpan.Parse (it.Value.Split(" ")[0]), it.Value.Substring (it.Value.IndexOf(" ") + 1))
|> List.sortBy fst |> List.sortBy fst
|> List.iter (fun chap -> |> List.iter (fun chap ->
let chapter = xmlDoc.CreateElement ("psc", "chapter", Namespace.psc) let chapter = xmlDoc.CreateElement("psc", "chapter", Namespace.psc)
chapter.SetAttribute ("start", (fst chap).ToString "hh:mm:ss") chapter.SetAttribute("start", (fst chap).ToString "hh:mm:ss")
chapter.SetAttribute ("title", snd chap) chapter.SetAttribute("title", snd chap)
chapters.AppendChild chapter |> ignore) chapters.AppendChild chapter |> ignore)
item.ElementExtensions.Add chapters item.ElementExtensions.Add chapters
@ -300,21 +297,21 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
rssFeed.ElementExtensions.Add categorization rssFeed.ElementExtensions.Add categorization
rssFeed.ElementExtensions.Add iTunesImage rssFeed.ElementExtensions.Add iTunesImage
rssFeed.ElementExtensions.Add rawVoice rssFeed.ElementExtensions.Add rawVoice
rssFeed.ElementExtensions.Add ("summary", Namespace.iTunes, podcast.Summary) rssFeed.ElementExtensions.Add("summary", Namespace.iTunes, podcast.Summary)
rssFeed.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor) rssFeed.ElementExtensions.Add("author", Namespace.iTunes, podcast.DisplayedAuthor)
rssFeed.ElementExtensions.Add ("explicit", Namespace.iTunes, ExplicitRating.toString podcast.Explicit) rssFeed.ElementExtensions.Add("explicit", Namespace.iTunes, podcast.Explicit.Value)
podcast.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub)) podcast.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub))
podcast.FundingUrl podcast.FundingUrl
|> Option.iter (fun url -> |> Option.iter (fun url ->
let funding = xmlDoc.CreateElement ("podcast", "funding", Namespace.podcast) let funding = xmlDoc.CreateElement("podcast", "funding", Namespace.podcast)
funding.SetAttribute ("url", toAbsolute webLog url) funding.SetAttribute("url", toAbsolute webLog url)
funding.InnerText <- defaultArg podcast.FundingText "Support This Podcast" funding.InnerText <- defaultArg podcast.FundingText "Support This Podcast"
rssFeed.ElementExtensions.Add funding) rssFeed.ElementExtensions.Add funding)
podcast.PodcastGuid podcast.PodcastGuid
|> Option.iter (fun guid -> |> Option.iter (fun guid ->
rssFeed.ElementExtensions.Add ("guid", Namespace.podcast, guid.ToString().ToLowerInvariant ())) rssFeed.ElementExtensions.Add("guid", Namespace.podcast, guid.ToString().ToLowerInvariant()))
podcast.Medium podcast.Medium
|> Option.iter (fun med -> rssFeed.ElementExtensions.Add ("medium", Namespace.podcast, PodcastMedium.toString med)) |> Option.iter (fun med -> rssFeed.ElementExtensions.Add("medium", Namespace.podcast, PodcastMedium.toString med))
/// Get the feed's self reference and non-feed link /// Get the feed's self reference and non-feed link
let private selfAndLink webLog feedType ctx = let private selfAndLink webLog feedType ctx =

6
src/MyWebLog/Handlers/Helpers.fs
View File

@ -348,12 +348,12 @@ let requireUser : HttpHandler = requiresAuthentication Error.notAuthorized
/// Require a specific level of access for a route /// Require a specific level of access for a route
let requireAccess level : HttpHandler = fun next ctx -> task { let requireAccess level : HttpHandler = fun next ctx -> task {
match ctx.UserAccessLevel with match ctx.UserAccessLevel with
| Some userLevel when AccessLevel.hasAccess level userLevel -> return! next ctx | Some userLevel when userLevel.HasAccess level -> return! next ctx
| Some userLevel -> | Some userLevel ->
do! addMessage ctx do! addMessage ctx
{ UserMessage.warning with { UserMessage.warning with
Message = $"The page you tried to access requires {AccessLevel.toString level} privileges" Message = $"The page you tried to access requires {level.Value} privileges"
Detail = Some $"Your account only has {AccessLevel.toString userLevel} privileges" Detail = Some $"Your account only has {userLevel.Value} privileges"
} }
return! Error.notAuthorized next ctx return! Error.notAuthorized next ctx
| None -> | None ->

8
src/MyWebLog/Handlers/Post.fs
View File

@ -242,10 +242,10 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])) |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]))
|> addToHash "templates" templates |> addToHash "templates" templates
|> addToHash "explicit_values" [| |> addToHash "explicit_values" [|
KeyValuePair.Create ("", "&ndash; Default &ndash;") KeyValuePair.Create("", "&ndash; Default &ndash;")
KeyValuePair.Create (ExplicitRating.toString Yes, "Yes") KeyValuePair.Create(Yes.Value, "Yes")
KeyValuePair.Create (ExplicitRating.toString No, "No") KeyValuePair.Create(No.Value, "No")
KeyValuePair.Create (ExplicitRating.toString Clean, "Clean") KeyValuePair.Create(Clean.Value, "Clean")
|] |]
|> adminView "post-edit" next ctx |> adminView "post-edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx

13
src/MyWebLog/Handlers/User.fs
View File

@ -58,7 +58,7 @@ let doLogOn : HttpHandler = fun next ctx -> task {
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id) Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id)
Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}") Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
Claim (ClaimTypes.GivenName, user.PreferredName) Claim (ClaimTypes.GivenName, user.PreferredName)
Claim (ClaimTypes.Role, AccessLevel.toString user.AccessLevel) Claim (ClaimTypes.Role, user.AccessLevel.Value)
} }
let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme) let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
@ -110,11 +110,10 @@ let private showEdit (model : EditUserModel) : HttpHandler = fun next ctx ->
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash ViewContext.Model model |> addToHash ViewContext.Model model
|> addToHash "access_levels" [| |> addToHash "access_levels" [|
KeyValuePair.Create (AccessLevel.toString Author, "Author") KeyValuePair.Create(Author.Value, "Author")
KeyValuePair.Create (AccessLevel.toString Editor, "Editor") KeyValuePair.Create(Editor.Value, "Editor")
KeyValuePair.Create (AccessLevel.toString WebLogAdmin, "Web Log Admin") KeyValuePair.Create(WebLogAdmin.Value, "Web Log Admin")
if ctx.HasAccessLevel Administrator then if ctx.HasAccessLevel Administrator then KeyValuePair.Create(Administrator.Value, "Administrator")
KeyValuePair.Create (AccessLevel.toString Administrator, "Administrator")
|] |]
|> adminBareView "user-edit" next ctx |> adminBareView "user-edit" next ctx
@ -160,7 +159,7 @@ let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandl
hashForPage "Edit Your Information" hashForPage "Edit Your Information"
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash ViewContext.Model model |> addToHash ViewContext.Model model
|> addToHash "access_level" (AccessLevel.toString user.AccessLevel) |> addToHash "access_level" (user.AccessLevel.Value)
|> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn) |> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn)
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog |> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog
(defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0))) (defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))

4
src/MyWebLog/Maintenance.fs
View File

@ -334,7 +334,7 @@ module Backup =
| Some _ -> | Some _ ->
// Err'body gets new IDs... // Err'body gets new IDs...
let newWebLogId = WebLogId.create () let newWebLogId = WebLogId.create ()
let newCatIds = archive.Categories |> List.map (fun cat -> cat.Id, CategoryId.create ()) |> dict let newCatIds = archive.Categories |> List.map (fun cat -> cat.Id, CategoryId.Create ()) |> dict
let newMapIds = archive.TagMappings |> List.map (fun tm -> tm.Id, TagMapId.create ()) |> dict let newMapIds = archive.TagMappings |> List.map (fun tm -> tm.Id, TagMapId.create ()) |> dict
let newPageIds = archive.Pages |> List.map (fun page -> page.Id, PageId.create ()) |> dict let newPageIds = archive.Pages |> List.map (fun page -> page.Id, PageId.create ()) |> dict
let newPostIds = archive.Posts |> List.map (fun post -> post.Id, PostId.create ()) |> dict let newPostIds = archive.Posts |> List.map (fun post -> post.Id, PostId.create ()) |> dict
@ -481,7 +481,7 @@ let private doUserUpgrade urlBase email (data : IData) = task {
| WebLogAdmin -> | WebLogAdmin ->
do! data.WebLogUser.Update { user with AccessLevel = Administrator } do! data.WebLogUser.Update { user with AccessLevel = Administrator }
printfn $"{email} is now an Administrator user" printfn $"{email} is now an Administrator user"
| other -> eprintfn $"ERROR: {email} is an {AccessLevel.toString other}, not a WebLogAdmin" | other -> eprintfn $"ERROR: {email} is an {other.Value}, not a WebLogAdmin"
| None -> eprintfn $"ERROR: no user {email} found at {urlBase}" | None -> eprintfn $"ERROR: no user {email} found at {urlBase}"
| None -> eprintfn $"ERROR: no web log found for {urlBase}" | None -> eprintfn $"ERROR: no web log found for {urlBase}"
} }