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

Migrate several templates to GVE

Browse Source 
All that remains is post/page edit
This commit is contained in:
Daniel J. Summers
2024-03-15 17:00:32 -04:00
parent 91046c643e
commit 3998399e11
15 changed files with 1009 additions and 1054 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -27,35 +27,13 @@ module Dashboard =
ListedPages = listed
Categories = cats
TopLevelCategories = topCats }
return! adminPage "Dashboard" false next ctx (Views.Admin.dashboard model)
return! adminPage "Dashboard" false next ctx (Views.WebLog.dashboard model)
}
// GET /admin/administration
let admin : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let! themes = ctx.Data.Theme.All()
let cachedTemplates = TemplateCache.allNames ()
return!
hashForPage "myWebLog Administration"
|> withAntiCsrf ctx
|> addToHash "cached_themes" (
themes
|> Seq.ofList
|> Seq.map (fun it -> [|
string it.Id
it.Name
cachedTemplates
|> List.filter _.StartsWith(string it.Id)
|> List.length
|> string
|])
|> Array.ofSeq)
|> addToHash "web_logs" (
WebLogCache.all ()
|> Seq.ofList
|> Seq.sortBy _.Name
|> Seq.map (fun it -> [| string it.Id; it.Name; it.UrlBase |])
|> Array.ofSeq)
|> adminView "admin-dashboard" next ctx
let! themes = ctx.Data.Theme.All()
return! adminPage "myWebLog Administration" true next ctx (Views.Admin.dashboard themes)
}
/// Redirect the user to the admin dashboard
@@ -117,43 +95,24 @@ module Category =
open MyWebLog.Data
// GET /admin/categories
let all : HttpHandler = fun next ctx -> task {
match! TemplateCache.get adminTheme "category-list-body" ctx.Data with
| Ok catListTemplate ->
let! hash =
hashForPage "Categories"
|> withAntiCsrf ctx
|> addViewContext ctx
return!
addToHash "category_list" (catListTemplate.Render hash) hash
|> adminView "category-list" next ctx
| Error message -> return! Error.server message next ctx
}
// GET /admin/categories/bare
let bare : HttpHandler = fun next ctx ->
hashForPage "Categories"
|> withAntiCsrf ctx
|> adminBareView "category-list-body" next ctx
let all : HttpHandler = fun next ctx ->
adminPage "Categories" true next ctx Views.WebLog.categoryList
// GET /admin/category/{id}/edit
let edit catId : HttpHandler = fun next ctx -> task {
let! result = task {
match catId with
| "new" -> return Some("Add a New Category", { Category.Empty with Id = CategoryId "new" })
| "new" -> return Some ("Add a New Category", { Category.Empty with Id = CategoryId "new" })
| _ ->
match! ctx.Data.Category.FindById (CategoryId catId) ctx.WebLog.Id with
| Some cat -> return Some("Edit Category", cat)
| Some cat -> return Some ("Edit Category", cat)
| None -> return None
}
match result with
| Some (title, cat) ->
return!
hashForPage title
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditCategoryModel.FromCategory cat)
|> adminBareView "category-edit" next ctx
Views.WebLog.categoryEdit (EditCategoryModel.FromCategory cat)
|> adminBarePage title true next ctx
| None -> return! Error.notFound next ctx
}
@@ -171,16 +130,16 @@ 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" }
return! bare next ctx
return! all next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/category/{id}/delete
let delete catId : HttpHandler = fun next ctx -> task {
// DELETE /admin/category/{id}
let delete catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! result = ctx.Data.Category.Delete (CategoryId catId) ctx.WebLog.Id
match result with
| CategoryDeleted
@@ -194,7 +153,7 @@ module Category =
do! addMessage ctx { UserMessage.Success with Message = "Category deleted successfully"; Detail = detail }
| CategoryNotFound ->
do! addMessage ctx { UserMessage.Error with Message = "Category not found; cannot delete" }
return! bare next ctx
return! all next ctx
}
@@ -205,19 +164,20 @@ module RedirectRules =
// GET /admin/settings/redirect-rules
let all : HttpHandler = fun next ctx ->
adminPage "Redirect Rules" true next ctx (Views.Admin.redirectList ctx.WebLog.RedirectRules)
adminPage "Redirect Rules" true next ctx (Views.WebLog.redirectList ctx.WebLog.RedirectRules)
// GET /admin/settings/redirect-rules/[index]
let edit idx : HttpHandler = fun next ctx ->
let titleAndView =
if idx = -1 then
Some ("Add", Views.Admin.redirectEdit (EditRedirectRuleModel.FromRule -1 RedirectRule.Empty))
Some ("Add", Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule -1 RedirectRule.Empty))
else
let rules = ctx.WebLog.RedirectRules
if rules.Length < idx || idx < 0 then
None
else
Some ("Edit", (Views.Admin.redirectEdit (EditRedirectRuleModel.FromRule idx (List.item idx rules))))
Some
("Edit", (Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule idx (List.item idx rules))))
match titleAndView with
| Some (title, view) -> adminBarePage $"{title} Redirect Rule" true next ctx view
| None -> Error.notFound next ctx
@@ -284,7 +244,7 @@ module TagMapping =
// GET /admin/settings/tag-mappings
let all : HttpHandler = fun next ctx -> task {
let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
return! adminBarePage "Tag Mapping List" true next ctx (Views.Admin.tagMapList mappings)
return! adminBarePage "Tag Mapping List" true next ctx (Views.WebLog.tagMapList mappings)
}
// GET /admin/settings/tag-mapping/{id}/edit
@@ -296,7 +256,7 @@ module TagMapping =
match! tagMap with
| Some tm ->
return!
Views.Admin.tagMapEdit (EditTagMapModel.FromMapping tm)
Views.WebLog.tagMapEdit (EditTagMapModel.FromMapping tm)
|> adminBarePage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag") true next ctx
| None -> return! Error.notFound next ctx
}
@@ -497,7 +457,7 @@ module WebLog =
let uploads = [ Database; Disk ]
let feeds = ctx.WebLog.Rss.CustomFeeds |> List.map (DisplayCustomFeed.FromFeed (CategoryCache.get ctx))
return!
Views.Admin.webLogSettings
Views.WebLog.webLogSettings
(SettingsModel.FromWebLog ctx.WebLog) themes pages uploads (EditRssModel.FromRssOptions ctx.WebLog.Rss)
feeds
|> adminPage "Web Log Settings" true next ctx

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

