tag/category post pages, moved themes

The "themes" directory will be used as the customization point

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

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

src/myWebLog.Data/Post.fs

@@ -9,37 +9,69 @@ open System.Dynamic
 
 let private r = RethinkDB.R
 
-/// Get a page of published posts
+/// Shorthand to select all published posts for a web log
-let findPageOfPublishedPosts conn webLogId pageNbr nbrPerPage =
+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
+/// Shorthand to get a newer or older post
-let tryFindNewerPost conn post =
+let private adjacentPost conn post theFilter =
-  table Table.Post
+  publishedPosts post.webLogId
-  |> getAll [| post.webLogId, PostStatus.Published |]
+  |> filter theFilter
-  |> optArg "index" "webLogAndStatus"
-  |> filter  (fun p -> upcast p.["publishedOn"].Gt(post.publishedOn))
   |> 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 =
+let tryFindOlderPost conn post = adjacentPost conn post (fun p -> upcast p.["publishedOn"].Lt(post.publishedOn))
-  table Table.Post
+
-  |> getAll [| post.webLogId, PostStatus.Published |]
+/// Try to get the next oldest post assigned to the given category
-  |> optArg "index" "webLogAndStatus"
+let tryFindOlderCategorizedPost conn (categoryId : string) post =
-  |> filter  (fun p -> upcast p.["publishedOn"].Lt(post.publishedOn))
+  adjacentPost conn post
-  |> orderBy (fun p -> upcast r.Desc(p.["publishedOn"]))
+               (fun p -> upcast p.["publishedOn"].Lt(post.publishedOn).And(p.["categoryIds"].Contains(categoryId)))
-  |> limit 1
+
-  |> runCursorAsync<Post> conn
+/// Try to get the next oldest tagged post from the given tagged post
-  |> Seq.tryHead
+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 =
+let tryFindPostByPriorPermalink conn webLogId (permalink : string) =
-  (table Table.Post
+  table Table.Post
   |> getAll [| webLogId |]
-   |> optArg "index" "webLogId")
+  |> optArg "index" "webLogId"
-   .Filter(fun post -> post.["priorPermalinks"].Contains(permalink :> obj))
+  |> filter (fun p -> upcast p.["priorPermalinks"].Contains(permalink).And(p.["status"].Eq(PostStatus.Published)))
   |> without [| "revisions" |]
   |> runCursorAsync<Post> conn
   |> Seq.tryHead

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

src/myWebLog.Data/myWebLog.Data.fsproj

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

src/myWebLog.Resources/Resources.Designer.cs

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

src/myWebLog.Resources/Resources.resx

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

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

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<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) =

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/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 parms)
+    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
+    | "posts" -> this.PublishedPostsPage 1
-    | page    -> match tryFindPageWithoutRevisions conn this.WebLog.id page with
+    | 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 ----
 

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<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 "/"

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

src/myWebLog.Web/myWebLog.Web.fsproj

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

src/myWebLog/myWebLog.csproj

@@ -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\admin\user\logon.html" />
-    <Content Include="views\default\index.html" />
+    <Content Include="views\themes\default\index-content.html" />
-    <Content Include="views\default\layout.html" />
+    <Content Include="views\themes\default\index.html" />
-    <Content Include="views\default\page-content.html" />
+    <Content Include="views\themes\default\layout.html" />
-    <Content Include="views\default\page.html" />
+    <Content Include="views\themes\default\page-content.html" />
-    <Content Include="views\default\single-content.html" />
+    <Content Include="views\themes\default\page.html" />
-    <Content Include="views\default\single.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. 

src/myWebLog/views/admin/page/edit.html

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

src/myWebLog/views/admin/user/logon.html

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

src/myWebLog/views/default/index.html

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

src/myWebLog/views/default/page.html

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

src/myWebLog/views/default/single.html

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

src/myWebLog/views/themes/default/index-content.html

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

src/myWebLog/views/themes/default/index.html

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

src/myWebLog/views/themes/default/layout.html

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

src/myWebLog/views/themes/default/page.html

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

src/myWebLog/views/themes/default/single.html

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