From ed9b8adc1c6f849cfd89134074341bf57b3e4890 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Thu, 10 Nov 2016 22:17:46 -0600 Subject: [PATCH] Log on works now ...but wait, there's more! - Admin area dashboard works, list pages work - Minor admin area style tweaks --- src/MyWebLog.App/AdminModule.fs | 8 +- src/MyWebLog.App/App.fs | 77 +++--- src/MyWebLog.App/CategoryModule.fs | 107 ++++---- src/MyWebLog.App/ModuleExtensions.fs | 8 +- src/MyWebLog.App/PageModule.fs | 98 ++++---- src/MyWebLog.App/PostModule.fs | 238 +++++++++--------- src/MyWebLog.App/UserModule.fs | 43 ++-- src/MyWebLog.App/ViewModels.fs | 71 +++--- src/MyWebLog.Data.RethinkDB/DataConfig.fs | 43 ++-- src/MyWebLog.Data.RethinkDB/Post.fs | 2 +- .../RethinkMyWebLogData.fs | 3 +- src/MyWebLog.Data.RethinkDB/User.fs | 12 +- src/MyWebLog.Entities/IMyWebLogData.fs | 3 + src/MyWebLog.Logic/User.fs | 2 + src/MyWebLog.Resources/en-US.json | 1 + src/MyWebLog/views/admin/content/admin.css | 5 + src/myWebLog/views/admin/admin-layout.html | 4 +- 17 files changed, 378 insertions(+), 347 deletions(-) create mode 100644 src/MyWebLog/views/admin/content/admin.css diff --git a/src/MyWebLog.App/AdminModule.fs b/src/MyWebLog.App/AdminModule.fs index a828c66..de094f0 100644 --- a/src/MyWebLog.App/AdminModule.fs +++ b/src/MyWebLog.App/AdminModule.fs @@ -8,15 +8,15 @@ open Nancy open RethinkDb.Driver.Net /// Handle /admin routes -type AdminModule(data : IMyWebLogData) as this = - inherit NancyModule("/admin") +type AdminModule (data : IMyWebLogData) as this = + inherit NancyModule ("/admin") do - this.Get("/", fun _ -> this.Dashboard ()) + this.Get ("/", fun _ -> this.Dashboard ()) /// Admin dashboard member this.Dashboard () : obj = this.RequiresAccessLevel AuthorizationLevel.Administrator - let model = DashboardModel(this.Context, this.WebLog, findDashboardCounts data this.WebLog.Id) + let model = DashboardModel (this.Context, this.WebLog, findDashboardCounts data this.WebLog.Id) model.PageTitle <- Strings.get "Dashboard" upcast this.View.["admin/dashboard", model] diff --git a/src/MyWebLog.App/App.fs b/src/MyWebLog.App/App.fs index c22de60..4454307 100644 --- a/src/MyWebLog.App/App.fs +++ b/src/MyWebLog.App/App.fs @@ -33,11 +33,11 @@ open System.Text.RegularExpressions let cfg = try AppConfig.FromJson (System.IO.File.ReadAllText "config.json") with ex -> raise <| Exception (Strings.get "ErrBadAppConfig", ex) -let data = lazy (RethinkMyWebLogData(cfg.DataConfig.Conn, cfg.DataConfig) :> IMyWebLogData) +let data = lazy (RethinkMyWebLogData (cfg.DataConfig.Conn, cfg.DataConfig) :> IMyWebLogData) /// Support RESX lookup via the @Translate SSVE alias type TranslateTokenViewEngineMatcher() = - static let regex = Regex("@Translate\.(?[a-zA-Z0-9-_]+);?", RegexOptions.Compiled) + static let regex = Regex ("@Translate\.(?[a-zA-Z0-9-_]+);?", RegexOptions.Compiled) interface ISuperSimpleViewEngineMatcher with member this.Invoke (content, model, host) = let translate (m : Match) = Strings.get m.Groups.["TranslationKey"].Value @@ -45,17 +45,24 @@ type TranslateTokenViewEngineMatcher() = /// Handle forms authentication -type MyWebLogUser(name, claims) = - inherit ClaimsPrincipal() - member this.UserName with get() = name - member this.Claims with get() = claims +type MyWebLogUser (claims : Claim seq) = + inherit ClaimsPrincipal (ClaimsIdentity (claims, "forms")) + + new (user : User) = + // TODO: refactor the User.Claims property to produce this, and just pass it as the constructor + let claims = + seq { + yield Claim (ClaimTypes.Name, user.PreferredName) + for claim in user.Claims -> Claim (ClaimTypes.Role, claim) + } + MyWebLogUser claims -type MyWebLogUserMapper(container : TinyIoCContainer) = +type MyWebLogUserMapper (container : TinyIoCContainer) = interface IUserMapper with member this.GetUserFromIdentifier (identifier, context) = - match context.Request.PersistableSession.GetOrDefault(Keys.User, User.Empty) with - | user when user.Id = string identifier -> upcast MyWebLogUser(user.PreferredName, user.Claims) + match context.Request.PersistableSession.GetOrDefault (Keys.User, User.Empty) with + | user when user.Id = string identifier -> upcast MyWebLogUser user | _ -> null @@ -71,49 +78,47 @@ type MyWebLogBootstrapper() = override this.ConfigureConventions (conventions) = base.ConfigureConventions conventions - // Make theme content available at [theme-name]/ - let addContentDir dir = - let contentDir = Path.Combine [| dir; "content" |] - match Directory.Exists contentDir with - | true -> conventions.StaticContentsConventions.Add - (StaticContentConventionBuilder.AddDirectory ((Path.GetFileName dir), contentDir)) - | _ -> () conventions.StaticContentsConventions.Add - (StaticContentConventionBuilder.AddDirectory("admin/content", "views/admin/content")) + (StaticContentConventionBuilder.AddDirectory ("admin/content", "views/admin/content")) + // Make theme content available at [theme-name]/ Directory.EnumerateDirectories (Path.Combine [| "views"; "themes" |]) - |> Seq.iter addContentDir + |> Seq.map (fun themeDir -> themeDir, Path.Combine [| themeDir; "content" |]) + |> Seq.filter (fun (_, contentDir) -> Directory.Exists contentDir) + |> Seq.iter (fun (themeDir, contentDir) -> + conventions.StaticContentsConventions.Add + (StaticContentConventionBuilder.AddDirectory ((Path.GetFileName themeDir), contentDir))) override this.ConfigureApplicationContainer (container) = base.ConfigureApplicationContainer container - container.Register(cfg) + container.Register cfg |> ignore data.Force().SetUp () - container.Register(data.Force ()) + container.Register (data.Force ()) |> ignore // NodaTime - container.Register(SystemClock.Instance) + container.Register SystemClock.Instance |> ignore // I18N in SSVE - container.Register>(fun _ _ -> - Seq.singleton (TranslateTokenViewEngineMatcher() :> ISuperSimpleViewEngineMatcher)) + container.Register (fun _ _ -> + Seq.singleton (TranslateTokenViewEngineMatcher () :> ISuperSimpleViewEngineMatcher)) |> ignore override this.ApplicationStartup (container, pipelines) = base.ApplicationStartup (container, pipelines) // Forms authentication configuration let auth = - FormsAuthenticationConfiguration( + FormsAuthenticationConfiguration ( CryptographyConfiguration = - CryptographyConfiguration( - AesEncryptionProvider(PassphraseKeyGenerator(cfg.AuthEncryptionPassphrase, cfg.AuthSalt)), - DefaultHmacProvider(PassphraseKeyGenerator(cfg.AuthHmacPassphrase, cfg.AuthSalt))), + CryptographyConfiguration ( + AesEncryptionProvider (PassphraseKeyGenerator (cfg.AuthEncryptionPassphrase, cfg.AuthSalt)), + DefaultHmacProvider (PassphraseKeyGenerator (cfg.AuthHmacPassphrase, cfg.AuthSalt))), RedirectUrl = "~/user/logon", - UserMapper = container.Resolve()) + UserMapper = container.Resolve ()) FormsAuthentication.Enable (pipelines, auth) // CSRF Csrf.Enable pipelines // Sessions - let sessions = RethinkDBSessionConfiguration(cfg.DataConfig.Conn) + let sessions = RethinkDBSessionConfiguration cfg.DataConfig.Conn sessions.Database <- cfg.DataConfig.Database //let sessions = RelationalSessionConfiguration(ConfigurationManager.ConnectionStrings.["SessionStore"].ConnectionString) PersistableSessions.Enable (pipelines, sessions) @@ -121,7 +126,7 @@ type MyWebLogBootstrapper() = override this.Configure (environment) = base.Configure environment - environment.Tracing(true, true) + environment.Tracing (true, true) let version = @@ -149,16 +154,16 @@ type RequestEnvironment() = type Startup() = member this.Configure (app : IApplicationBuilder) = - let opt = NancyOptions() - opt.Bootstrapper <- new MyWebLogBootstrapper() - app.UseOwin(fun x -> x.UseNancy(opt) |> ignore) |> ignore + let opt = NancyOptions () + opt.Bootstrapper <- new MyWebLogBootstrapper () + app.UseOwin (fun x -> x.UseNancy opt |> ignore) |> ignore let Run () = use host = WebHostBuilder() - .UseContentRoot(System.IO.Directory.GetCurrentDirectory()) + .UseContentRoot(System.IO.Directory.GetCurrentDirectory ()) .UseKestrel() .UseStartup() - .Build() - host.Run() + .Build () + host.Run () diff --git a/src/MyWebLog.App/CategoryModule.fs b/src/MyWebLog.App/CategoryModule.fs index 9b621c2..05197fb 100644 --- a/src/MyWebLog.App/CategoryModule.fs +++ b/src/MyWebLog.App/CategoryModule.fs @@ -10,68 +10,71 @@ open Nancy.Security open RethinkDb.Driver.Net /// Handle /category and /categories URLs -type CategoryModule(data : IMyWebLogData) as this = - inherit NancyModule() +type CategoryModule (data : IMyWebLogData) as this = + inherit NancyModule () do - this.Get ("/categories", fun _ -> this.CategoryList ()) - this.Get ("/category/{id}/edit", fun parms -> this.EditCategory (downcast parms)) - this.Post ("/category/{id}/edit", fun parms -> this.SaveCategory (downcast parms)) - this.Delete("/category/{id}/delete", fun parms -> this.DeleteCategory (downcast parms)) + this.Get ("/categories", fun _ -> this.CategoryList ()) + this.Get ("/category/{id}/edit", fun parms -> this.EditCategory (downcast parms)) + this.Post ("/category/{id}/edit", fun parms -> this.SaveCategory (downcast parms)) + this.Delete ("/category/{id}/delete", fun parms -> this.DeleteCategory (downcast parms)) /// Display a list of categories member this.CategoryList () : obj = this.RequiresAccessLevel AuthorizationLevel.Administrator - let model = CategoryListModel(this.Context, this.WebLog, - (findAllCategories data this.WebLog.Id - |> List.map (fun cat -> IndentedCategory.Create cat (fun _ -> false)))) - upcast this.View.["/admin/category/list", model] + let model = + CategoryListModel ( + this.Context, this.WebLog, findAllCategories data this.WebLog.Id + |> List.map (fun cat -> IndentedCategory.Create cat (fun _ -> false))) + upcast this.View.["admin/category/list", model] /// Edit a category member this.EditCategory (parameters : DynamicDictionary) : obj = this.RequiresAccessLevel AuthorizationLevel.Administrator let catId = parameters.["id"].ToString () - match (match catId with - | "new" -> Some Category.Empty - | _ -> tryFindCategory data this.WebLog.Id catId) with - | Some cat -> let model = CategoryEditModel(this.Context, this.WebLog, cat) - model.Categories <- findAllCategories data this.WebLog.Id - |> List.map (fun cat -> IndentedCategory.Create cat - (fun c -> c = defaultArg (fst cat).ParentId "")) - upcast this.View.["admin/category/edit", model] + match catId with "new" -> Some Category.Empty | _ -> tryFindCategory data this.WebLog.Id catId + |> function + | Some cat -> + let model = CategoryEditModel(this.Context, this.WebLog, cat) + model.Categories <- findAllCategories data this.WebLog.Id + |> List.map (fun cat -> IndentedCategory.Create cat + (fun c -> c = defaultArg (fst cat).ParentId "")) + upcast this.View.["admin/category/edit", model] | _ -> this.NotFound () /// Save a category member this.SaveCategory (parameters : DynamicDictionary) : obj = this.ValidateCsrfToken () this.RequiresAccessLevel AuthorizationLevel.Administrator - let catId = parameters.["id"].ToString () - let form = this.Bind () - let oldCat = match catId with - | "new" -> Some { Category.Empty with WebLogId = this.WebLog.Id } - | _ -> tryFindCategory data this.WebLog.Id catId - match oldCat with - | Some old -> let cat = { old with Name = form.Name - Slug = form.Slug - Description = match form.Description with "" -> None | d -> Some d - ParentId = match form.ParentId with "" -> None | p -> Some p } - let newCatId = saveCategory data cat - match old.ParentId = cat.ParentId with - | true -> () - | _ -> match old.ParentId with - | Some parentId -> removeCategoryFromParent data this.WebLog.Id parentId newCatId - | _ -> () - match cat.ParentId with - | Some parentId -> addCategoryToParent data this.WebLog.Id parentId newCatId - | _ -> () - let model = MyWebLogModel(this.Context, this.WebLog) - { UserMessage.Empty with - Level = Level.Info - Message = System.String.Format - (Strings.get "MsgCategoryEditSuccess", - Strings.get (match catId with "new" -> "Added" | _ -> "Updated")) } - |> model.AddMessage - this.Redirect (sprintf "/category/%s/edit" newCatId) model + let catId = parameters.["id"].ToString () + let form = this.Bind () + match catId with + | "new" -> Some { Category.Empty with WebLogId = this.WebLog.Id } + | _ -> tryFindCategory data this.WebLog.Id catId + |> function + | Some old -> + let cat = { old with Name = form.Name + Slug = form.Slug + Description = match form.Description with "" -> None | d -> Some d + ParentId = match form.ParentId with "" -> None | p -> Some p } + let newCatId = saveCategory data cat + match old.ParentId = cat.ParentId with + | true -> () + | _ -> + match old.ParentId with + | Some parentId -> removeCategoryFromParent data this.WebLog.Id parentId newCatId + | _ -> () + match cat.ParentId with + | Some parentId -> addCategoryToParent data this.WebLog.Id parentId newCatId + | _ -> () + let model = MyWebLogModel (this.Context, this.WebLog) + { UserMessage.Empty with + Level = Level.Info + Message = System.String.Format + (Strings.get "MsgCategoryEditSuccess", + Strings.get (match catId with "new" -> "Added" | _ -> "Updated")) } + |> model.AddMessage + this.Redirect (sprintf "/category/%s/edit" newCatId) model | _ -> this.NotFound () /// Delete a category @@ -80,10 +83,12 @@ type CategoryModule(data : IMyWebLogData) as this = this.RequiresAccessLevel AuthorizationLevel.Administrator let catId = parameters.["id"].ToString () match tryFindCategory data this.WebLog.Id catId with - | Some cat -> deleteCategory data cat - let model = MyWebLogModel(this.Context, this.WebLog) - { UserMessage.Empty with Level = Level.Info - Message = System.String.Format(Strings.get "MsgCategoryDeleted", cat.Name) } - |> model.AddMessage - this.Redirect "/categories" model + | Some cat -> + deleteCategory data cat + let model = MyWebLogModel(this.Context, this.WebLog) + { UserMessage.Empty with + Level = Level.Info + Message = System.String.Format(Strings.get "MsgCategoryDeleted", cat.Name) } + |> model.AddMessage + this.Redirect "/categories" model | _ -> this.NotFound () diff --git a/src/MyWebLog.App/ModuleExtensions.fs b/src/MyWebLog.App/ModuleExtensions.fs index 0efca20..dd3d069 100644 --- a/src/MyWebLog.App/ModuleExtensions.fs +++ b/src/MyWebLog.App/ModuleExtensions.fs @@ -25,10 +25,12 @@ type NancyModule with match List.length model.Messages with | 0 -> () | _ -> this.Session.[Keys.Messages] <- model.Messages - upcast this.Response.AsRedirect(url).WithStatusCode HttpStatusCode.TemporaryRedirect + // Temp (307) redirects don't reset the HTTP method; this allows POST-process-REDIRECT workflow + upcast this.Response.AsRedirect(url).WithStatusCode HttpStatusCode.MovedPermanently /// Require a specific level of access for the current web log member this.RequiresAccessLevel level = - let findClaim = new Predicate(fun claim -> claim.Type = ClaimTypes.Role && claim.Value = sprintf "%s|%s" this.WebLog.Id level) - this.RequiresAuthentication() + let findClaim = Predicate (fun claim -> + claim.Type = ClaimTypes.Role && claim.Value = sprintf "%s|%s" this.WebLog.Id level) + this.RequiresAuthentication () this.RequiresClaims [| findClaim |] diff --git a/src/MyWebLog.App/PageModule.fs b/src/MyWebLog.App/PageModule.fs index 0059c28..368f8b7 100644 --- a/src/MyWebLog.App/PageModule.fs +++ b/src/MyWebLog.App/PageModule.fs @@ -11,20 +11,21 @@ open NodaTime open RethinkDb.Driver.Net /// Handle /pages and /page URLs -type PageModule(data : IMyWebLogData, clock : IClock) as this = - inherit NancyModule() +type PageModule (data : IMyWebLogData, clock : IClock) as this = + inherit NancyModule () do - this.Get ("/pages", fun _ -> this.PageList ()) - this.Get ("/page/{id}/edit", fun parms -> this.EditPage (downcast parms)) - this.Post ("/page/{id}/edit", fun parms -> this.SavePage (downcast parms)) - this.Delete("/page/{id}/delete", fun parms -> this.DeletePage (downcast parms)) + this.Get ("/pages", fun _ -> this.PageList ()) + this.Get ("/page/{id}/edit", fun parms -> this.EditPage (downcast parms)) + this.Post ("/page/{id}/edit", fun parms -> this.SavePage (downcast parms)) + this.Delete ("/page/{id}/delete", fun parms -> this.DeletePage (downcast parms)) /// List all pages member this.PageList () : obj = this.RequiresAccessLevel AuthorizationLevel.Administrator - let model = PagesModel(this.Context, this.WebLog, (findAllPages data this.WebLog.Id - |> List.map (fun p -> PageForDisplay(this.WebLog, p)))) + let model = + PagesModel(this.Context, this.WebLog, findAllPages data this.WebLog.Id + |> List.map (fun p -> PageForDisplay (this.WebLog, p))) model.PageTitle <- Strings.get "Pages" upcast this.View.["admin/page/list", model] @@ -34,15 +35,16 @@ type PageModule(data : IMyWebLogData, clock : IClock) as this = let pageId = parameters.["id"].ToString () match pageId with "new" -> Some Page.Empty | _ -> tryFindPage data this.WebLog.Id pageId |> function - | Some page -> let rev = match page.Revisions - |> List.sortByDescending (fun r -> r.AsOf) - |> List.tryHead with - | Some r -> r - | _ -> Revision.Empty - let model = EditPageModel(this.Context, this.WebLog, page, rev) - model.PageTitle <- Strings.get <| match pageId with "new" -> "AddNewPage" | _ -> "EditPage" - upcast this.View.["admin/page/edit", model] - | _ -> this.NotFound () + | Some page -> + let rev = match page.Revisions + |> List.sortByDescending (fun r -> r.AsOf) + |> List.tryHead with + | Some r -> r + | _ -> Revision.Empty + let model = EditPageModel (this.Context, this.WebLog, page, rev) + model.PageTitle <- Strings.get <| match pageId with "new" -> "AddNewPage" | _ -> "EditPage" + upcast this.View.["admin/page/edit", model] + | _ -> this.NotFound () /// Save a page member this.SavePage (parameters : DynamicDictionary) : obj = @@ -50,29 +52,31 @@ type PageModule(data : IMyWebLogData, clock : IClock) as this = this.RequiresAccessLevel AuthorizationLevel.Administrator let pageId = parameters.["id"].ToString () let form = this.Bind () - let now = clock.GetCurrentInstant().ToUnixTimeTicks() - match (match pageId with "new" -> Some Page.Empty | _ -> tryFindPage data 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 - UpdatedOn = 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 data - let model = MyWebLogModel(this.Context, this.WebLog) - { UserMessage.Empty with - Level = Level.Info - Message = System.String.Format - (Strings.get "MsgPageEditSuccess", - Strings.get (match pageId with "new" -> "Added" | _ -> "Updated")) } - |> model.AddMessage - this.Redirect (sprintf "/page/%s/edit" pId) model + let now = clock.GetCurrentInstant().ToUnixTimeTicks () + match pageId with "new" -> Some Page.Empty | _ -> tryFindPage data this.WebLog.Id pageId + |> function + | 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 + UpdatedOn = 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 data + let model = MyWebLogModel (this.Context, this.WebLog) + { UserMessage.Empty with + Level = Level.Info + Message = System.String.Format + (Strings.get "MsgPageEditSuccess", + Strings.get (match pageId with "new" -> "Added" | _ -> "Updated")) } + |> model.AddMessage + this.Redirect (sprintf "/page/%s/edit" pId) model | _ -> this.NotFound () /// Delete a page @@ -81,10 +85,12 @@ type PageModule(data : IMyWebLogData, clock : IClock) as this = this.RequiresAccessLevel AuthorizationLevel.Administrator let pageId = parameters.["id"].ToString () match tryFindPageWithoutRevisions data this.WebLog.Id pageId with - | Some page -> deletePage data page.WebLogId page.Id - let model = MyWebLogModel(this.Context, this.WebLog) - { UserMessage.Empty with Level = Level.Info - Message = Strings.get "MsgPageDeleted" } - |> model.AddMessage - this.Redirect "/pages" model + | Some page -> + deletePage data page.WebLogId page.Id + let model = MyWebLogModel (this.Context, this.WebLog) + { UserMessage.Empty with + Level = Level.Info + Message = Strings.get "MsgPageDeleted" } + |> model.AddMessage + this.Redirect "/pages" model | _ -> this.NotFound () diff --git a/src/MyWebLog.App/PostModule.fs b/src/MyWebLog.App/PostModule.fs index 98f046d..531e660 100644 --- a/src/MyWebLog.App/PostModule.fs +++ b/src/MyWebLog.App/PostModule.fs @@ -24,20 +24,20 @@ type NewsItem = /// Routes dealing with posts (including the home page, /tag, /category, RSS, and catch-all routes) type PostModule(data : IMyWebLogData, clock : IClock) as this = - inherit NancyModule() + inherit NancyModule () /// Get the page number from the dictionary let getPage (parameters : DynamicDictionary) = match parameters.ContainsKey "page" with true -> System.Int32.Parse (parameters.["page"].ToString ()) | _ -> 1 /// Convert a list of posts to a list of posts for display - let forDisplay posts = posts |> List.map (fun post -> PostForDisplay(this.WebLog, post)) + let forDisplay posts = posts |> List.map (fun post -> PostForDisplay (this.WebLog, post)) /// Generate an RSS/Atom feed of the latest posts let generateFeed format : obj = let myChannelFeed channelTitle channelLink channelDescription (items : NewsItem list) = let xn = XName.Get - let elem name (valu:string) = XElement(xn name, valu) + let elem name (valu:string) = XElement (xn name, valu) let elems = items |> List.sortBy (fun i -> i.ReleaseDate) @@ -54,12 +54,12 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this = XDeclaration("1.0", "utf-8", "yes"), XElement (xn "rss", - XAttribute(xn "version", "2.0"), + XAttribute (xn "version", "2.0"), elem "title" channelTitle, elem "link" channelLink, elem "description" (defaultArg channelDescription ""), elem "language" "en-us", - XElement(xn "channel", elems)) + XElement (xn "channel", elems)) |> box) |> box let schemeAndUrl = sprintf "%s://%s" this.Request.Url.Scheme this.WebLog.UrlBase @@ -103,24 +103,24 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this = upcast this.Response.FromStream(stream, sprintf "application/%s+xml" format) *) do - this.Get ("/", fun _ -> this.HomePage ()) - this.Get ("/{permalink*}", fun parms -> this.CatchAll (downcast parms)) - this.Get ("/posts/page/{page:int}", fun parms -> this.PublishedPostsPage (getPage <| downcast parms)) - this.Get ("/category/{slug}", fun parms -> this.CategorizedPosts (downcast parms)) - this.Get ("/category/{slug}/page/{page:int}", fun parms -> this.CategorizedPosts (downcast parms)) - this.Get ("/tag/{tag}", fun parms -> this.TaggedPosts (downcast parms)) - this.Get ("/tag/{tag}/page/{page:int}", fun parms -> this.TaggedPosts (downcast parms)) - this.Get ("/feed", fun _ -> this.Feed ()) - this.Get ("/posts/list", fun _ -> this.PostList 1) - this.Get ("/posts/list/page/{page:int}", fun parms -> this.PostList (getPage <| downcast parms)) - this.Get ("/post/{postId}/edit", fun parms -> this.EditPost (downcast parms)) - this.Post("/post/{postId}/edit", fun parms -> this.SavePost (downcast parms)) + this.Get ("/", fun _ -> this.HomePage ()) + this.Get ("/{permalink*}", fun parms -> this.CatchAll (downcast parms)) + this.Get ("/posts/page/{page:int}", fun parms -> this.PublishedPostsPage (getPage <| downcast parms)) + this.Get ("/category/{slug}", fun parms -> this.CategorizedPosts (downcast parms)) + this.Get ("/category/{slug}/page/{page:int}", fun parms -> this.CategorizedPosts (downcast parms)) + this.Get ("/tag/{tag}", fun parms -> this.TaggedPosts (downcast parms)) + this.Get ("/tag/{tag}/page/{page:int}", fun parms -> this.TaggedPosts (downcast parms)) + this.Get ("/feed", fun _ -> this.Feed ()) + this.Get ("/posts/list", fun _ -> this.PostList 1) + this.Get ("/posts/list/page/{page:int}", fun parms -> this.PostList (getPage <| downcast parms)) + this.Get ("/post/{postId}/edit", fun parms -> this.EditPost (downcast parms)) + this.Post ("/post/{postId}/edit", fun parms -> this.SavePost (downcast parms)) // ---- Display posts to users ---- /// Display a page of published posts member this.PublishedPostsPage pageNbr : obj = - let model = PostsModel(this.Context, this.WebLog) + let model = PostsModel (this.Context, this.WebLog) model.PageNbr <- pageNbr model.Posts <- findPageOfPublishedPosts data this.WebLog.Id pageNbr 10 |> forDisplay model.HasNewer <- match pageNbr with @@ -139,65 +139,68 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this = member this.HomePage () : obj = match this.WebLog.DefaultPage with | "posts" -> this.PublishedPostsPage 1 - | pageId -> match tryFindPageWithoutRevisions data this.WebLog.Id pageId with - | Some page -> let model = PageModel(this.Context, this.WebLog, page) - model.PageTitle <- page.Title - this.ThemedView "page" model - | _ -> this.NotFound () + | pageId -> + match tryFindPageWithoutRevisions data this.WebLog.Id pageId with + | Some page -> + let model = PageModel(this.Context, this.WebLog, page) + model.PageTitle <- page.Title + this.ThemedView "page" model + | _ -> this.NotFound () /// Derive a post or page from the URL, or redirect from a prior URL to the current one member this.CatchAll (parameters : DynamicDictionary) : obj = let url = parameters.["permalink"].ToString () match tryFindPostByPermalink data this.WebLog.Id url with | Some post -> // Hopefully the most common result; the permalink is a permalink! - let model = PostModel(this.Context, this.WebLog, post) - model.NewerPost <- tryFindNewerPost data post - model.OlderPost <- tryFindOlderPost data post - model.PageTitle <- post.Title - this.ThemedView "single" model + let model = PostModel(this.Context, this.WebLog, post) + model.NewerPost <- tryFindNewerPost data post + model.OlderPost <- tryFindOlderPost data post + model.PageTitle <- post.Title + this.ThemedView "single" model | _ -> // Maybe it's a page permalink instead... - match tryFindPageByPermalink data this.WebLog.Id url with - | Some page -> // ...and it is! - let model = PageModel(this.Context, this.WebLog, page) - model.PageTitle <- page.Title - this.ThemedView "page" model - | _ -> // Maybe it's an old permalink for a post - match tryFindPostByPriorPermalink data this.WebLog.Id url with - | Some post -> // Redirect them to the proper permalink - upcast this.Response.AsRedirect(sprintf "/%s" post.Permalink) - .WithStatusCode HttpStatusCode.MovedPermanently - | _ -> this.NotFound () + match tryFindPageByPermalink data this.WebLog.Id url with + | Some page -> // ...and it is! + let model = PageModel (this.Context, this.WebLog, page) + model.PageTitle <- page.Title + this.ThemedView "page" model + | _ -> // Maybe it's an old permalink for a post + match tryFindPostByPriorPermalink data this.WebLog.Id url with + | Some post -> // Redirect them to the proper permalink + upcast this.Response.AsRedirect(sprintf "/%s" post.Permalink) + .WithStatusCode HttpStatusCode.MovedPermanently + | _ -> this.NotFound () /// Display categorized posts member this.CategorizedPosts (parameters : DynamicDictionary) : obj = let slug = parameters.["slug"].ToString () match tryFindCategoryBySlug data this.WebLog.Id slug with - | Some cat -> let pageNbr = getPage parameters - let model = PostsModel(this.Context, this.WebLog) - model.PageNbr <- pageNbr - model.Posts <- findPageOfCategorizedPosts data this.WebLog.Id cat.Id pageNbr 10 |> forDisplay - model.HasNewer <- match List.isEmpty model.Posts with - | true -> false - | _ -> Option.isSome <| tryFindNewerCategorizedPost data cat.Id - (List.head model.Posts).Post - model.HasOlder <- match List.isEmpty model.Posts with - | true -> false - | _ -> Option.isSome <| tryFindOlderCategorizedPost data cat.Id - (List.last model.Posts).Post - 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 - | _ -> sprintf "Posts in the \"%s\" category" cat.Name - this.ThemedView "index" model + | Some cat -> + let pageNbr = getPage parameters + let model = PostsModel (this.Context, this.WebLog) + model.PageNbr <- pageNbr + model.Posts <- findPageOfCategorizedPosts data this.WebLog.Id cat.Id pageNbr 10 |> forDisplay + model.HasNewer <- match List.isEmpty model.Posts with + | true -> false + | _ -> Option.isSome <| tryFindNewerCategorizedPost data cat.Id + (List.head model.Posts).Post + model.HasOlder <- match List.isEmpty model.Posts with + | true -> false + | _ -> Option.isSome <| tryFindOlderCategorizedPost data cat.Id + (List.last model.Posts).Post + 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 + | _ -> sprintf "Posts in the \"%s\" category" cat.Name + this.ThemedView "index" model | _ -> this.NotFound () /// Display tagged posts member this.TaggedPosts (parameters : DynamicDictionary) : obj = let tag = parameters.["tag"].ToString () let pageNbr = getPage parameters - let model = PostsModel(this.Context, this.WebLog) + let model = PostsModel (this.Context, this.WebLog) model.PageNbr <- pageNbr model.Posts <- findPageOfTaggedPosts data this.WebLog.Id tag pageNbr 10 |> forDisplay model.HasNewer <- match List.isEmpty model.Posts with @@ -215,10 +218,11 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this = member this.Feed () : obj = let query = this.Request.Query :?> DynamicDictionary match query.ContainsKey "format" with - | true -> match query.["format"].ToString () with - | x when x = "atom" || x = "rss" -> generateFeed x - | x when x = "rss2" -> generateFeed "rss" - | _ -> this.Redirect "/feed" (MyWebLogModel(this.Context, this.WebLog)) + | true -> + match query.["format"].ToString () with + | x when x = "atom" || x = "rss" -> generateFeed x + | x when x = "rss2" -> generateFeed "rss" + | _ -> this.Redirect "/feed" (MyWebLogModel (this.Context, this.WebLog)) | _ -> generateFeed "rss" // ---- Administer posts ---- @@ -226,7 +230,7 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this = /// Display a page of posts in the admin area member this.PostList pageNbr : obj = this.RequiresAccessLevel AuthorizationLevel.Administrator - let model = PostsModel(this.Context, this.WebLog) + let model = PostsModel (this.Context, this.WebLog) model.PageNbr <- pageNbr model.Posts <- findPageOfAllPosts data this.WebLog.Id pageNbr 25 |> forDisplay model.HasNewer <- pageNbr > 1 @@ -239,20 +243,21 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this = member this.EditPost (parameters : DynamicDictionary) : obj = this.RequiresAccessLevel AuthorizationLevel.Administrator let postId = parameters.["postId"].ToString () - match (match postId with "new" -> Some Post.Empty | _ -> tryFindPost data this.WebLog.Id postId) with - | Some post -> let rev = match post.Revisions - |> List.sortByDescending (fun r -> r.AsOf) - |> List.tryHead with - | Some r -> r - | None -> Revision.Empty - let model = EditPostModel(this.Context, this.WebLog, post, rev) - model.Categories <- findAllCategories data this.WebLog.Id - |> List.map (fun cat -> string (fst cat).Id, - sprintf "%s%s" - (String.replicate (snd cat) "     ") - (fst cat).Name) - model.PageTitle <- Strings.get <| match post.Id with "new" -> "AddNewPost" | _ -> "EditPost" - upcast this.View.["admin/post/edit"] + match postId with "new" -> Some Post.Empty | _ -> tryFindPost data this.WebLog.Id postId + |> function + | Some post -> + let rev = match post.Revisions + |> List.sortByDescending (fun r -> r.AsOf) + |> List.tryHead with + | Some r -> r + | None -> Revision.Empty + let model = EditPostModel (this.Context, this.WebLog, post, rev) + model.Categories <- findAllCategories data this.WebLog.Id + |> List.map (fun cat -> string (fst cat).Id, + sprintf "%s%s" (String.replicate (snd cat) "     ") + (fst cat).Name) + model.PageTitle <- Strings.get <| match post.Id with "new" -> "AddNewPost" | _ -> "EditPost" + upcast this.View.["admin/post/edit"] | _ -> this.NotFound () /// Save a post @@ -260,42 +265,43 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this = this.RequiresAccessLevel AuthorizationLevel.Administrator this.ValidateCsrfToken () let postId = parameters.["postId"].ToString () - let form = this.Bind() - let now = clock.GetCurrentInstant().ToUnixTimeTicks() - match (match postId with "new" -> Some Post.Empty | _ -> tryFindPost data this.WebLog.Id postId) with - | Some p -> let justPublished = p.PublishedOn = int64 0 && form.PublishNow - let post = match postId with - | "new" -> { p with - WebLogId = this.WebLog.Id - AuthorId = (this.Request.PersistableSession.GetOrDefault - (Keys.User, User.Empty)).Id } - | _ -> p - let pId = { post with - Status = match form.PublishNow with - | true -> PostStatus.Published - | _ -> PostStatus.Draft - Title = form.Title - Permalink = form.Permalink - PublishedOn = match justPublished with true -> now | _ -> int64 0 - UpdatedOn = now - Text = match form.Source with - | RevisionSource.Markdown -> (* Markdown.TransformHtml *) form.Text - | _ -> form.Text - CategoryIds = Array.toList form.Categories - Tags = form.Tags.Split ',' - |> Seq.map (fun t -> t.Trim().ToLowerInvariant()) - |> Seq.toList - Revisions = { AsOf = now - SourceType = form.Source - Text = form.Text } :: post.Revisions } - |> savePost data - let model = MyWebLogModel(this.Context, this.WebLog) - { UserMessage.Empty with - Level = Level.Info - Message = System.String.Format - (Strings.get "MsgPostEditSuccess", - Strings.get (match postId with "new" -> "Added" | _ -> "Updated"), - (match justPublished with true -> Strings.get "AndPublished" | _ -> "")) } - |> model.AddMessage - this.Redirect (sprintf "/post/%s/edit" pId) model + let form = this.Bind () + let now = clock.GetCurrentInstant().ToUnixTimeTicks () + match postId with "new" -> Some Post.Empty | _ -> tryFindPost data this.WebLog.Id postId + |> function + | Some p -> + let justPublished = p.PublishedOn = int64 0 && form.PublishNow + let post = match postId with + | "new" -> { p with + WebLogId = this.WebLog.Id + AuthorId = (this.Request.PersistableSession.GetOrDefault + (Keys.User, User.Empty)).Id } + | _ -> p + let pId = + { post with + Status = match form.PublishNow with true -> PostStatus.Published | _ -> PostStatus.Draft + Title = form.Title + Permalink = form.Permalink + PublishedOn = match justPublished with true -> now | _ -> int64 0 + UpdatedOn = now + Text = match form.Source with + | RevisionSource.Markdown -> (* Markdown.TransformHtml *) form.Text + | _ -> form.Text + CategoryIds = Array.toList form.Categories + Tags = form.Tags.Split ',' + |> Seq.map (fun t -> t.Trim().ToLowerInvariant ()) + |> Seq.toList + Revisions = { AsOf = now + SourceType = form.Source + Text = form.Text } :: post.Revisions } + |> savePost data + let model = MyWebLogModel(this.Context, this.WebLog) + { UserMessage.Empty with + Level = Level.Info + Message = System.String.Format + (Strings.get "MsgPostEditSuccess", + Strings.get (match postId with "new" -> "Added" | _ -> "Updated"), + (match justPublished with true -> Strings.get "AndPublished" | _ -> "")) } + |> model.AddMessage + this.Redirect (sprintf "/post/%s/edit" pId) model | _ -> this.NotFound () diff --git a/src/MyWebLog.App/UserModule.fs b/src/MyWebLog.App/UserModule.fs index bc414fe..2ad8ea3 100644 --- a/src/MyWebLog.App/UserModule.fs +++ b/src/MyWebLog.App/UserModule.fs @@ -14,8 +14,8 @@ open RethinkDb.Driver.Net open System.Text /// Handle /user URLs -type UserModule(data : IMyWebLogData, cfg : AppConfig) as this = - inherit NancyModule("/user") +type UserModule (data : IMyWebLogData, cfg : AppConfig) as this = + inherit NancyModule ("/user") /// Hash the user's password let pbkdf2 (pw : string) = @@ -23,13 +23,13 @@ type UserModule(data : IMyWebLogData, cfg : AppConfig) as this = |> Seq.fold (fun acc byt -> sprintf "%s%s" acc (byt.ToString "x2")) "" do - this.Get ("/logon", fun _ -> this.ShowLogOn ()) - this.Post("/logon", fun parms -> this.DoLogOn (downcast parms)) - this.Get ("/logoff", fun _ -> this.LogOff ()) + this.Get ("/logon", fun _ -> this.ShowLogOn ()) + this.Post ("/logon", fun p -> this.DoLogOn (downcast p)) + this.Get ("/logoff", fun _ -> this.LogOff ()) /// Show the log on page member this.ShowLogOn () : obj = - let model = LogOnModel(this.Context, this.WebLog) + let model = LogOnModel (this.Context, this.WebLog) let query = this.Request.Query :?> DynamicDictionary model.Form.ReturnUrl <- match query.ContainsKey "returnUrl" with true -> query.["returnUrl"].ToString () | _ -> "" upcast this.View.["admin/user/logon", model] @@ -40,27 +40,26 @@ type UserModule(data : IMyWebLogData, cfg : AppConfig) as this = let form = this.Bind () let model = MyWebLogModel(this.Context, this.WebLog) match tryUserLogOn data form.Email (pbkdf2 form.Password) with - | Some user -> this.Session.[Keys.User] <- user - { UserMessage.Empty with Level = Level.Info - Message = Strings.get "MsgLogOnSuccess" } - |> 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 - upcast this.LoginAndRedirect (System.Guid.Parse user.Id, - fallbackRedirectUrl = defaultArg (Option.ofObj form.ReturnUrl) "/") - | _ -> { UserMessage.Empty with Level = Level.Error - Message = Strings.get "ErrBadLogOnAttempt" } - |> model.AddMessage - this.Redirect (sprintf "/user/logon?returnUrl=%s" form.ReturnUrl) model + | Some user -> + this.Session.[Keys.User] <- user + model.AddMessage { UserMessage.Empty with Message = Strings.get "MsgLogOnSuccess" } + 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 + upcast this.LoginAndRedirect (System.Guid.Parse user.Id, + fallbackRedirectUrl = defaultArg (Option.ofObj form.ReturnUrl) "/") + | _ -> + { UserMessage.Empty with + Level = Level.Error + Message = Strings.get "ErrBadLogOnAttempt" } + |> model.AddMessage + this.Redirect (sprintf "/user/logon?returnUrl=%s" form.ReturnUrl) model /// Log a user off member this.LogOff () : obj = // FIXME: why are we getting the user here if we don't do anything with it? let user = this.Request.PersistableSession.GetOrDefault (Keys.User, User.Empty) this.Session.DeleteAll () - let model = MyWebLogModel(this.Context, this.WebLog) - { UserMessage.Empty with Level = Level.Info - Message = Strings.get "MsgLogOffSuccess" } - |> model.AddMessage + let model = MyWebLogModel (this.Context, this.WebLog) + model.AddMessage { UserMessage.Empty with Message = Strings.get "MsgLogOffSuccess" } this.Redirect "" model |> ignore upcast this.LogoutAndRedirect "/" diff --git a/src/MyWebLog.App/ViewModels.fs b/src/MyWebLog.App/ViewModels.fs index 9486c02..65c8252 100644 --- a/src/MyWebLog.App/ViewModels.fs +++ b/src/MyWebLog.App/ViewModels.fs @@ -86,15 +86,15 @@ module FormatDateTime = /// Display the time let time timeZone ticks = (zonedTime timeZone ticks - |> ZonedDateTimePattern.CreateWithCurrentCulture("h':'mmtt", DateTimeZoneProviders.Tzdb).Format).ToLower() + |> ZonedDateTimePattern.CreateWithCurrentCulture("h':'mmtt", DateTimeZoneProviders.Tzdb).Format).ToLower () /// Parent view model for all myWebLog views -type MyWebLogModel(ctx : NancyContext, webLog : WebLog) = +type MyWebLogModel (ctx : NancyContext, webLog : WebLog) = /// Get the messages from the session let getMessages () = - let msg = ctx.Request.PersistableSession.GetOrDefault(Keys.Messages, []) + let msg = ctx.Request.PersistableSession.GetOrDefault (Keys.Messages, []) match List.length msg with | 0 -> () | _ -> ctx.Request.Session.Delete Keys.Messages @@ -107,7 +107,7 @@ type MyWebLogModel(ctx : NancyContext, webLog : WebLog) = /// User messages member val Messages = getMessages () with get, set /// The currently logged in user - member this.User = ctx.Request.PersistableSession.GetOrDefault(Keys.User, User.Empty) + member this.User = ctx.Request.PersistableSession.GetOrDefault (Keys.User, User.Empty) /// The title of the page member val PageTitle = "" with get, set /// The name and version of the application @@ -128,9 +128,10 @@ type MyWebLogModel(ctx : NancyContext, webLog : WebLog) = /// The page title with the web log name appended member this.DisplayPageTitle = match this.PageTitle with - | "" -> match this.WebLog.Subtitle with - | Some st -> sprintf "%s | %s" this.WebLog.Name st - | None -> this.WebLog.Name + | "" -> + match this.WebLog.Subtitle with + | Some st -> sprintf "%s | %s" this.WebLog.Name st + | None -> this.WebLog.Name | pt -> sprintf "%s | %s" pt this.WebLog.Name /// An image with the version and load time in the tool tip @@ -151,8 +152,8 @@ type MyWebLogModel(ctx : NancyContext, webLog : WebLog) = // ---- Admin models ---- /// Admin Dashboard view model -type DashboardModel(ctx, webLog, counts : DashboardCounts) = - inherit MyWebLogModel(ctx, webLog) +type DashboardModel (ctx, webLog, counts : DashboardCounts) = + inherit MyWebLogModel (ctx, webLog) /// The number of posts for the current web log member val Posts = counts.Posts with get, set /// The number of pages for the current web log @@ -190,15 +191,15 @@ with /// Model for the list of categories -type CategoryListModel(ctx, webLog, categories) = - inherit MyWebLogModel(ctx, webLog) +type CategoryListModel (ctx, webLog, categories) = + inherit MyWebLogModel (ctx, webLog) /// The categories member this.Categories : IndentedCategory list = categories /// Form for editing a category -type CategoryForm(category : Category) = - new() = CategoryForm(Category.Empty) +type CategoryForm (category : Category) = + new() = CategoryForm (Category.Empty) /// The name of the category member val Name = category.Name with get, set /// The slug of the category (used in category URLs) @@ -209,10 +210,10 @@ type CategoryForm(category : Category) = member val ParentId = defaultArg category.ParentId "" with get, set /// Model for editing a category -type CategoryEditModel(ctx, webLog, category) = - inherit MyWebLogModel(ctx, webLog) +type CategoryEditModel (ctx, webLog, category) = + inherit MyWebLogModel (ctx, webLog) /// The form with the category information - member val Form = CategoryForm(category) with get, set + member val Form = CategoryForm (category) with get, set /// The categories member val Categories : IndentedCategory list = [] with get, set @@ -220,14 +221,14 @@ type CategoryEditModel(ctx, webLog, category) = // ---- Page models ---- /// Model for page display -type PageModel(ctx, webLog, page) = - inherit MyWebLogModel(ctx, webLog) +type PageModel (ctx, webLog, page) = + inherit MyWebLogModel (ctx, webLog) /// The page to be displayed member this.Page : Page = page /// Wrapper for a page with additional properties -type PageForDisplay(webLog, page) = +type PageForDisplay (webLog, page) = /// The page member this.Page : Page = page /// The time zone of the web log @@ -239,8 +240,8 @@ type PageForDisplay(webLog, page) = /// Model for page list display -type PagesModel(ctx, webLog, pages) = - inherit MyWebLogModel(ctx, webLog) +type PagesModel (ctx, webLog, pages) = + inherit MyWebLogModel (ctx, webLog) /// The pages member this.Pages : PageForDisplay list = pages @@ -273,8 +274,8 @@ type EditPageForm() = /// Model for the edit page page -type EditPageModel(ctx, webLog, page, revision) = - inherit MyWebLogModel(ctx, webLog) +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 @@ -296,8 +297,8 @@ type EditPageModel(ctx, webLog, page, revision) = // ---- Post models ---- /// Model for single post display -type PostModel(ctx, webLog, post) = - inherit MyWebLogModel(ctx, webLog) +type PostModel (ctx, webLog, post) = + inherit MyWebLogModel (ctx, webLog) /// The post being displayed member this.Post : Post = post /// The next newer post @@ -321,7 +322,7 @@ type PostModel(ctx, webLog, post) = /// Wrapper for a post with additional properties -type PostForDisplay(webLog : WebLog, post : Post) = +type PostForDisplay (webLog : WebLog, post : Post) = /// Turn tags into a pipe-delimited string of tags let pipedTags tags = tags |> List.reduce (fun acc x -> sprintf "%s | %s" acc x) /// The actual post @@ -342,8 +343,8 @@ type PostForDisplay(webLog : WebLog, post : Post) = /// Model for all page-of-posts pages -type PostsModel(ctx, webLog) = - inherit MyWebLogModel(ctx, webLog) +type PostsModel (ctx, webLog) = + inherit MyWebLogModel (ctx, webLog) /// The subtitle for the page member val Subtitle : string option = None with get, set /// The posts to display @@ -368,7 +369,7 @@ type PostsModel(ctx, webLog) = /// Form for editing a post -type EditPostForm() = +type EditPostForm () = /// The title of the post member val Title = "" with get, set /// The permalink for the post @@ -399,8 +400,8 @@ type EditPostForm() = this /// View model for the edit post page -type EditPostModel(ctx, webLog, post, revision) = - inherit MyWebLogModel(ctx, webLog) +type EditPostModel (ctx, webLog, post, revision) = + inherit MyWebLogModel (ctx, webLog) /// The form member val Form = EditPostForm().ForPost(post).ForRevision(revision) with get, set @@ -419,7 +420,7 @@ type EditPostModel(ctx, webLog, post, revision) = // ---- User models ---- /// Form for the log on page -type LogOnForm() = +type LogOnForm () = /// The URL to which the user will be directed upon successful log on member val ReturnUrl = "" with get, set /// The e-mail address @@ -429,7 +430,7 @@ type LogOnForm() = /// Model to support the user log on page -type LogOnModel(ctx, webLog) = - inherit MyWebLogModel(ctx, webLog) +type LogOnModel (ctx, webLog) = + inherit MyWebLogModel (ctx, webLog) /// The log on form - member val Form = LogOnForm() with get, set + member val Form = LogOnForm () with get, set diff --git a/src/MyWebLog.Data.RethinkDB/DataConfig.fs b/src/MyWebLog.Data.RethinkDB/DataConfig.fs index 86057f5..0d993c2 100644 --- a/src/MyWebLog.Data.RethinkDB/DataConfig.fs +++ b/src/MyWebLog.Data.RethinkDB/DataConfig.fs @@ -27,32 +27,17 @@ type DataConfig = with /// Use RethinkDB defaults for non-provided options, and connect to the server static member Connect config = - let ensureHostname cfg = match cfg.Hostname with - | null -> { cfg with Hostname = RethinkDBConstants.DefaultHostname } - | _ -> cfg - let ensurePort cfg = match cfg.Port with - | 0 -> { cfg with Port = RethinkDBConstants.DefaultPort } - | _ -> cfg - let ensureAuthKey cfg = match cfg.AuthKey with - | null -> { cfg with AuthKey = RethinkDBConstants.DefaultAuthkey } - | _ -> cfg - let ensureTimeout cfg = match cfg.Timeout with - | 0 -> { cfg with Timeout = RethinkDBConstants.DefaultTimeout } - | _ -> cfg - let ensureDatabase cfg = match cfg.Database with - | null -> { cfg with Database = RethinkDBConstants.DefaultDbName } - | _ -> cfg - let connect cfg = { cfg with Conn = RethinkDB.R.Connection() - .Hostname(cfg.Hostname) - .Port(cfg.Port) - .AuthKey(cfg.AuthKey) - .Db(cfg.Database) - .Timeout(cfg.Timeout) - .Connect() } - config - |> ensureHostname - |> ensurePort - |> ensureAuthKey - |> ensureTimeout - |> ensureDatabase - |> connect + let host cfg = match cfg.Hostname with null -> { cfg with Hostname = RethinkDBConstants.DefaultHostname } | _ -> cfg + let port cfg = match cfg.Port with 0 -> { cfg with Port = RethinkDBConstants.DefaultPort } | _ -> cfg + let auth cfg = match cfg.AuthKey with null -> { cfg with AuthKey = RethinkDBConstants.DefaultAuthkey } | _ -> cfg + let timeout cfg = match cfg.Timeout with 0 -> { cfg with Timeout = RethinkDBConstants.DefaultTimeout } | _ -> cfg + let db cfg = match cfg.Database with null -> { cfg with Database = RethinkDBConstants.DefaultDbName } | _ -> cfg + let connect cfg = + { cfg with Conn = RethinkDB.R.Connection() + .Hostname(cfg.Hostname) + .Port(cfg.Port) + .AuthKey(cfg.AuthKey) + .Db(cfg.Database) + .Timeout(cfg.Timeout) + .Connect () } + (host >> port >> auth >> timeout >> db >> connect) config diff --git a/src/MyWebLog.Data.RethinkDB/Post.fs b/src/MyWebLog.Data.RethinkDB/Post.fs index f7da374..da4f62a 100644 --- a/src/MyWebLog.Data.RethinkDB/Post.fs +++ b/src/MyWebLog.Data.RethinkDB/Post.fs @@ -101,7 +101,7 @@ let tryFindPost conn webLogId postId : Post option = r.Table(Table.Post) .Get(postId) .Filter(ReqlFunction1 (fun p -> upcast p.["WebLogId"].Eq webLogId)) - .RunResultAsync conn + .RunAtomAsync conn return match box p with null -> None | post -> Some <| unbox post } |> Async.RunSynchronously diff --git a/src/MyWebLog.Data.RethinkDB/RethinkMyWebLogData.fs b/src/MyWebLog.Data.RethinkDB/RethinkMyWebLogData.fs index 04e0e26..a7cf789 100644 --- a/src/MyWebLog.Data.RethinkDB/RethinkMyWebLogData.fs +++ b/src/MyWebLog.Data.RethinkDB/RethinkMyWebLogData.fs @@ -40,7 +40,8 @@ type RethinkMyWebLogData(conn : IConnection, cfg : DataConfig) = member __.AddPost = Post.addPost conn member __.UpdatePost = Post.updatePost conn - member __.LogOn = User.tryUserLogOn conn + member __.LogOn = User.tryUserLogOn conn + member __.SetUserPassword = User.setUserPassword conn member __.WebLogByUrlBase = WebLog.tryFindWebLogByUrlBase conn member __.DashboardCounts = WebLog.findDashboardCounts conn diff --git a/src/MyWebLog.Data.RethinkDB/User.fs b/src/MyWebLog.Data.RethinkDB/User.fs index fd3ed48..0e4cecf 100644 --- a/src/MyWebLog.Data.RethinkDB/User.fs +++ b/src/MyWebLog.Data.RethinkDB/User.fs @@ -14,8 +14,18 @@ let tryUserLogOn conn (email : string) (passwordHash : string) = let! user = r.Table(Table.User) .GetAll(email).OptArg("index", "UserName") - .Filter(ReqlFunction1(fun u -> upcast u.["PasswordHash"].Eq(passwordHash))) + .Filter(ReqlFunction1 (fun u -> upcast u.["PasswordHash"].Eq passwordHash)) .RunResultAsync conn return user |> List.tryHead } |> Async.RunSynchronously + +/// Set a user's password +let setUserPassword conn (email : string) (passwordHash : string) = + async { + do! r.Table(Table.User) + .GetAll(email).OptArg("index", "UserName") + .Update(dict [ "PasswordHash", passwordHash ]) + .RunResultAsync conn + } + |> Async.RunSynchronously \ No newline at end of file diff --git a/src/MyWebLog.Entities/IMyWebLogData.fs b/src/MyWebLog.Entities/IMyWebLogData.fs index 3f4840b..2972f79 100644 --- a/src/MyWebLog.Entities/IMyWebLogData.fs +++ b/src/MyWebLog.Entities/IMyWebLogData.fs @@ -105,6 +105,9 @@ type IMyWebLogData = /// Attempt to log on a user abstract LogOn : (string -> string -> User option) + /// Set a user's password (e-mail, password hash) + abstract SetUserPassword : (string -> string -> unit) + // --- WebLog --- /// Get a web log by its URL base diff --git a/src/MyWebLog.Logic/User.fs b/src/MyWebLog.Logic/User.fs index 4ffa4d4..4c6c1dc 100644 --- a/src/MyWebLog.Logic/User.fs +++ b/src/MyWebLog.Logic/User.fs @@ -5,3 +5,5 @@ open MyWebLog.Data /// Try to log on a user let tryUserLogOn (data : IMyWebLogData) email passwordHash = data.LogOn email passwordHash + +let setUserPassword (data : IMyWebLogData) = data.SetUserPassword \ No newline at end of file diff --git a/src/MyWebLog.Resources/en-US.json b/src/MyWebLog.Resources/en-US.json index 05a86f6..f308d25 100644 --- a/src/MyWebLog.Resources/en-US.json +++ b/src/MyWebLog.Resources/en-US.json @@ -7,6 +7,7 @@ "Admin": "Admin", "AndPublished": " and Published", "andXMore": "and {0} more...", + "at": "at", "Categories": "Categories", "Category": "Category", "CategoryDeleteWarning": "Are you sure you wish to delete the category", diff --git a/src/MyWebLog/views/admin/content/admin.css b/src/MyWebLog/views/admin/content/admin.css new file mode 100644 index 0000000..7a8dc5c --- /dev/null +++ b/src/MyWebLog/views/admin/content/admin.css @@ -0,0 +1,5 @@ +footer { + background-color: #808080; + border-top: solid 1px black; + color: white; +} \ No newline at end of file diff --git a/src/myWebLog/views/admin/admin-layout.html b/src/myWebLog/views/admin/admin-layout.html index d281591..439dbcb 100644 --- a/src/myWebLog/views/admin/admin-layout.html +++ b/src/myWebLog/views/admin/admin-layout.html @@ -7,7 +7,7 @@ - +
@@ -46,7 +46,7 @@ - + @Section['Scripts']; \ No newline at end of file