V2 #1

Merged
danieljsummers merged 102 commits from v2 into main 2022-06-23 00:35:12 +00:00
5 changed files with 116 additions and 36 deletions
Showing only changes of commit c229aac68e - Show all commits

View File

@ -140,6 +140,10 @@ module Bson =
open LiteDB open LiteDB
module AuthorizationLevelMapping =
let fromBson (value : BsonValue) = AuthorizationLevel.parse value.AsString
let toBson (value : AuthorizationLevel) : BsonValue = AuthorizationLevel.toString value
module CategoryIdMapping = module CategoryIdMapping =
let fromBson (value : BsonValue) = CategoryId value.AsString let fromBson (value : BsonValue) = CategoryId value.AsString
let toBson (value : CategoryId) : BsonValue = CategoryId.toString value let toBson (value : CategoryId) : BsonValue = CategoryId.toString value
@ -148,6 +152,10 @@ module Bson =
let fromBson (value : BsonValue) = CommentId value.AsString let fromBson (value : BsonValue) = CommentId value.AsString
let toBson (value : CommentId) : BsonValue = CommentId.toString value let toBson (value : CommentId) : BsonValue = CommentId.toString value
module CommentStatusMapping =
let fromBson (value : BsonValue) = CommentStatus.parse value.AsString
let toBson (value : CommentStatus) : BsonValue = CommentStatus.toString value
module CustomFeedIdMapping = module CustomFeedIdMapping =
let fromBson (value : BsonValue) = CustomFeedId value.AsString let fromBson (value : BsonValue) = CustomFeedId value.AsString
let toBson (value : CustomFeedId) : BsonValue = CustomFeedId.toString value let toBson (value : CustomFeedId) : BsonValue = CustomFeedId.toString value
@ -181,9 +189,9 @@ module Bson =
let intToBson (value : int option) : BsonValue = match value with Some nbr -> nbr | None -> BsonValue.Null let intToBson (value : int option) : BsonValue = match value with Some nbr -> nbr | None -> BsonValue.Null
let podcastOptionsFromBson (value : BsonValue) = let podcastOptionsFromBson (value : BsonValue) =
if value.IsNull then None else Some (value.RawValue :?> PodcastOptions) if value.IsNull then None else Some (BsonMapper.Global.ToObject<PodcastOptions> value.AsDocument)
let podcastOptionsToBson (value : PodcastOptions option) : BsonValue = let podcastOptionsToBson (value : PodcastOptions option) : BsonValue =
match value with Some opts -> BsonValue opts | None -> BsonValue.Null match value with Some opts -> BsonMapper.Global.ToDocument opts | None -> BsonValue.Null
let stringFromBson (value : BsonValue) = if value.IsNull then None else Some value.AsString let stringFromBson (value : BsonValue) = if value.IsNull then None else Some value.AsString
let stringToBson (value : string option) : BsonValue = match value with Some str -> str | None -> BsonValue.Null let stringToBson (value : string option) : BsonValue = match value with Some str -> str | None -> BsonValue.Null
@ -200,6 +208,10 @@ module Bson =
let fromBson (value : BsonValue) = PostId value.AsString let fromBson (value : BsonValue) = PostId value.AsString
let toBson (value : PostId) : BsonValue = PostId.toString value let toBson (value : PostId) : BsonValue = PostId.toString value
module PostStatusMapping =
let fromBson (value : BsonValue) = PostStatus.parse value.AsString
let toBson (value : PostStatus) : BsonValue = PostStatus.toString value
module TagMapIdMapping = module TagMapIdMapping =
let fromBson (value : BsonValue) = TagMapId value.AsString let fromBson (value : BsonValue) = TagMapId value.AsString
let toBson (value : TagMapId) : BsonValue = TagMapId.toString value let toBson (value : TagMapId) : BsonValue = TagMapId.toString value
@ -223,20 +235,23 @@ module Bson =
/// Register all BSON mappings /// Register all BSON mappings
let registerAll () = let registerAll () =
let g = BsonMapper.Global let g = BsonMapper.Global
g.RegisterType<CategoryId> (CategoryIdMapping.toBson, CategoryIdMapping.fromBson) g.RegisterType<AuthorizationLevel> (AuthorizationLevelMapping.toBson, AuthorizationLevelMapping.fromBson)
g.RegisterType<CommentId> (CommentIdMapping.toBson, CommentIdMapping.fromBson) g.RegisterType<CategoryId> (CategoryIdMapping.toBson, CategoryIdMapping.fromBson)
g.RegisterType<CustomFeedId> (CustomFeedIdMapping.toBson, CustomFeedIdMapping.fromBson) g.RegisterType<CommentId> (CommentIdMapping.toBson, CommentIdMapping.fromBson)
g.RegisterType<CustomFeedSource> (CustomFeedSourceMapping.toBson, CustomFeedSourceMapping.fromBson) g.RegisterType<CommentStatus> (CommentStatusMapping.toBson, CommentStatusMapping.fromBson)
g.RegisterType<ExplicitRating> (ExplicitRatingMapping.toBson, ExplicitRatingMapping.fromBson) g.RegisterType<CustomFeedId> (CustomFeedIdMapping.toBson, CustomFeedIdMapping.fromBson)
g.RegisterType<MarkupText> (MarkupTextMapping.toBson, MarkupTextMapping.fromBson) g.RegisterType<CustomFeedSource> (CustomFeedSourceMapping.toBson, CustomFeedSourceMapping.fromBson)
g.RegisterType<Permalink> (PermalinkMapping.toBson, PermalinkMapping.fromBson) g.RegisterType<ExplicitRating> (ExplicitRatingMapping.toBson, ExplicitRatingMapping.fromBson)
g.RegisterType<PageId> (PageIdMapping.toBson, PageIdMapping.fromBson) g.RegisterType<MarkupText> (MarkupTextMapping.toBson, MarkupTextMapping.fromBson)
g.RegisterType<PostId> (PostIdMapping.toBson, PostIdMapping.fromBson) g.RegisterType<Permalink> (PermalinkMapping.toBson, PermalinkMapping.fromBson)
g.RegisterType<TagMapId> (TagMapIdMapping.toBson, TagMapIdMapping.fromBson) g.RegisterType<PageId> (PageIdMapping.toBson, PageIdMapping.fromBson)
g.RegisterType<ThemeAssetId> (ThemeAssetIdMapping.toBson, ThemeAssetIdMapping.fromBson) g.RegisterType<PostId> (PostIdMapping.toBson, PostIdMapping.fromBson)
g.RegisterType<ThemeId> (ThemeIdMapping.toBson, ThemeIdMapping.fromBson) g.RegisterType<PostStatus> (PostStatusMapping.toBson, PostStatusMapping.fromBson)
g.RegisterType<WebLogId> (WebLogIdMapping.toBson, WebLogIdMapping.fromBson) g.RegisterType<TagMapId> (TagMapIdMapping.toBson, TagMapIdMapping.fromBson)
g.RegisterType<WebLogUserId> (WebLogUserIdMapping.toBson, WebLogUserIdMapping.fromBson) g.RegisterType<ThemeAssetId> (ThemeAssetIdMapping.toBson, ThemeAssetIdMapping.fromBson)
g.RegisterType<ThemeId> (ThemeIdMapping.toBson, ThemeIdMapping.fromBson)
g.RegisterType<WebLogId> (WebLogIdMapping.toBson, WebLogIdMapping.fromBson)
g.RegisterType<WebLogUserId> (WebLogUserIdMapping.toBson, WebLogUserIdMapping.fromBson)
g.RegisterType<CategoryId option> (OptionMapping.categoryIdToBson, OptionMapping.categoryIdFromBson) g.RegisterType<CategoryId option> (OptionMapping.categoryIdToBson, OptionMapping.categoryIdFromBson)
g.RegisterType<CommentId option> (OptionMapping.commentIdToBson, OptionMapping.commentIdFromBson) g.RegisterType<CommentId option> (OptionMapping.commentIdToBson, OptionMapping.commentIdFromBson)

