WIP on backups

src/MyWebLog.Data/Interfaces.fs

@@ -26,6 +26,9 @@ type ICategoryData =
     /// Find a category by its ID
     abstract member findById : CategoryId -> WebLogId -> Task<Category option>
     
+    /// Find all categories for the given web log
+    abstract member findByWebLog : WebLogId -> Task<Category list>
+    
     /// Update a category (slug, name, description, and parent ID)
     abstract member update : Category -> Task<unit>
 
@@ -60,6 +63,9 @@ type IPageData =
     /// Find a page by its ID (including revisions and prior permalinks)
     abstract member findFullById : PageId -> WebLogId -> Task<Page option>
     
+    /// Find all pages for the given web log (including revisions and prior permalinks)
+    abstract member findFullByWebLog : WebLogId -> Task<Page list>
+    
     /// Find pages marked as "show in page list" for the given web log (excluding text, revisions, and prior permalinks)
     abstract member findListed : WebLogId -> Task<Page list>
     
@@ -94,6 +100,9 @@ type IPostData =
     /// Find a post by its ID (including revisions and prior permalinks)
     abstract member findFullById : PostId -> WebLogId -> Task<Post option>
     
+    /// Find all posts for the given web log (including revisions and prior permalinks)
+    abstract member findFullByWebLog : WebLogId -> Task<Post list>
+    
     /// Find posts to be displayed on a category list page (excluding revisions and prior permalinks)
     abstract member findPageOfCategorizedPosts :
         WebLogId -> CategoryId list -> pageNbr : int -> postsPerPage : int -> Task<Post list>
@@ -121,9 +130,6 @@ type IPostData =
 /// Functions to manipulate tag mappings
 type ITagMapData =
     
-    /// Retrieve all tag mappings for the given web log
-    abstract member all : WebLogId -> Task<TagMap list>
-    
     /// Delete a tag mapping
     abstract member delete : TagMapId -> WebLogId -> Task<bool>
     
@@ -133,6 +139,9 @@ type ITagMapData =
     /// Find a tag mapping by its URL value
     abstract member findByUrlValue : string -> WebLogId -> Task<TagMap option>
     
+    /// Retrieve all tag mappings for the given web log
+    abstract member findByWebLog : WebLogId -> Task<TagMap list>
+    
     /// Find tag mappings for the given tags
     abstract member findMappingForTags : tags : string list -> WebLogId -> Task<TagMap list>
     
@@ -171,6 +180,9 @@ type IThemeAssetData =
     /// Find all assets for the given theme (excludes data)
     abstract member findByTheme : ThemeId -> Task<ThemeAsset list>
     
+    /// Find all assets for the given theme (includes data)
+    abstract member findByThemeWithData : ThemeId -> Task<ThemeAsset list>
+    
     /// Save a theme asset (insert or update)
     abstract member save : ThemeAsset -> Task<unit>
 
@@ -209,6 +221,9 @@ type IWebLogUserData =
     /// Find a web log user by their ID
     abstract member findById : WebLogUserId -> WebLogId -> Task<WebLogUser option>
     
+    /// Find all web log users for the given web log
+    abstract member findByWebLog : WebLogId -> Task<WebLogUser list>
+    
     /// Get a user ID -> name dictionary for the given user IDs
     abstract member findNames : WebLogId -> WebLogUserId list -> Task<MetaItem list>
     

src/MyWebLog.Data/LiteDbData.fs

@@ -3,7 +3,6 @@ namespace MyWebLog.Data
 open LiteDB
 open MyWebLog
 open System.Threading.Tasks
-open MyWebLog.Converters
 open MyWebLog.Data
 
 /// Functions to assist with retrieving data
@@ -156,6 +155,10 @@ type LiteDbData (db : LiteDatabase) =
                     Collection.Category.FindById (CategoryIdMapping.toBson catId)
                     |> verifyWebLog webLogId (fun c -> c.webLogId)
                 
+                member _.findByWebLog webLogId =
+                    Collection.Category.Find (fun c -> c.webLogId = webLogId)
+                    |> toList
+                
                 member this.delete catId webLogId = backgroundTask {
                     match! this.findById catId webLogId with
                     | Some _ ->
@@ -234,6 +237,10 @@ type LiteDbData (db : LiteDatabase) =
                     return result |> Option.map (fun pg -> pg.permalink)
                 }
                 
+                member _.findFullByWebLog webLogId =
+                    Collection.Page.Find (fun p -> p.webLogId = webLogId)
+                    |> toList
+                
                 member _.findListed webLogId =
                     Collection.Page.Find (fun p -> p.webLogId = webLogId && p.showInPageList)
                     |> Seq.map pageWithoutText
@@ -300,6 +307,10 @@ type LiteDbData (db : LiteDatabase) =
                     return result |> Option.map (fun post -> post.permalink)
                 }
 
