From 84e6e856f5089441eeab42c888da09fae7f8e2fb Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Tue, 12 Jul 2016 22:26:00 -0500 Subject: [PATCH] tag/category post pages, moved themes The "themes" directory will be used as the customization point --- src/myWebLog.Data/Category.fs | 9 ++ src/myWebLog.Data/Page.fs | 24 +++++ src/myWebLog.Data/Post.fs | 77 +++++++++---- src/myWebLog.Data/User.fs | 12 +++ src/myWebLog.Data/myWebLog.Data.fsproj | 1 + src/myWebLog.Resources/Resources.Designer.cs | 101 +++++++++++++++++- src/myWebLog.Resources/Resources.resx | 35 +++++- src/myWebLog.Web/ModuleExtensions.fs | 2 +- src/myWebLog.Web/PageModule.fs | 61 ++++++++++- src/myWebLog.Web/PostModule.fs | 75 ++++++++++--- src/myWebLog.Web/UserModule.fs | 67 ++++++++++++ src/myWebLog.Web/ViewModels.fs | 65 +++++++++++ src/myWebLog.Web/myWebLog.Web.fsproj | 1 + src/myWebLog/myWebLog.csproj | 16 +-- src/myWebLog/views/admin/page/edit.html | 57 ++++++++++ src/myWebLog/views/admin/user/logon.html | 41 +++++++ src/myWebLog/views/default/index.html | 5 - src/myWebLog/views/default/page.html | 5 - src/myWebLog/views/default/single.html | 5 - .../{ => themes}/default/index-content.html | 2 +- src/myWebLog/views/themes/default/index.html | 5 + .../views/{ => themes}/default/layout.html | 5 +- .../{ => themes}/default/page-content.html | 0 src/myWebLog/views/themes/default/page.html | 5 + .../{ => themes}/default/single-content.html | 0 src/myWebLog/views/themes/default/single.html | 5 + 26 files changed, 615 insertions(+), 66 deletions(-) create mode 100644 src/myWebLog.Data/User.fs create mode 100644 src/myWebLog.Web/UserModule.fs create mode 100644 src/myWebLog/views/admin/page/edit.html create mode 100644 src/myWebLog/views/admin/user/logon.html delete mode 100644 src/myWebLog/views/default/index.html delete mode 100644 src/myWebLog/views/default/page.html delete mode 100644 src/myWebLog/views/default/single.html rename src/myWebLog/views/{ => themes}/default/index-content.html (97%) create mode 100644 src/myWebLog/views/themes/default/index.html rename src/myWebLog/views/{ => themes}/default/layout.html (94%) rename src/myWebLog/views/{ => themes}/default/page-content.html (100%) create mode 100644 src/myWebLog/views/themes/default/page.html rename src/myWebLog/views/{ => themes}/default/single-content.html (100%) create mode 100644 src/myWebLog/views/themes/default/single.html diff --git a/src/myWebLog.Data/Category.fs b/src/myWebLog.Data/Category.fs index 7beea8f..e9e3540 100644 --- a/src/myWebLog.Data/Category.fs +++ b/src/myWebLog.Data/Category.fs @@ -130,3 +130,12 @@ let deleteCategory conn cat = |> delete |> runResultAsync conn |> ignore + +/// Get a category by its slug +let tryFindCategoryBySlug conn webLogId slug = + table Table.Category + |> getAll [| slug |] + |> optArg "index" "slug" + |> filter (fun c -> upcast c.["webLogId"].Eq(webLogId)) + |> runCursorAsync conn + |> Seq.tryHead diff --git a/src/myWebLog.Data/Page.fs b/src/myWebLog.Data/Page.fs index ccc3f1e..9e4d1de 100644 --- a/src/myWebLog.Data/Page.fs +++ b/src/myWebLog.Data/Page.fs @@ -1,7 +1,9 @@ module myWebLog.Data.Page +open FSharp.Interop.Dynamic open myWebLog.Entities open Rethink +open System.Dynamic /// Shorthand to get the page by its Id, filtering on web log Id let private page webLogId pageId = @@ -52,6 +54,28 @@ let findAllPages conn webLogId = |> runCursorAsync conn |> Seq.toList +/// Save a page +let savePage conn (pg : Page) = + match pg.id with + | "new" -> let newPage = { pg with id = string <| System.Guid.NewGuid() } + table Table.Page + |> insert page + |> runResultAsync conn + |> ignore + newPage.id + | _ -> let upd8 = ExpandoObject() + upd8?title <- pg.title + upd8?permalink <- pg.permalink + upd8?publishedOn <- pg.publishedOn + upd8?lastUpdatedOn <- pg.lastUpdatedOn + upd8?text <- pg.text + upd8?revisions <- pg.revisions + page pg.webLogId pg.id + |> update upd8 + |> runResultAsync conn + |> ignore + pg.id + /// Delete a page let deletePage conn webLogId pageId = page webLogId pageId diff --git a/src/myWebLog.Data/Post.fs b/src/myWebLog.Data/Post.fs index d73f7b3..eceadd6 100644 --- a/src/myWebLog.Data/Post.fs +++ b/src/myWebLog.Data/Post.fs @@ -9,37 +9,69 @@ open System.Dynamic let private r = RethinkDB.R -/// Get a page of published posts -let findPageOfPublishedPosts conn webLogId pageNbr nbrPerPage = +/// Shorthand to select all published posts for a web log +let private publishedPosts webLogId = table Table.Post |> getAll [| webLogId, PostStatus.Published |] |> optArg "index" "webLogAndStatus" + +/// Shorthand to sort posts by published date, slice for the given page, and return a list +let private toPostList conn pageNbr nbrPerPage filter = + filter |> orderBy (fun p -> upcast r.Desc(p.["publishedOn"])) |> slice ((pageNbr - 1) * nbrPerPage) (pageNbr * nbrPerPage) |> runCursorAsync conn |> Seq.toList -/// Try to get the next newest post from the given post -let tryFindNewerPost conn post = - table Table.Post - |> getAll [| post.webLogId, PostStatus.Published |] - |> optArg "index" "webLogAndStatus" - |> filter (fun p -> upcast p.["publishedOn"].Gt(post.publishedOn)) +/// Shorthand to get a newer or older post +let private adjacentPost conn post theFilter = + publishedPosts post.webLogId + |> filter theFilter |> orderBy (fun p -> upcast p.["publishedOn"]) |> limit 1 |> runCursorAsync conn |> Seq.tryHead + +/// Get a page of published posts +let findPageOfPublishedPosts conn webLogId pageNbr nbrPerPage = + publishedPosts webLogId + |> toPostList conn pageNbr nbrPerPage + +/// Get a page of published posts assigned to a given category +let findPageOfCategorizedPosts conn webLogId (categoryId : string) pageNbr nbrPerPage = + publishedPosts webLogId + |> filter (fun p -> upcast p.["categoryIds"].Contains(categoryId)) + |> toPostList conn pageNbr nbrPerPage + +/// Get a page of published posts tagged with a given tag +let findPageOfTaggedPosts conn webLogId (tag : string) pageNbr nbrPerPage = + publishedPosts webLogId + |> filter (fun p -> upcast p.["tags"].Contains(tag)) + |> toPostList conn pageNbr nbrPerPage + +/// Try to get the next newest post from the given post +let tryFindNewerPost conn post = adjacentPost conn post (fun p -> upcast p.["publishedOn"].Gt(post.publishedOn)) + +/// Try to get the next newest post assigned to the given category +let tryFindNewerCategorizedPost conn (categoryId : string) post = + adjacentPost conn post + (fun p -> upcast p.["publishedOn"].Gt(post.publishedOn).And(p.["categoryIds"].Contains(categoryId))) + +/// Try to get the next newest tagged post from the given tagged post +let tryFindNewerTaggedPost conn (tag : string) post = + adjacentPost conn post (fun p -> upcast p.["publishedOn"].Gt(post.publishedOn).And(p.["tags"].Contains(tag))) /// Try to get the next oldest post from the given post -let tryFindOlderPost conn post = - table Table.Post - |> getAll [| post.webLogId, PostStatus.Published |] - |> optArg "index" "webLogAndStatus" - |> filter (fun p -> upcast p.["publishedOn"].Lt(post.publishedOn)) - |> orderBy (fun p -> upcast r.Desc(p.["publishedOn"])) - |> limit 1 - |> runCursorAsync conn - |> Seq.tryHead +let tryFindOlderPost conn post = adjacentPost conn post (fun p -> upcast p.["publishedOn"].Lt(post.publishedOn)) + +/// Try to get the next oldest post assigned to the given category +let tryFindOlderCategorizedPost conn (categoryId : string) post = + adjacentPost conn post + (fun p -> upcast p.["publishedOn"].Lt(post.publishedOn).And(p.["categoryIds"].Contains(categoryId))) + +/// Try to get the next oldest tagged post from the given tagged post +let tryFindOlderTaggedPost conn (tag : string) post = + adjacentPost conn post (fun p -> upcast p.["publishedOn"].Lt(post.publishedOn).And(p.["tags"].Contains(tag))) /// Get a page of all posts in all statuses let findPageOfAllPosts conn webLogId pageNbr nbrPerPage = @@ -66,6 +98,7 @@ let tryFindPostByPermalink conn webLogId permalink = (table Table.Post |> getAll [| webLogId, permalink |] |> optArg "index" "permalink" + |> filter (fun p -> upcast p.["status"].Eq(PostStatus.Published)) |> without [| "revisions" |]) .Merge(fun post -> ExpandoObject()?categories <- post.["categoryIds"] @@ -80,11 +113,11 @@ let tryFindPostByPermalink conn webLogId permalink = |> Seq.tryHead /// Try to find a post by its prior permalink -let tryFindPostByPriorPermalink conn webLogId permalink = - (table Table.Post - |> getAll [| webLogId |] - |> optArg "index" "webLogId") - .Filter(fun post -> post.["priorPermalinks"].Contains(permalink :> obj)) +let tryFindPostByPriorPermalink conn webLogId (permalink : string) = + table Table.Post + |> getAll [| webLogId |] + |> optArg "index" "webLogId" + |> filter (fun p -> upcast p.["priorPermalinks"].Contains(permalink).And(p.["status"].Eq(PostStatus.Published))) |> without [| "revisions" |] |> runCursorAsync conn |> Seq.tryHead diff --git a/src/myWebLog.Data/User.fs b/src/myWebLog.Data/User.fs new file mode 100644 index 0000000..c45bb4c --- /dev/null +++ b/src/myWebLog.Data/User.fs @@ -0,0 +1,12 @@ +module myWebLog.Data.User + +open myWebLog.Entities +open Rethink + +/// Log on a user +let tryUserLogOn conn email passwordHash = + table Table.User + |> getAll [| email, passwordHash |] + |> optArg "index" "logOn" + |> runCursorAsync conn + |> Seq.tryHead diff --git a/src/myWebLog.Data/myWebLog.Data.fsproj b/src/myWebLog.Data/myWebLog.Data.fsproj index ba49719..7f038f0 100644 --- a/src/myWebLog.Data/myWebLog.Data.fsproj +++ b/src/myWebLog.Data/myWebLog.Data.fsproj @@ -59,6 +59,7 @@ + diff --git a/src/myWebLog.Resources/Resources.Designer.cs b/src/myWebLog.Resources/Resources.Designer.cs index edd0e09..4b1c60b 100644 --- a/src/myWebLog.Resources/Resources.Designer.cs +++ b/src/myWebLog.Resources/Resources.Designer.cs @@ -87,6 +87,15 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to Add New Page. + /// + public static string AddNewPage { + get { + return ResourceManager.GetString("AddNewPage", resourceCulture); + } + } + /// /// Looks up a localized string similar to Add New Post. /// @@ -186,6 +195,15 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to Edit Page. + /// + public static string EditPage { + get { + return ResourceManager.GetString("EditPage", resourceCulture); + } + } + /// /// Looks up a localized string similar to Edit Post. /// @@ -195,6 +213,24 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to E-mail Address. + /// + public static string EmailAddress { + get { + return ResourceManager.GetString("EmailAddress", resourceCulture); + } + } + + /// + /// Looks up a localized string similar to Invalid e-mail address or password. + /// + public static string ErrBadLogOnAttempt { + get { + return ResourceManager.GetString("ErrBadLogOnAttempt", resourceCulture); + } + } + /// /// Looks up a localized string similar to Could not convert data-config.json to RethinkDB connection. /// @@ -222,6 +258,15 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to Last Updated Date. + /// + public static string LastUpdatedDate { + get { + return ResourceManager.GetString("LastUpdatedDate", resourceCulture); + } + } + /// /// Looks up a localized string similar to List All. /// @@ -267,6 +312,24 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to Log off successful | Have a nice day!. + /// + public static string MsgLogOffSuccess { + get { + return ResourceManager.GetString("MsgLogOffSuccess", resourceCulture); + } + } + + /// + /// Looks up a localized string similar to Log on successful | Welcome to myWebLog!. + /// + public static string MsgLogOnSuccess { + get { + return ResourceManager.GetString("MsgLogOnSuccess", resourceCulture); + } + } + /// /// Looks up a localized string similar to Deleted page successfully. /// @@ -276,6 +339,15 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to {0} edited successfully. + /// + public static string MsgPageEditSuccess { + get { + return ResourceManager.GetString("MsgPageEditSuccess", resourceCulture); + } + } + /// /// Looks up a localized string similar to {0}{1} post successfully. /// @@ -339,6 +411,15 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to Page Details. + /// + public static string PageDetails { + get { + return ResourceManager.GetString("PageDetails", resourceCulture); + } + } + /// /// Looks up a localized string similar to Page #. /// @@ -366,6 +447,15 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to Password. + /// + public static string Password { + get { + return ResourceManager.GetString("Password", resourceCulture); + } + } + /// /// Looks up a localized string similar to Permalink. /// @@ -430,7 +520,7 @@ namespace myWebLog { } /// - /// Looks up a localized string similar to PublishedDate. + /// Looks up a localized string similar to Published Date. /// public static string PublishedDate { get { @@ -456,6 +546,15 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to Show in Page List. + /// + public static string ShowInPageList { + get { + return ResourceManager.GetString("ShowInPageList", resourceCulture); + } + } + /// /// Looks up a localized string similar to Slug. /// diff --git a/src/myWebLog.Resources/Resources.resx b/src/myWebLog.Resources/Resources.resx index c31b4cf..d1c13bd 100644 --- a/src/myWebLog.Resources/Resources.resx +++ b/src/myWebLog.Resources/Resources.resx @@ -205,7 +205,7 @@ Previous Post - PublishedDate + Published Date Publish This Post @@ -273,4 +273,37 @@ Slug + + Add New Page + + + Edit Page + + + E-mail Address + + + Invalid e-mail address or password + + + Last Updated Date + + + Log off successful | Have a nice day! + + + Log on successful | Welcome to myWebLog! + + + {0} edited successfully + + + Page Details + + + Password + + + Show in Page List + \ No newline at end of file diff --git a/src/myWebLog.Web/ModuleExtensions.fs b/src/myWebLog.Web/ModuleExtensions.fs index c5be2ba..c7e34ce 100644 --- a/src/myWebLog.Web/ModuleExtensions.fs +++ b/src/myWebLog.Web/ModuleExtensions.fs @@ -13,7 +13,7 @@ type NancyModule with member this.WebLog = this.Context.Items.[Keys.WebLog] :?> WebLog /// Display a view using the theme specified for the web log - member this.ThemedView view model = this.View.[(sprintf "%s/%s" this.WebLog.themePath view), model] + member this.ThemedView view model = this.View.[(sprintf "themes/%s/%s" this.WebLog.themePath view), model] /// Return a 404 member this.NotFound () = this.Negotiate.WithStatusCode 404 diff --git a/src/myWebLog.Web/PageModule.fs b/src/myWebLog.Web/PageModule.fs index fc0b2bc..fb74660 100644 --- a/src/myWebLog.Web/PageModule.fs +++ b/src/myWebLog.Web/PageModule.fs @@ -1,17 +1,22 @@ namespace myWebLog +open FSharp.Markdown open myWebLog.Data.Page open myWebLog.Entities open Nancy +open Nancy.ModelBinding open Nancy.Security +open NodaTime open RethinkDb.Driver.Net /// Handle /pages and /page URLs -type PageModule(conn : IConnection) as this = +type PageModule(conn : IConnection, clock : IClock) as this = inherit NancyModule() do this.Get .["/pages" ] <- fun _ -> upcast this.PageList () + this.Get .["/page/{id}/edit" ] <- fun parms -> upcast this.EditPage (downcast parms) + this.Post .["/page/{id}/edit" ] <- fun parms -> upcast this.SavePage (downcast parms) this.Delete.["/page/{id}/delete"] <- fun parms -> upcast this.DeletePage (downcast parms) /// List all pages @@ -21,7 +26,59 @@ type PageModule(conn : IConnection) as this = model.pageTitle <- Resources.Pages this.View.["admin/page/list", model] - // TODO: edit goes here! + /// Edit a page + member this.EditPage (parameters : DynamicDictionary) = + this.RequiresAccessLevel AuthorizationLevel.Administrator + let pageId : string = downcast parameters.["id"] + match (match pageId with + | "new" -> Some Page.empty + | _ -> tryFindPage conn this.WebLog.id pageId) with + | Some page -> let rev = match page.revisions + |> List.sortByDescending (fun r -> r.asOf) + |> List.tryHead with + | Some r -> r + | None -> Revision.empty + let model = EditPageModel(this.Context, this.WebLog, page, rev) + model.pageTitle <- match pageId with + | "new" -> Resources.AddNewPage + | _ -> Resources.EditPage + this.View.["admin/page/edit"] + | None -> this.NotFound () + + /// Save a page + member this.SavePage (parameters : DynamicDictionary) = + this.ValidateCsrfToken () + this.RequiresAccessLevel AuthorizationLevel.Administrator + let pageId : string = downcast parameters.["id"] + let form = this.Bind () + let now = clock.Now.Ticks + match (match pageId with + | "new" -> Some Page.empty + | _ -> tryFindPage conn this.WebLog.id pageId) with + | Some p -> let page = match pageId with + | "new" -> { p with webLogId = this.WebLog.id } + | _ -> p + let pId = { p with + title = form.title + permalink = form.permalink + publishedOn = match pageId with | "new" -> now | _ -> page.publishedOn + lastUpdatedOn = now + text = match form.source with + | RevisionSource.Markdown -> Markdown.TransformHtml form.text + | _ -> form.text + revisions = { asOf = now + sourceType = form.source + text = form.text } :: page.revisions } + |> savePage conn + let model = MyWebLogModel(this.Context, this.WebLog) + { level = Level.Info + message = System.String.Format + (Resources.MsgPageEditSuccess, + (match pageId with | "new" -> Resources.Added | _ -> Resources.Updated)) + details = None } + |> model.addMessage + this.Redirect (sprintf "/page/%s/edit" pId) model + | None -> this.NotFound () /// Delete a page member this.DeletePage (parameters : DynamicDictionary) = diff --git a/src/myWebLog.Web/PostModule.fs b/src/myWebLog.Web/PostModule.fs index eb45248..ebfe22e 100644 --- a/src/myWebLog.Web/PostModule.fs +++ b/src/myWebLog.Web/PostModule.fs @@ -12,25 +12,31 @@ open Nancy.Session.Persistable open NodaTime open RethinkDb.Driver.Net -/// Routes dealing with posts (including the home page and catch-all routes) +/// Routes dealing with posts (including the home page, /tag, /category, and catch-all routes) type PostModule(conn : IConnection, clock : IClock) as this = inherit NancyModule() - let getPage (parms : obj) = ((parms :?> DynamicDictionary).["page"] :?> int) + /// Get the page number from the dictionary + let getPage (parameters : DynamicDictionary) = + match parameters.ContainsKey "page" with | true -> downcast parameters.["page"] | _ -> 1 do - this.Get .["/" ] <- fun _ -> upcast this.HomePage () - this.Get .["/{permalink*}" ] <- fun parms -> upcast this.CatchAll (downcast parms) - this.Get .["/posts/page/{page:int}" ] <- fun parms -> upcast this.DisplayPageOfPublishedPosts (getPage parms) - this.Get .["/posts/list" ] <- fun _ -> upcast this.PostList 1 - this.Get .["/posts/list/page/{page:int}"] <- fun parms -> upcast this.PostList (getPage parms) - this.Get .["/post/{postId}/edit" ] <- fun parms -> upcast this.EditPost (downcast parms) - this.Post.["/post/{postId}/edit" ] <- fun parms -> upcast this.SavePost (downcast parms) + this.Get .["/" ] <- fun _ -> upcast this.HomePage () + this.Get .["/{permalink*}" ] <- fun parms -> upcast this.CatchAll (downcast parms) + this.Get .["/posts/page/{page:int}" ] <- fun parms -> upcast this.PublishedPostsPage (getPage <| downcast parms) + this.Get .["/category/{slug}" ] <- fun parms -> upcast this.CategorizedPosts (downcast parms) + this.Get .["/category/{slug}/page/{page:int}"] <- fun parms -> upcast this.CategorizedPosts (downcast parms) + this.Get .["/tag/{tag}" ] <- fun parms -> upcast this.TaggedPosts (downcast parms) + this.Get .["/tag/{tag}/page/{page:int}" ] <- fun parms -> upcast this.TaggedPosts (downcast parms) + this.Get .["/posts/list" ] <- fun _ -> upcast this.PostList 1 + this.Get .["/posts/list/page/{page:int}" ] <- fun parms -> upcast this.PostList (getPage <| downcast parms) + this.Get .["/post/{postId}/edit" ] <- fun parms -> upcast this.EditPost (downcast parms) + this.Post.["/post/{postId}/edit" ] <- fun parms -> upcast this.SavePost (downcast parms) // ---- Display posts to users ---- /// Display a page of published posts - member this.DisplayPageOfPublishedPosts pageNbr = + member this.PublishedPostsPage pageNbr = let model = PostsModel(this.Context, this.WebLog) model.pageNbr <- pageNbr model.posts <- findPageOfPublishedPosts conn this.WebLog.id pageNbr 10 @@ -49,8 +55,8 @@ type PostModule(conn : IConnection, clock : IClock) as this = /// Display either the newest posts or the configured home page member this.HomePage () = match this.WebLog.defaultPage with - | "posts" -> this.DisplayPageOfPublishedPosts 1 - | page -> match tryFindPageWithoutRevisions conn this.WebLog.id page with + | "posts" -> this.PublishedPostsPage 1 + | pageId -> match tryFindPageWithoutRevisions conn this.WebLog.id pageId with | Some page -> let model = PageModel(this.Context, this.WebLog, page) model.pageTitle <- page.title this.ThemedView "page" model @@ -77,9 +83,52 @@ type PostModule(conn : IConnection, clock : IClock) as this = | Some post -> // Redirect them to the proper permalink this.Negotiate .WithHeader("Location", sprintf "/%s" post.permalink) - .WithStatusCode(HttpStatusCode.MovedPermanently) + .WithStatusCode HttpStatusCode.MovedPermanently | None -> this.NotFound () + /// Display categorized posts + member this.CategorizedPosts (parameters : DynamicDictionary) = + let slug : string = downcast parameters.["slug"] + match tryFindCategoryBySlug conn this.WebLog.id slug with + | Some cat -> let pageNbr = getPage parameters + let model = PostsModel(this.Context, this.WebLog) + model.pageNbr <- pageNbr + model.posts <- findPageOfCategorizedPosts conn this.WebLog.id cat.id pageNbr 10 + model.hasNewer <- match List.isEmpty model.posts with + | true -> false + | _ -> Option.isSome <| tryFindNewerCategorizedPost conn cat.id + (List.last model.posts) + model.hasOlder <- match List.isEmpty model.posts with + | true -> false + | _ -> Option.isSome <| tryFindOlderCategorizedPost conn cat.id + (List.last model.posts) + model.urlPrefix <- sprintf "/category/%s" slug + model.pageTitle <- sprintf "\"%s\" Category%s" cat.name + (match pageNbr with | 1 -> "" | n -> sprintf " | Page %i" n) + model.subtitle <- Some <| match cat.description with + | Some desc -> desc + | None -> sprintf "Posts in the \"%s\" category" cat.name + this.ThemedView "posts" model + | None -> this.NotFound () + + /// Display tagged posts + member this.TaggedPosts (parameters : DynamicDictionary) = + let tag : string = downcast parameters.["tag"] + let pageNbr = getPage parameters + let model = PostsModel(this.Context, this.WebLog) + model.pageNbr <- pageNbr + model.posts <- findPageOfTaggedPosts conn this.WebLog.id tag pageNbr 10 + model.hasNewer <- match List.isEmpty model.posts with + | true -> false + | _ -> Option.isSome <| tryFindNewerTaggedPost conn tag (List.last model.posts) + model.hasOlder <- match List.isEmpty model.posts with + | true -> false + | _ -> Option.isSome <| tryFindOlderTaggedPost conn tag (List.last model.posts) + model.urlPrefix <- sprintf "/tag/%s" tag + model.pageTitle <- sprintf "\"%s\" Tag%s" tag (match pageNbr with | 1 -> "" | n -> sprintf " | Page %i" n) + model.subtitle <- Some <| sprintf "Posts tagged \"%s\"" tag + this.ThemedView "posts" model + // ---- Administer posts ---- diff --git a/src/myWebLog.Web/UserModule.fs b/src/myWebLog.Web/UserModule.fs new file mode 100644 index 0000000..ba4a176 --- /dev/null +++ b/src/myWebLog.Web/UserModule.fs @@ -0,0 +1,67 @@ +namespace myWebLog + +open myWebLog.Data.User +open myWebLog.Entities +open Nancy +open Nancy.Authentication.Forms +open Nancy.Cryptography +open Nancy.ModelBinding +open Nancy.Security +open Nancy.Session.Persistable +open RethinkDb.Driver.Net +open System.Text + +/// Handle /user URLs +type UserModule(conn : IConnection) as this = + inherit NancyModule("/user") + + /// Hash the user's password + let pbkdf2 (pw : string) = + PassphraseKeyGenerator(pw, UTF8Encoding().GetBytes("// TODO: make this salt part of the config"), 4096).GetBytes 512 + |> Seq.fold (fun acc bit -> System.String.Format("{0}{1:x2}", acc, bit)) "" + + do + this.Get .["/logon" ] <- fun parms -> upcast this.ShowLogOn (downcast parms) + this.Post.["/logon" ] <- fun parms -> upcast this.DoLogOn (downcast parms) + this.Get .["/logoff"] <- fun parms -> upcast this.LogOff () + + /// Show the log on page + member this.ShowLogOn (parameters : DynamicDictionary) = + let model = LogOnModel(this.Context, this.WebLog) + model.returnUrl <- defaultArg (Option.ofObj(downcast parameters.["returnUrl"])) "" + this.View.["admin/user/logon", model] + + /// Process a user log on + member this.DoLogOn (parameters : DynamicDictionary) = + this.ValidateCsrfToken () + let model = this.Bind () + match tryUserLogOn conn model.email (pbkdf2 model.password) with + | Some user -> this.Session.[Keys.User] <- user + { level = Level.Info + message = Resources.MsgLogOnSuccess + details = None } + |> model.addMessage + this.Redirect "" model |> ignore // Save the messages in the session before the Nancy redirect + // TODO: investigate if addMessage should update the session when it's called + this.LoginAndRedirect + (System.Guid.Parse user.id, fallbackRedirectUrl = defaultArg (Option.ofObj(model.returnUrl)) "/") + | None -> { level = Level.Error + message = Resources.ErrBadLogOnAttempt + details = None } + |> model.addMessage + this.Redirect "" model |> ignore // Save the messages in the session before the Nancy redirect + // Can't redirect with a negotiator when the other leg uses a straight response... :/ + this.Response.AsRedirect((sprintf "/user/logon?returnUrl=%s" model.returnUrl), + Responses.RedirectResponse.RedirectType.SeeOther) + + /// Log a user off + member this.LogOff () = + let user = this.Request.PersistableSession.GetOrDefault (Keys.User, User.empty) + this.Session.DeleteAll () + let model = MyWebLogModel(this.Context, this.WebLog) + { level = Level.Info + message = Resources.MsgLogOffSuccess + details = None } + |> model.addMessage + this.Redirect "" model |> ignore + this.LogoutAndRedirect "/" diff --git a/src/myWebLog.Web/ViewModels.fs b/src/myWebLog.Web/ViewModels.fs index eac66e3..e9c595e 100644 --- a/src/myWebLog.Web/ViewModels.fs +++ b/src/myWebLog.Web/ViewModels.fs @@ -162,6 +162,55 @@ type PagesModel(ctx, webLog, pages) = /// The pages member this.pages : Page list = pages + +/// Form used to edit a page +type EditPageForm() = + /// The title of the page + member val title = "" with get, set + /// The link for the page + member val permalink = "" with get, set + /// The source type of the revision + member val source = "" with get, set + /// The text of the revision + member val text = "" with get, set + /// Whether to show the page in the web log's page list + member val showInPageList = false with get, set + + /// Fill the form with applicable values from a page + member this.forPage (page : Page) = + this.title <- page.title + this.permalink <- page.permalink + this.showInPageList <- page.showInPageList + this + + /// Fill the form with applicable values from a revision + member this.forRevision rev = + this.source <- rev.sourceType + this.text <- rev.text + this + + +/// Model for the edit page page +type EditPageModel(ctx, webLog, page, revision) = + inherit MyWebLogModel(ctx, webLog) + /// The page edit form + member val form = EditPageForm().forPage(page).forRevision(revision) + /// The page itself + member this.page = page + /// The page's published date + member this.publishedDate = this.displayLongDate page.publishedOn + /// The page's published time + member this.publishedTime = this.displayTime page.publishedOn + /// The page's last updated date + member this.lastUpdatedDate = this.displayLongDate page.lastUpdatedOn + /// The page's last updated time + member this.lastUpdatedTime = this.displayTime page.lastUpdatedOn + /// Is this a new page? + member this.isNew = "new" = page.id + /// Generate a checked attribute if this page shows in the page list + member this.pageListChecked = match page.showInPageList with | true -> "checked=\"checked\"" | _ -> "" + + // ---- Post models ---- /// Model for post display @@ -188,6 +237,9 @@ type PostModel(ctx, webLog, post) = type PostsModel(ctx, webLog) = inherit MyWebLogModel(ctx, webLog) + /// The subtitle for the page + member val subtitle = Option.None with get, set + /// The posts to display member val posts = List.empty with get, set @@ -260,3 +312,16 @@ type EditPostModel(ctx, webLog, post, revision) = member this.publishedDate = this.displayLongDate this.post.publishedOn /// The published time member this.publishedTime = this.displayTime this.post.publishedOn + + +// ---- User models ---- + +/// Model to support the user log on page +type LogOnModel(ctx, webLog) = + inherit MyWebLogModel(ctx, webLog) + /// The URL to which the user will be directed upon successful log on + member val returnUrl = "" with get, set + /// The e-mail address + member val email = "" with get, set + /// The user's passwor + member val password = "" with get, set diff --git a/src/myWebLog.Web/myWebLog.Web.fsproj b/src/myWebLog.Web/myWebLog.Web.fsproj index a5e5e43..6204272 100644 --- a/src/myWebLog.Web/myWebLog.Web.fsproj +++ b/src/myWebLog.Web/myWebLog.Web.fsproj @@ -58,6 +58,7 @@ + diff --git a/src/myWebLog/myWebLog.csproj b/src/myWebLog/myWebLog.csproj index c86e362..f6d928b 100644 --- a/src/myWebLog/myWebLog.csproj +++ b/src/myWebLog/myWebLog.csproj @@ -72,16 +72,18 @@ + - - - - - - - + + + + + + + + +
+ +
+ +
+
+
@Translate.PageDetails
+
+ @IfNot.isNew +
+ +

