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

WIP on backups

Browse Source
This commit is contained in:
Daniel J. Summers 2022-06-13 19:12:29 -04:00
parent 476a3acd73
commit 2cb2a7f453
6 changed files with 165 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

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

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

@ -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)
@ -442,7 +454,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|> tryFirst) conn
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

2
src/MyWebLog/Handlers/Admin.fs
View File

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

71
src/MyWebLog/Maintenance.fs
View File

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

9
src/MyWebLog/Program.fs
View File

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