V2 #1

Merged
danieljsummers merged 102 commits from v2 into main 2022-06-23 00:35:12 +00:00
9 changed files with 453 additions and 67 deletions
Showing only changes of commit afca5edfdd - Show all commits

View File

@ -82,14 +82,16 @@ module Startup =
indexCreate "priorPermalinks" [ Multi ] indexCreate "priorPermalinks" [ Multi ]
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
// Post needs index by category (used for counting posts) // Post needs indexes by category and tag (used for counting and retrieving posts)
if Table.Post = table && not (indexes |> List.contains "categoryIds") then if Table.Post = table then
log.LogInformation $"Creating index {table}.categoryIds..." for idx in [ "categoryIds"; "tags" ] do
do! rethink { if not (List.contains idx indexes) then
withTable table log.LogInformation $"Creating index {table}.{idx}..."
indexCreate "categoryIds" [ Multi ] do! rethink {
write; withRetryOnce; ignoreResult conn withTable table
} indexCreate idx [ Multi ]
write; withRetryOnce; ignoreResult conn
}
// Users log on with e-mail // Users log on with e-mail
if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then
log.LogInformation $"Creating index {table}.logOn..." log.LogInformation $"Creating index {table}.logOn..."
@ -194,6 +196,7 @@ module Category =
withTable Table.Post withTable Table.Post
getAll catIds "categoryIds" getAll catIds "categoryIds"
filter "status" Published filter "status" Published
distinct
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -395,6 +398,8 @@ module Page =
/// Functions to manipulate posts /// Functions to manipulate posts
module Post = module Post =
open System
/// Add a post /// Add a post
let add (post : Post) = let add (post : Post) =
rethink { rethink {
@ -445,6 +450,22 @@ module Post =
} }
|> tryFirst |> tryFirst
/// Find posts to be displayed on a category list page
let findPageOfCategorizedPosts (webLogId : WebLogId) (catIds : CategoryId list) (pageNbr : int64) postsPerPage =
let pg = int pageNbr
rethink<Post list> {
withTable Table.Post
getAll (catIds |> List.map (fun it -> it :> obj)) "categoryIds"
filter "webLogId" webLogId
filter "status" Published
without [ "priorPermalinks"; "revisions" ]
distinct
orderByDescending "publishedOn"
skip ((pg - 1) * postsPerPage)
limit (postsPerPage + 1)
result; withRetryDefault
}
/// Find posts to be displayed on an admin page /// Find posts to be displayed on an admin page
let findPageOfPosts (webLogId : WebLogId) (pageNbr : int64) postsPerPage = let findPageOfPosts (webLogId : WebLogId) (pageNbr : int64) postsPerPage =
let pg = int pageNbr let pg = int pageNbr
@ -472,6 +493,46 @@ module Post =
result; withRetryDefault result; withRetryDefault
} }
/// Find posts to be displayed on a tag list page
let findPageOfTaggedPosts (webLogId : WebLogId) (tag : string) (pageNbr : int64) postsPerPage =
let pg = int pageNbr
rethink<Post list> {
withTable Table.Post
getAll [ tag ] "tags"
filter "webLogId" webLogId
filter "status" Published
without [ "priorPermalinks"; "revisions" ]
orderByDescending "publishedOn"
skip ((pg - 1) * postsPerPage)
limit (postsPerPage + 1)
result; withRetryDefault
}
/// Find the next older and newer post for the given post
let findSurroundingPosts (webLogId : WebLogId) (publishedOn : DateTime) conn = backgroundTask {
let! older =
rethink<Post list> {
withTable Table.Post
getAll [ webLogId ] (nameof webLogId)
filter (fun row -> row.G("publishedOn").Lt publishedOn :> obj)
orderByDescending "publishedOn"
limit 1
result; withRetryDefault
}
|> tryFirst <| conn
let! newer =
rethink<Post list> {
withTable Table.Post
getAll [ webLogId ] (nameof webLogId)
filter (fun row -> row.G("publishedOn").Gt publishedOn :> obj)
orderBy "publishedOn"
limit 1
result; withRetryDefault
}
|> tryFirst <| conn
return older, newer
}
/// Update a post (all fields are updated) /// Update a post (all fields are updated)
let update (post : Post) = let update (post : Post) =
rethink { rethink {
@ -542,6 +603,14 @@ module WebLogUser =
} }
|> tryFirst |> tryFirst
/// Find a user by their ID
let findById (userId : WebLogUserId) =
rethink<WebLogUser> {
withTable Table.WebLogUser
get userId
resultOption; withRetryOptionDefault
}
/// Get a user ID -> name dictionary for the given user IDs /// Get a user ID -> name dictionary for the given user IDs
let findNames (webLogId : WebLogId) conn (userIds : WebLogUserId list) = backgroundTask { let findNames (webLogId : WebLogId) conn (userIds : WebLogUserId list) = backgroundTask {
let! users = rethink<WebLogUser list> { let! users = rethink<WebLogUser list> {
@ -552,3 +621,19 @@ module WebLogUser =
} }
return users |> List.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u }) return users |> List.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u })
} }
/// Update a user
let update (user : WebLogUser) =
rethink {
withTable Table.WebLogUser
get user.id
update [
"firstName", user.firstName :> obj
"lastName", user.lastName
"preferredName", user.preferredName
"passwordHash", user.passwordHash
"salt", user.salt
]
write; withRetryDefault; ignoreResult
}

