Use most specific URL base match
- Add extensions for web log and data connection - Add forwarded header middleware
This commit is contained in:
parent
cbf87f5b49
commit
8631a76217
|
|
@ -2,16 +2,22 @@
|
|||
|
||||
open Microsoft.AspNetCore.Http
|
||||
|
||||
/// Helper functions for caches
|
||||
module Cache =
|
||||
/// Extension properties on HTTP context for web log
|
||||
[<AutoOpen>]
|
||||
module Extensions =
|
||||
|
||||
/// Create the cache key for the web log for the current request
|
||||
let makeKey (ctx : HttpContext) = (ctx.Items["webLog"] :?> WebLog).urlBase
|
||||
open Microsoft.Extensions.DependencyInjection
|
||||
open RethinkDb.Driver.Net
|
||||
|
||||
type HttpContext with
|
||||
/// The web log for the current request
|
||||
member this.WebLog = this.Items["webLog"] :?> WebLog
|
||||
|
||||
/// The RethinkDB data connection
|
||||
member this.Conn = this.RequestServices.GetRequiredService<IConnection> ()
|
||||
|
||||
|
||||
open System.Collections.Concurrent
|
||||
open Microsoft.Extensions.DependencyInjection
|
||||
open RethinkDb.Driver.Net
|
||||
|
||||
/// <summary>
|
||||
/// In-memory cache of web log details
|
||||
|
|
@ -27,15 +33,13 @@ module WebLogCache =
|
|||
/// The cache of web log details
|
||||
let mutable private _cache : WebLog list = []
|
||||
|
||||
/// Does a host exist in the cache?
|
||||
let exists ctx =
|
||||
/// Try to get the web log for the current request (longest matching URL base wins)
|
||||
let tryGet ctx =
|
||||
let path = fullPath ctx
|
||||
_cache |> List.exists (fun wl -> path.StartsWith wl.urlBase)
|
||||
|
||||
/// Get the web log for the current request
|
||||
let get ctx =
|
||||
let path = fullPath ctx
|
||||
_cache |> List.find (fun wl -> path.StartsWith wl.urlBase)
|
||||
_cache
|
||||
|> List.filter (fun wl -> path.StartsWith wl.urlBase)
|
||||
|> List.sortByDescending (fun wl -> wl.urlBase.Length)
|
||||
|> List.tryHead
|
||||
|
||||
/// Cache the web log for a particular host
|
||||
let set webLog =
|
||||
|
|
@ -57,17 +61,16 @@ module PageListCache =
|
|||
let private _cache = ConcurrentDictionary<string, DisplayPage[]> ()
|
||||
|
||||
/// Are there pages cached for this web log?
|
||||
let exists ctx = _cache.ContainsKey (Cache.makeKey ctx)
|
||||
let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.urlBase
|
||||
|
||||
/// Get the pages for the web log for this request
|
||||
let get ctx = _cache[Cache.makeKey ctx]
|
||||
let get (ctx : HttpContext) = _cache[ctx.WebLog.urlBase]
|
||||
|
||||
/// Update the pages for the current web log
|
||||
let update (ctx : HttpContext) = backgroundTask {
|
||||
let webLog = ctx.Items["webLog"] :?> WebLog
|
||||
let conn = ctx.RequestServices.GetRequiredService<IConnection> ()
|
||||
let! pages = Data.Page.findListed webLog.id conn
|
||||
_cache[Cache.makeKey ctx] <- pages |> List.map (DisplayPage.fromPage webLog) |> Array.ofList
|
||||
let webLog = ctx.WebLog
|
||||
let! pages = Data.Page.findListed webLog.id ctx.Conn
|
||||
_cache[webLog.urlBase] <- pages |> List.map (DisplayPage.fromPage webLog) |> Array.ofList
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -80,17 +83,15 @@ module CategoryCache =
|
|||
let private _cache = ConcurrentDictionary<string, DisplayCategory[]> ()
|
||||
|
||||
/// Are there categories cached for this web log?
|
||||
let exists ctx = _cache.ContainsKey (Cache.makeKey ctx)
|
||||
let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.urlBase
|
||||
|
||||
/// Get the categories for the web log for this request
|
||||
let get ctx = _cache[Cache.makeKey ctx]
|
||||
let get (ctx : HttpContext) = _cache[ctx.WebLog.urlBase]
|
||||
|
||||
/// Update the cache with fresh data
|
||||
let update (ctx : HttpContext) = backgroundTask {
|
||||
let webLog = ctx.Items["webLog"] :?> WebLog
|
||||
let conn = ctx.RequestServices.GetRequiredService<IConnection> ()
|
||||
let! cats = Data.Category.findAllForView webLog.id conn
|
||||
_cache[Cache.makeKey ctx] <- cats
|
||||
let! cats = Data.Category.findAllForView ctx.WebLog.id ctx.Conn
|
||||
_cache[ctx.WebLog.urlBase] <- cats
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,8 +1,6 @@
|
|||
/// Handlers to manipulate admin functions
|
||||
module MyWebLog.Handlers.Admin
|
||||
|
||||
// TODO: remove requireUser, as this is applied in the router
|
||||
|
||||
open System.Collections.Generic
|
||||
open System.IO
|
||||
|
||||
|
|
@ -22,10 +20,10 @@ open MyWebLog.ViewModels
|
|||
open RethinkDb.Driver.Net
|
||||
|
||||
// GET /admin
|
||||
let dashboard : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
let conn = conn ctx
|
||||
let getCount (f : WebLogId -> IConnection -> Task<int>) = f webLog.id conn
|
||||
let dashboard : HttpHandler = fun next ctx -> task {
|
||||
let webLogId = ctx.WebLog.id
|
||||
let conn = ctx.Conn
|
||||
let getCount (f : WebLogId -> IConnection -> Task<int>) = f webLogId conn
|
||||
let! posts = Data.Post.countByStatus Published |> getCount
|
||||
let! drafts = Data.Post.countByStatus Draft |> getCount
|
||||
let! pages = Data.Page.countAll |> getCount
|
||||
|
|
@ -50,7 +48,7 @@ let dashboard : HttpHandler = requireUser >=> fun next ctx -> task {
|
|||
// -- CATEGORIES --
|
||||
|
||||
// GET /admin/categories
|
||||
let listCategories : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let listCategories : HttpHandler = fun next ctx -> task {
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
categories = CategoryCache.get ctx
|
||||
|
|
@ -61,14 +59,12 @@ let listCategories : HttpHandler = requireUser >=> fun next ctx -> task {
|
|||
}
|
||||
|
||||
// GET /admin/category/{id}/edit
|
||||
let editCategory catId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
let conn = conn ctx
|
||||
let editCategory 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" })
|
||||
| _ ->
|
||||
match! Data.Category.findById (CategoryId catId) webLog.id conn with
|
||||
match! Data.Category.findById (CategoryId catId) ctx.WebLog.id ctx.Conn with
|
||||
| Some cat -> return Some ("Edit Category", cat)
|
||||
| None -> return None
|
||||
}
|
||||
|
|
@ -86,10 +82,10 @@ let editCategory catId : HttpHandler = requireUser >=> fun next ctx -> task {
|
|||
}
|
||||
|
||||
// POST /admin/category/save
|
||||
let saveCategory : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|
||||
let saveCategory : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
let conn = ctx.Conn
|
||||
let! model = ctx.BindFormAsync<EditCategoryModel> ()
|
||||
let webLog = webLog ctx
|
||||
let conn = conn ctx
|
||||
let! category = task {
|
||||
match model.categoryId with
|
||||
| "new" -> return Some { Category.empty with id = CategoryId.create (); webLogId = webLog.id }
|
||||
|
|
@ -114,10 +110,9 @@ let saveCategory : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -
|
|||
}
|
||||
|
||||
// POST /admin/category/{id}/delete
|
||||
let deleteCategory catId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
let conn = conn ctx
|
||||
match! Data.Category.delete (CategoryId catId) webLog.id conn with
|
||||
let deleteCategory catId : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
match! Data.Category.delete (CategoryId catId) webLog.id ctx.Conn with
|
||||
| true ->
|
||||
do! CategoryCache.update ctx
|
||||
do! addMessage ctx { UserMessage.success with message = "Category deleted successfully" }
|
||||
|
|
@ -129,9 +124,9 @@ let deleteCategory catId : HttpHandler = requireUser >=> validateCsrf >=> fun ne
|
|||
|
||||
// GET /admin/pages
|
||||
// GET /admin/pages/page/{pageNbr}
|
||||
let listPages pageNbr : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
let! pages = Data.Page.findPageOfPages webLog.id pageNbr (conn ctx)
|
||||
let listPages pageNbr : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
let! pages = Data.Page.findPageOfPages webLog.id pageNbr ctx.Conn
|
||||
return!
|
||||
Hash.FromAnonymousObject
|
||||
{| pages = pages |> List.map (DisplayPage.fromPageMinimal webLog)
|
||||
|
|
@ -141,12 +136,12 @@ let listPages pageNbr : HttpHandler = requireUser >=> fun next ctx -> task {
|
|||
}
|
||||
|
||||
// GET /admin/page/{id}/edit
|
||||
let editPage pgId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let editPage pgId : HttpHandler = fun next ctx -> task {
|
||||
let! result = task {
|
||||
match pgId with
|
||||
| "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new" })
|
||||
| _ ->
|
||||
match! Data.Page.findByFullId (PageId pgId) (webLog ctx).id (conn ctx) with
|
||||
match! Data.Page.findByFullId (PageId pgId) ctx.WebLog.id ctx.Conn with
|
||||
| Some page -> return Some ("Edit Page", page)
|
||||
| None -> return None
|
||||
}
|
||||
|
|
@ -167,8 +162,8 @@ let editPage pgId : HttpHandler = requireUser >=> fun next ctx -> task {
|
|||
}
|
||||
|
||||
// GET /admin/page/{id}/permalinks
|
||||
let editPagePermalinks pgId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
match! Data.Page.findByFullId (PageId pgId) (webLog ctx).id (conn ctx) with
|
||||
let editPagePermalinks pgId : HttpHandler = fun next ctx -> task {
|
||||
match! Data.Page.findByFullId (PageId pgId) ctx.WebLog.id ctx.Conn with
|
||||
| Some pg ->
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
|
|
@ -181,11 +176,11 @@ let editPagePermalinks pgId : HttpHandler = requireUser >=> fun next ctx -> task
|
|||
}
|
||||
|
||||
// POST /admin/page/permalinks
|
||||
let savePagePermalinks : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
let savePagePermalinks : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
|
||||
let links = model.prior |> Array.map Permalink |> List.ofArray
|
||||
match! Data.Page.updatePriorPermalinks (PageId model.id) webLog.id links (conn ctx) with
|
||||
match! Data.Page.updatePriorPermalinks (PageId model.id) webLog.id links ctx.Conn with
|
||||
| true ->
|
||||
do! addMessage ctx { UserMessage.success with message = "Page permalinks saved successfully" }
|
||||
return! redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/page/{model.id}/permalinks")) next ctx
|
||||
|
|
@ -193,9 +188,9 @@ let savePagePermalinks : HttpHandler = requireUser >=> validateCsrf >=> fun next
|
|||
}
|
||||
|
||||
// POST /admin/page/{id}/delete
|
||||
let deletePage pgId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
match! Data.Page.delete (PageId pgId) webLog.id (conn ctx) with
|
||||
let deletePage pgId : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
match! Data.Page.delete (PageId pgId) webLog.id ctx.Conn with
|
||||
| true -> do! addMessage ctx { UserMessage.success with message = "Page deleted successfully" }
|
||||
| false -> do! addMessage ctx { UserMessage.error with message = "Page not found; nothing deleted" }
|
||||
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/pages")) next ctx
|
||||
|
|
@ -206,10 +201,10 @@ open System
|
|||
#nowarn "3511"
|
||||
|
||||
// POST /admin/page/save
|
||||
let savePage : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|
||||
let savePage : HttpHandler = fun next ctx -> task {
|
||||
let! model = ctx.BindFormAsync<EditPageModel> ()
|
||||
let webLog = webLog ctx
|
||||
let conn = conn ctx
|
||||
let webLog = ctx.WebLog
|
||||
let conn = ctx.Conn
|
||||
let now = DateTime.UtcNow
|
||||
let! pg = task {
|
||||
match model.pageId with
|
||||
|
|
@ -261,9 +256,9 @@ let savePage : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> ta
|
|||
// -- WEB LOG SETTINGS --
|
||||
|
||||
// GET /admin/settings
|
||||
let settings : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
let! allPages = Data.Page.findAll webLog.id (conn ctx)
|
||||
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
|
||||
|
|
@ -284,9 +279,9 @@ let settings : HttpHandler = requireUser >=> fun next ctx -> task {
|
|||
}
|
||||
|
||||
// POST /admin/settings
|
||||
let saveSettings : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
let conn = conn ctx
|
||||
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 ->
|
||||
|
|
@ -312,8 +307,8 @@ let saveSettings : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -
|
|||
// -- TAG MAPPINGS --
|
||||
|
||||
// GET /admin/tag-mappings
|
||||
let tagMappings : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let! mappings = Data.TagMap.findByWebLogId (webLog ctx).id (conn ctx)
|
||||
let tagMappings : HttpHandler = fun next ctx -> task {
|
||||
let! mappings = Data.TagMap.findByWebLogId ctx.WebLog.id ctx.Conn
|
||||
return!
|
||||
Hash.FromAnonymousObject
|
||||
{| csrf = csrfToken ctx
|
||||
|
|
@ -325,13 +320,13 @@ let tagMappings : HttpHandler = requireUser >=> fun next ctx -> task {
|
|||
}
|
||||
|
||||
// GET /admin/tag-mapping/{id}/edit
|
||||
let editMapping tagMapId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let editMapping tagMapId : HttpHandler = fun next ctx -> task {
|
||||
let isNew = tagMapId = "new"
|
||||
let tagMap =
|
||||
if isNew then
|
||||
Task.FromResult (Some { TagMap.empty with id = TagMapId "new" })
|
||||
else
|
||||
Data.TagMap.findById (TagMapId tagMapId) (webLog ctx).id (conn ctx)
|
||||
Data.TagMap.findById (TagMapId tagMapId) ctx.WebLog.id ctx.Conn
|
||||
match! tagMap with
|
||||
| Some tm ->
|
||||
return!
|
||||
|
|
@ -345,9 +340,9 @@ let editMapping tagMapId : HttpHandler = requireUser >=> fun next ctx -> task {
|
|||
}
|
||||
|
||||
// POST /admin/tag-mapping/save
|
||||
let saveMapping : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
let conn = conn ctx
|
||||
let saveMapping : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
let conn = ctx.Conn
|
||||
let! model = ctx.BindFormAsync<EditTagMapModel> ()
|
||||
let tagMap =
|
||||
if model.id = "new" then
|
||||
|
|
@ -365,9 +360,9 @@ let saveMapping : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx ->
|
|||
}
|
||||
|
||||
// POST /admin/tag-mapping/{id}/delete
|
||||
let deleteMapping tagMapId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
match! Data.TagMap.delete (TagMapId tagMapId) webLog.id (conn ctx) with
|
||||
let deleteMapping tagMapId : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
match! Data.TagMap.delete (TagMapId tagMapId) webLog.id ctx.Conn with
|
||||
| true -> do! addMessage ctx { UserMessage.success with message = "Tag mapping deleted successfully" }
|
||||
| false -> do! addMessage ctx { UserMessage.error with message = "Tag mapping not found; nothing deleted" }
|
||||
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/tag-mappings")) next ctx
|
||||
|
|
|
|||
|
|
@ -9,10 +9,10 @@ open MyWebLog
|
|||
|
||||
/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
|
||||
let notAuthorized : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.Items["webLog"] :?> WebLog
|
||||
if ctx.Request.Method = "GET" then
|
||||
let returnUrl = WebUtility.UrlEncode ctx.Request.Path
|
||||
return! redirectTo false (WebLog.relativeUrl webLog (Permalink $"user/log-on?returnUrl={returnUrl}")) next ctx
|
||||
return!
|
||||
redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink $"user/log-on?returnUrl={returnUrl}")) next ctx
|
||||
else
|
||||
return! (setStatusCode 401 >=> fun _ _ -> Task.FromResult<HttpContext option> None) next ctx
|
||||
}
|
||||
|
|
|
|||
|
|
@ -64,20 +64,18 @@ let generator (ctx : HttpContext) =
|
|||
| Some gen -> gen
|
||||
| None ->
|
||||
let cfg = ctx.RequestServices.GetRequiredService<IConfiguration> ()
|
||||
generatorString <- Option.ofObj cfg["Generator"]
|
||||
defaultArg generatorString "generator not configured"
|
||||
generatorString <-
|
||||
match Option.ofObj cfg["Generator"] with
|
||||
| Some gen -> Some gen
|
||||
| None -> Some "generator not configured"
|
||||
generatorString.Value
|
||||
|
||||
open MyWebLog
|
||||
|
||||
/// Get the web log for the request from the context (established by middleware)
|
||||
let webLog (ctx : HttpContext) =
|
||||
ctx.Items["webLog"] :?> WebLog
|
||||
|
||||
open DotLiquid
|
||||
|
||||
/// Either get the web log from the hash, or get it from the cache and add it to the hash
|
||||
let private deriveWebLogFromHash (hash : Hash) ctx =
|
||||
if hash.ContainsKey "web_log" then () else hash.Add ("web_log", webLog ctx)
|
||||
let private deriveWebLogFromHash (hash : Hash) (ctx : HttpContext) =
|
||||
if hash.ContainsKey "web_log" then () else hash.Add ("web_log", ctx.WebLog)
|
||||
hash["web_log"] :?> WebLog
|
||||
|
||||
open Giraffe
|
||||
|
|
@ -125,11 +123,6 @@ open System.Security.Claims
|
|||
let userId (ctx : HttpContext) =
|
||||
WebLogUserId (ctx.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value
|
||||
|
||||
open RethinkDb.Driver.Net
|
||||
|
||||
/// Get the RethinkDB connection
|
||||
let conn (ctx : HttpContext) = ctx.RequestServices.GetRequiredService<IConnection> ()
|
||||
|
||||
open Microsoft.AspNetCore.Antiforgery
|
||||
|
||||
/// Get the Anti-CSRF service
|
||||
|
|
@ -153,11 +146,11 @@ open System.Collections.Generic
|
|||
open System.IO
|
||||
|
||||
/// Get the templates available for the current web log's theme (in a key/value pair list)
|
||||
let templatesForTheme ctx (typ : string) =
|
||||
let templatesForTheme (ctx : HttpContext) (typ : string) =
|
||||
seq {
|
||||
KeyValuePair.Create ("", $"- Default (single-{typ}) -")
|
||||
yield!
|
||||
Path.Combine ("themes", (webLog ctx).themePath)
|
||||
Path.Combine ("themes", ctx.WebLog.themePath)
|
||||
|> Directory.EnumerateFiles
|
||||
|> Seq.filter (fun it -> it.EndsWith $"{typ}.liquid")
|
||||
|> Seq.map (fun it ->
|
||||
|
|
@ -167,3 +160,24 @@ let templatesForTheme ctx (typ : string) =
|
|||
}
|
||||
|> Array.ofSeq
|
||||
|
||||
open Microsoft.Extensions.Logging
|
||||
|
||||
/// Log level for debugging
|
||||
let mutable private debugEnabled : bool option = None
|
||||
|
||||
/// Is debug enabled for handlers?
|
||||
let private isDebugEnabled (ctx : HttpContext) =
|
||||
match debugEnabled with
|
||||
| Some flag -> flag
|
||||
| None ->
|
||||
let fac = ctx.RequestServices.GetRequiredService<ILoggerFactory> ()
|
||||
let log = fac.CreateLogger "MyWebLog.Handlers"
|
||||
debugEnabled <- Some (log.IsEnabled LogLevel.Debug)
|
||||
debugEnabled.Value
|
||||
|
||||
/// Log a debug message
|
||||
let debug name ctx (msg : unit -> string) =
|
||||
if isDebugEnabled ctx then
|
||||
let fac = ctx.RequestServices.GetRequiredService<ILoggerFactory> ()
|
||||
let log = fac.CreateLogger $"MyWebLog.Handlers.{name}"
|
||||
log.LogDebug (msg ())
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
module MyWebLog.Handlers.Post
|
||||
|
||||
open System
|
||||
open Microsoft.AspNetCore.Http
|
||||
|
||||
/// Parse a slug and page number from an "everything else" URL
|
||||
let private parseSlugAndPage (slugAndPage : string seq) =
|
||||
|
|
@ -98,8 +99,8 @@ open Giraffe
|
|||
|
||||
// GET /page/{pageNbr}
|
||||
let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
let conn = conn ctx
|
||||
let webLog = ctx.WebLog
|
||||
let conn = ctx.Conn
|
||||
let! posts = Data.Post.findPageOfPublishedPosts webLog.id pageNbr webLog.postsPerPage conn
|
||||
let! hash = preparePostList webLog posts PostList "" pageNbr webLog.postsPerPage ctx conn
|
||||
let title =
|
||||
|
|
@ -115,8 +116,8 @@ let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
|
|||
// GET /category/{slug}/
|
||||
// GET /category/{slug}/page/{pageNbr}
|
||||
let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
let conn = conn ctx
|
||||
let webLog = ctx.WebLog
|
||||
let conn = ctx.Conn
|
||||
match parseSlugAndPage slugAndPage with
|
||||
| Some pageNbr, slug ->
|
||||
let allCats = CategoryCache.get ctx
|
||||
|
|
@ -145,8 +146,8 @@ open System.Web
|
|||
// GET /tag/{tag}/
|
||||
// GET /tag/{tag}/page/{pageNbr}
|
||||
let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
let conn = conn ctx
|
||||
let webLog = ctx.WebLog
|
||||
let conn = ctx.Conn
|
||||
match parseSlugAndPage slugAndPage with
|
||||
| Some pageNbr, rawTag ->
|
||||
let urlTag = HttpUtility.UrlDecode rawTag
|
||||
|
|
@ -178,11 +179,11 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
|
|||
|
||||
// GET /
|
||||
let home : HttpHandler = fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
let webLog = ctx.WebLog
|
||||
match webLog.defaultPage with
|
||||
| "posts" -> return! pageOfPosts 1 next ctx
|
||||
| pageId ->
|
||||
match! Data.Page.findById (PageId pageId) webLog.id (conn ctx) with
|
||||
match! Data.Page.findById (PageId pageId) webLog.id ctx.Conn with
|
||||
| Some page ->
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
|
|
@ -203,8 +204,8 @@ open System.Xml
|
|||
// GET /feed.xml
|
||||
// (Routing handled by catch-all handler for future configurability)
|
||||
let generateFeed : HttpHandler = fun next ctx -> backgroundTask {
|
||||
let conn = conn ctx
|
||||
let webLog = webLog ctx
|
||||
let webLog = ctx.WebLog
|
||||
let conn = ctx.Conn
|
||||
// TODO: hard-coded number of items
|
||||
let! posts = Data.Post.findPageOfPublishedPosts webLog.id 1 10 conn
|
||||
let! authors = getAuthors webLog posts conn
|
||||
|
|
@ -274,13 +275,16 @@ let generateFeed : HttpHandler = fun next ctx -> backgroundTask {
|
|||
}
|
||||
|
||||
/// Sequence where the first returned value is the proper handler for the link
|
||||
let private deriveAction ctx : HttpHandler seq =
|
||||
let webLog = webLog ctx
|
||||
let conn = conn ctx
|
||||
let private deriveAction (ctx : HttpContext) : HttpHandler seq =
|
||||
let webLog = ctx.WebLog
|
||||
let conn = ctx.Conn
|
||||
let textLink =
|
||||
let _, extra = WebLog.hostAndPath webLog
|
||||
let textLink = if extra = "" then ctx.Request.Path.Value else ctx.Request.Path.Value.Substring extra.Length
|
||||
let url = string ctx.Request.Path
|
||||
if extra = "" then url else url.Substring extra.Length
|
||||
let await it = (Async.AwaitTask >> Async.RunSynchronously) it
|
||||
seq {
|
||||
debug "Post" ctx (fun () -> $"Considering URL {textLink}")
|
||||
// Home page directory without the directory slash
|
||||
if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.empty)
|
||||
let permalink = Permalink (textLink.Substring 1)
|
||||
|
|
@ -329,9 +333,9 @@ let catchAll : HttpHandler = fun next ctx -> task {
|
|||
|
||||
// GET /admin/posts
|
||||
// GET /admin/posts/page/{pageNbr}
|
||||
let all pageNbr : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
let conn = conn ctx
|
||||
let all pageNbr : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
let conn = ctx.Conn
|
||||
let! posts = Data.Post.findPageOfPosts webLog.id pageNbr 25 conn
|
||||
let! hash = preparePostList webLog posts AdminList "" pageNbr 25 ctx conn
|
||||
hash.Add ("page_title", "Posts")
|
||||
|
|
@ -339,9 +343,9 @@ let all pageNbr : HttpHandler = requireUser >=> fun next ctx -> task {
|
|||
}
|
||||
|
||||
// GET /admin/post/{id}/edit
|
||||
let edit postId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
let conn = conn ctx
|
||||
let edit postId : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
let conn = ctx.Conn
|
||||
let! result = task {
|
||||
match postId with
|
||||
| "new" -> return Some ("Write a New Post", { Post.empty with id = PostId "new" })
|
||||
|
|
@ -365,8 +369,8 @@ let edit postId : HttpHandler = requireUser >=> fun next ctx -> task {
|
|||
}
|
||||
|
||||
// GET /admin/post/{id}/permalinks
|
||||
let editPermalinks postId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
match! Data.Post.findByFullId (PostId postId) (webLog ctx).id (conn ctx) with
|
||||
let editPermalinks postId : HttpHandler = fun next ctx -> task {
|
||||
match! Data.Post.findByFullId (PostId postId) ctx.WebLog.id ctx.Conn with
|
||||
| Some post ->
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
|
|
@ -379,11 +383,11 @@ let editPermalinks postId : HttpHandler = requireUser >=> fun next ctx -> task {
|
|||
}
|
||||
|
||||
// POST /admin/post/permalinks
|
||||
let savePermalinks : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
let savePermalinks : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
|
||||
let links = model.prior |> Array.map Permalink |> List.ofArray
|
||||
match! Data.Post.updatePriorPermalinks (PostId model.id) webLog.id links (conn ctx) with
|
||||
match! Data.Post.updatePriorPermalinks (PostId model.id) webLog.id links ctx.Conn with
|
||||
| true ->
|
||||
do! addMessage ctx { UserMessage.success with message = "Post permalinks saved successfully" }
|
||||
return! redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{model.id}/permalinks")) next ctx
|
||||
|
|
@ -391,9 +395,9 @@ let savePermalinks : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx
|
|||
}
|
||||
|
||||
// POST /admin/post/{id}/delete
|
||||
let delete postId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|
||||
let webLog = webLog ctx
|
||||
match! Data.Post.delete (PostId postId) webLog.id (conn ctx) with
|
||||
let delete postId : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
match! Data.Post.delete (PostId postId) webLog.id ctx.Conn with
|
||||
| true -> do! addMessage ctx { UserMessage.success with message = "Post deleted successfully" }
|
||||
| false -> do! addMessage ctx { UserMessage.error with message = "Post not found; nothing deleted" }
|
||||
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/posts")) next ctx
|
||||
|
|
@ -402,10 +406,10 @@ let delete postId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx
|
|||
#nowarn "3511"
|
||||
|
||||
// POST /admin/post/save
|
||||
let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|
||||
let save : HttpHandler = fun next ctx -> task {
|
||||
let! model = ctx.BindFormAsync<EditPostModel> ()
|
||||
let webLog = webLog ctx
|
||||
let conn = conn ctx
|
||||
let webLog = ctx.WebLog
|
||||
let conn = ctx.Conn
|
||||
let now = DateTime.UtcNow
|
||||
let! pst = task {
|
||||
match model.postId with
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ let router : HttpHandler = choose [
|
|||
])
|
||||
route "/user/edit" >=> User.edit
|
||||
]
|
||||
POST >=> choose [
|
||||
POST >=> validateCsrf >=> choose [
|
||||
subRoute "/category" (choose [
|
||||
route "/save" >=> Admin.saveCategory
|
||||
routef "/%s/delete" Admin.deleteCategory
|
||||
|
|
@ -65,7 +65,7 @@ let router : HttpHandler = choose [
|
|||
route "/log-on" >=> User.logOn None
|
||||
route "/log-off" >=> User.logOff
|
||||
]
|
||||
POST >=> choose [
|
||||
POST >=> validateCsrf >=> choose [
|
||||
route "/log-on" >=> User.doLogOn
|
||||
]
|
||||
])
|
||||
|
|
@ -79,7 +79,7 @@ let routerWithPath extraPath : HttpHandler =
|
|||
|
||||
/// Handler to apply Giraffe routing with a possible sub-route
|
||||
let handleRoute : HttpHandler = fun next ctx -> task {
|
||||
let _, extraPath = WebLog.hostAndPath (webLog ctx)
|
||||
let _, extraPath = WebLog.hostAndPath ctx.WebLog
|
||||
return! (if extraPath = "" then router else routerWithPath extraPath) next ctx
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -39,10 +39,10 @@ open Microsoft.AspNetCore.Authentication.Cookies
|
|||
open MyWebLog
|
||||
|
||||
// POST /user/log-on
|
||||
let doLogOn : HttpHandler = validateCsrf >=> fun next ctx -> task {
|
||||
let doLogOn : HttpHandler = fun next ctx -> task {
|
||||
let! model = ctx.BindFormAsync<LogOnModel> ()
|
||||
let webLog = webLog ctx
|
||||
match! Data.WebLogUser.findByEmail model.emailAddress webLog.id (conn ctx) with
|
||||
let webLog = ctx.WebLog
|
||||
match! Data.WebLogUser.findByEmail model.emailAddress webLog.id ctx.Conn with
|
||||
| Some user when user.passwordHash = hashedPassword model.password user.userName user.salt ->
|
||||
let claims = seq {
|
||||
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.id)
|
||||
|
|
@ -66,7 +66,7 @@ let doLogOn : HttpHandler = validateCsrf >=> fun next ctx -> task {
|
|||
let logOff : HttpHandler = fun next ctx -> task {
|
||||
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
|
||||
do! addMessage ctx { UserMessage.info with message = "Log off successful" }
|
||||
return! redirectToGet (WebLog.relativeUrl (webLog ctx) Permalink.empty) next ctx
|
||||
return! redirectToGet (WebLog.relativeUrl ctx.WebLog Permalink.empty) next ctx
|
||||
}
|
||||
|
||||
/// Display the user edit page, with information possibly filled in
|
||||
|
|
@ -77,8 +77,8 @@ let private showEdit (hash : Hash) : HttpHandler = fun next ctx -> task {
|
|||
}
|
||||
|
||||
// GET /admin/user/edit
|
||||
let edit : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
match! Data.WebLogUser.findById (userId ctx) (conn ctx) with
|
||||
let edit : HttpHandler = fun next ctx -> task {
|
||||
match! Data.WebLogUser.findById (userId ctx) ctx.Conn with
|
||||
| Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
|
@ -87,7 +87,7 @@ let edit : HttpHandler = requireUser >=> fun next ctx -> task {
|
|||
let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|
||||
let! model = ctx.BindFormAsync<EditUserModel> ()
|
||||
if model.newPassword = model.newPasswordConfirm then
|
||||
let conn = conn ctx
|
||||
let conn = ctx.Conn
|
||||
match! Data.WebLogUser.findById (userId ctx) conn with
|
||||
| Some user ->
|
||||
let pw, salt =
|
||||
|
|
@ -107,7 +107,7 @@ let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|
|||
do! Data.WebLogUser.update user conn
|
||||
let pwMsg = if model.newPassword = "" then "" else " and updated your password"
|
||||
do! addMessage ctx { UserMessage.success with message = $"Saved your information{pwMsg} successfully" }
|
||||
return! redirectToGet (WebLog.relativeUrl (webLog ctx) (Permalink "admin/user/edit")) next ctx
|
||||
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/user/edit")) next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
else
|
||||
do! addMessage ctx { UserMessage.error with message = "Passwords did not match; no updates made" }
|
||||
|
|
|
|||
|
|
@ -5,13 +5,13 @@ open MyWebLog
|
|||
type WebLogMiddleware (next : RequestDelegate) =
|
||||
|
||||
member this.InvokeAsync (ctx : HttpContext) = task {
|
||||
if WebLogCache.exists ctx then
|
||||
ctx.Items["webLog"] <- WebLogCache.get ctx
|
||||
match WebLogCache.tryGet ctx with
|
||||
| Some webLog ->
|
||||
ctx.Items["webLog"] <- webLog
|
||||
if PageListCache.exists ctx then () else do! PageListCache.update ctx
|
||||
if CategoryCache.exists ctx then () else do! CategoryCache.update ctx
|
||||
return! next.Invoke ctx
|
||||
else
|
||||
ctx.Response.StatusCode <- 404
|
||||
| None -> ctx.Response.StatusCode <- 404
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -151,6 +151,7 @@ open Giraffe.EndpointRouting
|
|||
open Microsoft.AspNetCore.Antiforgery
|
||||
open Microsoft.AspNetCore.Authentication.Cookies
|
||||
open Microsoft.AspNetCore.Builder
|
||||
open Microsoft.AspNetCore.HttpOverrides
|
||||
open Microsoft.Extensions.Configuration
|
||||
open Microsoft.Extensions.Logging
|
||||
open MyWebLog.ViewModels
|
||||
|
|
@ -161,6 +162,8 @@ open RethinkDb.Driver.FSharp
|
|||
let main args =
|
||||
|
||||
let builder = WebApplication.CreateBuilder(args)
|
||||
let _ = builder.Services.Configure<ForwardedHeadersOptions>(fun (opts : ForwardedHeadersOptions) ->
|
||||
opts.ForwardedHeaders <- ForwardedHeaders.XForwardedFor ||| ForwardedHeaders.XForwardedProto)
|
||||
let _ =
|
||||
builder.Services
|
||||
.AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme)
|
||||
|
|
@ -227,6 +230,7 @@ let main args =
|
|||
| Some it when it = "import-permalinks" ->
|
||||
NewWebLog.importPermalinks args app.Services |> Async.AwaitTask |> Async.RunSynchronously
|
||||
| _ ->
|
||||
let _ = app.UseForwardedHeaders ()
|
||||
let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
|
||||
let _ = app.UseMiddleware<WebLogMiddleware> ()
|
||||
let _ = app.UseAuthentication ()
|
||||
|
|
|
|||
|
|
@ -3,5 +3,10 @@
|
|||
"hostname": "data02.bitbadger.solutions",
|
||||
"database": "myWebLog_dev"
|
||||
},
|
||||
"Generator": "myWebLog 2.0-alpha08"
|
||||
"Generator": "myWebLog 2.0-alpha10",
|
||||
"Logging": {
|
||||
"LogLevel": {
|
||||
"MyWebLog.Handlers": "Debug"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user