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

V2 #1

Merged
danieljsummers merged 102 commits from v2 into main 2022-06-23 00:35:12 +00:00
Conversation 0 Commits 102 Files Changed 125 +116 -36
5 changed files with 116 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit c229aac68e - Show all commits

47
src/MyWebLog.Data/Converters.fs
View File

@ -140,6 +140,10 @@ module Bson =
open LiteDB
module AuthorizationLevelMapping =
let fromBson (value : BsonValue) = AuthorizationLevel.parse value.AsString
let toBson (value : AuthorizationLevel) : BsonValue = AuthorizationLevel.toString value
module CategoryIdMapping =
let fromBson (value : BsonValue) = CategoryId value.AsString
let toBson (value : CategoryId) : BsonValue = CategoryId.toString value
@ -148,6 +152,10 @@ module Bson =
let fromBson (value : BsonValue) = CommentId value.AsString
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 =
let fromBson (value : BsonValue) = CustomFeedId value.AsString
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 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 =
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 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 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 =
let fromBson (value : BsonValue) = TagMapId value.AsString
let toBson (value : TagMapId) : BsonValue = TagMapId.toString value
@ -223,20 +235,23 @@ module Bson =
/// Register all BSON mappings
let registerAll () =
let g = BsonMapper.Global
g.RegisterType<CategoryId> (CategoryIdMapping.toBson, CategoryIdMapping.fromBson)
g.RegisterType<CommentId> (CommentIdMapping.toBson, CommentIdMapping.fromBson)
g.RegisterType<CustomFeedId> (CustomFeedIdMapping.toBson, CustomFeedIdMapping.fromBson)
g.RegisterType<CustomFeedSource> (CustomFeedSourceMapping.toBson, CustomFeedSourceMapping.fromBson)
g.RegisterType<ExplicitRating> (ExplicitRatingMapping.toBson, ExplicitRatingMapping.fromBson)
g.RegisterType<MarkupText> (MarkupTextMapping.toBson, MarkupTextMapping.fromBson)
g.RegisterType<Permalink> (PermalinkMapping.toBson, PermalinkMapping.fromBson)
g.RegisterType<PageId> (PageIdMapping.toBson, PageIdMapping.fromBson)
g.RegisterType<PostId> (PostIdMapping.toBson, PostIdMapping.fromBson)
g.RegisterType<TagMapId> (TagMapIdMapping.toBson, TagMapIdMapping.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<AuthorizationLevel> (AuthorizationLevelMapping.toBson, AuthorizationLevelMapping.fromBson)
g.RegisterType<CategoryId> (CategoryIdMapping.toBson, CategoryIdMapping.fromBson)
g.RegisterType<CommentId> (CommentIdMapping.toBson, CommentIdMapping.fromBson)
g.RegisterType<CommentStatus> (CommentStatusMapping.toBson, CommentStatusMapping.fromBson)
g.RegisterType<CustomFeedId> (CustomFeedIdMapping.toBson, CustomFeedIdMapping.fromBson)
g.RegisterType<CustomFeedSource> (CustomFeedSourceMapping.toBson, CustomFeedSourceMapping.fromBson)
g.RegisterType<ExplicitRating> (ExplicitRatingMapping.toBson, ExplicitRatingMapping.fromBson)
g.RegisterType<MarkupText> (MarkupTextMapping.toBson, MarkupTextMapping.fromBson)
g.RegisterType<Permalink> (PermalinkMapping.toBson, PermalinkMapping.fromBson)
g.RegisterType<PageId> (PageIdMapping.toBson, PageIdMapping.fromBson)
g.RegisterType<PostId> (PostIdMapping.toBson, PostIdMapping.fromBson)
g.RegisterType<PostStatus> (PostStatusMapping.toBson, PostStatusMapping.fromBson)
g.RegisterType<TagMapId> (TagMapIdMapping.toBson, TagMapIdMapping.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<CommentId option> (OptionMapping.commentIdToBson, OptionMapping.commentIdFromBson)

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

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

35
src/MyWebLog.Domain/SupportTypes.fs
View File

@ -53,6 +53,20 @@ type CommentStatus =
/// The comment was unsolicited and unwelcome
| 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 Markdown.ColorCode
@ -170,6 +184,13 @@ module PostStatus =
/// Convert a post status to a string
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
type PostId = PostId of string
@ -319,6 +340,7 @@ module CustomFeed =
/// Really Simple Syndication (RSS) options for this web log
[<CLIMutable; NoComparison; NoEquality>]
type RssOptions =
{ /// Whether the site feed of posts is enabled
feedEnabled : bool
@ -429,6 +451,19 @@ type AuthorizationLevel =
/// <summary>The user is a known user of a web log</summary>
| 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
type WebLogUserId = WebLogUserId of string

50
src/MyWebLog/Maintenance.fs
View File

@ -214,6 +214,7 @@ module Backup =
let plural count ifOne ifMany =
if count = 1 then ifOne else ifMany
printfn ""
printfn $"""{msg.Replace ("{{NAME}}", webLog.name)}"""
printfn $""" - The theme "{archive.theme.name}" with {assetCount} asset{plural assetCount "" "s"}"""
printfn $""" - {userCount} user{plural userCount "" "s"}"""
@ -225,14 +226,26 @@ module Backup =
/// Create a backup archive
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
let! assets = data.ThemeAsset.findByThemeWithData themeId
let! users = data.WebLogUser.findByWebLog webLog.id
let themeId = ThemeId webLog.themePath
printfn "- Exporting theme..."
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! 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 = {
webLog = webLog
users = users
@ -301,19 +314,32 @@ module Backup =
}
// 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.TagMap.restore restore.tagMappings
do! data.Category.restore restore.categories
do! data.Page.restore restore.pages
do! data.Post.restore restore.posts
printfn "- Restoring categories and tag mappings..."
do! data.TagMap.restore restore.tagMappings
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
// Restore theme and assets (one at a time, as assets can be large)
printfn "- Importing theme..."
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
displayStats "Restored for {{NAME}}:" restore.webLog restore
}
/// Decide whether to restore a backup

11
src/MyWebLog/Program.fs
View File

@ -41,7 +41,7 @@ module DataImplementation =
let get (sp : IServiceProvider) : IData option =
let config = sp.GetRequiredService<IConfiguration> ()
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
let rethinkCfg = DataConfig.FromConfiguration (config.GetSection "RethinkDB")
let conn = rethinkCfg.CreateConnectionAsync () |> Async.AwaitTask |> Async.RunSynchronously
@ -118,10 +118,11 @@ let rec 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 = "backup" -> Maintenance.Backup.generateBackup 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
| Some it when it = "restore" -> Maintenance.Backup.restoreFromBackup args app.Services
| _ ->
let _ = app.UseForwardedHeaders ()
let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))