View File

@ -14,7 +14,7 @@
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" /> <PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" /> <PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" /> <PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.8.0-alpha-0008" /> <PackageReference Include="RethinkDb.Driver.FSharp" Version="0.8.0-alpha-0009" />
<PackageReference Update="FSharp.Core" Version="6.0.3" /> <PackageReference Update="FSharp.Core" Version="6.0.3" />
</ItemGroup> </ItemGroup>

View File

@ -255,6 +255,32 @@ type EditPostModel =
} }
/// View model to edit a user
[<CLIMutable; NoComparison; NoEquality>]
type EditUserModel =
{ /// The user's first name
firstName : string
/// The user's last name
lastName : string
/// The user's preferred name
preferredName : string
/// A new password for the user
newPassword : string
/// A new password for the user, confirmed
newPasswordConfirm : string
}
/// Create an edit model from a user
static member fromUser (user : WebLogUser) =
{ firstName = user.firstName
lastName = user.lastName
preferredName = user.preferredName
newPassword = ""
newPasswordConfirm = ""
}
/// The model to use to allow a user to log on /// The model to use to allow a user to log on
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type LogOnModel = type LogOnModel =
@ -342,8 +368,14 @@ type PostDisplay =
/// The link to view newer (more recent) posts /// The link to view newer (more recent) posts
newerLink : string option newerLink : string option
/// The name of the next newer post (single-post only)
newerName : string option
/// The link to view older (less recent) posts /// The link to view older (less recent) posts
olderLink : string option olderLink : string option
/// The name of the next older post (single-post only)
olderName : string option
} }

View File

