diff --git a/src/MyWebLog.Data/Converters.fs b/src/MyWebLog.Data/Converters.fs index 9a2ca9a..fc303b5 100644 --- a/src/MyWebLog.Data/Converters.fs +++ b/src/MyWebLog.Data/Converters.fs @@ -140,6 +140,10 @@ module Bson = open LiteDB + module AuthorizationLevelMapping = + let fromBson (value : BsonValue) = AuthorizationLevel.parse value.AsString + let toBson (value : AuthorizationLevel) : BsonValue = AuthorizationLevel.toString value + module CategoryIdMapping = let fromBson (value : BsonValue) = CategoryId value.AsString let toBson (value : CategoryId) : BsonValue = CategoryId.toString value @@ -148,6 +152,10 @@ module Bson = let fromBson (value : BsonValue) = CommentId value.AsString let toBson (value : CommentId) : BsonValue = CommentId.toString value + module CommentStatusMapping = + let fromBson (value : BsonValue) = CommentStatus.parse value.AsString + let toBson (value : CommentStatus) : BsonValue = CommentStatus.toString value + module CustomFeedIdMapping = let fromBson (value : BsonValue) = CustomFeedId value.AsString let toBson (value : CustomFeedId) : BsonValue = CustomFeedId.toString value @@ -181,9 +189,9 @@ module Bson = let intToBson (value : int option) : BsonValue = match value with Some nbr -> nbr | None -> BsonValue.Null let podcastOptionsFromBson (value : BsonValue) = - if value.IsNull then None else Some (value.RawValue :?> PodcastOptions) + if value.IsNull then None else Some (BsonMapper.Global.ToObject value.AsDocument) let podcastOptionsToBson (value : PodcastOptions option) : BsonValue = - match value with Some opts -> BsonValue opts | None -> BsonValue.Null + match value with Some opts -> BsonMapper.Global.ToDocument opts | None -> BsonValue.Null let stringFromBson (value : BsonValue) = if value.IsNull then None else Some value.AsString let stringToBson (value : string option) : BsonValue = match value with Some str -> str | None -> BsonValue.Null @@ -191,7 +199,7 @@ module Bson = module PermalinkMapping = let fromBson (value : BsonValue) = Permalink value.AsString let toBson (value : Permalink) : BsonValue = Permalink.toString value - + module PageIdMapping = let fromBson (value : BsonValue) = PageId value.AsString let toBson (value : PageId) : BsonValue = PageId.toString value @@ -200,6 +208,10 @@ module Bson = let fromBson (value : BsonValue) = PostId value.AsString let toBson (value : PostId) : BsonValue = PostId.toString value + module PostStatusMapping = + let fromBson (value : BsonValue) = PostStatus.parse value.AsString + let toBson (value : PostStatus) : BsonValue = PostStatus.toString value + module TagMapIdMapping = let fromBson (value : BsonValue) = TagMapId value.AsString let toBson (value : TagMapId) : BsonValue = TagMapId.toString value @@ -223,20 +235,23 @@ module Bson = /// Register all BSON mappings let registerAll () = let g = BsonMapper.Global - g.RegisterType (CategoryIdMapping.toBson, CategoryIdMapping.fromBson) - g.RegisterType (CommentIdMapping.toBson, CommentIdMapping.fromBson) - g.RegisterType (CustomFeedIdMapping.toBson, CustomFeedIdMapping.fromBson) - g.RegisterType (CustomFeedSourceMapping.toBson, CustomFeedSourceMapping.fromBson) - g.RegisterType (ExplicitRatingMapping.toBson, ExplicitRatingMapping.fromBson) - g.RegisterType (MarkupTextMapping.toBson, MarkupTextMapping.fromBson) - g.RegisterType (PermalinkMapping.toBson, PermalinkMapping.fromBson) - g.RegisterType (PageIdMapping.toBson, PageIdMapping.fromBson) - g.RegisterType (PostIdMapping.toBson, PostIdMapping.fromBson) - g.RegisterType (TagMapIdMapping.toBson, TagMapIdMapping.fromBson) - g.RegisterType (ThemeAssetIdMapping.toBson, ThemeAssetIdMapping.fromBson) - g.RegisterType (ThemeIdMapping.toBson, ThemeIdMapping.fromBson) - g.RegisterType (WebLogIdMapping.toBson, WebLogIdMapping.fromBson) - g.RegisterType (WebLogUserIdMapping.toBson, WebLogUserIdMapping.fromBson) + g.RegisterType (AuthorizationLevelMapping.toBson, AuthorizationLevelMapping.fromBson) + g.RegisterType (CategoryIdMapping.toBson, CategoryIdMapping.fromBson) + g.RegisterType (CommentIdMapping.toBson, CommentIdMapping.fromBson) + g.RegisterType (CommentStatusMapping.toBson, CommentStatusMapping.fromBson) + g.RegisterType (CustomFeedIdMapping.toBson, CustomFeedIdMapping.fromBson) + g.RegisterType (CustomFeedSourceMapping.toBson, CustomFeedSourceMapping.fromBson) + g.RegisterType (ExplicitRatingMapping.toBson, ExplicitRatingMapping.fromBson) + g.RegisterType (MarkupTextMapping.toBson, MarkupTextMapping.fromBson) + g.RegisterType (PermalinkMapping.toBson, PermalinkMapping.fromBson) + g.RegisterType (PageIdMapping.toBson, PageIdMapping.fromBson) + g.RegisterType (PostIdMapping.toBson, PostIdMapping.fromBson) + g.RegisterType (PostStatusMapping.toBson, PostStatusMapping.fromBson) + g.RegisterType (TagMapIdMapping.toBson, TagMapIdMapping.fromBson) + g.RegisterType (ThemeAssetIdMapping.toBson, ThemeAssetIdMapping.fromBson) + g.RegisterType (ThemeIdMapping.toBson, ThemeIdMapping.fromBson) + g.RegisterType (WebLogIdMapping.toBson, WebLogIdMapping.fromBson) + g.RegisterType (WebLogUserIdMapping.toBson, WebLogUserIdMapping.fromBson) g.RegisterType (OptionMapping.categoryIdToBson, OptionMapping.categoryIdFromBson) g.RegisterType (OptionMapping.commentIdToBson, OptionMapping.commentIdFromBson) diff --git a/src/MyWebLog.Data/LiteDbData.fs b/src/MyWebLog.Data/LiteDbData.fs index cd759de..9b647f5 100644 --- a/src/MyWebLog.Data/LiteDbData.fs +++ b/src/MyWebLog.Data/LiteDbData.fs @@ -459,8 +459,11 @@ type LiteDbData (db : LiteDatabase) = |> toList member _.deleteByTheme themeId = backgroundTask { - let _ = Collection.ThemeAsset.DeleteMany (fun ta -> - (ThemeAssetId.toString ta.id).StartsWith (ThemeId.toString themeId)) + (ThemeId.toString + >> sprintf "$.id LIKE '%s%%'" + >> BsonExpression.Create + >> Collection.ThemeAsset.DeleteMany) themeId + |> ignore do! checkpoint () } diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index 9150f98..6fa4464 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -53,6 +53,20 @@ 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 + | "Approved" -> Approved + | "Pending" -> Pending + | "Spam" -> Spam + | it -> invalidOp $"{it} is not a valid post status" + open Markdig open Markdown.ColorCode @@ -169,6 +183,13 @@ module PostStatus = /// Convert a post status to a string let toString = function Draft -> "Draft" | Published -> "Published" + + /// Parse a string into a post status + let parse value = + match value with + | "Draft" -> Draft + | "Published" -> Published + | it -> invalidOp $"{it} is not a valid post status" /// An identifier for a post @@ -319,6 +340,7 @@ module CustomFeed = /// Really Simple Syndication (RSS) options for this web log +[] type RssOptions = { /// Whether the site feed of posts is enabled feedEnabled : bool @@ -429,6 +451,19 @@ type AuthorizationLevel = /// The user is a known user of a web log | User +/// Functions to support authorization levels +module AuthorizationLevel = + + /// Convert an authorization level to a string + let toString = function Administrator -> "Administrator" | User -> "User" + + /// Parse a string into an authorization level + let parse value = + match value with + | "Administrator" -> Administrator + | "User" -> User + | it -> invalidOp $"{it} is not a valid authorization level" + /// An identifier for a web log user type WebLogUserId = WebLogUserId of string diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index c65b787..530597d 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -214,6 +214,7 @@ module Backup = let plural count ifOne ifMany = if count = 1 then ifOne else ifMany + printfn "" printfn $"""{msg.Replace ("{{NAME}}", webLog.name)}""" printfn $""" - The theme "{archive.theme.name}" with {assetCount} asset{plural assetCount "" "s"}""" printfn $""" - {userCount} user{plural userCount "" "s"}""" @@ -225,14 +226,26 @@ module Backup = /// Create a backup archive let private createBackup webLog (fileName : string) prettyOutput (data : IData) = task { // Create the data structure - let themeId = ThemeId webLog.themePath - let! theme = data.Theme.findById themeId - let! assets = data.ThemeAsset.findByThemeWithData themeId - let! users = data.WebLogUser.findByWebLog webLog.id + let themeId = ThemeId webLog.themePath + + printfn "- Exporting theme..." + let! theme = data.Theme.findById themeId + let! assets = data.ThemeAsset.findByThemeWithData themeId + + printfn "- Exporting users..." + let! users = data.WebLogUser.findByWebLog webLog.id + + printfn "- Exporting categories and tag mappings..." let! categories = data.Category.findByWebLog webLog.id let! tagMaps = data.TagMap.findByWebLog webLog.id - let! pages = data.Page.findFullByWebLog webLog.id - let! posts = data.Post.findFullByWebLog webLog.id + + printfn "- Exporting pages..." + let! pages = data.Page.findFullByWebLog webLog.id + + printfn "- Exporting posts..." + let! posts = data.Post.findFullByWebLog webLog.id + + printfn "- Writing archive..." let archive = { webLog = webLog users = users @@ -301,19 +314,32 @@ module Backup = } // Restore web log data - do! data.WebLog.add restore.webLog + + printfn "" + printfn "- Restoring web log..." + do! data.WebLog.add restore.webLog + + printfn "- Restoring users..." do! data.WebLogUser.restore restore.users - do! data.TagMap.restore restore.tagMappings - do! data.Category.restore restore.categories - do! data.Page.restore restore.pages - do! data.Post.restore restore.posts + + printfn "- Restoring categories and tag mappings..." + do! data.TagMap.restore restore.tagMappings + do! data.Category.restore restore.categories + + printfn "- Restoring pages..." + do! data.Page.restore restore.pages + + printfn "- Restoring posts..." + do! data.Post.restore restore.posts + // TODO: comments not yet implemented // Restore theme and assets (one at a time, as assets can be large) + printfn "- Importing theme..." do! data.Theme.save restore.theme let! _ = restore.assets |> List.map (EncodedAsset.fromAsset >> data.ThemeAsset.save) |> Task.WhenAll - displayStats "Restored for {{NAME}}" restore.webLog restore + displayStats "Restored for {{NAME}}:" restore.webLog restore } /// Decide whether to restore a backup diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 050ad23..0013704 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -41,7 +41,7 @@ module DataImplementation = let get (sp : IServiceProvider) : IData option = let config = sp.GetRequiredService () let isNotNull it = (isNull >> not) it - if isNotNull (config.GetSection "RethinkDB") then + if isNotNull (config.GetSection "RethinkDB").Value then Json.all () |> Seq.iter Converter.Serializer.Converters.Add let rethinkCfg = DataConfig.FromConfiguration (config.GetSection "RethinkDB") let conn = rethinkCfg.CreateConnectionAsync () |> Async.AwaitTask |> Async.RunSynchronously @@ -118,10 +118,11 @@ let rec main args = let app = builder.Build () match args |> Array.tryHead with - | Some it when it = "init" -> Maintenance.createWebLog args app.Services - | Some it when it = "import-links" -> Maintenance.importLinks args app.Services - | Some it when it = "load-theme" -> Maintenance.loadTheme args app.Services - | Some it when it = "backup" -> Maintenance.Backup.generateBackup args app.Services + | Some it when it = "init" -> Maintenance.createWebLog args app.Services + | Some it when it = "import-links" -> Maintenance.importLinks args app.Services + | Some it when it = "load-theme" -> Maintenance.loadTheme args app.Services + | Some it when it = "backup" -> Maintenance.Backup.generateBackup args app.Services + | Some it when it = "restore" -> Maintenance.Backup.restoreFromBackup args app.Services | _ -> let _ = app.UseForwardedHeaders () let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))