diff --git a/src/MyWebLog.Data/Interfaces.fs b/src/MyWebLog.Data/Interfaces.fs index 747e1dc..01f5511 100644 --- a/src/MyWebLog.Data/Interfaces.fs +++ b/src/MyWebLog.Data/Interfaces.fs @@ -26,6 +26,9 @@ type ICategoryData = /// Find a category by its ID abstract member findById : CategoryId -> WebLogId -> Task + /// Find all categories for the given web log + abstract member findByWebLog : WebLogId -> Task + /// Update a category (slug, name, description, and parent ID) abstract member update : Category -> Task @@ -60,6 +63,9 @@ type IPageData = /// Find a page by its ID (including revisions and prior permalinks) abstract member findFullById : PageId -> WebLogId -> Task + /// Find all pages for the given web log (including revisions and prior permalinks) + abstract member findFullByWebLog : WebLogId -> Task + /// Find pages marked as "show in page list" for the given web log (excluding text, revisions, and prior permalinks) abstract member findListed : WebLogId -> Task @@ -94,6 +100,9 @@ type IPostData = /// Find a post by its ID (including revisions and prior permalinks) abstract member findFullById : PostId -> WebLogId -> Task + /// Find all posts for the given web log (including revisions and prior permalinks) + abstract member findFullByWebLog : WebLogId -> Task + /// 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 @@ -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 - /// Delete a tag mapping abstract member delete : TagMapId -> WebLogId -> Task @@ -133,6 +139,9 @@ type ITagMapData = /// Find a tag mapping by its URL value abstract member findByUrlValue : string -> WebLogId -> Task + /// Retrieve all tag mappings for the given web log + abstract member findByWebLog : WebLogId -> Task + /// Find tag mappings for the given tags abstract member findMappingForTags : tags : string list -> WebLogId -> Task @@ -171,6 +180,9 @@ type IThemeAssetData = /// Find all assets for the given theme (excludes data) abstract member findByTheme : ThemeId -> Task + /// Find all assets for the given theme (includes data) + abstract member findByThemeWithData : ThemeId -> Task + /// Save a theme asset (insert or update) abstract member save : ThemeAsset -> Task @@ -209,6 +221,9 @@ type IWebLogUserData = /// Find a web log user by their ID abstract member findById : WebLogUserId -> WebLogId -> Task + /// Find all web log users for the given web log + abstract member findByWebLog : WebLogId -> Task + /// Get a user ID -> name dictionary for the given user IDs abstract member findNames : WebLogId -> WebLogUserId list -> Task diff --git a/src/MyWebLog.Data/LiteDbData.fs b/src/MyWebLog.Data/LiteDbData.fs index 3b65e65..a4e83e0 100644 --- a/src/MyWebLog.Data/LiteDbData.fs +++ b/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 }) diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index 1877c24..b96cde4 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -213,6 +213,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun c -> c.webLogId) <| conn + member _.findByWebLog webLogId = rethink { + 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 0UL } - member _.findFullById pageId webLogId = - rethink { - withTable Table.Page - get pageId - resultOption; withRetryOptionDefault - } - |> verifyWebLog webLogId (fun it -> it.webLogId) <| conn - member _.findById pageId webLogId = rethink { withTable Table.Page @@ -331,6 +329,20 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger Option.map (fun pg -> pg.permalink) } + member _.findFullById pageId webLogId = + rethink { + withTable Table.Page + get pageId + resultOption; withRetryOptionDefault + } + |> verifyWebLog webLogId (fun it -> it.webLogId) <| conn + + member _.findFullByWebLog webLogId = rethink { + withTable Table.Page + getAll [ webLogId ] (nameof webLogId) + result; withRetryDefault conn + } + member _.findListed webLogId = rethink { withTable Table.Page getAll [ webLogId ] (nameof webLogId) @@ -442,7 +454,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger tryFirst) conn return result |> Option.map (fun post -> post.permalink) } - + + member _.findFullByWebLog webLogId = rethink { + withTable Table.Post + getAll [ webLogId ] (nameof webLogId) + result; withRetryDefault conn + } + member _.findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink { withTable Table.Post getAll (objList categoryIds) "categoryIds" @@ -546,13 +564,6 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { - 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 { withTable Table.TagMap @@ -581,6 +592,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger tryFirst <| conn + member _.findByWebLog webLogId = rethink { + 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 { 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 { + 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 verifyWebLog webLogId (fun u -> u.webLogId) <| conn + member _.findByWebLog webLogId = rethink { + withTable Table.WebLogUser + getAll [ webLogId ] (nameof webLogId) + result; withRetryDefault conn + } + member _.findNames webLogId userIds = backgroundTask { let! users = rethink { withTable Table.WebLogUser diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index 2e7ba7c..502030c 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/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 diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 440cba7..4507cca 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/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 () + 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]" + } \ No newline at end of file diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 7e039ee..050ad23 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -62,7 +62,7 @@ open Microsoft.AspNetCore.HttpOverrides open RethinkDB.DistributedCache [] -let main args = +let rec main args = let builder = WebApplication.CreateBuilder(args) let _ = builder.Services.Configure(fun (opts : ForwardedHeadersOptions) -> @@ -118,9 +118,10 @@ let 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 = "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))