From 7071d606f11053fdf4e98b27bb18cb05577da274 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Thu, 14 Dec 2023 23:49:38 -0500 Subject: [PATCH] WIP on module/member conversion --- src/MyWebLog.Data/Converters.fs | 74 ++++--- .../Postgres/PostgresCategoryData.fs | 12 +- .../Postgres/PostgresPostData.fs | 2 +- src/MyWebLog.Data/SQLite/Helpers.fs | 2 +- .../SQLite/SQLiteCategoryData.fs | 14 +- src/MyWebLog.Data/SQLite/SQLitePostData.fs | 8 +- .../SQLite/SQLiteWebLogUserData.fs | 2 +- src/MyWebLog.Data/SQLiteData.fs | 4 +- src/MyWebLog.Data/Utils.fs | 16 +- src/MyWebLog.Domain/DataTypes.fs | 6 +- src/MyWebLog.Domain/SupportTypes.fs | 207 +++++++++--------- src/MyWebLog.Domain/ViewModels.fs | 34 +-- src/MyWebLog/Caches.fs | 4 +- src/MyWebLog/Handlers/Admin.fs | 2 +- src/MyWebLog/Handlers/Feed.fs | 87 ++++---- src/MyWebLog/Handlers/Helpers.fs | 6 +- src/MyWebLog/Handlers/Post.fs | 8 +- src/MyWebLog/Handlers/User.fs | 13 +- src/MyWebLog/Maintenance.fs | 4 +- 19 files changed, 250 insertions(+), 255 deletions(-) diff --git a/src/MyWebLog.Data/Converters.fs b/src/MyWebLog.Data/Converters.fs index 52a132c..0c3be03 100644 --- a/src/MyWebLog.Data/Converters.fs +++ b/src/MyWebLog.Data/Converters.fs @@ -9,20 +9,27 @@ module Json = open Newtonsoft.Json - type CategoryIdConverter () = - inherit JsonConverter () - override _.WriteJson (writer : JsonWriter, value : CategoryId, _ : JsonSerializer) = - writer.WriteValue (CategoryId.toString value) - override _.ReadJson (reader : JsonReader, _ : Type, _ : CategoryId, _ : bool, _ : JsonSerializer) = + type CategoryIdConverter() = + inherit JsonConverter() + override _.WriteJson(writer: JsonWriter, value: CategoryId, _: JsonSerializer) = + writer.WriteValue value.Value + override _.ReadJson(reader: JsonReader, _: Type, _: CategoryId, _: bool, _: JsonSerializer) = (string >> CategoryId) reader.Value - type CommentIdConverter () = - inherit JsonConverter () - override _.WriteJson (writer : JsonWriter, value : CommentId, _ : JsonSerializer) = - writer.WriteValue (CommentId.toString value) - override _.ReadJson (reader : JsonReader, _ : Type, _ : CommentId, _ : bool, _ : JsonSerializer) = + type CommentIdConverter() = + inherit JsonConverter() + override _.WriteJson(writer: JsonWriter, value: CommentId, _: JsonSerializer) = + writer.WriteValue value.Value + override _.ReadJson(reader: JsonReader, _: Type, _: CommentId, _: bool, _: JsonSerializer) = (string >> CommentId) reader.Value + type CommentStatusConverter() = + inherit JsonConverter() + 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 () = inherit JsonConverter () override _.WriteJson (writer : JsonWriter, value : CustomFeedId, _ : JsonSerializer) = @@ -37,12 +44,12 @@ module Json = override _.ReadJson (reader : JsonReader, _ : Type, _ : CustomFeedSource, _ : bool, _ : JsonSerializer) = (string >> CustomFeedSource.parse) reader.Value - type ExplicitRatingConverter () = - inherit JsonConverter () - override _.WriteJson (writer : JsonWriter, value : ExplicitRating, _ : JsonSerializer) = - writer.WriteValue (ExplicitRating.toString value) - override _.ReadJson (reader : JsonReader, _ : Type, _ : ExplicitRating, _ : bool, _ : JsonSerializer) = - (string >> ExplicitRating.parse) reader.Value + type ExplicitRatingConverter() = + inherit JsonConverter() + override _.WriteJson(writer: JsonWriter, value: ExplicitRating, _: JsonSerializer) = + writer.WriteValue value.Value + override _.ReadJson(reader: JsonReader, _: Type, _: ExplicitRating, _: bool, _: JsonSerializer) = + (string >> ExplicitRating.Parse) reader.Value type MarkupTextConverter () = inherit JsonConverter () @@ -128,27 +135,28 @@ module Json = /// Configure a serializer to use these converters let configure (ser : JsonSerializer) = // Our converters - [ CategoryIdConverter () :> JsonConverter - CommentIdConverter () - CustomFeedIdConverter () - CustomFeedSourceConverter () - ExplicitRatingConverter () - MarkupTextConverter () - PermalinkConverter () - PageIdConverter () - PodcastMediumConverter () - PostIdConverter () - TagMapIdConverter () - ThemeAssetIdConverter () - ThemeIdConverter () - UploadIdConverter () - WebLogIdConverter () - WebLogUserIdConverter () + [ CategoryIdConverter() :> JsonConverter + CommentIdConverter() + CommentStatusConverter() + CustomFeedIdConverter() + CustomFeedSourceConverter() + ExplicitRatingConverter() + MarkupTextConverter() + PermalinkConverter() + PageIdConverter() + PodcastMediumConverter() + PostIdConverter() + TagMapIdConverter() + ThemeAssetIdConverter() + ThemeIdConverter() + UploadIdConverter() + WebLogIdConverter() + WebLogUserIdConverter() ] |> List.iter ser.Converters.Add // NodaTime let _ = ser.ConfigureForNodaTime DateTimeZoneProviders.Tzdb // Handles DUs with no associated data, as well as option fields - ser.Converters.Add (CompactUnionJsonConverter ()) + ser.Converters.Add(CompactUnionJsonConverter()) ser.NullValueHandling <- NullValueHandling.Ignore ser.MissingMemberHandling <- MissingMemberHandling.Ignore ser diff --git a/src/MyWebLog.Data/Postgres/PostgresCategoryData.fs b/src/MyWebLog.Data/Postgres/PostgresCategoryData.fs index 5b703fa..60ef682 100644 --- a/src/MyWebLog.Data/Postgres/PostgresCategoryData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresCategoryData.fs @@ -65,7 +65,7 @@ type PostgresCategoryData (log : ILogger) = /// Find a category by its ID for the given web log let findById catId webLogId = log.LogTrace "Category.findById" - Document.findByIdAndWebLog Table.Category catId CategoryId.toString webLogId + Document.findByIdAndWebLog Table.Category catId (_.Value) webLogId /// Find all categories for the given web log let findByWebLog webLogId = @@ -74,7 +74,7 @@ type PostgresCategoryData (log : ILogger) = /// Create parameters for a category insert / update let catParameters (cat : Category) = - Query.docParameters (CategoryId.toString cat.Id) cat + Query.docParameters cat.Id.Value cat /// Delete a category let delete catId webLogId = backgroundTask { @@ -82,7 +82,7 @@ type PostgresCategoryData (log : ILogger) = match! findById catId webLogId with | Some cat -> // Reassign any children to the category's parent category - let! children = Find.byContains Table.Category {| ParentId = CategoryId.toString catId |} + let! children = Find.byContains Table.Category {| ParentId = catId.Value |} let hasChildren = not (List.isEmpty children) if hasChildren then let! _ = @@ -91,7 +91,7 @@ type PostgresCategoryData (log : ILogger) = |> Sql.executeTransactionAsync [ Query.Update.partialById Table.Category, children |> List.map (fun child -> [ - "@id", Sql.string (CategoryId.toString child.Id) + "@id", Sql.string child.Id.Value "@data", Query.jsonbDocParam {| ParentId = cat.ParentId |} ]) ] @@ -99,7 +99,7 @@ type PostgresCategoryData (log : ILogger) = // Delete the category off all posts where it is assigned let! posts = Custom.list $"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.empty.CategoryIds}' @> @id" - [ "@id", Query.jsonbDocParam [| CategoryId.toString catId |] ] fromData + [ "@id", Query.jsonbDocParam [| catId.Value |] ] fromData if not (List.isEmpty posts) then let! _ = Configuration.dataSource () @@ -114,7 +114,7 @@ type PostgresCategoryData (log : ILogger) = ] () // 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 | None -> return CategoryNotFound } diff --git a/src/MyWebLog.Data/Postgres/PostgresPostData.fs b/src/MyWebLog.Data/Postgres/PostgresPostData.fs index ac676e7..70a6c54 100644 --- a/src/MyWebLog.Data/Postgres/PostgresPostData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresPostData.fs @@ -106,7 +106,7 @@ type PostgresPostData (log : ILogger) = /// Get a page of categorized posts for the given web log (excludes revisions) let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = 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 $"{selectWithCriteria Table.Post} AND {catSql} diff --git a/src/MyWebLog.Data/SQLite/Helpers.fs b/src/MyWebLog.Data/SQLite/Helpers.fs index 2a4f06a..08ab5a4 100644 --- a/src/MyWebLog.Data/SQLite/Helpers.fs +++ b/src/MyWebLog.Data/SQLite/Helpers.fs @@ -362,7 +362,7 @@ module Map = PreferredName = getString "preferred_name" rdr PasswordHash = getString "password_hash" rdr Url = tryString "url" rdr - AccessLevel = getString "access_level" rdr |> AccessLevel.parse + AccessLevel = getString "access_level" rdr |> AccessLevel.Parse CreatedOn = getInstant "created_on" rdr LastSeenOn = tryInstant "last_seen_on" rdr } diff --git a/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs b/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs index 75728b8..3caae20 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs @@ -10,12 +10,12 @@ type SQLiteCategoryData (conn : SqliteConnection) = /// Add parameters for category INSERT or UPDATE statements 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 ("@name", cat.Name) cmd.Parameters.AddWithValue ("@slug", cat.Slug) 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 /// Add a category @@ -101,10 +101,10 @@ type SQLiteCategoryData (conn : SqliteConnection) = |> Array.ofSeq } /// 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 () 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 () return Helpers.verifyWebLog webLogId (fun c -> c.WebLogId) Map.toCategory rdr } @@ -125,11 +125,11 @@ type SQLiteCategoryData (conn : SqliteConnection) = use cmd = conn.CreateCommand () // Reassign any children to the category's parent category 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 if children > 0 then 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 do! write cmd // 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); DELETE FROM category WHERE id = @id" cmd.Parameters.Clear () - let _ = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) + let _ = cmd.Parameters.AddWithValue ("@id", catId.Value) addWebLogId cmd webLogId do! write cmd return if children = 0 then CategoryDeleted else ReassignedChildCategories diff --git a/src/MyWebLog.Data/SQLite/SQLitePostData.fs b/src/MyWebLog.Data/SQLite/SQLitePostData.fs index 257bdf7..d73cf86 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePostData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePostData.fs @@ -83,7 +83,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) = /// Update a post's assigned categories let updatePostCategories postId oldCats newCats = backgroundTask { - let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString + let toDelete, toAdd = Utils.diffLists oldCats newCats _.Value if List.isEmpty toDelete && List.isEmpty toAdd then return () else @@ -91,8 +91,8 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) = [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) cmd.Parameters.Add ("@categoryId", SqliteType.Text) ] |> ignore - let runCmd catId = backgroundTask { - cmd.Parameters["@categoryId"].Value <- CategoryId.toString catId + let runCmd (catId: CategoryId) = backgroundTask { + cmd.Parameters["@categoryId"].Value <- catId.Value do! write cmd } 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) let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask { 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 <- $" {selectPost} INNER JOIN post_category pc ON pc.post_id = p.id diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs index 8eb8cd9..f99bf05 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs @@ -19,7 +19,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName) cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash) 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 ("@lastSeenOn", maybeInstant user.LastSeenOn) ] |> ignore diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index d1a3aaf..61d5f48 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -188,7 +188,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger, ser : JsonS ImageUrl = Map.getString "image_url" podcastRdr |> Permalink AppleCategory = Map.getString "apple_category" 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 MediaBaseUrl = Map.tryString "media_base_url" podcastRdr PodcastGuid = Map.tryGuid "podcast_guid" podcastRdr @@ -220,7 +220,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger, ser : JsonS ImageUrl = Map.tryString "image_url" epRdr Subtitle = Map.tryString "subtitle" epRdr Explicit = Map.tryString "explicit" epRdr - |> Option.map ExplicitRating.parse + |> Option.map ExplicitRating.Parse Chapters = Map.tryString "chapters" epRdr |> Option.map (Utils.deserialize ser) ChapterFile = Map.tryString "chapter_file" epRdr diff --git a/src/MyWebLog.Data/Utils.fs b/src/MyWebLog.Data/Utils.fs index c241a65..14f94aa 100644 --- a/src/MyWebLog.Data/Utils.fs +++ b/src/MyWebLog.Data/Utils.fs @@ -12,7 +12,7 @@ let currentDbVersion = "v2.1" let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq { for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug - { Id = CategoryId.toString cat.Id + { Id = cat.Id.Value Slug = fullSlug Name = cat.Name 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 -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)) List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems @@ -38,21 +38,21 @@ let diffPermalinks oldLinks newLinks = /// Find the revisions added and removed 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 Newtonsoft.Json /// Serialize an object to JSON -let serialize<'T> ser (item : 'T) = - JsonConvert.SerializeObject (item, Json.settings ser) +let serialize<'T> ser (item: 'T) = + JsonConvert.SerializeObject(item, Json.settings ser) /// Deserialize a JSON string -let deserialize<'T> (ser : JsonSerializer) value = - JsonConvert.DeserializeObject<'T> (value, Json.settings ser) +let deserialize<'T> (ser: JsonSerializer) value = + JsonConvert.DeserializeObject<'T>(value, Json.settings ser) open Microsoft.Extensions.Logging /// 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}" diff --git a/src/MyWebLog.Domain/DataTypes.fs b/src/MyWebLog.Domain/DataTypes.fs index cae8b76..baf4742 100644 --- a/src/MyWebLog.Domain/DataTypes.fs +++ b/src/MyWebLog.Domain/DataTypes.fs @@ -31,7 +31,7 @@ module Category = /// An empty category let empty = { - Id = CategoryId.empty + Id = CategoryId.Empty WebLogId = WebLogId.empty Name = "" Slug = "" @@ -76,7 +76,7 @@ module Comment = /// An empty comment let empty = { - Id = CommentId.empty + Id = CommentId.Empty PostId = PostId.empty InReplyToId = None Name = "" @@ -485,4 +485,4 @@ module WebLogUser = /// Does a user have the required access level? let hasAccess level user = - AccessLevel.hasAccess level user.AccessLevel + user.AccessLevel.HasAccess level diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index c3e0fe1..e6ac59c 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -10,20 +10,20 @@ module private Helpers = /// Create a new ID (short GUID) // https://www.madskristensen.net/blog/A-shorter-and-URL-friendly-GUID let newId () = - Convert.ToBase64String(Guid.NewGuid().ToByteArray ()).Replace('/', '_').Replace('+', '-')[..22] + Convert.ToBase64String(Guid.NewGuid().ToByteArray()).Replace('/', '_').Replace('+', '-')[..22] /// Functions to support NodaTime manipulation module Noda = /// 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 let epoch = Instant.FromUnixTimeSeconds 0L /// Truncate an instant to remove fractional seconds - let toSecondsPrecision (value : Instant) = + let toSecondsPrecision (value: Instant) = Instant.FromUnixTimeSeconds(value.ToUnixTimeSeconds()) /// The current Instant, with fractional seconds truncated @@ -31,11 +31,12 @@ module Noda = clock.GetCurrentInstant >> toSecondsPrecision /// 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 /// A user's access level +[] type AccessLevel = /// The user may create and publish posts and edit the ones they have created | Author @@ -45,74 +46,73 @@ type AccessLevel = | WebLogAdmin /// The user may manage themes (which affects all web logs for an installation) | Administrator - -/// Functions to support access levels -module AccessLevel = - - /// 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 - | 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 + static member Parse = + function + | "Author" -> Author + | "Editor" -> Editor + | "WebLogAdmin" -> WebLogAdmin | "Administrator" -> Administrator - | _ -> invalidOp $"{it} is not a valid access level" + | 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" /// Does a given access level allow an action that requires a certain access level? - let hasAccess needed held = - weights[needed] <= weights[held] + member this.HasAccess(needed: AccessLevel) = + // 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 -type CategoryId = CategoryId of string - -/// Functions to support category IDs -module CategoryId = +[] +type CategoryId = + | CategoryId of string /// An empty category ID - let empty = CategoryId "" - - /// Convert a category ID to a string - let toString = function CategoryId ci -> ci + static member Empty = CategoryId "" /// 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 -type CommentId = CommentId of string - -/// Functions to support comment IDs -module CommentId = +[] +type CommentId = + | CommentId of string /// An empty comment ID - let empty = CommentId "" - - /// Convert a comment ID to a string - let toString = function CommentId ci -> ci + static member Empty = CommentId "" /// 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 +[] type CommentStatus = /// The comment is approved | Approved @@ -121,77 +121,71 @@ type CommentStatus = /// The comment was unsolicited and unwelcome | 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 - let parse value = - match value with + static member Parse = + function | "Approved" -> Approved - | "Pending" -> Pending - | "Spam" -> Spam - | it -> invalidArg "status" $"{it} is not a valid comment status" + | "Pending" -> Pending + | "Spam" -> Spam + | 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 +[] type ExplicitRating = | Yes | No | Clean - -/// Functions to support iTunes explicit ratings -module ExplicitRating = - /// Convert an explicit rating to a string - let toString : ExplicitRating -> string = - function - | Yes -> "yes" - | No -> "no" - | Clean -> "clean" /// Parse a string into an explicit rating - let parse : string -> ExplicitRating = + static member Parse = function - | "yes" -> Yes - | "no" -> No + | "yes" -> Yes + | "no" -> No | "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) type Location = { /// The name of the location (free-form text) - Name : string + Name: string /// A geographic coordinate string (RFC 5870) - Geo : string option + Geo: string option /// An OpenStreetMap query - Osm : string option + Osm: string option } /// A chapter in a podcast episode type Chapter = { /// The start time for the chapter - StartTime : Duration + StartTime: Duration /// The title for this chapter - Title : string option + Title: string option /// A URL for an image for this chapter - ImageUrl : string option + ImageUrl: string option /// Whether this chapter is hidden - IsHidden : bool option + IsHidden: bool option /// The episode end time for the chapter - EndTime : Duration option + EndTime: Duration option /// A location that applies to a chapter - Location : Location option + Location: Location option } @@ -200,65 +194,62 @@ open NodaTime.Text /// A podcast episode type Episode = { /// The URL to the media file for the episode (may be permalink) - Media : string + Media: string /// The length of the media file, in bytes - Length : int64 + Length: int64 /// The duration of the episode - Duration : Duration option + Duration: Duration option /// 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) - ImageUrl : string option + ImageUrl: string option /// A subtitle for this episode - Subtitle : string option + Subtitle: string option /// This episode's explicit rating (overrides podcast rating if present) - Explicit : ExplicitRating option + Explicit: ExplicitRating option /// Chapters for this episode - Chapters : Chapter list option + Chapters: Chapter list option /// A link to a chapter file - ChapterFile : string option + ChapterFile: string option /// The MIME type for the chapter file - ChapterType : string option + ChapterType: string option /// The URL for the transcript of the episode (may be permalink) - TranscriptUrl : string option + TranscriptUrl: string option /// The MIME type of the transcript - TranscriptType : string option + TranscriptType: string option /// 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 - TranscriptCaptions : bool option + TranscriptCaptions: bool option /// The season number (for serialized podcasts) - SeasonNumber : int option + SeasonNumber: int option /// A description of the season - SeasonDescription : string option + SeasonDescription: string option /// The episode number - EpisodeNumber : double option + EpisodeNumber: double option /// A description of the episode - EpisodeDescription : string option -} - -/// Functions to support episodes -module Episode = + EpisodeDescription: string option +} with /// An empty episode - let empty = { + static member Empty = { Media = "" Length = 0L Duration = None @@ -280,8 +271,8 @@ module Episode = } /// Format a duration for an episode - let formatDuration ep = - ep.Duration |> Option.map (DurationPattern.CreateWithInvariantCulture("H:mm:ss").Format) + member this.FormatDuration() = + this.Duration |> Option.map (DurationPattern.CreateWithInvariantCulture("H:mm:ss").Format) open Markdig diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index a0ebb3f..28c85e5 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -305,7 +305,7 @@ module DisplayUser = LastName = user.LastName PreferredName = user.PreferredName Url = defaultArg user.Url "" - AccessLevel = AccessLevel.toString user.AccessLevel + AccessLevel = user.AccessLevel.Value CreatedOn = WebLog.localTime webLog user.CreatedOn LastSeenOn = user.LastSeenOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable } @@ -332,11 +332,11 @@ type EditCategoryModel = /// Create an edit model from an existing category static member fromCategory (cat : Category) = - { CategoryId = CategoryId.toString cat.Id + { CategoryId = cat.Id.Value Name = cat.Name Slug = cat.Slug 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? @@ -457,7 +457,7 @@ type EditCustomFeedModel = ImageUrl = Permalink.toString p.ImageUrl AppleCategory = p.AppleCategory AppleSubcategory = defaultArg p.AppleSubcategory "" - Explicit = ExplicitRating.toString p.Explicit + Explicit = p.Explicit.Value DefaultMediaType = defaultArg p.DefaultMediaType "" MediaBaseUrl = defaultArg p.MediaBaseUrl "" FundingUrl = defaultArg p.FundingUrl "" @@ -486,7 +486,7 @@ type EditCustomFeedModel = ImageUrl = Permalink this.ImageUrl AppleCategory = this.AppleCategory AppleSubcategory = noneIfBlank this.AppleSubcategory - Explicit = ExplicitRating.parse this.Explicit + Explicit = ExplicitRating.Parse this.Explicit DefaultMediaType = noneIfBlank this.DefaultMediaType MediaBaseUrl = noneIfBlank this.MediaBaseUrl PodcastGuid = noneIfBlank this.PodcastGuid |> Option.map Guid.Parse @@ -714,11 +714,11 @@ type EditPostModel = /// Create an edit model from an existing past static member fromPost webLog (post : Post) = 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 | None -> Revision.empty 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 Title = post.Title Permalink = Permalink.toString post.Permalink @@ -726,22 +726,22 @@ type EditPostModel = Text = MarkupText.text latest.Text Tags = String.Join (", ", post.Tags) 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 DoPublish = false - MetaNames = post.Metadata |> List.map (fun m -> m.Name) |> Array.ofList - MetaValues = post.Metadata |> List.map (fun m -> m.Value) |> Array.ofList + MetaNames = post.Metadata |> List.map (_.Name) |> Array.ofList + MetaValues = post.Metadata |> List.map (_.Value) |> Array.ofList SetPublished = false PubOverride = post.PublishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable SetUpdated = false IsEpisode = Option.isSome post.Episode Media = episode.Media Length = episode.Length - Duration = defaultArg (Episode.formatDuration episode) "" + Duration = defaultArg (episode.FormatDuration()) "" MediaType = defaultArg episode.MediaType "" ImageUrl = defaultArg episode.ImageUrl "" Subtitle = defaultArg episode.Subtitle "" - Explicit = defaultArg (episode.Explicit |> Option.map ExplicitRating.toString) "" + Explicit = defaultArg (episode.Explicit |> Option.map (_.Value)) "" ChapterFile = defaultArg episode.ChapterFile "" ChapterType = defaultArg episode.ChapterType "" TranscriptUrl = defaultArg episode.TranscriptUrl "" @@ -800,7 +800,7 @@ type EditPostModel = MediaType = noneIfBlank this.MediaType ImageUrl = noneIfBlank this.ImageUrl 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 ChapterFile = noneIfBlank this.ChapterFile ChapterType = noneIfBlank this.ChapterType @@ -960,7 +960,7 @@ type EditUserModel = /// Construct a displayed user from a web log user static member fromUser (user : WebLogUser) = { Id = WebLogUserId.toString user.Id - AccessLevel = AccessLevel.toString user.AccessLevel + AccessLevel = user.AccessLevel.Value Url = defaultArg user.Url "" Email = user.Email FirstName = user.FirstName @@ -974,9 +974,9 @@ type EditUserModel = member this.IsNew = this.Id = "new" /// Update a user with values from this model (excludes password) - member this.UpdateUser (user : WebLogUser) = + member this.UpdateUser (user: WebLogUser) = { user with - AccessLevel = AccessLevel.parse this.AccessLevel + AccessLevel = AccessLevel.Parse this.AccessLevel Email = this.Email Url = noneIfBlank this.Url FirstName = this.FirstName @@ -1126,7 +1126,7 @@ type PostListItem = PublishedOn = post.PublishedOn |> Option.map inTZ |> Option.toNullable UpdatedOn = inTZ post.UpdatedOn Text = addBaseToRelativeUrls extra post.Text - CategoryIds = post.CategoryIds |> List.map CategoryId.toString + CategoryIds = post.CategoryIds |> List.map _.Value Tags = post.Tags Episode = post.Episode Metadata = post.Metadata diff --git a/src/MyWebLog/Caches.fs b/src/MyWebLog/Caches.fs index cfb0e0f..05bda8f 100644 --- a/src/MyWebLog/Caches.fs +++ b/src/MyWebLog/Caches.fs @@ -42,7 +42,7 @@ module Extensions = member this.UserAccessLevel = this.User.Claims |> 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 member this.UserId = @@ -53,7 +53,7 @@ module Extensions = /// Does the current user have the requested level of access? 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 diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index 4025843..de59270 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -177,7 +177,7 @@ module Category = let data = ctx.Data let! model = ctx.BindFormAsync () 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 match! category with | Some cat -> diff --git a/src/MyWebLog/Handlers/Feed.fs b/src/MyWebLog/Handlers/Feed.fs index 7db1dd9..2db2de4 100644 --- a/src/MyWebLog/Handlers/Feed.fs +++ b/src/MyWebLog/Handlers/Feed.fs @@ -48,8 +48,8 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option = /// Determine the function to retrieve posts for the given feed let private getFeedPosts ctx feedType = - let childIds catId = - let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = CategoryId.toString catId) + let childIds (catId: CategoryId) = + let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = catId.Value) getCategoryIds cat.Slug ctx let data = ctx.Data 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)) [ post.CategoryIds |> 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)) post.Tags |> List.map (fun tag -> @@ -143,28 +143,27 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po | link -> WebLog.absoluteUrl webLog (Permalink link) let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten 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 it = xmlDoc.CreateElement "enclosure" - it.SetAttribute ("url", epMediaUrl) - it.SetAttribute ("length", string episode.Length) - epMediaType |> Option.iter (fun typ -> it.SetAttribute ("type", typ)) + it.SetAttribute("url", epMediaUrl) + it.SetAttribute("length", string episode.Length) + epMediaType |> Option.iter (fun typ -> it.SetAttribute("type", typ)) it let image = - let it = xmlDoc.CreateElement ("itunes", "image", Namespace.iTunes) - it.SetAttribute ("href", epImageUrl) + let it = xmlDoc.CreateElement("itunes", "image", Namespace.iTunes) + it.SetAttribute("href", epImageUrl) it item.ElementExtensions.Add enclosure item.ElementExtensions.Add image - item.ElementExtensions.Add ("creator", Namespace.dc, podcast.DisplayedAuthor) - item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor) - item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit) - episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it)) - Episode.formatDuration episode - |> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it)) + item.ElementExtensions.Add("creator", Namespace.dc, podcast.DisplayedAuthor) + item.ElementExtensions.Add("author", Namespace.iTunes, podcast.DisplayedAuthor) + item.ElementExtensions.Add("explicit", Namespace.iTunes, epExplicit) + episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add("subtitle", Namespace.iTunes, it)) + episode.FormatDuration() |> Option.iter (fun it -> item.ElementExtensions.Add("duration", Namespace.iTunes, it)) match episode.ChapterFile with | Some chapters -> @@ -174,21 +173,20 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po | Some mime -> Some mime | None when chapters.EndsWith ".json" -> Some "application/json+chapters" | None -> None - let elt = xmlDoc.CreateElement ("podcast", "chapters", Namespace.podcast) - elt.SetAttribute ("url", url) - typ |> Option.iter (fun it -> elt.SetAttribute ("type", it)) + let elt = xmlDoc.CreateElement("podcast", "chapters", Namespace.podcast) + elt.SetAttribute("url", url) + typ |> Option.iter (fun it -> elt.SetAttribute("type", it)) item.ElementExtensions.Add elt | None -> () match episode.TranscriptUrl with | Some transcript -> let url = toAbsolute webLog transcript - let elt = xmlDoc.CreateElement ("podcast", "transcript", Namespace.podcast) - elt.SetAttribute ("url", url) - elt.SetAttribute ("type", Option.get episode.TranscriptType) - episode.TranscriptLang |> Option.iter (fun it -> elt.SetAttribute ("language", it)) - if defaultArg episode.TranscriptCaptions false then - elt.SetAttribute ("rel", "captions") + let elt = xmlDoc.CreateElement("podcast", "transcript", Namespace.podcast) + elt.SetAttribute("url", url) + elt.SetAttribute("type", Option.get episode.TranscriptType) + episode.TranscriptLang |> Option.iter (fun it -> elt.SetAttribute("language", it)) + if defaultArg episode.TranscriptCaptions false then elt.SetAttribute("rel", "captions") item.ElementExtensions.Add elt | None -> () @@ -196,38 +194,37 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po | Some season -> match episode.SeasonDescription with | Some desc -> - let elt = xmlDoc.CreateElement ("podcast", "season", Namespace.podcast) - elt.SetAttribute ("name", desc) + let elt = xmlDoc.CreateElement("podcast", "season", Namespace.podcast) + elt.SetAttribute("name", desc) elt.InnerText <- string season item.ElementExtensions.Add elt - | None -> item.ElementExtensions.Add ("season", Namespace.podcast, string season) + | None -> item.ElementExtensions.Add("season", Namespace.podcast, string season) | None -> () match episode.EpisodeNumber with | Some epNumber -> match episode.EpisodeDescription with | Some desc -> - let elt = xmlDoc.CreateElement ("podcast", "episode", Namespace.podcast) - elt.SetAttribute ("name", desc) + let elt = xmlDoc.CreateElement("podcast", "episode", Namespace.podcast) + elt.SetAttribute("name", desc) elt.InnerText <- string epNumber item.ElementExtensions.Add elt - | None -> item.ElementExtensions.Add ("episode", Namespace.podcast, string epNumber) + | None -> item.ElementExtensions.Add("episode", Namespace.podcast, string epNumber) | None -> () if post.Metadata |> List.exists (fun it -> it.Name = "chapter") then try - let chapters = xmlDoc.CreateElement ("psc", "chapters", Namespace.psc) - chapters.SetAttribute ("version", "1.2") + let chapters = xmlDoc.CreateElement("psc", "chapters", Namespace.psc) + chapters.SetAttribute("version", "1.2") post.Metadata |> List.filter (fun it -> it.Name = "chapter") - |> List.map (fun it -> - TimeSpan.Parse (it.Value.Split(" ")[0]), it.Value.Substring (it.Value.IndexOf(" ") + 1)) + |> List.map (fun it -> TimeSpan.Parse(it.Value.Split(" ")[0]), it.Value[it.Value.IndexOf(" ") + 1..]) |> List.sortBy fst |> List.iter (fun chap -> - let chapter = xmlDoc.CreateElement ("psc", "chapter", Namespace.psc) - chapter.SetAttribute ("start", (fst chap).ToString "hh:mm:ss") - chapter.SetAttribute ("title", snd chap) + let chapter = xmlDoc.CreateElement("psc", "chapter", Namespace.psc) + chapter.SetAttribute("start", (fst chap).ToString "hh:mm:ss") + chapter.SetAttribute("title", snd chap) chapters.AppendChild chapter |> ignore) item.ElementExtensions.Add chapters @@ -300,21 +297,21 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) = rssFeed.ElementExtensions.Add categorization rssFeed.ElementExtensions.Add iTunesImage rssFeed.ElementExtensions.Add rawVoice - rssFeed.ElementExtensions.Add ("summary", Namespace.iTunes, podcast.Summary) - rssFeed.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor) - rssFeed.ElementExtensions.Add ("explicit", Namespace.iTunes, ExplicitRating.toString podcast.Explicit) + rssFeed.ElementExtensions.Add("summary", Namespace.iTunes, podcast.Summary) + rssFeed.ElementExtensions.Add("author", Namespace.iTunes, podcast.DisplayedAuthor) + rssFeed.ElementExtensions.Add("explicit", Namespace.iTunes, podcast.Explicit.Value) podcast.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub)) podcast.FundingUrl |> Option.iter (fun url -> - let funding = xmlDoc.CreateElement ("podcast", "funding", Namespace.podcast) - funding.SetAttribute ("url", toAbsolute webLog url) + let funding = xmlDoc.CreateElement("podcast", "funding", Namespace.podcast) + funding.SetAttribute("url", toAbsolute webLog url) funding.InnerText <- defaultArg podcast.FundingText "Support This Podcast" rssFeed.ElementExtensions.Add funding) podcast.PodcastGuid |> Option.iter (fun guid -> - rssFeed.ElementExtensions.Add ("guid", Namespace.podcast, guid.ToString().ToLowerInvariant ())) + rssFeed.ElementExtensions.Add("guid", Namespace.podcast, guid.ToString().ToLowerInvariant())) 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 let private selfAndLink webLog feedType ctx = diff --git a/src/MyWebLog/Handlers/Helpers.fs b/src/MyWebLog/Handlers/Helpers.fs index 2edefe8..b1f4bd3 100644 --- a/src/MyWebLog/Handlers/Helpers.fs +++ b/src/MyWebLog/Handlers/Helpers.fs @@ -348,12 +348,12 @@ let requireUser : HttpHandler = requiresAuthentication Error.notAuthorized /// Require a specific level of access for a route let requireAccess level : HttpHandler = fun next ctx -> task { 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 -> do! addMessage ctx { UserMessage.warning with - Message = $"The page you tried to access requires {AccessLevel.toString level} privileges" - Detail = Some $"Your account only has {AccessLevel.toString userLevel} privileges" + Message = $"The page you tried to access requires {level.Value} privileges" + Detail = Some $"Your account only has {userLevel.Value} privileges" } return! Error.notAuthorized next ctx | None -> diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs index 087f66c..0f5ea97 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -242,10 +242,10 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])) |> addToHash "templates" templates |> addToHash "explicit_values" [| - KeyValuePair.Create ("", "– Default –") - KeyValuePair.Create (ExplicitRating.toString Yes, "Yes") - KeyValuePair.Create (ExplicitRating.toString No, "No") - KeyValuePair.Create (ExplicitRating.toString Clean, "Clean") + KeyValuePair.Create("", "– Default –") + KeyValuePair.Create(Yes.Value, "Yes") + KeyValuePair.Create(No.Value, "No") + KeyValuePair.Create(Clean.Value, "Clean") |] |> adminView "post-edit" next ctx | Some _ -> return! Error.notAuthorized next ctx diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index 43d9ccc..389fe56 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -58,7 +58,7 @@ let doLogOn : HttpHandler = fun next ctx -> task { Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id) Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}") Claim (ClaimTypes.GivenName, user.PreferredName) - Claim (ClaimTypes.Role, AccessLevel.toString user.AccessLevel) + Claim (ClaimTypes.Role, user.AccessLevel.Value) } let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme) @@ -110,11 +110,10 @@ let private showEdit (model : EditUserModel) : HttpHandler = fun next ctx -> |> withAntiCsrf ctx |> addToHash ViewContext.Model model |> addToHash "access_levels" [| - KeyValuePair.Create (AccessLevel.toString Author, "Author") - KeyValuePair.Create (AccessLevel.toString Editor, "Editor") - KeyValuePair.Create (AccessLevel.toString WebLogAdmin, "Web Log Admin") - if ctx.HasAccessLevel Administrator then - KeyValuePair.Create (AccessLevel.toString Administrator, "Administrator") + KeyValuePair.Create(Author.Value, "Author") + KeyValuePair.Create(Editor.Value, "Editor") + KeyValuePair.Create(WebLogAdmin.Value, "Web Log Admin") + if ctx.HasAccessLevel Administrator then KeyValuePair.Create(Administrator.Value, "Administrator") |] |> adminBareView "user-edit" next ctx @@ -160,7 +159,7 @@ let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandl hashForPage "Edit Your Information" |> withAntiCsrf ctx |> 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 "last_seen_on" (WebLog.localTime ctx.WebLog (defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0))) diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 8413504..ee7d934 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -334,7 +334,7 @@ module Backup = | Some _ -> // Err'body gets new IDs... 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 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 @@ -481,7 +481,7 @@ let private doUserUpgrade urlBase email (data : IData) = task { | WebLogAdmin -> do! data.WebLogUser.Update { user with AccessLevel = Administrator } 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 web log found for {urlBase}" }