diff --git a/src/MyWebLog.Data/Interfaces.fs b/src/MyWebLog.Data/Interfaces.fs index 01f5511..549e699 100644 --- a/src/MyWebLog.Data/Interfaces.fs +++ b/src/MyWebLog.Data/Interfaces.fs @@ -29,6 +29,9 @@ type ICategoryData = /// Find all categories for the given web log abstract member findByWebLog : WebLogId -> Task + /// Restore categories from a backup + abstract member restore : Category list -> Task + /// Update a category (slug, name, description, and parent ID) abstract member update : Category -> Task @@ -72,6 +75,9 @@ type IPageData = /// Find a page of pages (displayed in admin section) (excluding revisions and prior permalinks) abstract member findPageOfPages : WebLogId -> pageNbr : int -> Task + /// Restore pages from a backup + abstract member restore : Page list -> Task + /// Update a page abstract member update : Page -> Task @@ -120,6 +126,9 @@ type IPostData = /// Find the next older and newer post for the given published date/time (excluding revisions and prior permalinks) abstract member findSurroundingPosts : WebLogId -> publishedOn : DateTime -> Task + /// Restore posts from a backup + abstract member restore : Post list -> Task + /// Update a post abstract member update : Post -> Task @@ -145,6 +154,9 @@ type ITagMapData = /// Find tag mappings for the given tags abstract member findMappingForTags : tags : string list -> WebLogId -> Task + /// Restore tag mappings from a backup + abstract member restore : TagMap list -> Task + /// Save a tag mapping (insert or update) abstract member save : TagMap -> Task @@ -196,6 +208,9 @@ type IWebLogData = /// Retrieve all web logs abstract member all : unit -> Task + /// Delete a web log, including categories, tag mappings, posts/comments, and pages + abstract member delete : WebLogId -> Task + /// Find a web log by its host (URL base) abstract member findByHost : string -> Task @@ -227,6 +242,9 @@ type IWebLogUserData = /// Get a user ID -> name dictionary for the given user IDs abstract member findNames : WebLogId -> WebLogUserId list -> Task + /// Restore users from a backup + abstract member restore : WebLogUser list -> Task + /// Update a web log user abstract member update : WebLogUser -> Task diff --git a/src/MyWebLog.Data/LiteDbData.fs b/src/MyWebLog.Data/LiteDbData.fs index a4e83e0..cd759de 100644 --- a/src/MyWebLog.Data/LiteDbData.fs +++ b/src/MyWebLog.Data/LiteDbData.fs @@ -175,6 +175,11 @@ type LiteDbData (db : LiteDatabase) = | None -> return false } + member _.restore cats = backgroundTask { + let _ = Collection.Category.InsertBulk cats + do! checkpoint () + } + member _.update cat = backgroundTask { let _ = Collection.Category.Update cat do! checkpoint () @@ -253,13 +258,16 @@ type LiteDbData (db : LiteDatabase) = |> Seq.sortBy pageSort |> toPagedList pageNbr 25 - /// Update a page + member _.restore pages = backgroundTask { + let _ = Collection.Page.InsertBulk pages + do! checkpoint () + } + member _.update page = backgroundTask { let _ = Collection.Page.Update page do! checkpoint () } - /// Update prior permalinks for a page member this.updatePriorPermalinks pageId webLogId permalinks = backgroundTask { match! this.findFullById pageId webLogId with | Some page -> @@ -355,6 +363,11 @@ type LiteDbData (db : LiteDatabase) = return older, newer } + member _.restore posts = backgroundTask { + let _ = Collection.Post.InsertBulk posts + do! checkpoint () + } + member _.update post = backgroundTask { let _ = Collection.Post.Update post do! checkpoint () @@ -398,6 +411,11 @@ type LiteDbData (db : LiteDatabase) = Collection.TagMap.Find (fun tm -> tm.webLogId = webLogId && tags |> List.contains tm.tag) |> toList + member _.restore tagMaps = backgroundTask { + let _ = Collection.TagMap.InsertBulk tagMaps + do! checkpoint () + } + member _.save tagMap = backgroundTask { let _ = Collection.TagMap.Upsert tagMap do! checkpoint () @@ -479,6 +497,18 @@ type LiteDbData (db : LiteDatabase) = Collection.WebLog.FindAll () |> toList + member _.delete webLogId = backgroundTask { + let forWebLog = BsonExpression.Create $"$.webLogId = '{WebLogId.toString webLogId}'" + let _ = Collection.Comment.DeleteMany forWebLog + let _ = Collection.Post.DeleteMany forWebLog + let _ = Collection.Page.DeleteMany forWebLog + let _ = Collection.Category.DeleteMany forWebLog + let _ = Collection.TagMap.DeleteMany forWebLog + let _ = Collection.WebLogUser.DeleteMany forWebLog + let _ = Collection.WebLog.Delete (WebLogIdMapping.toBson webLogId) + do! checkpoint () + } + member _.findByHost url = Collection.WebLog.Find (fun wl -> wl.urlBase = url) |> tryFirst @@ -524,6 +554,11 @@ type LiteDbData (db : LiteDatabase) = |> Seq.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u }) |> toList + member _.restore users = backgroundTask { + let _ = Collection.WebLogUser.InsertBulk users + do! checkpoint () + } + member _.update user = backgroundTask { let _ = Collection.WebLogUser.Update user do! checkpoint () diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index d9579ee..47a2a2e 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -10,13 +10,13 @@ - + - - + + diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index b96cde4..824f447 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -41,6 +41,9 @@ module private RethinkHelpers = /// A list of all tables let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; WebLog; WebLogUser ] + + /// A list of all tables with a webLogId field + let allForWebLog = [ Comment; Post; Category; TagMap; Page; WebLogUser ] /// Shorthand for the ReQL starting point @@ -135,6 +138,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger return false } + member _.restore cats = backgroundTask { + for batch in cats |> List.chunkBySize restoreBatchSize do + do! rethink { + withTable Table.Category + insert batch + write; withRetryOnce; ignoreResult conn + } + } + member _.update cat = rethink { withTable Table.Category get cat.id @@ -337,10 +352,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun it -> it.webLogId) <| conn - member _.findFullByWebLog webLogId = rethink { + member _.findFullByWebLog webLogId = rethink { withTable Table.Page getAll [ webLogId ] (nameof webLogId) - result; withRetryDefault conn + resultCursor; withRetryCursorDefault; toList conn } member _.findListed webLogId = rethink { @@ -362,7 +377,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger List.chunkBySize restoreBatchSize do + do! rethink { + withTable Table.Page + insert batch + write; withRetryOnce; ignoreResult conn + } + } + member _.update page = rethink { withTable Table.Page get page.id @@ -380,7 +403,6 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger @@ -455,10 +477,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger Option.map (fun post -> post.permalink) } - member _.findFullByWebLog webLogId = rethink { + member _.findFullByWebLog webLogId = rethink { withTable Table.Post getAll [ webLogId ] (nameof webLogId) - result; withRetryDefault conn + resultCursor; withRetryCursorDefault; toList conn } member _.findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink { @@ -533,6 +555,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger List.chunkBySize restoreBatchSize do + do! rethink { + withTable Table.Post + insert batch + write; withRetryOnce; ignoreResult conn + } + } + member _.update post = rethink { withTable Table.Post get post.id @@ -605,6 +636,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger List.chunkBySize restoreBatchSize do + do! rethink { + withTable Table.TagMap + insert batch + write; withRetryOnce; ignoreResult conn + } + } + member _.save tagMap = rethink { withTable Table.TagMap get tagMap.id @@ -674,10 +714,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + member _.findByThemeWithData themeId = rethink { withTable Table.ThemeAsset filter (matchAssetByThemeId themeId) - result; withRetryDefault conn + resultCursor; withRetryCursorDefault; toList conn } member _.save asset = rethink { @@ -702,6 +742,22 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.WebLog @@ -784,6 +840,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger List.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u }) } + member _.restore users = backgroundTask { + for batch in users |> List.chunkBySize restoreBatchSize do + do! rethink { + withTable Table.WebLogUser + insert batch + write; withRetryOnce; ignoreResult conn + } + } + member _.update user = rethink { withTable Table.WebLogUser get user.id diff --git a/src/MyWebLog.Domain/MyWebLog.Domain.fsproj b/src/MyWebLog.Domain/MyWebLog.Domain.fsproj index a3c3e9b..da6624e 100644 --- a/src/MyWebLog.Domain/MyWebLog.Domain.fsproj +++ b/src/MyWebLog.Domain/MyWebLog.Domain.fsproj @@ -13,7 +13,7 @@ - + diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 4507cca..c65b787 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -135,6 +135,7 @@ let loadTheme (args : string[]) (sp : IServiceProvider) = task { /// Back up a web log's data module Backup = + open System.Threading.Tasks open MyWebLog.Converters open Newtonsoft.Json @@ -192,16 +193,37 @@ module Backup = posts : Post list } - // TODO: finish implementation; paused for LiteDB data capability development, will work with both - /// Create a JSON serializer (uses RethinkDB data implementation's JSON converters) - let private getSerializer () = + let private getSerializer prettyOutput = let serializer = JsonSerializer.CreateDefault () Json.all () |> Seq.iter serializer.Converters.Add + if prettyOutput then serializer.Formatting <- Formatting.Indented serializer + /// Display statistics for a backup archive + let private displayStats (msg : string) (webLog : WebLog) archive = + + let userCount = List.length archive.users + let assetCount = List.length archive.assets + let categoryCount = List.length archive.categories + let tagMapCount = List.length archive.tagMappings + let pageCount = List.length archive.pages + let postCount = List.length archive.posts + + // Create a pluralized output based on the count + let plural count ifOne ifMany = + if count = 1 then ifOne else ifMany + + printfn $"""{msg.Replace ("{{NAME}}", webLog.name)}""" + printfn $""" - The theme "{archive.theme.name}" with {assetCount} asset{plural assetCount "" "s"}""" + printfn $""" - {userCount} user{plural userCount "" "s"}""" + printfn $""" - {categoryCount} categor{plural categoryCount "y" "ies"}""" + printfn $""" - {tagMapCount} tag mapping{plural tagMapCount "" "s"}""" + printfn $""" - {pageCount} page{plural pageCount "" "s"}""" + printfn $""" - {postCount} post{plural postCount "" "s"}""" + /// Create a backup archive - let createBackup webLog (fileName : string) (data : IData) = task { + 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 @@ -211,7 +233,7 @@ module Backup = let! tagMaps = data.TagMap.findByWebLog webLog.id let! pages = data.Page.findFullByWebLog webLog.id let! posts = data.Post.findFullByWebLog webLog.id - let archive = { + let archive = { webLog = webLog users = users theme = Option.get theme @@ -224,31 +246,124 @@ module Backup = // Write the structure to the backup file if File.Exists fileName then File.Delete fileName - let serializer = getSerializer () + let serializer = getSerializer prettyOutput use writer = new StreamWriter (fileName) serializer.Serialize (writer, archive) writer.Close () - printfn "Backup Stats:" - printfn $" - Users: {archive.users |> List.length}" - printfn $" - Categories: {archive.categories |> List.length}" - printfn $" - Tag Maps: {archive.tagMappings |> List.length}" - printfn $" - Pages: {archive.pages |> List.length}" - printfn $" - Posts: {archive.posts |> List.length}" - printfn "" + displayStats "{{NAME}} backup contains:" webLog archive } + let private doRestore archive newUrlBase (data : IData) = task { + let! restore = task { + match! data.WebLog.findById archive.webLog.id with + | Some webLog when defaultArg newUrlBase webLog.urlBase = webLog.urlBase -> + do! data.WebLog.delete webLog.id + return archive + | Some _ -> + // Err'body gets new IDs... + let newWebLogId = WebLogId.create () + 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 + let newUserIds = archive.users |> List.map (fun user -> user.id, WebLogUserId.create ()) |> dict + return + { archive with + webLog = { archive.webLog with id = newWebLogId; urlBase = Option.get newUrlBase } + users = archive.users + |> List.map (fun u -> { u with id = newUserIds[u.id]; webLogId = newWebLogId }) + categories = archive.categories + |> List.map (fun c -> { c with id = newCatIds[c.id]; webLogId = newWebLogId }) + tagMappings = archive.tagMappings + |> List.map (fun tm -> { tm with id = newMapIds[tm.id]; webLogId = newWebLogId }) + pages = archive.pages + |> List.map (fun page -> + { page with + id = newPageIds[page.id] + webLogId = newWebLogId + authorId = newUserIds[page.authorId] + }) + posts = archive.posts + |> List.map (fun post -> + { post with + id = newPostIds[post.id] + webLogId = newWebLogId + authorId = newUserIds[post.authorId] + categoryIds = post.categoryIds |> List.map (fun c -> newCatIds[c]) + }) + } + | None -> + return + { archive with + webLog = { archive.webLog with urlBase = defaultArg newUrlBase archive.webLog.urlBase } + } + } + + // Restore web log data + do! data.WebLog.add restore.webLog + 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 + // TODO: comments not yet implemented + + // Restore theme and assets (one at a time, as assets can be large) + 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 + } + + /// Decide whether to restore a backup + let private restoreBackup (fileName : string) newUrlBase promptForOverwrite data = task { + + let serializer = getSerializer false + use stream = new FileStream (fileName, FileMode.Open) + use reader = new StreamReader (stream) + use jsonReader = new JsonTextReader (reader) + let archive = serializer.Deserialize jsonReader + + let mutable doOverwrite = not promptForOverwrite + if promptForOverwrite then + printfn "** WARNING: Restoring a web log will delete existing data for that web log" + printfn " (unless restoring to a different URL base), and will overwrite the" + printfn " theme in either case." + printfn "" + printf "Continue? [Y/n] " + doOverwrite <- not ((Console.ReadKey ()).Key = ConsoleKey.N) + + if doOverwrite then + do! doRestore archive newUrlBase data + else + printfn $"{archive.webLog.name} backup restoration canceled" + } + /// Generate a backup archive let generateBackup (args : string[]) (sp : IServiceProvider) = task { - if args.Length = 3 then + if args.Length = 3 || args.Length = 4 then let data = sp.GetRequiredService () match! data.WebLog.findByHost args[1] with | Some webLog -> - let fileName = if args[2].EndsWith ".json" then args[2] else $"{args[1]}.json" - do! createBackup webLog fileName data - printfn $"Backup created for {args[1]}" + let fileName = if args[2].EndsWith ".json" then args[2] else $"{args[2]}.json" + let prettyOutput = args.Length = 4 && args[3] = "pretty" + do! createBackup webLog fileName prettyOutput data | None -> printfn $"Error: no web log found for {args[1]}" else - printfn "Usage: MyWebLog backup [url-base] [backup-file-name]" + printfn """Usage: MyWebLog backup [url-base] [backup-file-name] [*"pretty"]""" + printfn """ * optional - default is non-pretty JSON output""" + } + + /// Restore a backup archive + let restoreFromBackup (args : string[]) (sp : IServiceProvider) = task { + if args.Length = 2 || args.Length = 3 then + let data = sp.GetRequiredService () + let newUrlBase = if args.Length = 3 then Some args[2] else None + do! restoreBackup args[1] newUrlBase (args[0] <> "do-restore") data + else + printfn "Usage: MyWebLog restore [backup-file-name] [*url-base]" + printfn " * optional - will restore to original URL base if omitted" + printfn " (use do-restore to skip confirmation prompt)" } \ No newline at end of file diff --git a/src/MyWebLog/MyWebLog.fsproj b/src/MyWebLog/MyWebLog.fsproj index 4012791..cfb5be8 100644 --- a/src/MyWebLog/MyWebLog.fsproj +++ b/src/MyWebLog/MyWebLog.fsproj @@ -27,7 +27,7 @@ - +