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

tag/category post pages, moved themes

Browse Source 
The "themes" directory will be used as the customization point
This commit is contained in:
Daniel J. Summers 2016-07-12 22:26:00 -05:00
parent 08ee8990d3
commit 84e6e856f5
26 changed files with 615 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/myWebLog.Data/Category.fs
View File

@ -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<Category> conn
|> Seq.tryHead

24
src/myWebLog.Data/Page.fs
View File

@ -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<Page> 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

77
src/myWebLog.Data/Post.fs
View File

@ -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<Post> 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<Post> 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<Post> 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<Post> conn
|> Seq.tryHead

12
src/myWebLog.Data/User.fs Normal file
View File

@ -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<User> conn
|> Seq.tryHead

1
src/myWebLog.Data/myWebLog.Data.fsproj
View File

@ -59,6 +59,7 @@
<Compile Include="Category.fs" />
<Compile Include="Page.fs" />
<Compile Include="Post.fs" />
<Compile Include="User.fs" />
<Compile Include="WebLog.fs" />
<Content Include="packages.config" />
</ItemGroup>

101
src/myWebLog.Resources/Resources.Designer.cs generated
View File

@ -87,6 +87,15 @@ namespace myWebLog {
}
}
/// <summary>
/// Looks up a localized string similar to Add New Page.
/// </summary>
public static string AddNewPage {
get {
return ResourceManager.GetString("AddNewPage", resourceCulture);
}
}
/// <summary>
/// Looks up a localized string similar to Add New Post.
/// </summary>
@ -186,6 +195,15 @@ namespace myWebLog {
}
}
/// <summary>
/// Looks up a localized string similar to Edit Page.
/// </summary>
public static string EditPage {
get {
return ResourceManager.GetString("EditPage", resourceCulture);
}
}
/// <summary>
/// Looks up a localized string similar to Edit Post.
/// </summary>
@ -195,6 +213,24 @@ namespace myWebLog {
}
}
/// <summary>
/// Looks up a localized string similar to E-mail Address.
/// </summary>
public static string EmailAddress {
get {
return ResourceManager.GetString("EmailAddress", resourceCulture);
}
}
/// <summary>
/// Looks up a localized string similar to Invalid e-mail address or password.
/// </summary>
public static string ErrBadLogOnAttempt {
get {
return ResourceManager.GetString("ErrBadLogOnAttempt", resourceCulture);
}
}
/// <summary>
/// Looks up a localized string similar to Could not convert data-config.json to RethinkDB connection.
/// </summary>
@ -222,6 +258,15 @@ namespace myWebLog {
}
}
/// <summary>
/// Looks up a localized string similar to Last Updated Date.
/// </summary>
public static string LastUpdatedDate {
get {
return ResourceManager.GetString("LastUpdatedDate", resourceCulture);
}
}
/// <summary>
/// Looks up a localized string similar to List All.
/// </summary>
@ -267,6 +312,24 @@ namespace myWebLog {
}
}
/// <summary>
/// Looks up a localized string similar to Log off successful | Have a nice day!.
/// </summary>
public static string MsgLogOffSuccess {
get {
return ResourceManager.GetString("MsgLogOffSuccess", resourceCulture);
}
}
/// <summary>
/// Looks up a localized string similar to Log on successful | Welcome to myWebLog!.
/// </summary>
public static string MsgLogOnSuccess {
get {
return ResourceManager.GetString("MsgLogOnSuccess", resourceCulture);
}
}
/// <summary>
/// Looks up a localized string similar to Deleted page successfully.
/// </summary>
@ -276,6 +339,15 @@ namespace myWebLog {
}
}
/// <summary>
/// Looks up a localized string similar to {0} edited successfully.
/// </summary>
public static string MsgPageEditSuccess {
get {
return ResourceManager.GetString("MsgPageEditSuccess", resourceCulture);
}
}
/// <summary>
/// Looks up a localized string similar to {0}{1} post successfully.
/// </summary>
@ -339,6 +411,15 @@ namespace myWebLog {
}
}
/// <summary>
/// Looks up a localized string similar to Page Details.
/// </summary>
public static string PageDetails {
get {
return ResourceManager.GetString("PageDetails", resourceCulture);
}
}
/// <summary>
/// Looks up a localized string similar to Page #.
/// </summary>
@ -366,6 +447,15 @@ namespace myWebLog {
}
}
/// <summary>
/// Looks up a localized string similar to Password.
/// </summary>
public static string Password {
get {
return ResourceManager.GetString("Password", resourceCulture);
}
}
/// <summary>
/// Looks up a localized string similar to Permalink.
/// </summary>
@ -430,7 +520,7 @@ namespace myWebLog {
}
/// <summary>
/// Looks up a localized string similar to PublishedDate.
/// Looks up a localized string similar to Published Date.
/// </summary>
public static string PublishedDate {
get {
@ -456,6 +546,15 @@ namespace myWebLog {
}
}
/// <summary>
/// Looks up a localized string similar to Show in Page List.
/// </summary>
public static string ShowInPageList {
get {
return ResourceManager.GetString("ShowInPageList", resourceCulture);
}
}
/// <summary>
/// Looks up a localized string similar to Slug.
/// </summary>

35
src/myWebLog.Resources/Resources.resx
View File

@ -205,7 +205,7 @@
<value>Previous Post</value>
</data>
<data name="PublishedDate" xml:space="preserve">
<value>PublishedDate</value>
<value>Published Date</value>
</data>
<data name="PublishThisPost" xml:space="preserve">
<value>Publish This Post</value>
@ -273,4 +273,37 @@
<data name="Slug" xml:space="preserve">
<value>Slug</value>
</data>
<data name="AddNewPage" xml:space="preserve">
<value>Add New Page</value>
</data>
<data name="EditPage" xml:space="preserve">
<value>Edit Page</value>
</data>
<data name="EmailAddress" xml:space="preserve">
<value>E-mail Address</value>
</data>
<data name="ErrBadLogOnAttempt" xml:space="preserve">
<value>Invalid e-mail address or password</value>
</data>
<data name="LastUpdatedDate" xml:space="preserve">
<value>Last Updated Date</value>
</data>
<data name="MsgLogOffSuccess" xml:space="preserve">
<value>Log off successful | Have a nice day!</value>
</data>
<data name="MsgLogOnSuccess" xml:space="preserve">
<value>Log on successful | Welcome to myWebLog!</value>
</data>
<data name="MsgPageEditSuccess" xml:space="preserve">
<value>{0} edited successfully</value>
</data>
<data name="PageDetails" xml:space="preserve">
<value>Page Details</value>
</data>
<data name="Password" xml:space="preserve">
<value>Password</value>
</data>
<data name="ShowInPageList" xml:space="preserve">
<value>Show in Page List</value>
</data>
</root>

2
src/myWebLog.Web/ModuleExtensions.fs
View File

@ -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

61
src/myWebLog.Web/PageModule.fs
View File

@ -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<EditPageForm> ()
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) =