+                member _.findFullByWebLog webLogId =
+                    Collection.Post.Find (fun p -> p.webLogId = webLogId)
+                    |> toList
+
                 member _.findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
                     Collection.Post.Find (fun p ->
                         p.webLogId = webLogId
@@ -361,11 +372,6 @@ type LiteDbData (db : LiteDatabase) =
         member _.TagMap = {
             new ITagMapData with
                 
-                member _.all webLogId =
-                    Collection.TagMap.Find (fun tm -> tm.webLogId = webLogId)
-                    |> Seq.sortBy (fun tm -> tm.tag)
-                    |> toList
-                
                 member _.findById tagMapId webLogId =
                     Collection.TagMap.FindById (TagMapIdMapping.toBson tagMapId)
                     |> verifyWebLog webLogId (fun tm -> tm.webLogId)
@@ -383,6 +389,11 @@ type LiteDbData (db : LiteDatabase) =
                     Collection.TagMap.Find (fun tm -> tm.webLogId = webLogId && tm.urlValue = urlValue)
                     |> tryFirst
                 
+                member _.findByWebLog webLogId =
+                    Collection.TagMap.Find (fun tm -> tm.webLogId = webLogId)
+                    |> Seq.sortBy (fun tm -> tm.tag)
+                    |> toList
+                
                 member _.findMappingForTags tags webLogId =
                     Collection.TagMap.Find (fun tm -> tm.webLogId = webLogId && tags |> List.contains tm.tag)
                     |> toList
@@ -445,6 +456,11 @@ type LiteDbData (db : LiteDatabase) =
                     |> Seq.map (fun ta -> { ta with data = [||] })
                     |> toList
                 
+                member _.findByThemeWithData themeId =
+                    Collection.ThemeAsset.Find (fun ta ->
+                        (ThemeAssetId.toString ta.id).StartsWith (ThemeId.toString themeId))
+                    |> toList
+                
                 member _.save asset = backgroundTask {
                     let _ = Collection.ThemeAsset.Upsert asset
                     do! checkpoint ()
@@ -499,6 +515,10 @@ type LiteDbData (db : LiteDatabase) =
                     Collection.WebLogUser.FindById (WebLogUserIdMapping.toBson userId)
                     |> verifyWebLog webLogId (fun u -> u.webLogId)
                 
+                member _.findByWebLog webLogId =
+                    Collection.WebLogUser.Find (fun wlu -> wlu.webLogId = webLogId)
+                    |> toList
+                
                 member _.findNames webLogId userIds =
                     Collection.WebLogUser.Find (fun wlu -> userIds |> List.contains wlu.id)
                     |> Seq.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u })

src/MyWebLog.Data/RethinkDbData.fs

@@ -213,6 +213,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     }
                     |> verifyWebLog webLogId (fun c -> c.webLogId) <| conn
                 
+                member _.findByWebLog webLogId = rethink<Category list> {
+                    withTable Table.Category
+                    getAll [ webLogId ] (nameof webLogId)
+                    result; withRetryDefault conn
+                }
+                
                 member this.delete catId webLogId = backgroundTask {
                     match! this.findById catId webLogId with
                     | Some _ ->
@@ -290,14 +296,6 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     return result.Deleted > 0UL
                 }
                 
-                member _.findFullById pageId webLogId =
-                    rethink<Page> {
-                        withTable Table.Page
-                        get pageId
-                        resultOption; withRetryOptionDefault
-                    }
-                    |> verifyWebLog webLogId (fun it -> it.webLogId) <| conn
-
                 member _.findById pageId webLogId =
                     rethink<Page> {
                         withTable Table.Page
@@ -331,6 +329,20 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     return result |> Option.map (fun pg -> pg.permalink)
                 }
                 
+                member _.findFullById pageId webLogId =
+                    rethink<Page> {
+                        withTable Table.Page
+                        get pageId
+                        resultOption; withRetryOptionDefault
+                    }
+                    |> verifyWebLog webLogId (fun it -> it.webLogId) <| conn
+                
+                member _.findFullByWebLog webLogId = rethink<Page list> {
+                    withTable Table.Page
+                    getAll [ webLogId ] (nameof webLogId)
+                    result; withRetryDefault conn
+                }
+                
                 member _.findListed webLogId = rethink<Page list> {
                     withTable Table.Page
                     getAll [ webLogId ] (nameof webLogId)
@@ -443,6 +455,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     return result |> Option.map (fun post -> post.permalink)
                 }
                 
