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

Version 2.1 #41

Merged
danieljsummers merged 123 commits from version-2.1 into main 2024-03-27 00:13:28 +00:00
Conversation 0 Commits 123 Files Changed 116 +331 -371
16 changed files with 331 additions and 371 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit cb02055d87 - Show all commits

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

@ -7,6 +7,7 @@ open Newtonsoft.Json
open NodaTime
/// The result of a category deletion attempt
[<Struct>]
type CategoryDeleteResult =
/// The category was deleted successfully
| CategoryDeleted
@ -32,7 +33,7 @@ type ICategoryData =
abstract member Delete : CategoryId -> WebLogId -> Task<CategoryDeleteResult>
/// Find all categories for a web log, sorted alphabetically and grouped by hierarchy
abstract member FindAllForView : WebLogId -> Task<DisplayCategory[]>
abstract member FindAllForView : WebLogId -> Task<DisplayCategory array>
/// Find a category by its ID
abstract member FindById : CategoryId -> WebLogId -> Task<Category option>

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

@ -320,8 +320,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
PostCount = counts
|> Array.tryFind (fun c -> fst c = cat.Id)
|> Option.map snd
|> Option.defaultValue 0
})
|> Option.defaultValue 0 })
|> Array.ofSeq
}
@ -331,7 +330,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get catId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun c -> c.WebLogId) <| conn
|> verifyWebLog webLogId _.WebLogId <| conn
member _.FindByWebLog webLogId = rethink<Category list> {
withTable Table.Category
@ -586,7 +585,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
without [ nameof Post.Empty.PriorPermalinks; nameof Post.Empty.Revisions ]
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun p -> p.WebLogId) <| conn
|> verifyWebLog webLogId _.WebLogId <| conn
member _.FindByPermalink permalink webLogId =
rethink<Post list> {
@ -604,7 +603,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get postId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun p -> p.WebLogId) <| conn
|> verifyWebLog webLogId _.WebLogId <| conn
member _.FindCurrentPermalink permalinks webLogId = backgroundTask {
let! result =
@ -617,7 +616,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
result; withRetryDefault
}
|> tryFirst) conn
return result |> Option.map (fun post -> post.Permalink)
return result |> Option.map _.Permalink
}
member _.FindFullByWebLog webLogId = rethink<Post> {
@ -756,7 +755,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get tagMapId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (_.WebLogId) <| conn
|> verifyWebLog webLogId _.WebLogId <| conn
member _.FindByUrlValue urlValue webLogId =
rethink<TagMap list> {
@ -908,7 +907,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get uploadId
resultOption; withRetryOptionDefault
}
|> verifyWebLog<Upload> webLogId (fun u -> u.WebLogId) <| conn
|> verifyWebLog<Upload> webLogId _.WebLogId <| conn
match upload with
| Some up ->
do! rethink {
@ -1078,7 +1077,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get userId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun u -> u.WebLogId) <| conn
|> verifyWebLog webLogId _.WebLogId <| conn
member this.Delete userId webLogId = backgroundTask {
match! this.FindById userId webLogId with

3
src/MyWebLog.Data/Utils.fs
View File

@ -18,8 +18,7 @@ let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames =
Description = cat.Description
ParentNames = Array.ofList parentNames
// Post counts are filled on a second pass
PostCount = 0
}
PostCount = 0 }
yield! orderByHierarchy cats (Some cat.Id) (Some fullSlug) ([ cat.Name ] |> List.append parentNames)
}

6
src/MyWebLog/Caches.fs
View File

@ -84,7 +84,7 @@ module WebLogCache =
let tryGet (path : string) =
_cache
|> List.filter (fun wl -> path.StartsWith wl.UrlBase)
|> List.sortByDescending (fun wl -> wl.UrlBase.Length)
|> List.sortByDescending _.UrlBase.Length
|> List.tryHead
/// Cache the web log for a particular host
@ -126,7 +126,7 @@ module PageListCache =
open MyWebLog.ViewModels
/// Cache of displayed pages
let private _cache = ConcurrentDictionary<WebLogId, DisplayPage[]> ()
let private _cache = ConcurrentDictionary<WebLogId, DisplayPage array> ()
let private fillPages (webLog: WebLog) pages =
_cache[webLog.Id] <-
@ -159,7 +159,7 @@ module CategoryCache =
open MyWebLog.ViewModels
/// The cache itself
let private _cache = ConcurrentDictionary<WebLogId, DisplayCategory[]> ()
let private _cache = ConcurrentDictionary<WebLogId, DisplayCategory array> ()
/// Are there categories cached for this web log?
let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id

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