@ -1,15 +1,16 @@
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module MyWebLog.Handlers module MyWebLog.Handlers
open System
open System.Net
open System.Threading.Tasks
open System.Web
open DotLiquid open DotLiquid
open Giraffe open Giraffe
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open MyWebLog open MyWebLog
open MyWebLog.ViewModels open MyWebLog.ViewModels
open RethinkDb.Driver.Net open RethinkDb.Driver.Net
open System
open System.Net
open System.Threading.Tasks
/// Handlers for error conditions /// Handlers for error conditions
module Error = module Error =
@ -99,7 +100,7 @@ module private Helpers =
let mutable private generatorString : string option = None let mutable private generatorString : string option = None
/// Get the generator string /// Get the generator string
let private generator (ctx : HttpContext) = let generator (ctx : HttpContext) =
if Option.isNone generatorString then if Option.isNone generatorString then
let cfg = ctx.RequestServices.GetRequiredService<IConfiguration> () let cfg = ctx.RequestServices.GetRequiredService<IConfiguration> ()
generatorString <- Option.ofObj cfg["Generator"] generatorString <- Option.ofObj cfg["Generator"]
@ -458,51 +459,74 @@ module Page =
/// Handlers to manipulate posts /// Handlers to manipulate posts
module Post = module Post =
open System.IO
open System.ServiceModel.Syndication
open System.Xml
/// Split the "rest" capture for categories and tags into the page number and category/tag URL parts
let private pathAndPageNumber (ctx : HttpContext) =
let slugs = (string ctx.Request.RouteValues["slug"]).Split "/" |> Array.filter (fun it -> it <> "")
let pageIdx = Array.IndexOf (slugs, "page")
let pageNbr = if pageIdx > 0 then (int64 slugs[pageIdx + 1]) else 1L
let slugParts = if pageIdx > 0 then Array.truncate pageIdx slugs else slugs
pageNbr, String.Join ("/", slugParts)
/// The type of post list being prepared /// The type of post list being prepared
type ListType = type ListType =
| AdminList
| CategoryList | CategoryList
| TagList
| PostList | PostList
| SinglePost | SinglePost
| AdminList | TagList
/// Get all authors for a list of posts as metadata items
let private getAuthors (webLog : WebLog) (posts : Post list) conn =
posts
|> List.map (fun p -> p.authorId)
|> List.distinct
|> Data.WebLogUser.findNames webLog.id conn
/// Convert a list of posts into items ready to be displayed /// Convert a list of posts into items ready to be displayed
let private preparePostList (webLog : WebLog) (posts : Post list) listType pageNbr perPage ctx conn = task { let private preparePostList webLog posts listType url pageNbr perPage ctx conn = task {
let! authors = let! authors = getAuthors webLog posts conn
posts
|> List.map (fun p -> p.authorId)
|> List.distinct
|> Data.WebLogUser.findNames webLog.id conn
let postItems = let postItems =
posts posts
|> Seq.ofList |> Seq.ofList
|> Seq.truncate perPage |> Seq.truncate perPage
|> Seq.map (PostListItem.fromPost webLog) |> Seq.map (PostListItem.fromPost webLog)
|> Array.ofSeq |> Array.ofSeq
let! olderPost, newerPost =
match listType with
| SinglePost -> Data.Post.findSurroundingPosts webLog.id (List.head posts).publishedOn.Value conn
| _ -> Task.FromResult (None, None)
let newerLink = let newerLink =
match listType, pageNbr with match listType, pageNbr with
| SinglePost, _ -> Some "TODO: retrieve prior post" | SinglePost, _ -> newerPost |> Option.map (fun p -> Permalink.toString p.permalink)
| _, 1L -> None | _, 1L -> None
| PostList, 2L when webLog.defaultPage = "posts" -> Some "" | PostList, 2L when webLog.defaultPage = "posts" -> Some ""
| PostList, _ -> Some $"page/{pageNbr - 1L}" | PostList, _ -> Some $"page/{pageNbr - 1L}"
| CategoryList, _ -> Some "TODO" | CategoryList, 2L -> Some $"category/{url}/"
| TagList, _ -> Some "TODO" | CategoryList, _ -> Some $"category/{url}/page/{pageNbr - 1L}"
| TagList, 2L -> Some $"tag/{url}/"
| TagList, _ -> Some $"tag/{url}/page/{pageNbr - 1L}"
| AdminList, 2L -> Some "posts" | AdminList, 2L -> Some "posts"
| AdminList, _ -> Some $"posts/page/{pageNbr - 1L}" | AdminList, _ -> Some $"posts/page/{pageNbr - 1L}"
let olderLink = let olderLink =
match listType, List.length posts > perPage with match listType, List.length posts > perPage with
| SinglePost, _ -> Some "TODO: retrieve next post" | SinglePost, _ -> olderPost |> Option.map (fun p -> Permalink.toString p.permalink)
| _, false -> None | _, false -> None
| PostList, true -> Some $"page/{pageNbr + 1L}" | PostList, true -> Some $"page/{pageNbr + 1L}"
| CategoryList, true -> Some $"category/TODO-slug-goes-here/page/{pageNbr + 1L}" | CategoryList, true -> Some $"category/{url}/page/{pageNbr + 1L}"
| TagList, true -> Some $"tag/TODO-slug-goes-here/page/{pageNbr + 1L}" | TagList, true -> Some $"tag/{url}/page/{pageNbr + 1L}"
| AdminList, true -> Some $"posts/page/{pageNbr + 1L}" | AdminList, true -> Some $"posts/page/{pageNbr + 1L}"
let model = let model =
{ posts = postItems { posts = postItems
authors = authors authors = authors
subtitle = None subtitle = None
newerLink = newerLink newerLink = newerLink
newerName = newerPost |> Option.map (fun p -> p.title)
olderLink = olderLink olderLink = olderLink
olderName = olderPost |> Option.map (fun p -> p.title)
} }
return Hash.FromAnonymousObject {| model = model; categories = CategoryCache.get ctx |} return Hash.FromAnonymousObject {| model = model; categories = CategoryCache.get ctx |}
} }
@ -512,16 +536,60 @@ module Post =
let webLog = WebLogCache.get ctx let webLog = WebLogCache.get ctx
let conn = conn ctx let conn = conn ctx
let! posts = Data.Post.findPageOfPublishedPosts webLog.id pageNbr webLog.postsPerPage conn let! posts = Data.Post.findPageOfPublishedPosts webLog.id pageNbr webLog.postsPerPage conn
let! hash = preparePostList webLog posts PostList pageNbr webLog.postsPerPage ctx conn let! hash = preparePostList webLog posts PostList "" pageNbr webLog.postsPerPage ctx conn
let title = let title =
match pageNbr, webLog.defaultPage with match pageNbr, webLog.defaultPage with
| 1L, "posts" -> None | 1L, "posts" -> None
| _, "posts" -> Some $"Page {pageNbr}" | _, "posts" -> Some $"Page {pageNbr}"
| _, _ -> Some $"Page {pageNbr} &laquo; Posts" | _, _ -> Some $"Page {pageNbr} &laquo; Posts"
match title with Some ttl -> hash.Add ("page_title", ttl) | None -> () match title with Some ttl -> hash.Add ("page_title", ttl) | None -> ()
if pageNbr = 1L && webLog.defaultPage = "posts" then hash.Add ("is_home", true)
return! themedView "index" next ctx hash return! themedView "index" next ctx hash
} }
// GET /category/{slug}/
// GET /category/{slug}/page/{pageNbr}
let pageOfCategorizedPosts : HttpHandler = fun next ctx -> task {
let webLog = WebLogCache.get ctx
let conn = conn ctx
let pageNbr, slug = pathAndPageNumber ctx
let allCats = CategoryCache.get ctx
let cat = allCats |> Array.find (fun cat -> cat.slug = slug)
// Category pages include posts in subcategories
let catIds =
allCats
|> Seq.ofArray
|> Seq.filter (fun c -> c.id = cat.id || Array.contains cat.name c.parentNames)
|> Seq.map (fun c -> CategoryId c.id)
|> List.ofSeq
match! Data.Post.findPageOfCategorizedPosts webLog.id catIds pageNbr webLog.postsPerPage conn with
| posts when List.length posts > 0 ->
let! hash = preparePostList webLog posts CategoryList cat.slug pageNbr webLog.postsPerPage ctx conn
let pgTitle = if pageNbr = 1L then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
hash.Add ("page_title", $"{cat.name}: Category Archive{pgTitle}")
hash.Add ("subtitle", cat.description.Value)
hash.Add ("is_category", true)
return! themedView "index" next ctx hash
| _ -> return! Error.notFound next ctx
}
// GET /tag/{tag}/
// GET /tag/{tag}/page/{pageNbr}
let pageOfTaggedPosts : HttpHandler = fun next ctx -> task {
let webLog = WebLogCache.get ctx
let conn = conn ctx
let pageNbr, rawTag = pathAndPageNumber ctx
let tag = HttpUtility.UrlDecode rawTag
match! Data.Post.findPageOfTaggedPosts webLog.id tag pageNbr webLog.postsPerPage conn with
| posts when List.length posts > 0 ->
let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.postsPerPage ctx conn
let pgTitle = if pageNbr = 1L then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
hash.Add ("page_title", $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}")
hash.Add ("is_tag", true)
return! themedView "index" next ctx hash
| _ -> return! Error.notFound next ctx
}
// GET / // GET /
let home : HttpHandler = fun next ctx -> task { let home : HttpHandler = fun next ctx -> task {
let webLog = WebLogCache.get ctx let webLog = WebLogCache.get ctx
@ -531,41 +599,108 @@ module Post =
match! Data.Page.findById (PageId pageId) webLog.id (conn ctx) with match! Data.Page.findById (PageId pageId) webLog.id (conn ctx) with
| Some page -> | Some page ->
return! return!
Hash.FromAnonymousObject {| page = DisplayPage.fromPage webLog page; page_title = page.title |} Hash.FromAnonymousObject {|
page = DisplayPage.fromPage webLog page
page_title = page.title
is_home = true
|}
|> themedView (defaultArg page.template "single-page") next ctx |> themedView (defaultArg page.template "single-page") next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// GET {**link} // GET /feed.xml
let catchAll : HttpHandler = fun next ctx -> task { // (Routing handled by catch-all handler for future configurability)
let generateFeed : HttpHandler = fun next ctx -> backgroundTask {
let conn = conn ctx
let webLog = WebLogCache.get ctx
// TODO: hard-coded number of items
let! posts = Data.Post.findPageOfPublishedPosts webLog.id 1L 10 conn
let! authors = getAuthors webLog posts conn
let cats = CategoryCache.get ctx
let toItem (post : Post) =
let urlBase = $"https://{webLog.urlBase}/"
let item = SyndicationItem (
Id = $"{urlBase}{Permalink.toString post.permalink}",
Title = TextSyndicationContent.CreateHtmlContent post.title,
PublishDate = DateTimeOffset post.publishedOn.Value)
item.AddPermalink (Uri item.Id)
let doc = XmlDocument ()
let content = doc.CreateElement ("content", "encoded", "http://purl.org/rss/1.0/modules/content/")
content.InnerText <- post.text
.Replace("src=\"/", $"src=\"{urlBase}")
.Replace ("href=\"/", $"href=\"{urlBase}")
item.ElementExtensions.Add content
item.Authors.Add (SyndicationPerson (
Name = (authors |> List.find (fun a -> a.name = WebLogUserId.toString post.authorId)).value))
for catId in post.categoryIds do
let cat = cats |> Array.find (fun c -> c.id = CategoryId.toString catId)
item.Categories.Add (SyndicationCategory (cat.name, $"{urlBase}category/{cat.slug}/", cat.name))
for tag in post.tags do
let urlTag = tag.Replace (" ", "+")
item.Categories.Add (SyndicationCategory (tag, $"{urlBase}tag/{urlTag}/", $"{tag} (tag)"))
item
let feed = SyndicationFeed ()
feed.Title <- TextSyndicationContent webLog.name
feed.Description <- TextSyndicationContent <| defaultArg webLog.subtitle webLog.name
feed.LastUpdatedTime <- DateTimeOffset <| (List.head posts).updatedOn
feed.Generator <- generator ctx
feed.Items <- posts |> Seq.ofList |> Seq.map toItem
use mem = new MemoryStream ()
use xml = XmlWriter.Create mem
let formatter = Rss20FeedFormatter feed
formatter.WriteTo xml
xml.Close ()
let _ = mem.Seek (0L, SeekOrigin.Begin)
let rdr = new StreamReader(mem)
let! output = rdr.ReadToEndAsync ()
return! ( setHttpHeader "Content-Type" "text/xml" >=> setStatusCode 200 >=> setBodyFromString output) next ctx
}
/// Sequence where the first returned value is the proper handler for the link
let private deriveAction ctx : HttpHandler seq =
let webLog = WebLogCache.get ctx let webLog = WebLogCache.get ctx
let conn = conn ctx let conn = conn ctx
let permalink = (string >> Permalink) ctx.Request.RouteValues["link"] let permalink = (string >> Permalink) ctx.Request.RouteValues["link"]
// Current post let await it = (Async.AwaitTask >> Async.RunSynchronously) it
match! Data.Post.findByPermalink permalink webLog.id conn with seq {
| Some post -> // Current post
let! model = preparePostList webLog [ post ] SinglePost 1 1 ctx conn match Data.Post.findByPermalink permalink webLog.id conn |> await with
model.Add ("page_title", post.title) | Some post ->
return! themedView "single-post" next ctx model let model = preparePostList webLog [ post ] SinglePost "" 1 1 ctx conn |> await
| None -> model.Add ("page_title", post.title)
yield fun next ctx -> themedView "single-post" next ctx model
| None -> ()
// Current page // Current page
match! Data.Page.findByPermalink permalink webLog.id conn with match Data.Page.findByPermalink permalink webLog.id conn |> await with
| Some page -> | Some page ->
return! yield fun next ctx ->
Hash.FromAnonymousObject {| page = DisplayPage.fromPage webLog page; page_title = page.title |} Hash.FromAnonymousObject {| page = DisplayPage.fromPage webLog page; page_title = page.title |}
|> themedView (defaultArg page.template "single-page") next ctx |> themedView (defaultArg page.template "single-page") next ctx
| None -> | None -> ()
// Prior post // RSS feed
match! Data.Post.findCurrentPermalink permalink webLog.id conn with // TODO: configure this via web log
| Some link -> return! redirectTo true $"/{Permalink.toString link}" next ctx if Permalink.toString permalink = "feed.xml" then yield generateFeed
| None -> // Prior post
// Prior page match Data.Post.findCurrentPermalink permalink webLog.id conn |> await with
match! Data.Page.findCurrentPermalink permalink webLog.id conn with | Some link -> yield redirectTo true $"/{Permalink.toString link}"
| Some link -> return! redirectTo true $"/{Permalink.toString link}" next ctx | None -> ()
| None -> // Prior permalink
// We tried, we really did... match Data.Page.findCurrentPermalink permalink webLog.id conn |> await with
Console.Write($"Returning 404 for permalink |{permalink}|"); | Some link -> yield redirectTo true $"/{Permalink.toString link}"
return! Error.notFound next ctx | None -> ()
}
// GET {**link}
let catchAll : HttpHandler = fun next ctx -> task {
match deriveAction ctx |> Seq.tryHead with
| Some handler -> return! handler next ctx
| None -> return! Error.notFound next ctx
} }
// GET /posts // GET /posts
@ -574,7 +709,7 @@ module Post =
let webLog = WebLogCache.get ctx let webLog = WebLogCache.get ctx
let conn = conn ctx let conn = conn ctx
let! posts = Data.Post.findPageOfPosts webLog.id pageNbr 25 conn let! posts = Data.Post.findPageOfPosts webLog.id pageNbr 25 conn
let! hash = preparePostList webLog posts AdminList pageNbr 25 ctx conn let! hash = preparePostList webLog posts AdminList "" pageNbr 25 ctx conn
hash.Add ("page_title", "Posts") hash.Add ("page_title", "Posts")
return! viewForTheme "admin" "post-list" next ctx hash return! viewForTheme "admin" "post-list" next ctx hash
} }
@ -746,6 +881,52 @@ module User =
return! redirectToGet "/" next ctx return! redirectToGet "/" next ctx
} }
/// Display the user edit page, with information possibly filled in
let private showEdit (hash : Hash) : HttpHandler = fun next ctx -> task {
hash.Add ("page_title", "Edit Your Information")
hash.Add ("csrf", csrfToken ctx)
return! viewForTheme "admin" "user-edit" next ctx hash
}
// GET /user/edit
let edit : HttpHandler = requireUser >=> fun next ctx -> task {
match! Data.WebLogUser.findById (userId ctx) (conn ctx) with
| Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) next ctx
| None -> return! Error.notFound next ctx
}
// POST /user/save
let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel> ()
if model.newPassword = model.newPasswordConfirm then
let conn = conn ctx
match! Data.WebLogUser.findById (userId ctx) conn with
| Some user ->
let pw, salt =
if model.newPassword = "" then
user.passwordHash, user.salt
else
let newSalt = Guid.NewGuid ()
hashedPassword model.newPassword user.userName newSalt, newSalt
let user =
{ user with
firstName = model.firstName
lastName = model.lastName
preferredName = model.preferredName
passwordHash = pw
salt = salt
}
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 "/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" }
return! showEdit (Hash.FromAnonymousObject {|
model = { model with newPassword = ""; newPasswordConfirm = "" }
|}) next ctx
}
open Giraffe.EndpointRouting open Giraffe.EndpointRouting
@ -765,8 +946,9 @@ let endpoints = [
] ]
subRoute "/categor" [ subRoute "/categor" [
GET [ GET [
route "ies" Category.all route "ies" Category.all
routef "y/%s/edit" Category.edit routef "y/%s/edit" Category.edit
route "y/{**slug}" Post.pageOfCategorizedPosts
] ]
POST [ POST [
route "y/save" Category.save route "y/save" Category.save
@ -776,6 +958,7 @@ let endpoints = [
subRoute "/page" [ subRoute "/page" [
GET [ GET [
routef "/%d" Post.pageOfPosts routef "/%d" Post.pageOfPosts
//routef "/%d/" (fun pg -> redirectTo true $"/page/{pg}")
routef "/%s/edit" Page.edit routef "/%s/edit" Page.edit
route "s" (Page.all 1) route "s" (Page.all 1)
routef "s/page/%d" Page.all routef "s/page/%d" Page.all
@ -794,13 +977,20 @@ let endpoints = [
route "/save" Post.save route "/save" Post.save
] ]
] ]
subRoute "/tag" [
GET [
route "/{**slug}" Post.pageOfTaggedPosts
]
]
subRoute "/user" [ subRoute "/user" [
GET [ GET [
route "/edit" User.edit
route "/log-on" (User.logOn None) route "/log-on" (User.logOn None)
route "/log-off" User.logOff route "/log-off" User.logOff
] ]
POST [ POST [
route "/log-on" User.doLogOn route "/log-on" User.doLogOn
route "/save" User.save
] ]
] ]
route "{**link}" Post.catchAll route "{**link}" Post.catchAll

View File

@ -207,9 +207,9 @@ let main args =
[ // Domain types [ // Domain types
typeof<MetaItem>; typeof<Page>; typeof<WebLog> typeof<MetaItem>; typeof<Page>; typeof<WebLog>
// View models // View models
typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayPage>; typeof<EditCategoryModel> typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayPage>; typeof<EditCategoryModel>
typeof<EditPageModel>; typeof<EditPostModel>; typeof<LogOnModel>; typeof<PostDisplay> typeof<EditPageModel>; typeof<EditPostModel>; typeof<EditUserModel>; typeof<LogOnModel>
typeof<PostListItem>; typeof<SettingsModel>; typeof<UserMessage> typeof<PostDisplay>; typeof<PostListItem>; typeof<SettingsModel>; typeof<UserMessage>
// Framework types // Framework types
typeof<AntiforgeryTokenSet>; typeof<KeyValuePair>; typeof<MetaItem list>; typeof<string list> typeof<AntiforgeryTokenSet>; typeof<KeyValuePair>; typeof<MetaItem list>; typeof<string list>
typeof<string option> typeof<string option>

View File

@ -28,6 +28,7 @@
{%- endif %} {%- endif %}
<ul class="navbar-nav flex-grow-1 justify-content-end"> <ul class="navbar-nav flex-grow-1 justify-content-end">
{% if logged_on -%} {% if logged_on -%}
{{ "user/edit" | nav_link: "Edit User" }}
{{ "user/log-off" | nav_link: "Log Off" }} {{ "user/log-off" | nav_link: "Log Off" }}
{%- else -%} {%- else -%}
{{ "user/log-on" | nav_link: "Log On" }} {{ "user/log-on" | nav_link: "Log On" }}

View File

@ -0,0 +1,64 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="/user/save" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="container">
<div class="row mb-3">
<div class="col-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="firstName" id="firstName" class="form-control" autofocus required
placeholder="First" value="{{ model.first_name }}">
<label for="firstName">First Name</label>
</div>
</div>
<div class="col-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="lastName" id="lastName" class="form-control" required
placeholder="Last" value="{{ model.last_name }}">
<label for="lastName">Last Name</label>
</div>
</div>
<div class="col-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="preferredName" id="preferredName" class="form-control" required
placeholder="Preferred" value="{{ model.preferred_name }}">
<label for="preferredName">Preferred Name</label>
</div>
</div>
</div>
<div class="row mb-3">
<div class="col">
<fieldset class="container">
<legend>Change Password</legend>
<div class="row">
<div class="col">
<p class="form-text">Optional; leave blank to keep your current password</p>
</div>
</div>
<div class="row">
<div class="col">
<div class="form-floating">
<input type="password" name="newPassword" id="newPassword" class="form-control"
placeholder="Password">
<label for="newPassword">New Password</label>
</div>
</div>
<div class="col">
<div class="form-floating">
<input type="password" name="newPasswordConfirm" id="newPasswordConfirm" class="form-control"
placeholder="Confirm">
<label for="newPasswordConfirm">Confirm New Password</label>
</div>
</div>
</div>
</fieldset>
</div>
</div>
<div class="row">
<div class="col mb-3">
<button type="submit" class="btn btn-primary">Save Changes</button>
</div>
</div>
</div>
</form>
</article>

View File

@ -1,4 +1,10 @@
<div class="content"> <div class="content">
{% if is_category or is_tag %}
<h2>{{ page_title }}</h2>
{%- if subtitle %}
<p>{{ subtitle }}</p>
{%- endif %}
{% endif %}
{%- for post in model.posts %} {%- for post in model.posts %}
<article class="item"> <article class="item">
<h1 class="item-heading"> <h1 class="item-heading">
@ -8,7 +14,11 @@
</h1> </h1>
<h4 class="text-center"> <h4 class="text-center">
<i class="fa fa-calendar" title="Date"></i> {{ post.published_on | date: "MMMM d, yyyy" }} &nbsp; <i class="fa fa-calendar" title="Date"></i> {{ post.published_on | date: "MMMM d, yyyy" }} &nbsp;
<i class="fa fa-clock-o" title="Time"></i> {{ post.published_on | date: "h:mm tt" | downcase }} <i class="fa fa-clock-o" title="Time"></i> {{ post.published_on | date: "h:mm tt" | downcase }} &nbsp;
<i class="fa fa-user" title="Author"></i> {{ model.authors | value: post.author_id }}
{% if logged_on %}
&nbsp; <a href="/post/{{ post.id }}/edit"><i class="fa fa-pencil-square-o"></i> Edit Post</a>
{% endif %}
</h4> </h4>
{{ post.text }} {{ post.text }}
</article> </article>
@ -56,7 +66,7 @@
{% for cat in categories -%} {% for cat in categories -%}
{%- assign indent = cat.parent_names | size -%} {%- assign indent = cat.parent_names | size -%}
<li class="cat-list-item"{% if indent > 0 %} style="padding-left:{{ indent }}rem;"{% endif %}> <li class="cat-list-item"{% if indent > 0 %} style="padding-left:{{ indent }}rem;"{% endif %}>
<a href="/category/{{ cat.slug }}" class="cat-list-link">{{ cat.name }}</a> <a href="/category/{{ cat.slug }}/" class="cat-list-link">{{ cat.name }}</a>
<span class="cat-list-count">{{ cat.post_count }}</span> <span class="cat-list-count">{{ cat.post_count }}</span>
</li> </li>
{%- endfor %} {%- endfor %}

View File

@ -5,9 +5,13 @@
<h4 class="text-center"> <h4 class="text-center">
{% if post.published_on -%} {% if post.published_on -%}
<i class="fa fa-calendar" title="Date"></i> {{ post.published_on | date: "MMMM d, yyyy" }} &nbsp; <i class="fa fa-calendar" title="Date"></i> {{ post.published_on | date: "MMMM d, yyyy" }} &nbsp;
<i class="fa fa-clock-o" title="Time"></i> {{ post.published_on | date: "h:mm tt" | downcase }} <i class="fa fa-clock-o" title="Time"></i> {{ post.published_on | date: "h:mm tt" | downcase }} &nbsp;
{%- else -%} {%- else -%}
**DRAFT** **DRAFT** &nbsp;
{% endif %}
<i class="fa fa-user" title="Author"></i> {{ model.authors | value: post.author_id }}
{% if logged_on %}
&nbsp; <a href="/post/{{ post.id }}/edit"><i class="fa fa-pencil-square-o"></i> Edit Post</a>
{% endif %} {% endif %}
</h4> </h4>
<div>{{ post.text }}</div> <div>{{ post.text }}</div>
@ -19,7 +23,7 @@
{% assign cat = categories | where: "id", cat_id | first %} {% assign cat = categories | where: "id", cat_id | first %}
<span class="no-wrap"> <span class="no-wrap">
<i class="fa fa-folder-open-o" title="Category"></i> <i class="fa fa-folder-open-o" title="Category"></i>
<a href="/category/{{ cat.slug }}" title="Categorized under &ldquo;{{ cat.name | escape }}&rdquo;"> <a href="/category/{{ cat.slug }}/" title="Categorized under &ldquo;{{ cat.name | escape }}&rdquo;">
{{ cat.name }} {{ cat.name }}
</a> &nbsp; &nbsp; </a> &nbsp; &nbsp;
</span> </span>
@ -32,7 +36,7 @@
Tagged &nbsp; Tagged &nbsp;
{% for tag in post.tags %} {% for tag in post.tags %}
<span class="no-wrap"> <span class="no-wrap">
<a href="/tag/{{ tag | replace: " ", "-" }}" title="Posts tagged &ldquo;{{ tag | escape }}&rdquo;"> <a href="/tag/{{ tag | replace: " ", "+" }}/" title="Posts tagged &ldquo;{{ tag | escape }}&rdquo;">
<i class="fa fa-tag"></i> {{ tag }} <i class="fa fa-tag"></i> {{ tag }}
</a> &nbsp; &nbsp; </a> &nbsp; &nbsp;
</span> </span>
@ -46,7 +50,7 @@
{% if model.newer_link -%} {% if model.newer_link -%}
<li class="previous item"> <li class="previous item">
<h4 class="item-heading"><a href="/{{ model.newer_link.value }}">&laquo;</a> Previous Post</h4> <h4 class="item-heading"><a href="/{{ model.newer_link.value }}">&laquo;</a> Previous Post</h4>
<a href="/{{ model.newer_link.value }}">&ldquo;{{ model.newer_link.value }}&rdquo;</a> <a href="/{{ model.newer_link.value }}">{{ model.newer_name.value }}</a>
</li> </li>
{%- else -%} {%- else -%}
<li></li> <li></li>
@ -54,7 +58,7 @@
{% if model.older_link -%} {% if model.older_link -%}
<li class="next item"> <li class="next item">
<h4 class="item-heading">Next Post <a href="/{{ model.older_link.value }}">&raquo;</a></h4> <h4 class="item-heading">Next Post <a href="/{{ model.older_link.value }}">&raquo;</a></h4>
<a href="/{{ model.older_link.value }}">&ldquo;{{ model.older_link.value }}&rdquo;</a> <a href="/{{ model.older_link.value }}">{{ model.older_name.value }}</a>
</li> </li>
{%- endif -%} {%- endif -%}
</ul> </ul>