@Model.publishedDate
@Model.publishedTime

+
+
+ +

@Model.lastUpdatedDate
@Model.lastUpdatedTime

+
+ @EndIf +
+ +   +
+
+
+
+

+
+
+ + +@EndSection + +@Section['Scripts'] + + +@EndSection diff --git a/src/myWebLog/views/admin/user/logon.html b/src/myWebLog/views/admin/user/logon.html new file mode 100644 index 0000000..287ea15 --- /dev/null +++ b/src/myWebLog/views/admin/user/logon.html @@ -0,0 +1,41 @@ +@Master['admin/admin-layout'] + +@Section['Content'] +
+ @AntiForgeryToken + +
+
+
+ + +
+
+
+
+
+
+
+ + +
+
+
+
+
+

+
+ +

+
+
+
+@EndSection + +@Section['Scripts'] + +@EndSection diff --git a/src/myWebLog/views/default/index.html b/src/myWebLog/views/default/index.html deleted file mode 100644 index 1bd0be6..0000000 --- a/src/myWebLog/views/default/index.html +++ /dev/null @@ -1,5 +0,0 @@ -@Master['default/layout'] - -@Section['Content'] - @Partial['default/index-content', Model] -@EndSection \ No newline at end of file diff --git a/src/myWebLog/views/default/page.html b/src/myWebLog/views/default/page.html deleted file mode 100644 index d6ab560..0000000 --- a/src/myWebLog/views/default/page.html +++ /dev/null @@ -1,5 +0,0 @@ -@Master['default/layout'] - -@Section['Content'] - @Partial['default/page-content', Model] -@EndSection \ No newline at end of file diff --git a/src/myWebLog/views/default/single.html b/src/myWebLog/views/default/single.html deleted file mode 100644 index 8dceb73..0000000 --- a/src/myWebLog/views/default/single.html +++ /dev/null @@ -1,5 +0,0 @@ -@Master['default/layout'] - -@Section['Content'] - @Partial['default/single-content', Model] -@EndSection \ No newline at end of file diff --git a/src/myWebLog/views/default/index-content.html b/src/myWebLog/views/themes/default/index-content.html similarity index 97% rename from src/myWebLog/views/default/index-content.html rename to src/myWebLog/views/themes/default/index-content.html index 0706aed..7b1edb2 100644 --- a/src/myWebLog/views/default/index-content.html +++ b/src/myWebLog/views/themes/default/index-content.html @@ -1,4 +1,4 @@ -@If.subTitle +@If.subTitle.IsSome