@ -109,8 +109,7 @@ module Cache =
do! ThemeAssetCache.fill data
do! addMessage ctx
{ UserMessage.Success with
Message = "Successfully cleared template cache and refreshed theme asset cache"
}
Message = "Successfully cleared template cache and refreshed theme asset cache" }
else
match! data.Theme.FindById(ThemeId themeId) with
| Some theme ->
@ -118,8 +117,7 @@ module Cache =
do! ThemeAssetCache.refreshTheme theme.Id data
do! addMessage ctx
{ UserMessage.Success with
Message = $"Successfully cleared template cache and refreshed theme asset cache for {theme.Name}"
}
Message = $"Successfully cleared template cache and refreshed theme asset cache for {theme.Name}" }
| None ->
do! addMessage ctx { UserMessage.Error with Message = $"No theme exists with ID {themeId}" }
return! toAdminDashboard next ctx
@ -186,8 +184,7 @@ module Category =
Name = model.Name
Slug = model.Slug
Description = if model.Description = "" then None else Some model.Description
ParentId = if model.ParentId = "" then None else Some (CategoryId model.ParentId)
}
ParentId = if model.ParentId = "" then None else Some(CategoryId model.ParentId) }
do! (if model.IsNew then data.Category.Add else data.Category.Update) updatedCat
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.Success with Message = "Category saved successfully" }
@ -428,7 +425,7 @@ module Theme =
/// Update theme assets from the ZIP archive
let private updateAssets themeId (zip: ZipArchive) (data: IData) = backgroundTask {
for asset in zip.Entries |> Seq.filter (fun it -> it.FullName.StartsWith "wwwroot") do
for asset in zip.Entries |> Seq.filter _.FullName.StartsWith("wwwroot") do
let assetName = asset.FullName.Replace("wwwroot/", "")
if assetName <> "" && not (assetName.EndsWith "/") then
use stream = new MemoryStream()
@ -446,7 +443,7 @@ module Theme =
let themeName = fileName.Split(".").[0].ToLowerInvariant().Replace(" ", "-")
if themeName.EndsWith "-theme" then
if Regex.IsMatch(themeName, """^[a-z0-9\-]+$""") then
Ok (ThemeId (themeName.Substring (0, themeName.Length - 6)))
Ok(ThemeId(themeName[..themeName.Length - 6]))
else Error $"Theme ID {fileName} is invalid"
else Error "Theme .zip file name must end in \"-theme.zip\""
@ -489,14 +486,12 @@ module Theme =
do! themeFile.CopyToAsync file
do! addMessage ctx
{ UserMessage.Success with
Message = $"""Theme {if isNew then "add" else "updat"}ed successfully"""
}
Message = $"""Theme {if isNew then "add" else "updat"}ed successfully""" }
return! toAdminDashboard next ctx
else
do! addMessage ctx
{ UserMessage.Error with
Message = "Theme exists and overwriting was not requested; nothing saved"
}
Message = "Theme exists and overwriting was not requested; nothing saved" }
return! toAdminDashboard next ctx
| Ok _ ->
do! addMessage ctx { UserMessage.Error with Message = "You may not replace the admin theme" }
@ -517,8 +512,7 @@ module Theme =
| it when WebLogCache.isThemeInUse (ThemeId it) ->
do! addMessage ctx
{ UserMessage.Error with
Message = $"You may not delete the {themeId} theme, as it is currently in use"
}
Message = $"You may not delete the {themeId} theme, as it is currently in use" }
return! all next ctx
| _ ->
match! data.Theme.Delete (ThemeId themeId) with

21
src/MyWebLog/Handlers/Feed.fs
View File

@ -460,13 +460,12 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
match theFeed with
| Some feed ->
let feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun it -> it.Id <> feed.Id))
let webLog = { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
let webLog = { webLog with Rss.CustomFeeds = feeds }
do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog
do! addMessage ctx {
UserMessage.Success with
Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed"""
}
do! addMessage ctx
{ UserMessage.Success with
Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed""" }
return! redirectToGet $"admin/settings/rss/{feed.Id}/edit" next ctx
| None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx
@ -479,13 +478,11 @@ let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun ne
| Some webLog ->
let customId = CustomFeedId feedId
if webLog.Rss.CustomFeeds |> List.exists (fun f -> f.Id = customId) then
let webLog = {
webLog with
Rss = {
webLog.Rss with
CustomFeeds = webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> customId)
}
}
let webLog =
{ webLog with
Rss =
{ webLog.Rss with
CustomFeeds = webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> customId) } }
do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog
do! addMessage ctx { UserMessage.Success with Message = "Custom feed deleted successfully" }

