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

WIP on storing themes in database

Browse Source
This commit is contained in:
Daniel J. Summers
2022-06-06 22:58:59 -04:00
parent 5cd0212ae9
commit ae729e008e
99 changed files with 420 additions and 2947 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -50,7 +50,7 @@ let dashboard : HttpHandler = fun next ctx -> task {
// GET /admin/categories
let listCategories : HttpHandler = fun next ctx -> task {
let! catListTemplate = TemplateCache.get "admin" "category-list-body"
let! catListTemplate = TemplateCache.get "admin" "category-list-body" ctx.Conn
let hash = Hash.FromAnonymousObject {|
web_log = ctx.WebLog
categories = CategoryCache.get ctx
@@ -271,49 +271,6 @@ let savePage : HttpHandler = fun next ctx -> task {
| None -> return! Error.notFound next ctx
}
// -- WEB LOG SETTINGS --
// GET /admin/settings
let settings : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let! allPages = Data.Page.findAll webLog.id ctx.Conn
return!
Hash.FromAnonymousObject
{| csrf = csrfToken ctx
model = SettingsModel.fromWebLog webLog
pages =
seq {
KeyValuePair.Create ("posts", "- First Page of Posts -")
yield! allPages
|> List.sortBy (fun p -> p.title.ToLower ())
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.id, p.title))
}
|> Array.ofSeq
themes = themes ()
web_log = webLog
page_title = "Web Log Settings"
|}
|> viewForTheme "admin" "settings" next ctx
}
// POST /admin/settings
let saveSettings : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let conn = ctx.Conn
let! model = ctx.BindFormAsync<SettingsModel> ()
match! Data.WebLog.findById webLog.id conn with
| Some webLog ->
let webLog = model.update webLog
do! Data.WebLog.updateSettings webLog conn
// Update cache
WebLogCache.set webLog
do! addMessage ctx { UserMessage.success with message = "Web log settings saved successfully" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings")) next ctx
| None -> return! Error.notFound next ctx
}
// -- TAG MAPPINGS --
open Microsoft.AspNetCore.Http
@@ -332,7 +289,7 @@ let private tagMappingHash (ctx : HttpContext) = task {
// GET /admin/settings/tag-mappings
let tagMappings : HttpHandler = fun next ctx -> task {
let! hash = tagMappingHash ctx
let! listTemplate = TemplateCache.get "admin" "tag-mapping-list-body"
let! listTemplate = TemplateCache.get "admin" "tag-mapping-list-body" ctx.Conn
hash.Add ("tag_mapping_list", listTemplate.Render hash)
hash.Add ("page_title", "Tag Mappings")
@@ -392,3 +349,156 @@ let deleteMapping tagMapId : HttpHandler = fun next ctx -> task {
| false -> do! addMessage ctx { UserMessage.error with message = "Tag mapping not found; nothing deleted" }
return! tagMappingsBare next ctx
}
// -- THEMES --
open System.IO.Compression
open System.Text.RegularExpressions
// GET /admin/theme/update
let themeUpdatePage : HttpHandler = fun next ctx -> task {
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
page_title = "Upload Theme"
|}
|> viewForTheme "admin" "upload-theme" next ctx
}
/// Update the name and version for a theme based on the version.txt file, if present
let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = backgroundTask {
let now () = DateTime.UtcNow.ToString "yyyyMMdd.HHmm"
match zip.Entries |> Seq.filter (fun it -> it.FullName = "version.txt") |> Seq.tryHead with
| Some versionItem ->
use versionFile = new StreamReader(versionItem.Open ())
let! versionText = versionFile.ReadToEndAsync ()
let parts = versionText.Trim().Replace("\r", "").Split "\n"
let displayName = if parts[0] > "" then parts[0] else ThemeId.toString theme.id
let version = if parts.Length > 1 && parts[1] > "" then parts[1] else now ()
return { theme with name = displayName; version = version }
| None ->
return { theme with name = ThemeId.toString theme.id; version = now () }
}
/// Delete all theme assets, and remove templates from theme
let private checkForCleanLoad (theme : Theme) cleanLoad conn = backgroundTask {
if cleanLoad then
do! Data.ThemeAsset.deleteByTheme theme.id conn
return { theme with templates = [] }
else
return theme
}
/// Update the theme with all templates from the ZIP archive
let private updateTemplates (theme : Theme) (zip : ZipArchive) = backgroundTask {
let tasks =
zip.Entries
|> Seq.filter (fun it -> it.Name.EndsWith ".liquid")
|> Seq.map (fun templateItem -> backgroundTask {
use templateFile = new StreamReader (templateItem.Open ())
let! template = templateFile.ReadToEndAsync ()
return { name = templateItem.Name.Replace (".liquid", ""); text = template }
})
let! templates = Task.WhenAll tasks
return
templates
|> Array.fold (fun t template ->
{ t with templates = template :: (t.templates |> List.filter (fun it -> it.name <> template.name)) })
theme
}
/// Update theme assets from the ZIP archive
let private updateAssets themeId (zip : ZipArchive) conn = backgroundTask {
for asset in zip.Entries |> Seq.filter (fun it -> it.FullName.StartsWith "wwwroot") do
let assetName = asset.FullName.Replace ("wwwroot/", "")
if assetName <> "" && not (assetName.EndsWith "/") then
use stream = new MemoryStream ()
do! asset.Open().CopyToAsync stream
do! Data.ThemeAsset.save
{ id = ThemeAssetId (themeId, assetName)
updatedOn = asset.LastWriteTime.DateTime
data = stream.ToArray ()
} conn
}
/// Load a theme from the given stream, which should contain a ZIP archive
let loadThemeFromZip themeName file clean conn = backgroundTask {
use zip = new ZipArchive (file, ZipArchiveMode.Read)
let themeId = ThemeId themeName
let! theme = backgroundTask {
match! Data.Theme.findById themeId conn with
| Some t -> return t
| None -> return { Theme.empty with id = themeId }
}
let! theme = updateNameAndVersion theme zip
let! theme = checkForCleanLoad theme clean conn
let! theme = updateTemplates theme zip
do! updateAssets themeId zip conn
do! Data.Theme.save theme conn
}
// POST /admin/theme/update
let updateTheme : HttpHandler = fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let themeFile = Seq.head ctx.Request.Form.Files
let themeName = themeFile.FileName.Split(".").[0].ToLowerInvariant().Replace (" ", "-")
// TODO: add restriction for admin theme based on role
if Regex.IsMatch (themeName, """^[a-z0-9\-]+$""") then
use stream = new MemoryStream ()
do! themeFile.CopyToAsync stream
do! loadThemeFromZip themeName stream true ctx.Conn
do! addMessage ctx { UserMessage.success with message = "Theme updated successfully" }
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/dashboard")) next ctx
else
do! addMessage ctx { UserMessage.error with message = $"Theme name {themeName} is invalid" }
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/theme/update")) next ctx
else
return! RequestErrors.BAD_REQUEST "Bad request" next ctx
}
// -- WEB LOG SETTINGS --
// GET /admin/settings
let settings : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let! allPages = Data.Page.findAll webLog.id ctx.Conn
let! themes = Data.Theme.list ctx.Conn
return!
Hash.FromAnonymousObject
{| csrf = csrfToken ctx
model = SettingsModel.fromWebLog webLog
pages =
seq {
KeyValuePair.Create ("posts", "- First Page of Posts -")
yield! allPages
|> List.sortBy (fun p -> p.title.ToLower ())
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.id, p.title))
}
|> Array.ofSeq
themes = themes
|> Seq.ofList
|> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.id, $"{it.name} (v{it.version})"))
|> Array.ofSeq
web_log = webLog
page_title = "Web Log Settings"
|}
|> viewForTheme "admin" "settings" next ctx
}
// POST /admin/settings
let saveSettings : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let conn = ctx.Conn
let! model = ctx.BindFormAsync<SettingsModel> ()
match! Data.WebLog.findById webLog.id conn with
| Some webLog ->
let webLog = model.update webLog
do! Data.WebLog.updateSettings webLog conn
// Update cache
WebLogCache.set webLog
do! addMessage ctx { UserMessage.success with message = "Web log settings saved successfully" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings")) next ctx
| None -> return! Error.notFound next ctx
}

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