75
src/myWebLog.Web/PostModule.fs
View File

@ -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 ----

67
src/myWebLog.Web/UserModule.fs Normal file
View File

@ -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<LogOnModel> ()
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<User> (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 "/"

65
src/myWebLog.Web/ViewModels.fs
View File

@ -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<string>.None with get, set
/// The posts to display
member val posts = List.empty<Post> 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

1
src/myWebLog.Web/myWebLog.Web.fsproj
View File

@ -58,6 +58,7 @@
<Compile Include="CategoryModule.fs" />
<Compile Include="PageModule.fs" />
<Compile Include="PostModule.fs" />
<Compile Include="UserModule.fs" />
<Compile Include="App.fs" />
<Content Include="packages.config" />
</ItemGroup>

16
src/myWebLog/myWebLog.csproj
View File

@ -72,16 +72,18 @@
<Content Include="views\admin\category\edit.html" />
<Content Include="views\admin\category\list.html" />
<Content Include="views\admin\dashboard.html" />
<Content Include="views\admin\page\edit.html" />
<Content Include="views\admin\page\list.html" />
<Content Include="views\admin\post\edit.html" />
<Content Include="views\admin\post\list.html" />
<Content Include="views\default\index-content.html" />
<Content Include="views\default\index.html" />
<Content Include="views\default\layout.html" />
<Content Include="views\default\page-content.html" />
<Content Include="views\default\page.html" />
<Content Include="views\default\single-content.html" />
<Content Include="views\default\single.html" />
<Content Include="views\admin\user\logon.html" />
<Content Include="views\themes\default\index-content.html" />
<Content Include="views\themes\default\index.html" />
<Content Include="views\themes\default\layout.html" />
<Content Include="views\themes\default\page-content.html" />
<Content Include="views\themes\default\page.html" />
<Content Include="views\themes\default\single-content.html" />
<Content Include="views\themes\default\single.html" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.CSharp.targets" />
<!-- To modify your build process, add your task inside one of the targets below and uncomment it.

57
src/myWebLog/views/admin/page/edit.html Normal file
View File

@ -0,0 +1,57 @@
@Master['admin/admin-layout']
@Section['Content']
<form action="/page/@Model.page.id/edit" method="post">
@AntiForgeryToken
<div class="row">
<div class="col-sm-9">
<div class="form-group">
<label class="control-label" for="title">@Translate.Title</label>
<input type="text" name="title" id="title" class="form-control" value="@Model.form.title" />
</div>
<div class="form-group">
<label class="control-label" for="permalink">@Translate.Permalink</label>
<input type="text" name="permalink" id="permalink" class="form-control" value="@Model.form.permalink" />
<p class="form-hint"><em>@Translate.startingWith</em> http://@Model.webLog.urlBase/ </p>
</div>
<!-- // TODO: Markdown / HTML choice -->
<div class="form-group">
<textarea name="text" id="text" rows="15" class="form-control">@Model.form.text</textarea>
</div>
</div>
<div class="col-sm-3">
<div class="panel panel-default">
<div class="panel-heading">@Translate.PageDetails</div>
<div class="panel-body">
@IfNot.isNew
<div class="form-group">
<label class="control-label">@Translate.PublishedDate</label>
<p class="static-control">@Model.publishedDate<br />@Model.publishedTime</p>
</div>
<div class="form-group">
<label class="control-label">@Translate.LastUpdatedDate</label>
<p class="static-control">@Model.lastUpdatedDate<br />@Model.lastUpdatedTime</p>
</div>
@EndIf
<div class="form-group">
<input type="checkbox" name="showInPageList" id="showInPageList" @Model.pageListChecked />
&nbsp; <label for="showInPageList">@Translate.ShowInPageList</label>
</div>
</div>
</div>
<div class="text-center">
<p><button class="btn btn-primary" type="submit"><i class="fa fa-floppy-o"></i> @Translate.Save</button></p>
</div>
</div>
</div>
</form>
@EndSection
@Section['Scripts']
<script type="text/javascript" src="/content/scripts/tinymce-init.js"></script>
<script type="text/javascript">
/* <![CDATA[ */
$(document).ready(function () { $("#title").focus() })
/* ]]> */
</script>
@EndSection

41
src/myWebLog/views/admin/user/logon.html Normal file
View File

@ -0,0 +1,41 @@
@Master['admin/admin-layout']
@Section['Content']
<form action="/user/logon" method="post">
@AntiForgeryToken
<input type="hidden" name="returnUrl" value="@Model.returnUrl" />
<div class="row">
<div class="col-sm-offset-1 col-sm-8 col-md-offset-3 col-md-6">
<div class="input-group">
<span class="input-group-addon" title="@Translate.EmailAddress"><i class="fa fa-envelope"></i></span>
<input type="text" name="email" id="email" class="form-control" placeholder="@Translate.EmailAddress" />
</div>
</div>
</div>
<div class="row">
<div class="col-sm-offset-1 col-sm-8 col-md-offset-3 col-md-6">
<br />
<div class="input-group">
<span class="input-group-addon" title="@Translate.Password"><i class="fa fa-key"></i></span>
<input type="password" name="password" class="form-control" placeholder="@Translate.Password" />
</div>
</div>
</div>
<div class="row">
<div class="col-xs-12 text-center">
<p>
<br />
<button class="btn btn-primary"><i class="fa fa-sign-in"></i> @Translate.LogOn</button>
</p>
</div>
</div>
</form>
@EndSection
@Section['Scripts']
<script type="text/javascript">
/* <![CDATA[ */
$(document).ready(function () { $("#email").focus() })
/* ]]> */
</script>
@EndSection

5
src/myWebLog/views/default/index.html
View File

@ -1,5 +0,0 @@
@Master['default/layout']
@Section['Content']
@Partial['default/index-content', Model]
@EndSection

5
src/myWebLog/views/default/page.html
View File

@ -1,5 +0,0 @@
@Master['default/layout']
@Section['Content']
@Partial['default/page-content', Model]
@EndSection

5
src/myWebLog/views/default/single.html
View File

@ -1,5 +0,0 @@
@Master['default/layout']
@Section['Content']
@Partial['default/single-content', Model]
@EndSection

2
src/myWebLog/views/default/index-content.html → src/myWebLog/views/themes/default/index-content.html
View File

@ -1,4 +1,4 @@
@If.subTitle
@If.subTitle.IsSome
<h2>
<span class="label label-info">@Model.subTitle</span>
</h2>

5
src/myWebLog/views/themes/default/index.html Normal file
View File

@ -0,0 +1,5 @@
@Master['themes/default/layout']
@Section['Content']
@Partial['themes/default/index-content', Model]
@EndSection

5
src/myWebLog/views/default/layout.html → src/myWebLog/views/themes/default/layout.html
View File

@ -19,9 +19,8 @@
<p class="navbar-text">@Model.webLog.subtitle</p>
<ul class="nav navbar-nav navbar-left">
@Each.webLog.pageList
<li>
<a href="/@Current.permalink">@Current.title</a>
@EndEach
<li><a href="/@Current.permalink">@Current.title</a></li>
@EndEach
</ul>
<ul class="nav navbar-nav navbar-right">
@If.isAuthenticated

0
src/myWebLog/views/default/page-content.html → src/myWebLog/views/themes/default/page-content.html
View File

5
src/myWebLog/views/themes/default/page.html Normal file
View File

@ -0,0 +1,5 @@
@Master['themes/default/layout']
@Section['Content']
@Partial['themes/default/page-content', Model]
@EndSection

0
src/myWebLog/views/default/single-content.html → src/myWebLog/views/themes/default/single-content.html
View File

5
src/myWebLog/views/themes/default/single.html Normal file
View File

@ -0,0 +1,5 @@
@Master['themes/default/layout']
@Section['Content']
@Partial['themes/default/single-content', Model]
@EndSection