15
src/MyWebLog/Handlers/Helpers.fs
View File

@ -192,7 +192,7 @@ let addViewContext ctx (hash : Hash) = task {
return
if hash.ContainsKey ViewContext.HtmxScript && hash.ContainsKey ViewContext.Messages then
// We have already populated everything; just update messages
hash[ViewContext.Messages] <- Array.concat [ hash[ViewContext.Messages] :?> UserMessage[]; messages ]
hash[ViewContext.Messages] <- Array.concat [ hash[ViewContext.Messages] :?> UserMessage array; messages ]
hash
else
ctx.User.Claims
@ -253,8 +253,7 @@ module Error =
if isHtmx ctx then
let messages = [|
{ UserMessage.Error with
Message = $"You are not authorized to access the URL {ctx.Request.Path.Value}"
}
Message = $"You are not authorized to access the URL {ctx.Request.Path.Value}" }
|]
(messagesToHeaders messages >=> setStatusCode 401) earlyReturn ctx
else setStatusCode 401 earlyReturn ctx
@ -311,7 +310,7 @@ let bareForTheme themeId template next ctx (hash : Hash) = task {
match! TemplateCache.get themeId "layout-bare" ctx.Data with
| Ok layoutTemplate ->
return!
(messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage[])
(messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage array)
>=> htmlString (layoutTemplate.Render completeHash))
next ctx
| Error message -> return! Error.server message next ctx
@ -353,8 +352,7 @@ let requireAccess level : HttpHandler = fun next ctx -> task {
do! addMessage ctx
{ UserMessage.Warning with
Message = $"The page you tried to access requires {level} privileges"
Detail = Some $"Your account only has {userLevel} privileges"
}
Detail = Some $"Your account only has {userLevel} privileges" }
return! Error.notAuthorized next ctx
| None ->
do! addMessage ctx
@ -393,14 +391,14 @@ let templatesForTheme (ctx : HttpContext) (typ : string) = backgroundTask {
/// Get all authors for a list of posts as metadata items
let getAuthors (webLog: WebLog) (posts: Post list) (data: IData) =
posts
|> List.map (fun p -> p.AuthorId)
|> List.map _.AuthorId
|> List.distinct
|> data.WebLogUser.FindNames webLog.Id
/// Get all tag mappings for a list of posts as metadata items
let getTagMappings (webLog: WebLog) (posts: Post list) (data: IData) =
posts
|> List.map (fun p -> p.Tags)
|> List.map _.Tags
|> List.concat
|> List.distinct
|> fun tags -> data.TagMap.FindMappingForTags tags webLog.Id
@ -452,4 +450,3 @@ let warn (name : string) (ctx : HttpContext) msg =
let fac = ctx.RequestServices.GetRequiredService<ILoggerFactory>()
let log = fac.CreateLogger $"MyWebLog.Handlers.{name}"
log.LogWarning msg

3
src/MyWebLog/Handlers/Page.fs
View File

@ -150,8 +150,7 @@ let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
do! ctx.Data.Page.Update
{ pg with
Revisions = { rev with AsOf = Noda.now () }
:: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
}
:: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) }
do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/page/{pgId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx

11
src/MyWebLog/Handlers/Post.fs
View File

@ -27,6 +27,7 @@ let private parseSlugAndPage webLog (slugAndPage : string seq) =
pageNbr, String.Join("/", slugParts), isFeed
/// The type of post list being prepared
[<Struct>]
type ListType =
| AdminList
| CategoryList
@ -350,8 +351,7 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
do! ctx.Data.Post.Update
{ post with
Revisions = { rev with AsOf = Noda.now () }
:: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
}
:: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) }
do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
@ -380,8 +380,8 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
{ Post.Empty with
Id = PostId.Create()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
} |> someTask
AuthorId = ctx.UserId }
|> someTask
else data.Post.FindFullById (PostId model.PostId) ctx.WebLog.Id
match! tryPost with
| Some post when canEdit post.AuthorId ctx ->
@ -396,8 +396,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
{ post with
PublishedOn = Some dt
UpdatedOn = dt
Revisions = [ { (List.head post.Revisions) with AsOf = dt } ]
}
Revisions = [ { (List.head post.Revisions) with AsOf = dt } ] }
else { post with PublishedOn = Some dt }
else post
do! (if model.PostId = "new" then data.Post.Add else data.Post.Update) updatedPost

