Version 2.1 #41

Merged
danieljsummers merged 123 commits from version-2.1 into main 2024-03-27 00:13:28 +00:00
16 changed files with 331 additions and 371 deletions
Showing only changes of commit cb02055d87 - Show all commits

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -192,7 +192,7 @@ let addViewContext ctx (hash : Hash) = task {
return return
if hash.ContainsKey ViewContext.HtmxScript && hash.ContainsKey ViewContext.Messages then if hash.ContainsKey ViewContext.HtmxScript && hash.ContainsKey ViewContext.Messages then
// We have already populated everything; just update messages // 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 hash
else else
ctx.User.Claims ctx.User.Claims
@ -253,8 +253,7 @@ module Error =
if isHtmx ctx then if isHtmx ctx then
let messages = [| let messages = [|
{ UserMessage.Error with { 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 (messagesToHeaders messages >=> setStatusCode 401) earlyReturn ctx
else 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 match! TemplateCache.get themeId "layout-bare" ctx.Data with
| Ok layoutTemplate -> | Ok layoutTemplate ->
return! return!
(messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage[]) (messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage array)
>=> htmlString (layoutTemplate.Render completeHash)) >=> htmlString (layoutTemplate.Render completeHash))
next ctx next ctx
| Error message -> return! Error.server message 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 do! addMessage ctx
{ UserMessage.Warning with { UserMessage.Warning with
Message = $"The page you tried to access requires {level} privileges" 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 return! Error.notAuthorized next ctx
| None -> | None ->
do! addMessage ctx 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 /// Get all authors for a list of posts as metadata items
let getAuthors (webLog: WebLog) (posts: Post list) (data: IData) = let getAuthors (webLog: WebLog) (posts: Post list) (data: IData) =
posts posts
|> List.map (fun p -> p.AuthorId) |> List.map _.AuthorId
|> List.distinct |> List.distinct
|> data.WebLogUser.FindNames webLog.Id |> data.WebLogUser.FindNames webLog.Id
/// Get all tag mappings for a list of posts as metadata items /// Get all tag mappings for a list of posts as metadata items
let getTagMappings (webLog: WebLog) (posts: Post list) (data: IData) = let getTagMappings (webLog: WebLog) (posts: Post list) (data: IData) =
posts posts
|> List.map (fun p -> p.Tags) |> List.map _.Tags
|> List.concat |> List.concat
|> List.distinct |> List.distinct
|> fun tags -> data.TagMap.FindMappingForTags tags webLog.Id |> 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 fac = ctx.RequestServices.GetRequiredService<ILoggerFactory>()
let log = fac.CreateLogger $"MyWebLog.Handlers.{name}" let log = fac.CreateLogger $"MyWebLog.Handlers.{name}"
log.LogWarning msg log.LogWarning msg

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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