@@ -108,12 +108,12 @@ let viewForTheme theme template next ctx = fun (hash : Hash) -> task {
// the net effect is a "layout" capability similar to Razor or Pug
// Render view content...
let! contentTemplate = TemplateCache.get theme template
let! contentTemplate = TemplateCache.get theme template ctx.Conn
hash.Add ("content", contentTemplate.Render hash)
// ...then render that content with its layout
let isHtmx = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
let! layoutTemplate = TemplateCache.get theme (if isHtmx then "layout-partial" else "layout")
let! layoutTemplate = TemplateCache.get theme (if isHtmx then "layout-partial" else "layout") ctx.Conn
return! htmlString (layoutTemplate.Render hash) next ctx
}
@@ -123,10 +123,10 @@ let bareForTheme theme template next ctx = fun (hash : Hash) -> task {
do! populateHash hash ctx
// Bare templates are rendered with layout-bare
let! contentTemplate = TemplateCache.get theme template
let! contentTemplate = TemplateCache.get theme template ctx.Conn
hash.Add ("content", contentTemplate.Render hash)
let! layoutTemplate = TemplateCache.get theme "layout-bare"
let! layoutTemplate = TemplateCache.get theme "layout-bare" ctx.Conn
// add messages as HTTP headers
let messages = hash["messages"] :?> UserMessage[]

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

@@ -2,13 +2,13 @@
module MyWebLog.Handlers.Routes
open Giraffe
open Microsoft.AspNetCore.Http
open MyWebLog
/// Module to resolve routes that do not match any other known route (web blog content)
module CatchAll =
open DotLiquid
open Microsoft.AspNetCore.Http
open MyWebLog.ViewModels
/// Sequence where the first returned value is the proper handler for the link
@@ -89,6 +89,48 @@ module CatchAll =
| None -> return! Error.notFound next ctx
}
/// Serve theme assets
module Asset =
open System
open Microsoft.AspNetCore.Http.Headers
open Microsoft.AspNetCore.StaticFiles
open Microsoft.Net.Http.Headers
/// Determine if the asset has been modified since the date/time specified by the If-Modified-Since header
let private checkModified asset (ctx : HttpContext) : HttpHandler option =
match ctx.Request.Headers.IfModifiedSince with
| it when it.Count < 1 -> None
| it ->
if asset.updatedOn > DateTime.Parse it[0] then
None
else
Some (setStatusCode 304 >=> setBodyFromString "Not Modified")
/// An instance of ASP.NET Core's file extension to MIME type converter
let private mimeMap = FileExtensionContentTypeProvider ()
// GET /theme/{theme}/{**path}
let serveAsset (urlParts : string seq) : HttpHandler = fun next ctx -> task {
let path = urlParts |> Seq.skip 1 |> Seq.head
match! Data.ThemeAsset.findById (ThemeAssetId.ofString path) ctx.Conn with
| Some asset ->
match checkModified asset ctx with
| Some threeOhFour -> return! threeOhFour next ctx
| None ->
let mimeType =
match mimeMap.TryGetContentType path with
| true, typ -> typ
| false, _ -> "application/octet-stream"
let headers = ResponseHeaders ctx.Response.Headers
headers.LastModified <- Some (DateTimeOffset asset.updatedOn) |> Option.toNullable
headers.ContentType <- MediaTypeHeaderValue mimeType
return! setBody asset.data next ctx
| None -> return! Error.notFound next ctx
}
/// The primary myWebLog router
let router : HttpHandler = choose [
GET >=> choose [
@@ -126,7 +168,8 @@ let router : HttpHandler = choose [
routef "/%s/edit" Admin.editMapping
])
])
route "/user/edit" >=> User.edit
route "/theme/update" >=> Admin.themeUpdatePage
route "/user/edit" >=> User.edit
]
POST >=> validateCsrf >=> choose [
subRoute "/category" (choose [
@@ -155,15 +198,17 @@ let router : HttpHandler = choose [
routef "/%s/delete" Admin.deleteMapping
])
])
route "/user/save" >=> User.save
route "/theme/update" >=> Admin.updateTheme
route "/user/save" >=> User.save
]
])
GET >=> routexp "/category/(.*)" Post.pageOfCategorizedPosts
GET >=> routef "/page/%i" Post.pageOfPosts
GET >=> routef "/page/%i/" Post.redirectToPageOfPosts
GET >=> routexp "/tag/(.*)" Post.pageOfTaggedPosts
GET_HEAD >=> routexp "/category/(.*)" Post.pageOfCategorizedPosts
GET_HEAD >=> routef "/page/%i" Post.pageOfPosts
GET_HEAD >=> routef "/page/%i/" Post.redirectToPageOfPosts
GET_HEAD >=> routexp "/tag/(.*)" Post.pageOfTaggedPosts
GET_HEAD >=> routexp "/themes/(.*)" Asset.serveAsset
subRoute "/user" (choose [
GET >=> choose [
GET_HEAD >=> choose [
route "/log-on" >=> User.logOn None
route "/log-off" >=> User.logOff
]
@@ -171,7 +216,7 @@ let router : HttpHandler = choose [
route "/log-on" >=> User.doLogOn
]
])
GET >=> CatchAll.route
GET_HEAD >=> CatchAll.route
Error.notFound
]