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

Log on works now

Browse Source 
...but wait, there's more!
- Admin area dashboard works, list pages work
- Minor admin area style tweaks
This commit is contained in:
Daniel J. Summers 2016-11-10 22:17:46 -06:00
parent 1873f9d6fc
commit ed9b8adc1c
17 changed files with 378 additions and 347 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/MyWebLog.App/AdminModule.fs
View File

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

77
src/MyWebLog.App/App.fs
View File

@ -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\.(?<TranslationKey>[a-zA-Z0-9-_]+);?", RegexOptions.Compiled)
static let regex = Regex ("@Translate\.(?<TranslationKey>[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<AppConfig>(cfg)
container.Register<AppConfig> cfg
|> ignore
data.Force().SetUp ()
container.Register<IMyWebLogData>(data.Force ())
container.Register<IMyWebLogData> (data.Force ())
|> ignore
// NodaTime
container.Register<IClock>(SystemClock.Instance)
container.Register<IClock> SystemClock.Instance
|> ignore
// I18N in SSVE
container.Register<seq<ISuperSimpleViewEngineMatcher>>(fun _ _ ->
Seq.singleton (TranslateTokenViewEngineMatcher() :> ISuperSimpleViewEngineMatcher))
container.Register<ISuperSimpleViewEngineMatcher seq> (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<IUserMapper>())
UserMapper = container.Resolve<IUserMapper> ())
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<Startup>()
.Build()
host.Run()
.Build ()
host.Run ()

107
src/MyWebLog.App/CategoryModule.fs
View File

@ -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<CategoryForm> ()
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<CategoryForm> ()
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 ()

8
src/MyWebLog.App/ModuleExtensions.fs
View File

@ -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<Claim>(fun claim -> claim.Type = ClaimTypes.Role && claim.Value = sprintf "%s|%s" this.WebLog.Id level)
this.RequiresAuthentication()
let findClaim = Predicate<Claim> (fun claim ->
claim.Type = ClaimTypes.Role && claim.Value = sprintf "%s|%s" this.WebLog.Id level)
this.RequiresAuthentication ()
this.RequiresClaims [| findClaim |]

98
src/MyWebLog.App/PageModule.fs
View File

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

238
src/MyWebLog.App/PostModule.fs
View File

@ -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) " &nbsp; &nbsp; ")
(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) " &nbsp; &nbsp; ")
(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<EditPostForm>()
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<User>
(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<EditPostForm> ()
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<User>
(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 ()

43
src/MyWebLog.App/UserModule.fs
View File

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

71
src/MyWebLog.App/ViewModels.fs
View File

@ -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<UserMessage list>(Keys.Messages, [])
let msg = ctx.Request.PersistableSession.GetOrDefault<UserMessage list> (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<User>(Keys.User, User.Empty)
member this.User = ctx.Request.PersistableSession.GetOrDefault<User> (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

43
src/MyWebLog.Data.RethinkDB/DataConfig.fs
View File

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

2
src/MyWebLog.Data.RethinkDB/Post.fs
View File

@ -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<Post> conn
.RunAtomAsync<Post> conn
return match box p with null -> None | post -> Some <| unbox post
}
|> Async.RunSynchronously

3
src/MyWebLog.Data.RethinkDB/RethinkMyWebLogData.fs
View File

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

12
src/MyWebLog.Data.RethinkDB/User.fs
View File

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

3
src/MyWebLog.Entities/IMyWebLogData.fs
View File

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

2
src/MyWebLog.Logic/User.fs
View File

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

1
src/MyWebLog.Resources/en-US.json
View File

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

5
src/MyWebLog/views/admin/content/admin.css Normal file
View File

@ -0,0 +1,5 @@
footer {
background-color: #808080;
border-top: solid 1px black;
color: white;
}

4
src/myWebLog/views/admin/admin-layout.html
View File

@ -7,7 +7,7 @@
<link rel="stylesheet" type="text/css" href="//maxcdn.bootstrapcdn.com/bootstrap/3.3.4/css/bootstrap.css" />
<link rel="stylesheet" type="text/css" href="//maxcdn.bootstrapcdn.com/bootswatch/3.3.4/cosmo/bootstrap.min.css" />
<link rel="stylesheet" type="text/css" href="//maxcdn.bootstrapcdn.com/font-awesome/4.3.0/css/font-awesome.min.css" />
<link rel="stylesheet" type="text/css" href="/content/styles/admin.css" />
<link rel="stylesheet" type="text/css" href="/admin/content/admin.css" />
</head>
<body>
<header>
@ -46,7 +46,7 @@
</footer>
<script type="text/javascript" src="//ajax.aspnetcdn.com/ajax/jQuery/jquery-2.1.3.min.js"></script>
<script type="text/javascript" src="//maxcdn.bootstrapcdn.com/bootstrap/3.3.4/js/bootstrap.min.js"></script>
<script type="text/javascript" src="//tinymce.cachefly.net/4.1/tinymce.min.js"></script>
<script type="text/javascript" src="//cdn.tinymce.com/4/tinymce.min.js"></script>
@Section['Scripts'];
</body>
</html>