8
src/MyWebLog/Handlers/Upload.fs
View File

@ -87,7 +87,7 @@ open System.Text.RegularExpressions
open MyWebLog.ViewModels
/// Turn a string into a lowercase URL-safe slug
let makeSlug it = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 -]").Replace (it, ""), "-")).ToLowerInvariant ()
let makeSlug it = (Regex """\s+""").Replace((Regex "[^A-z0-9 -]").Replace(it, ""), "-").ToLowerInvariant()
// GET /admin/uploads
let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
@ -107,8 +107,7 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
Name = name
Path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace(slash, '/')
UpdatedOn = create
Source = string Disk
})
Source = string Disk })
|> List.ofSeq
with
| :? DirectoryNotFoundException -> [] // This is fine
@ -160,8 +159,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
WebLogId = ctx.WebLog.Id
Path = Permalink $"{year}/{month}/{fileName}"
UpdatedOn = now
Data = stream.ToArray()
}
Data = stream.ToArray() }
do! ctx.Data.Upload.Add file
| Disk ->
let fullPath = Path.Combine(uploadDir, ctx.WebLog.Slug, year, month)

21
src/MyWebLog/Handlers/User.fs
View File

@ -68,11 +68,10 @@ let doLogOn : HttpHandler = fun next ctx -> task {
do! addMessage ctx
{ UserMessage.Success with
Message = "Log on successful"
Detail = Some $"Welcome to {ctx.WebLog.Name}!"
}
Detail = Some $"Welcome to {ctx.WebLog.Name}!" }
return!
match model.ReturnTo with
| Some url -> redirectTo false url next ctx
| Some url -> redirectTo false url next ctx // TODO: change to redirectToGet?
| None -> redirectToGet "admin/dashboard" next ctx
| Error msg ->
do! addMessage ctx { UserMessage.Error with Message = msg }
@ -141,15 +140,13 @@ let delete userId : HttpHandler = fun next ctx -> task {
| Ok _ ->
do! addMessage ctx
{ UserMessage.Success with
Message = $"User {user.DisplayName} deleted successfully"
}
Message = $"User {user.DisplayName} deleted successfully" }
return! all next ctx
| Error msg ->
do! addMessage ctx
{ UserMessage.Error with
Message = $"User {user.DisplayName} was not deleted"
Detail = Some msg
}
Detail = Some msg }
return! all next ctx
| None -> return! Error.notFound next ctx
}
@ -184,8 +181,7 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
FirstName = model.FirstName
LastName = model.LastName
PreferredName = model.PreferredName
PasswordHash = pw
}
PasswordHash = pw }
do! data.WebLogUser.Update user
let pwMsg = if model.NewPassword = "" then "" else " and updated your password"
do! addMessage ctx { UserMessage.Success with Message = $"Saved your information{pwMsg} successfully" }
@ -208,8 +204,8 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
{ WebLogUser.Empty with
Id = WebLogUserId.Create()
WebLogId = ctx.WebLog.Id
CreatedOn = Noda.now ()
} |> someTask
CreatedOn = Noda.now () }
|> someTask
else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
match! tryUser with
| Some user when model.Password = model.PasswordConfirm ->
@ -223,8 +219,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate
do! addMessage ctx
{ UserMessage.Success with
Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully"""
}
Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully""" }
return! all next ctx
| Some _ ->
do! addMessage ctx { UserMessage.Error with Message = "The passwords did not match; nothing saved" }

56
src/MyWebLog/Maintenance.fs
View File