@Model.subTitle

diff --git a/src/myWebLog/views/themes/default/index.html b/src/myWebLog/views/themes/default/index.html new file mode 100644 index 0000000..dbf4978 --- /dev/null +++ b/src/myWebLog/views/themes/default/index.html @@ -0,0 +1,5 @@ +@Master['themes/default/layout'] + +@Section['Content'] + @Partial['themes/default/index-content', Model] +@EndSection \ No newline at end of file diff --git a/src/myWebLog/views/default/layout.html b/src/myWebLog/views/themes/default/layout.html similarity index 94% rename from src/myWebLog/views/default/layout.html rename to src/myWebLog/views/themes/default/layout.html index ed430a1..fd3161a 100644 --- a/src/myWebLog/views/default/layout.html +++ b/src/myWebLog/views/themes/default/layout.html @@ -19,9 +19,8 @@

@Model.webLog.subtitle

    @If.isAuthenticated diff --git a/src/myWebLog/views/default/page-content.html b/src/myWebLog/views/themes/default/page-content.html similarity index 100% rename from src/myWebLog/views/default/page-content.html rename to src/myWebLog/views/themes/default/page-content.html diff --git a/src/myWebLog/views/themes/default/page.html b/src/myWebLog/views/themes/default/page.html new file mode 100644 index 0000000..29da8d0 --- /dev/null +++ b/src/myWebLog/views/themes/default/page.html @@ -0,0 +1,5 @@ +@Master['themes/default/layout'] + +@Section['Content'] + @Partial['themes/default/page-content', Model] +@EndSection \ No newline at end of file diff --git a/src/myWebLog/views/default/single-content.html b/src/myWebLog/views/themes/default/single-content.html similarity index 100% rename from src/myWebLog/views/default/single-content.html rename to src/myWebLog/views/themes/default/single-content.html diff --git a/src/myWebLog/views/themes/default/single.html b/src/myWebLog/views/themes/default/single.html new file mode 100644 index 0000000..951fd83 --- /dev/null +++ b/src/myWebLog/views/themes/default/single.html @@ -0,0 +1,5 @@ +@Master['themes/default/layout'] + +@Section['Content'] + @Partial['themes/default/single-content', Model] +@EndSection \ No newline at end of file