+                member _.findFullByWebLog webLogId = rethink<Post list> {
+                    withTable Table.Post
+                    getAll [ webLogId ] (nameof webLogId)
+                    result; withRetryDefault conn
+                }
+                
                 member _.findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink<Post list> {
                     withTable Table.Post
                     getAll (objList categoryIds) "categoryIds"
@@ -546,13 +564,6 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
         member _.TagMap = {
             new ITagMapData with
                 
-                member _.all webLogId = rethink<TagMap list> {
-                    withTable Table.TagMap
-                    between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) [ Index "webLogAndTag" ]
-                    orderBy "tag"
-                    result; withRetryDefault conn
-                }
-                
                 member _.delete tagMapId webLogId = backgroundTask {
                     let! result = rethink<Model.Result> {
                         withTable Table.TagMap
@@ -581,6 +592,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     }
                     |> tryFirst <| conn
                 
+                member _.findByWebLog webLogId = rethink<TagMap list> {
+                    withTable Table.TagMap
+                    between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) [ Index "webLogAndTag" ]
+                    orderBy "tag"
+                    result; withRetryDefault conn
+                }
+                
                 member _.findMappingForTags tags webLogId = rethink<TagMap list> {
                     withTable Table.TagMap
                     getAll (tags |> List.map (fun tag -> r.Array (webLogId, tag) :> obj)) "webLogAndTag"
@@ -656,6 +674,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     result; withRetryDefault conn
                 }
                 
+                member _.findByThemeWithData themeId = rethink<ThemeAsset list> {
+                    withTable Table.ThemeAsset
+                    filter (matchAssetByThemeId themeId)
+                    result; withRetryDefault conn
+                }
+                
                 member _.save asset = rethink {
                     withTable Table.ThemeAsset
                     get asset.id
@@ -742,6 +766,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     }
                     |> verifyWebLog webLogId (fun u -> u.webLogId) <| conn
                 
+                member _.findByWebLog webLogId = rethink<WebLogUser list> {
+                    withTable Table.WebLogUser
+                    getAll [ webLogId ] (nameof webLogId)
+                    result; withRetryDefault conn
+                }
+                
                 member _.findNames webLogId userIds = backgroundTask {
                     let! users = rethink<WebLogUser list> {
                         withTable Table.WebLogUser

src/MyWebLog/Handlers/Admin.fs

@@ -264,7 +264,7 @@ open Microsoft.AspNetCore.Http
 
 /// Get the hash necessary to render the tag mapping list
 let private tagMappingHash (ctx : HttpContext) = task {
-    let! mappings = ctx.Data.TagMap.all ctx.WebLog.id
+    let! mappings = ctx.Data.TagMap.findByWebLog ctx.WebLog.id
     return Hash.FromAnonymousObject {|
         web_log     = ctx.WebLog
         csrf        = csrfToken ctx

src/MyWebLog/Maintenance.fs

@@ -135,6 +135,9 @@ let loadTheme (args : string[]) (sp : IServiceProvider) = task {
 /// Back up a web log's data
 module Backup =
     
+    open MyWebLog.Converters
+    open Newtonsoft.Json
+
     /// A theme asset, with the data base-64 encoded
     type EncodedAsset =
         {   /// The ID of the theme asset
@@ -154,6 +157,14 @@ module Backup =
               data      = Convert.ToBase64String asset.data
             }
     
+        /// Create a theme asset from an encoded theme asset
+        static member fromAsset (asset : EncodedAsset) : ThemeAsset =
+            { id        = asset.id
+              updatedOn = asset.updatedOn
+              data      = Convert.FromBase64String asset.data
+            }
+    
+        
     /// A unified archive for a web log
     type Archive =
         {   /// The web log to which this archive belongs
@@ -181,7 +192,63 @@ module Backup =
             posts : Post list
         }
     
-    let inline await f = (Async.AwaitTask >> Async.RunSynchronously) f
-    
     // 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 serializer = JsonSerializer.CreateDefault ()
+        Json.all () |> Seq.iter serializer.Converters.Add
+        serializer
+    
+    /// Create a backup archive
+    let createBackup webLog (fileName : string) (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! 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
+        let archive = {
+            webLog      = webLog
+            users       = users
+            theme       = Option.get theme
+            assets      = assets |> List.map EncodedAsset.fromAsset
+            categories  = categories
+            tagMappings = tagMaps
+            pages       = pages |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
+            posts       = posts |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
+        }
+        
+        // Write the structure to the backup file
+        if File.Exists fileName then File.Delete fileName
+        let serializer = getSerializer ()
+        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 ""
+    }
+    
+    /// Generate a backup archive
+    let generateBackup (args : string[]) (sp : IServiceProvider) = task {
+        if args.Length = 3 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"
+                do! createBackup webLog fileName data
+                printfn $"Backup created for {args[1]}"
+            | None -> printfn $"Error: no web log found for {args[1]}"
+        else
+            printfn "Usage: MyWebLog backup [url-base] [backup-file-name]"
+    }
+    

src/MyWebLog/Program.fs

@@ -62,7 +62,7 @@ open Microsoft.AspNetCore.HttpOverrides
 open RethinkDB.DistributedCache
 
 [<EntryPoint>]
-let main args =
+let rec main args =
 
     let builder = WebApplication.CreateBuilder(args)
     let _ = builder.Services.Configure<ForwardedHeadersOptions>(fun (opts : ForwardedHeadersOptions) ->
@@ -121,6 +121,7 @@ let main args =
     | 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
     | _ ->
         let _ = app.UseForwardedHeaders ()
         let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))