bit-badger/myWebLog
1
0
Fork 0
Code Issues 4 Pull Requests Packages Projects Releases 11 Activity

First cut of restoration logic

Browse Source
This commit is contained in:
Daniel J. Summers 2022-06-16 16:33:49 -04:00
parent 2cb2a7f453
commit 298417c6f0
7 changed files with 266 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/MyWebLog.Data/Interfaces.fs
View File

@ -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>

39
src/MyWebLog.Data/LiteDbData.fs
View File

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

6
src/MyWebLog.Data/MyWebLog.Data.fsproj
View File

@ -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 Update="FSharp.Core" Version="6.0.4" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-05" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup>
<ItemGroup>

81
src/MyWebLog.Data/RethinkDbData.fs
View File

@ -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<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

2
src/MyWebLog.Domain/MyWebLog.Domain.fsproj
View File

@ -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>

151
src/MyWebLog/Maintenance.fs
View File

@ -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<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"
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<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)"
}

2
src/MyWebLog/MyWebLog.fsproj
View File

@ -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>