@@ -2,7 +2,6 @@
module MyWebLog.Handlers.Feed
open System
open System.Collections.Generic
open System.IO
open System.Net
open System.ServiceModel.Syndication
@@ -446,7 +445,7 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
{ Name = string Newsletter; Value = "Newsletter" }
{ Name = string Blog; Value = "Blog" }
]
Views.Admin.feedEdit (EditCustomFeedModel.FromFeed f) ratings mediums
Views.WebLog.feedEdit (EditCustomFeedModel.FromFeed f) ratings mediums
|> adminPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed""" true next ctx
| None -> Error.notFound next ctx
@@ -474,7 +473,7 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
| None -> return! Error.notFound next ctx
}
// POST /admin/settings/rss/{id}/delete
// DELETE /admin/settings/rss/{id}
let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLog.FindById ctx.WebLog.Id with

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

@@ -114,7 +114,6 @@ let router : HttpHandler = choose [
route "/administration" >=> Admin.Dashboard.admin
subRoute "/categor" (requireAccess WebLogAdmin >=> choose [
route "ies" >=> Admin.Category.all
route "ies/bare" >=> Admin.Category.bare
routef "y/%s/edit" Admin.Category.edit
])
route "/dashboard" >=> Admin.Dashboard.user
@@ -184,11 +183,10 @@ let router : HttpHandler = choose [
routef "/%s/revision/%s/restore" Post.restoreRevision
])
subRoute "/settings" (requireAccess WebLogAdmin >=> choose [
route "" >=> Admin.WebLog.saveSettings
route "" >=> Admin.WebLog.saveSettings
subRoute "/rss" (choose [
route "" >=> Feed.saveSettings
route "/save" >=> Feed.saveCustomFeed
routef "/%s/delete" Feed.deleteCustomFeed
route "" >=> Feed.saveSettings
route "/save" >=> Feed.saveCustomFeed
])
subRoute "/redirect-rules" (choose [
routef "/%i" Admin.RedirectRules.save
@@ -202,13 +200,10 @@ let router : HttpHandler = choose [
route "/new" >=> Admin.Theme.save
routef "/%s/delete" Admin.Theme.delete
])
subRoute "/upload" (choose [
route "/save" >=> Upload.save
routexp "/delete/(.*)" Upload.deleteFromDisk
routef "/%s/delete" Upload.deleteFromDb
])
route "/upload/save" >=> Upload.save
]
DELETE >=> validateCsrf >=> choose [
routef "/category/%s" Admin.Category.delete
subRoute "/page" (choose [
routef "/%s" Page.delete
routef "/%s/revision/%s" Page.deleteRevision
@@ -221,9 +216,14 @@ let router : HttpHandler = choose [
routef "/%s/revisions" Post.purgeRevisions
])
subRoute "/settings" (requireAccess WebLogAdmin >=> choose [
routef "/user/%s" User.delete
routef "/redirect-rules/%i" Admin.RedirectRules.delete
routef "/rss/%s" Feed.deleteCustomFeed
routef "/tag-mapping/%s" Admin.TagMapping.delete
routef "/user/%s" User.delete
])
subRoute "/upload" (requireAccess WebLogAdmin >=> choose [
routexp "/disk/(.*)" Upload.deleteFromDisk
routef "/%s" Upload.deleteFromDb
])
]
])

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

@@ -108,30 +108,24 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
Path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace(slash, '/')
UpdatedOn = create
Source = string Disk })
|> List.ofSeq
with
| :? DirectoryNotFoundException -> [] // This is fine
| ex ->
warn "Upload" ctx $"Encountered {ex.GetType().Name} listing uploads for {path}:\n{ex.Message}"
[]
let allFiles =
dbUploads
|> List.map (DisplayUpload.FromUpload webLog Database)
|> List.append diskUploads
|> List.sortByDescending (fun file -> file.UpdatedOn, file.Path)
return!
hashForPage "Uploaded Files"
|> withAntiCsrf ctx
|> addToHash "files" allFiles
|> adminView "upload-list" next ctx
dbUploads
|> Seq.ofList
|> Seq.map (DisplayUpload.FromUpload webLog Database)
|> Seq.append diskUploads
|> Seq.sortByDescending (fun file -> file.UpdatedOn, file.Path)
|> Views.WebLog.uploadList
|> adminPage "Uploaded Files" true next ctx
}
// GET /admin/upload/new
let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
hashForPage "Upload a File"
|> withAntiCsrf ctx
|> addToHash "destination" (string ctx.WebLog.Uploads)
|> adminView "upload-new" next ctx
adminPage "Upload a File" true next ctx Views.WebLog.uploadNew
/// Redirect to the upload list
@@ -173,8 +167,8 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx
}
// POST /admin/upload/{id}/delete
let deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
// DELETE /admin/upload/{id}
let deleteFromDb upId : HttpHandler = fun next ctx -> task {
match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.Id with
| Ok fileName ->
do! addMessage ctx { UserMessage.Success with Message = $"{fileName} deleted successfully" }
@@ -193,8 +187,8 @@ let removeEmptyDirectories (webLog: WebLog) (filePath: string) =
path <- String.Join(slash, path.Split slash |> Array.rev |> Array.skip 1 |> Array.rev)
else finished <- true
// POST /admin/upload/delete/{**path}
let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
// DELETE /admin/upload/disk/{**path}
let deleteFromDisk urlParts : HttpHandler = fun next ctx -> task {
let filePath = urlParts |> Seq.skip 1 |> Seq.head
let path = Path.Combine(uploadDir, ctx.WebLog.Slug, filePath)
if File.Exists path then