@ -38,8 +38,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
Slug = slug
UrlBase = args[1]
DefaultPage = string homePageId
TimeZone = timeZone
}
TimeZone = timeZone }
// Create the admin user
let now = Noda.now ()
@ -52,8 +51,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
LastName = "User"
PreferredName = "Admin"
AccessLevel = accessLevel
CreatedOn = now
}
CreatedOn = now }
do! data.WebLogUser.Add { user with PasswordHash = Handlers.User.createPasswordHash user args[4] }
// Create the default home page
@ -69,10 +67,8 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
Text = "<p>This is your default home page.</p>"
Revisions = [
{ AsOf = now
Text = Html "<p>This is your default home page.</p>"
}
]
}
Text = Html "<p>This is your default home page.</p>" }
] }
printfn $"Successfully initialized database for {args[2]} with URL base {args[1]}"
match accessLevel with
@ -165,22 +161,19 @@ module Backup =
UpdatedOn: Instant
/// The data for this asset, base-64 encoded
Data : string
}
Data: string }
/// Create an encoded theme asset from the original theme asset
static member fromAsset (asset: ThemeAsset) =
{ Id = asset.Id
UpdatedOn = asset.UpdatedOn
Data = Convert.ToBase64String asset.Data
}
Data = Convert.ToBase64String asset.Data }
/// Create a theme asset from an encoded theme asset
static member toAsset (encoded: EncodedAsset) : ThemeAsset =
{ Id = encoded.Id
UpdatedOn = encoded.UpdatedOn
Data = Convert.FromBase64String encoded.Data
}
Data = Convert.FromBase64String encoded.Data }
/// An uploaded file, with the data base-64 encoded
type EncodedUpload =
@ -197,8 +190,7 @@ module Backup =
UpdatedOn: Instant
/// The data for the upload, base-64 encoded
Data : string
}
Data: string }
/// Create an encoded uploaded file from the original uploaded file
static member fromUpload (upload: Upload) : EncodedUpload =
@ -206,8 +198,7 @@ module Backup =
WebLogId = upload.WebLogId
Path = upload.Path
UpdatedOn = upload.UpdatedOn
Data = Convert.ToBase64String upload.Data
}
Data = Convert.ToBase64String upload.Data }
/// Create an uploaded file from an encoded uploaded file
static member toUpload (encoded: EncodedUpload) : Upload =
@ -215,8 +206,7 @@ module Backup =
WebLogId = encoded.WebLogId
Path = encoded.Path
UpdatedOn = encoded.UpdatedOn
Data = Convert.FromBase64String encoded.Data
}
Data = Convert.FromBase64String encoded.Data }
/// A unified archive for a web log
type Archive =
@ -245,8 +235,7 @@ module Backup =
Posts: Post list
/// The uploaded files for this web log
Uploads : EncodedUpload list
}
Uploads: EncodedUpload list }
/// Create a JSON serializer
let private getSerializer prettyOutput =
@ -312,8 +301,7 @@ module Backup =
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 })
Uploads = uploads |> List.map EncodedUpload.fromUpload
}
Uploads = uploads |> List.map EncodedUpload.fromUpload }
// Write the structure to the backup file
if File.Exists fileName then File.Delete fileName
@ -330,7 +318,7 @@ module Backup =
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 with WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase webLog.UrlBase } }
return { archive with Archive.WebLog.UrlBase = defaultArg newUrlBase webLog.UrlBase }
| Some _ ->
// Err'body gets new IDs...
let newWebLogId = WebLogId.Create()
@ -354,24 +342,18 @@ module Backup =
{ page with
Id = newPageIds[page.Id]
WebLogId = newWebLogId
AuthorId = newUserIds[page.AuthorId]
})
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])
})
CategoryIds = post.CategoryIds |> List.map (fun c -> newCatIds[c]) })
Uploads = archive.Uploads
|> List.map (fun u -> { u with Id = newUpIds[u.Id]; WebLogId = newWebLogId })
}
|> List.map (fun u -> { u with Id = newUpIds[u.Id]; WebLogId = newWebLogId }) }
| None ->
return
{ archive with
WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase archive.WebLog.UrlBase }
}
return { archive with Archive.WebLog.UrlBase = defaultArg newUrlBase archive.WebLog.UrlBase }
}
// Restore theme and assets (one at a time, as assets can be large)
@ -413,7 +395,7 @@ module Backup =
}
/// Decide whether to restore a backup
let private restoreBackup (fileName : string) newUrlBase promptForOverwrite data = task {
let private restoreBackup fileName newUrlBase promptForOverwrite data = task {
let serializer = getSerializer false
use stream = new FileStream(fileName, FileMode.Open)
@ -428,7 +410,7 @@ module Backup =
printfn " theme in either case."
printfn ""
printf "Continue? [Y/n] "
doOverwrite <- not ((Console.ReadKey ()).Key = ConsoleKey.N)
doOverwrite <- not (Console.ReadKey().Key = ConsoleKey.N)
if doOverwrite then
do! doRestore archive newUrlBase data

2
src/MyWebLog/Program.fs
View File

@ -178,7 +178,7 @@ let main args =
let conn = new SqliteConnection(sql.Conn.ConnectionString)
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
conn)
let _ = builder.Services.AddScoped<IData, SQLiteData> () |> ignore
let _ = builder.Services.AddScoped<IData, SQLiteData>()
// Use SQLite for caching as well
let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./session.db"
let _ = builder.Services.AddSqliteCache(fun o -> o.CachePath <- cachePath)