src/MyWebLog.Data/Interfaces.fs

@@ -29,6 +29,9 @@ type ICategoryData =
     /// Find all categories for the given web log
     abstract member findByWebLog : WebLogId -> Task<Category list>
     
+    /// Restore categories from a backup
+    abstract member restore : Category list -> Task<unit>
+    
     /// Update a category (slug, name, description, and parent ID)
     abstract member update : Category -> Task<unit>
 
@@ -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<Page list>
     
+    /// Restore pages from a backup
+    abstract member restore : Page list -> Task<unit>
+    
     /// Update a page
     abstract member update : Page -> Task<unit>
     
@@ -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<Post option * Post option>
     
+    /// Restore posts from a backup
+    abstract member restore : Post list -> Task<unit>
+    
     /// Update a post
     abstract member update : Post -> Task<unit>
     
@@ -145,6 +154,9 @@ type ITagMapData =
     /// Find tag mappings for the given tags
     abstract member findMappingForTags : tags : string list -> WebLogId -> Task<TagMap list>
     
+    /// Restore tag mappings from a backup
+    abstract member restore : TagMap list -> Task<unit>
+    
     /// Save a tag mapping (insert or update)
     abstract member save : TagMap -> Task<unit>
 
@@ -196,6 +208,9 @@ type IWebLogData =
     /// Retrieve all web logs
     abstract member all : unit -> Task<WebLog list>
     
+    /// Delete a web log, including categories, tag mappings, posts/comments, and pages
+    abstract member delete : WebLogId -> Task<unit>
+    
     /// Find a web log by its host (URL base)
     abstract member findByHost : string -> Task<WebLog option>
     
@@ -227,6 +242,9 @@ type IWebLogUserData =
     /// Get a user ID -> name dictionary for the given user IDs
     abstract member findNames : WebLogId -> WebLogUserId list -> Task<MetaItem list>
     
+    /// Restore users from a backup
+    abstract member restore : WebLogUser list -> Task<unit>
+    
     /// Update a web log user
     abstract member update : WebLogUser -> Task<unit>
 

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

src/MyWebLog.Data/MyWebLog.Data.fsproj

@@ -10,13 +10,13 @@
 	</ItemGroup>
 
 	<ItemGroup>
-		<PackageReference Include="LiteDB" Version="5.0.11" />
+		<PackageReference Include="LiteDB" Version="5.0.12" />
 		<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" />
 		<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
 		<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
 		<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
-		<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-03" />
+		<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-05" />
-		<PackageReference Update="FSharp.Core" Version="6.0.4" />
+		<PackageReference Update="FSharp.Core" Version="6.0.5" />
 	</ItemGroup>
 	
 	<ItemGroup>

src/MyWebLog.Data/RethinkDbData.fs

@@ -42,6 +42,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
     let r = RethinkDB.R
@@ -135,6 +138,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
             }
     }
     
+    /// The batch size for restoration methods
+    let restoreBatchSize = 100
+    
     /// The connection for this instance
     member _.Conn = conn
     
@@ -241,6 +247,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     | None -> 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<R
                     }
                     |> verifyWebLog webLogId (fun it -> it.webLogId) <| conn
                 
-                member _.findFullByWebLog webLogId = rethink<Page list> {
+                member _.findFullByWebLog webLogId = rethink<Page> {
                     withTable Table.Page
                     getAll [ webLogId ] (nameof webLogId)
-                    result; withRetryDefault conn
+                    resultCursor; withRetryCursorDefault; toList conn
                 }
                 
                 member _.findListed webLogId = rethink<Page list> {
@@ -362,7 +377,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     result; withRetryDefault conn
                 }
                 
-                /// Update a page
+                member _.restore pages = backgroundTask {
+                    for batch in pages |> 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<R
                     write; withRetryDefault; ignoreResult conn
                 }
                 
-                /// Update prior permalinks for a page
                 member this.updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
                     match! this.findById pageId webLogId with
                     | Some _ ->
@@ -455,10 +477,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     return result |> Option.map (fun post -> post.permalink)
                 }
                 
-                member _.findFullByWebLog webLogId = rethink<Post list> {
+                member _.findFullByWebLog webLogId = rethink<Post> {
                     withTable Table.Post
                     getAll [ webLogId ] (nameof webLogId)
-                    result; withRetryDefault conn
+                    resultCursor; withRetryCursorDefault; toList conn
                 }
                 
                 member _.findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink<Post list> {
@@ -533,6 +555,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     return older, newer
                 }
                 
+                member _.restore pages = backgroundTask {
+                    for batch in pages |> 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<R
                     result; withRetryDefault conn
                 }
                 
+                member _.restore tagMaps = backgroundTask {
+                    for batch in tagMaps |> 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<R
                     result; withRetryDefault conn
                 }
                 
-                member _.findByThemeWithData themeId = rethink<ThemeAsset list> {
+                member _.findByThemeWithData themeId = rethink<ThemeAsset> {
                     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<R
                     result; withRetryDefault conn
                 }
                 
+                member _.delete webLogId = backgroundTask {
+                    for table in Table.allForWebLog do
+                        do! rethink {
+                            withTable table
+                            getAll [ webLogId ] (nameof webLogId)
+                            delete
+                            write; withRetryOnce; ignoreResult conn
+                        }
+                    do! rethink {
+                        withTable Table.WebLog
+                        get webLogId
+                        delete
+                        write; withRetryOnce; ignoreResult conn
+                    }
+                }
+                
                 member _.findByHost url =
                     rethink<WebLog list> {
                         withTable Table.WebLog
@@ -784,6 +840,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                         |> 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

src/MyWebLog.Domain/MyWebLog.Domain.fsproj

@@ -13,7 +13,7 @@
 
   <ItemGroup>
     <PackageReference Include="Markdig" Version="0.30.2" />
-    <PackageReference Update="FSharp.Core" Version="6.0.4" />
+    <PackageReference Update="FSharp.Core" Version="6.0.5" />
     <PackageReference Include="Markdown.ColorCode" Version="1.0.1" />
   </ItemGroup>
 

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
@@ -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:"
+        displayStats "{{NAME}} backup contains:" webLog archive
-        printfn $" - Users: {archive.users |> List.length}"
+    }
-        printfn $" - Categories: {archive.categories |> List.length}"
+    
-        printfn $" - Tag Maps: {archive.tagMappings |> List.length}"
+    let private doRestore archive newUrlBase (data : IData) = task {
-        printfn $" - Pages: {archive.pages |> List.length}"
+        let! restore = task {
-        printfn $" - Posts: {archive.posts |> List.length}"
+            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<Archive> 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<IData> ()
             match! data.WebLog.findByHost args[1] with
             | Some webLog ->
-                let fileName = if args[2].EndsWith ".json" then args[2] else $"{args[1]}.json"
+                let fileName     = if args[2].EndsWith ".json" then args[2] else $"{args[2]}.json"
-                do! createBackup webLog fileName data
+                let prettyOutput = args.Length = 4 && args[3] = "pretty"
-                printfn $"Backup created for {args[1]}"
+                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<IData> ()
+            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)"
     }
     

src/MyWebLog/MyWebLog.fsproj

@@ -27,7 +27,7 @@
     <PackageReference Include="Giraffe.Htmx" Version="1.7.0" />
     <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.7.0" />
     <PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" />
-    <PackageReference Update="FSharp.Core" Version="6.0.4" />
+    <PackageReference Update="FSharp.Core" Version="6.0.5" />
     <PackageReference Include="System.ServiceModel.Syndication" Version="6.0.0" />
   </ItemGroup>