View File

@ -459,8 +459,11 @@ type LiteDbData (db : LiteDatabase) =
|> toList |> toList
member _.deleteByTheme themeId = backgroundTask { member _.deleteByTheme themeId = backgroundTask {
let _ = Collection.ThemeAsset.DeleteMany (fun ta -> (ThemeId.toString
(ThemeAssetId.toString ta.id).StartsWith (ThemeId.toString themeId)) >> sprintf "$.id LIKE '%s%%'"
>> BsonExpression.Create
>> Collection.ThemeAsset.DeleteMany) themeId
|> ignore
do! checkpoint () do! checkpoint ()
} }

View File

@ -53,6 +53,20 @@ type CommentStatus =
/// The comment was unsolicited and unwelcome /// The comment was unsolicited and unwelcome
| Spam | Spam
/// Functions to support post comment statuses
module CommentStatus =
/// Convert a comment status to a string
let toString = function Approved -> "Approved" | Pending -> "Pending" | Spam -> "Spam"
/// Parse a string into a comment status
let parse value =
match value with
| "Approved" -> Approved
| "Pending" -> Pending
| "Spam" -> Spam
| it -> invalidOp $"{it} is not a valid post status"
open Markdig open Markdig
open Markdown.ColorCode open Markdown.ColorCode
@ -170,6 +184,13 @@ module PostStatus =
/// Convert a post status to a string /// Convert a post status to a string
let toString = function Draft -> "Draft" | Published -> "Published" let toString = function Draft -> "Draft" | Published -> "Published"
/// Parse a string into a post status
let parse value =
match value with
| "Draft" -> Draft
| "Published" -> Published
| it -> invalidOp $"{it} is not a valid post status"
/// An identifier for a post /// An identifier for a post
type PostId = PostId of string type PostId = PostId of string
@ -319,6 +340,7 @@ module CustomFeed =
/// Really Simple Syndication (RSS) options for this web log /// Really Simple Syndication (RSS) options for this web log
[<CLIMutable; NoComparison; NoEquality>]
type RssOptions = type RssOptions =
{ /// Whether the site feed of posts is enabled { /// Whether the site feed of posts is enabled
feedEnabled : bool feedEnabled : bool
@ -429,6 +451,19 @@ type AuthorizationLevel =
/// <summary>The user is a known user of a web log</summary> /// <summary>The user is a known user of a web log</summary>
| User | User
/// Functions to support authorization levels
module AuthorizationLevel =
/// Convert an authorization level to a string
let toString = function Administrator -> "Administrator" | User -> "User"
/// Parse a string into an authorization level
let parse value =
match value with
| "Administrator" -> Administrator
| "User" -> User
| it -> invalidOp $"{it} is not a valid authorization level"
/// An identifier for a web log user /// An identifier for a web log user
type WebLogUserId = WebLogUserId of string type WebLogUserId = WebLogUserId of string

View File

@ -214,6 +214,7 @@ module Backup =
let plural count ifOne ifMany = let plural count ifOne ifMany =
if count = 1 then ifOne else ifMany if count = 1 then ifOne else ifMany
printfn ""
printfn $"""{msg.Replace ("{{NAME}}", webLog.name)}""" printfn $"""{msg.Replace ("{{NAME}}", webLog.name)}"""
printfn $""" - The theme "{archive.theme.name}" with {assetCount} asset{plural assetCount "" "s"}""" printfn $""" - The theme "{archive.theme.name}" with {assetCount} asset{plural assetCount "" "s"}"""
printfn $""" - {userCount} user{plural userCount "" "s"}""" printfn $""" - {userCount} user{plural userCount "" "s"}"""
@ -225,14 +226,26 @@ module Backup =
/// Create a backup archive /// Create a backup archive
let private createBackup webLog (fileName : string) prettyOutput (data : IData) = task { let private createBackup webLog (fileName : string) prettyOutput (data : IData) = task {
// Create the data structure // Create the data structure
let themeId = ThemeId webLog.themePath let themeId = ThemeId webLog.themePath
let! theme = data.Theme.findById themeId
let! assets = data.ThemeAsset.findByThemeWithData themeId printfn "- Exporting theme..."
let! users = data.WebLogUser.findByWebLog webLog.id let! theme = data.Theme.findById themeId
let! assets = data.ThemeAsset.findByThemeWithData themeId
printfn "- Exporting users..."
let! users = data.WebLogUser.findByWebLog webLog.id
printfn "- Exporting categories and tag mappings..."
let! categories = data.Category.findByWebLog webLog.id let! categories = data.Category.findByWebLog webLog.id
let! tagMaps = data.TagMap.findByWebLog webLog.id let! tagMaps = data.TagMap.findByWebLog webLog.id
let! pages = data.Page.findFullByWebLog webLog.id
let! posts = data.Post.findFullByWebLog webLog.id printfn "- Exporting pages..."
let! pages = data.Page.findFullByWebLog webLog.id
printfn "- Exporting posts..."
let! posts = data.Post.findFullByWebLog webLog.id
printfn "- Writing archive..."
let archive = { let archive = {
webLog = webLog webLog = webLog
users = users users = users
@ -301,19 +314,32 @@ module Backup =
} }
// Restore web log data // Restore web log data
do! data.WebLog.add restore.webLog
printfn ""
printfn "- Restoring web log..."
do! data.WebLog.add restore.webLog
printfn "- Restoring users..."
do! data.WebLogUser.restore restore.users do! data.WebLogUser.restore restore.users
do! data.TagMap.restore restore.tagMappings
do! data.Category.restore restore.categories printfn "- Restoring categories and tag mappings..."
do! data.Page.restore restore.pages do! data.TagMap.restore restore.tagMappings
do! data.Post.restore restore.posts do! data.Category.restore restore.categories
printfn "- Restoring pages..."
do! data.Page.restore restore.pages
printfn "- Restoring posts..."
do! data.Post.restore restore.posts
// TODO: comments not yet implemented // TODO: comments not yet implemented
// Restore theme and assets (one at a time, as assets can be large) // Restore theme and assets (one at a time, as assets can be large)
printfn "- Importing theme..."
do! data.Theme.save restore.theme do! data.Theme.save restore.theme
let! _ = restore.assets |> List.map (EncodedAsset.fromAsset >> data.ThemeAsset.save) |> Task.WhenAll let! _ = restore.assets |> List.map (EncodedAsset.fromAsset >> data.ThemeAsset.save) |> Task.WhenAll
displayStats "Restored for {{NAME}}" restore.webLog restore displayStats "Restored for {{NAME}}:" restore.webLog restore
} }
/// Decide whether to restore a backup /// Decide whether to restore a backup

View File

@ -41,7 +41,7 @@ module DataImplementation =
let get (sp : IServiceProvider) : IData option = let get (sp : IServiceProvider) : IData option =
let config = sp.GetRequiredService<IConfiguration> () let config = sp.GetRequiredService<IConfiguration> ()
let isNotNull it = (isNull >> not) it let isNotNull it = (isNull >> not) it
if isNotNull (config.GetSection "RethinkDB") then if isNotNull (config.GetSection "RethinkDB").Value then
Json.all () |> Seq.iter Converter.Serializer.Converters.Add Json.all () |> Seq.iter Converter.Serializer.Converters.Add
let rethinkCfg = DataConfig.FromConfiguration (config.GetSection "RethinkDB") let rethinkCfg = DataConfig.FromConfiguration (config.GetSection "RethinkDB")
let conn = rethinkCfg.CreateConnectionAsync () |> Async.AwaitTask |> Async.RunSynchronously let conn = rethinkCfg.CreateConnectionAsync () |> Async.AwaitTask |> Async.RunSynchronously
@ -118,10 +118,11 @@ let rec main args =
let app = builder.Build () let app = builder.Build ()
match args |> Array.tryHead with match args |> Array.tryHead with
| Some it when it = "init" -> Maintenance.createWebLog 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 = "import-links" -> Maintenance.importLinks args app.Services
| Some it when it = "load-theme" -> Maintenance.loadTheme 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 | Some it when it = "backup" -> Maintenance.Backup.generateBackup args app.Services
| Some it when it = "restore" -> Maintenance.Backup.restoreFromBackup args app.Services
| _ -> | _ ->
let _ = app.UseForwardedHeaders () let _ = app.UseForwardedHeaders ()
let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict)) let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))