bit-badger/myWebLog
1
0
Fork 0
Code Issues 2 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

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

@ -12,17 +12,24 @@ module 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) =
@ -40,9 +47,9 @@ module Json =
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> ()
@ -130,6 +137,7 @@ module Json =
// Our converters // Our converters
[ CategoryIdConverter() :> JsonConverter [ CategoryIdConverter() :> JsonConverter
CommentIdConverter() CommentIdConverter()
CommentStatusConverter()
CustomFeedIdConverter() CustomFeedIdConverter()
CustomFeedSourceConverter() CustomFeedSourceConverter()
ExplicitRatingConverter() ExplicitRatingConverter()

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

2
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

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

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

@ -36,6 +36,7 @@ module Noda =
/// 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 =
function
| "Author" -> Author
| "Editor" -> Editor
| "WebLogAdmin" -> WebLogAdmin
| "Administrator" -> Administrator
| it -> invalidArg "level" $"{it} is not a valid access level"
/// Weightings for access levels /// The string representation of this access level
let private weights = member this.Value =
match this with
| Author -> "Author"
| Editor -> "Editor"
| WebLogAdmin -> "WebLogAdmin"
| Administrator -> "Administrator"
/// Does a given access level allow an action that requires a certain access level?
member this.HasAccess(needed: AccessLevel) =
// TODO: Move this to user where it seems to belong better...
let weights =
[ Author, 10 [ Author, 10
Editor, 20 Editor, 20
WebLogAdmin, 30 WebLogAdmin, 30
Administrator, 40 Administrator, 40
] ]
|> Map.ofList |> Map.ofList
weights[needed] <= weights[this]
/// Convert an access level to its string representation
let toString =
function
| Author -> "Author"
| Editor -> "Editor"
| WebLogAdmin -> "WebLogAdmin"
| 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?
let hasAccess needed held =
weights[needed] <= weights[held]
/// 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,43 +121,37 @@ type CommentStatus =
/// The comment was unsolicited and unwelcome /// The comment was unsolicited and unwelcome
| Spam | Spam
/// Functions to support post comment statuses
module CommentStatus =
/// Convert a comment status to a string
let toString = function Approved -> "Approved" | Pending -> "Pending" | Spam -> "Spam"
/// Parse a string into a comment status /// Parse a string into a comment status
let parse value = static member Parse =
match value with function
| "Approved" -> Approved | "Approved" -> Approved
| "Pending" -> Pending | "Pending" -> Pending
| "Spam" -> Spam | "Spam" -> Spam
| it -> invalidArg "status" $"{it} is not a valid comment status" | it -> invalidArg "status" $"{it} is not a valid comment status"
/// Convert a comment status to a string
member this.Value =
match this with Approved -> "Approved" | Pending -> "Pending" | Spam -> "Spam"
/// 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)
@ -252,13 +246,10 @@ type Episode = {
/// 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

32
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
@ -976,7 +976,7 @@ type EditUserModel =
/// 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 ->

19
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,7 +143,7 @@ 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 =
@ -163,8 +163,7 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
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 ->
@ -187,8 +186,7 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
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 -> ()
@ -221,8 +219,7 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
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)
@ -302,7 +299,7 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
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 ->

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

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

@ -243,9 +243,9 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> 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}"
} }