Log on works now
...but wait, there's more! - Admin area dashboard works, list pages work - Minor admin area style tweaks
This commit is contained in:
parent
1873f9d6fc
commit
ed9b8adc1c
@ -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) =
|
||||
|
||||
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)
|
||||
| user when user.Id = string identifier -> upcast MyWebLogUser user
|
||||
| _ -> null
|
||||
|
||||
|
||||
@ -71,30 +78,28 @@ 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"))
|
||||
// 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 ())
|
||||
|> ignore
|
||||
// NodaTime
|
||||
container.Register<IClock>(SystemClock.Instance)
|
||||
container.Register<IClock> SystemClock.Instance
|
||||
|> ignore
|
||||
// I18N in SSVE
|
||||
container.Register<seq<ISuperSimpleViewEngineMatcher>>(fun _ _ ->
|
||||
container.Register<ISuperSimpleViewEngineMatcher seq> (fun _ _ ->
|
||||
Seq.singleton (TranslateTokenViewEngineMatcher () :> ISuperSimpleViewEngineMatcher))
|
||||
|> ignore
|
||||
|
||||
@ -113,7 +118,7 @@ type MyWebLogBootstrapper() =
|
||||
// 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)
|
||||
@ -151,7 +156,7 @@ type Startup() =
|
||||
member this.Configure (app : IApplicationBuilder) =
|
||||
let opt = NancyOptions ()
|
||||
opt.Bootstrapper <- new MyWebLogBootstrapper ()
|
||||
app.UseOwin(fun x -> x.UseNancy(opt) |> ignore) |> ignore
|
||||
app.UseOwin (fun x -> x.UseNancy opt |> ignore) |> ignore
|
||||
|
||||
|
||||
let Run () =
|
||||
|
@ -22,19 +22,20 @@ type CategoryModule(data : IMyWebLogData) as this =
|
||||
/// 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)
|
||||
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 ""))
|
||||
@ -47,18 +48,20 @@ type CategoryModule(data : IMyWebLogData) as this =
|
||||
this.RequiresAccessLevel AuthorizationLevel.Administrator
|
||||
let catId = parameters.["id"].ToString ()
|
||||
let form = this.Bind<CategoryForm> ()
|
||||
let oldCat = match catId with
|
||||
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
|
||||
|> 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
|
||||
| _ ->
|
||||
match old.ParentId with
|
||||
| Some parentId -> removeCategoryFromParent data this.WebLog.Id parentId newCatId
|
||||
| _ -> ()
|
||||
match cat.ParentId with
|
||||
@ -80,9 +83,11 @@ 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
|
||||
| Some cat ->
|
||||
deleteCategory data cat
|
||||
let model = MyWebLogModel(this.Context, this.WebLog)
|
||||
{ UserMessage.Empty with Level = Level.Info
|
||||
{ UserMessage.Empty with
|
||||
Level = Level.Info
|
||||
Message = System.String.Format(Strings.get "MsgCategoryDeleted", cat.Name) }
|
||||
|> model.AddMessage
|
||||
this.Redirect "/categories" model
|
||||
|
@ -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)
|
||||
let findClaim = Predicate<Claim> (fun claim ->
|
||||
claim.Type = ClaimTypes.Role && claim.Value = sprintf "%s|%s" this.WebLog.Id level)
|
||||
this.RequiresAuthentication ()
|
||||
this.RequiresClaims [| findClaim |]
|
||||
|
@ -23,8 +23,9 @@ type PageModule(data : IMyWebLogData, clock : IClock) as this =
|
||||
/// 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,7 +35,8 @@ 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
|
||||
| Some page ->
|
||||
let rev = match page.Revisions
|
||||
|> List.sortByDescending (fun r -> r.AsOf)
|
||||
|> List.tryHead with
|
||||
| Some r -> r
|
||||
@ -51,8 +53,10 @@ type PageModule(data : IMyWebLogData, clock : IClock) as this =
|
||||
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
|
||||
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
|
||||
@ -81,9 +85,11 @@ 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
|
||||
| Some page ->
|
||||
deletePage data page.WebLogId page.Id
|
||||
let model = MyWebLogModel (this.Context, this.WebLog)
|
||||
{ UserMessage.Empty with Level = Level.Info
|
||||
{ UserMessage.Empty with
|
||||
Level = Level.Info
|
||||
Message = Strings.get "MsgPageDeleted" }
|
||||
|> model.AddMessage
|
||||
this.Redirect "/pages" model
|
||||
|
@ -139,8 +139,10 @@ 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)
|
||||
| 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 ()
|
||||
@ -172,7 +174,8 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
|
||||
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
|
||||
| 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
|
||||
@ -215,7 +218,8 @@ 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
|
||||
| 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))
|
||||
@ -239,8 +243,10 @@ 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
|
||||
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
|
||||
@ -248,8 +254,7 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
|
||||
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) " ")
|
||||
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"]
|
||||
@ -262,18 +267,19 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
|
||||
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
|
||||
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
|
||||
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
|
||||
|
@ -24,7 +24,7 @@ type UserModule(data : IMyWebLogData, cfg : AppConfig) as this =
|
||||
|
||||
do
|
||||
this.Get ("/logon", fun _ -> this.ShowLogOn ())
|
||||
this.Post("/logon", fun parms -> this.DoLogOn (downcast parms))
|
||||
this.Post ("/logon", fun p -> this.DoLogOn (downcast p))
|
||||
this.Get ("/logoff", fun _ -> this.LogOff ())
|
||||
|
||||
/// Show the log on page
|
||||
@ -40,15 +40,16 @@ 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
|
||||
| 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
|
||||
| _ ->
|
||||
{ UserMessage.Empty with
|
||||
Level = Level.Error
|
||||
Message = Strings.get "ErrBadLogOnAttempt" }
|
||||
|> model.AddMessage
|
||||
this.Redirect (sprintf "/user/logon?returnUrl=%s" form.ReturnUrl) model
|
||||
@ -59,8 +60,6 @@ type UserModule(data : IMyWebLogData, cfg : AppConfig) as this =
|
||||
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
|
||||
model.AddMessage { UserMessage.Empty with Message = Strings.get "MsgLogOffSuccess" }
|
||||
this.Redirect "" model |> ignore
|
||||
upcast this.LogoutAndRedirect "/"
|
||||
|
@ -128,7 +128,8 @@ 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
|
||||
| "" ->
|
||||
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
|
||||
|
@ -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()
|
||||
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 () }
|
||||
config
|
||||
|> ensureHostname
|
||||
|> ensurePort
|
||||
|> ensureAuthKey
|
||||
|> ensureTimeout
|
||||
|> ensureDatabase
|
||||
|> connect
|
||||
(host >> port >> auth >> timeout >> db >> connect) config
|
||||
|
@ -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
|
||||
|
@ -41,6 +41,7 @@ type RethinkMyWebLogData(conn : IConnection, cfg : DataConfig) =
|
||||
member __.UpdatePost = Post.updatePost conn
|
||||
|
||||
member __.LogOn = User.tryUserLogOn conn
|
||||
member __.SetUserPassword = User.setUserPassword conn
|
||||
|
||||
member __.WebLogByUrlBase = WebLog.tryFindWebLogByUrlBase conn
|
||||
member __.DashboardCounts = WebLog.findDashboardCounts conn
|
||||
|
@ -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
|
@ -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
|
||||
|
@ -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
|
@ -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
5
src/MyWebLog/views/admin/content/admin.css
Normal file
@ -0,0 +1,5 @@
|
||||
footer {
|
||||
background-color: #808080;
|
||||
border-top: solid 1px black;
|
||||
color: white;
|
||||
}
|
@ -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>
|
Loading…
x
Reference in New Issue
Block a user