V2 #1

Merged
danieljsummers merged 102 commits from v2 into main 2022-06-23 00:35:12 +00:00
15 changed files with 409 additions and 66 deletions
Showing only changes of commit 1897095ff2 - Show all commits

View File

@ -94,7 +94,7 @@ module Startup =
let! _ = let! _ =
rethink { rethink {
withTable table withTable table
indexCreate "logOn" (fun row -> r.Array(row.G "webLogId", row.G "email")) indexCreate "logOn" (fun row -> r.Array(row.G "webLogId", row.G "userName"))
write write
withRetryOnce conn withRetryOnce conn
} }
@ -342,3 +342,14 @@ module WebLogUser =
ignoreResult ignoreResult
} }
/// Find a user by their e-mail address
let findByEmail (email : string) (webLogId : WebLogId) =
rethink<WebLogUser list> {
withTable Table.WebLogUser
getAll [ r.Array (webLogId, email) ] "logOn"
limit 1
result
withRetryDefault
}
|> tryFirst

View File

@ -30,3 +30,25 @@ type SinglePageModel =
} }
/// Is this the home page? /// Is this the home page?
member this.isHome with get () = PageId.toString this.page.id = this.webLog.defaultPage member this.isHome with get () = PageId.toString this.page.id = this.webLog.defaultPage
/// The model used to display the admin dashboard
type DashboardModel =
{ /// The number of published posts
posts : int
/// The number of post drafts
drafts : int
/// The number of pages
pages : int
/// The number of pages in the page list
listedPages : int
/// The number of categories
categories : int
/// The top-level categories
topLevelCategories : int
}

View File

@ -1,36 +1,139 @@
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module MyWebLog.Handlers module MyWebLog.Handlers
open DotLiquid
open Giraffe open Giraffe
open Microsoft.AspNetCore.Http
open MyWebLog open MyWebLog
open MyWebLog.ViewModels open MyWebLog.ViewModels
open RethinkDb.Driver.Net
open System open System
open System.Net
open System.Threading.Tasks
/// Handlers for error conditions
module Error =
(* open Microsoft.Extensions.Logging *)
(*/// Handle errors
let error (ex : Exception) (log : ILogger) =
log.LogError (EventId(), ex, "An unhandled exception has occurred while executing the request.")
clearResponse
>=> setStatusCode 500
>=> setHttpHeader "X-Toast" (sprintf "error|||%s: %s" (ex.GetType().Name) ex.Message)
>=> text ex.Message *)
/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
let notAuthorized : HttpHandler =
fun next ctx ->
(next, ctx)
||> match ctx.Request.Method with
| "GET" -> redirectTo false $"/user/log-on?returnUrl={WebUtility.UrlEncode ctx.Request.Path}"
| _ -> setStatusCode 401 >=> fun _ _ -> Task.FromResult<HttpContext option> None
/// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there
let notFound : HttpHandler =
setStatusCode 404 >=> text "Not found"
[<AutoOpen>] [<AutoOpen>]
module private Helpers = module private Helpers =
open DotLiquid open Microsoft.Extensions.DependencyInjection
open System.Collections.Concurrent open System.Collections.Concurrent
open System.IO open System.IO
/// Cache for parsed templates /// Cache for parsed templates
let private themeViews = ConcurrentDictionary<string, Template> () module private TemplateCache =
/// Return a view for a theme /// Cache of parsed templates
let themedView<'T> (template : string) (model : obj) : HttpHandler = fun next ctx -> task { let private views = ConcurrentDictionary<string, Template> ()
let webLog = WebLogCache.getByCtx ctx
let templatePath = $"themes/{webLog.themePath}/{template}" /// Get a template for the given web log
match themeViews.ContainsKey templatePath with let get (theme : string) (templateName : string) = task {
let templatePath = $"themes/{theme}/{templateName}"
match views.ContainsKey templatePath with
| true -> () | true -> ()
| false -> | false ->
let! file = File.ReadAllTextAsync $"{templatePath}.liquid" let! file = File.ReadAllTextAsync $"{templatePath}.liquid"
themeViews[templatePath] <- Template.Parse file views[templatePath] <- Template.Parse (file, SyntaxCompatibility.DotLiquid22)
let view = themeViews[templatePath].Render (Hash.FromAnonymousObject model) return views[templatePath]
return! htmlString view next ctx }
/// Either get the web log from the hash, or get it from the cache and add it to the hash
let deriveWebLogFromHash (hash : Hash) ctx =
match hash.ContainsKey "web_log" with
| true -> hash["web_log"] :?> WebLog
| false ->
let wl = WebLogCache.getByCtx ctx
hash.Add ("web_log", wl)
wl
/// Render a view for the specified theme, using the specified template, layout, and hash
let viewForTheme theme template layout next ctx = fun (hash : Hash) -> task {
// Don't need the web log, but this adds it to the hash if the function is called directly
let _ = deriveWebLogFromHash hash ctx
hash.Add ("logged_on", ctx.User.Identity.IsAuthenticated)
// NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a two-pass
// render; the net effect is a "layout" capability similar to Razor or Pug
// Render view content...
let! contentTemplate = TemplateCache.get theme template
hash.Add ("content", contentTemplate.Render hash)
// ...then render that content with its layout
let! layoutTemplate = TemplateCache.get theme (defaultArg layout "layout")
return! htmlString (layoutTemplate.Render hash) next ctx
}
/// Return a view for the web log's default theme
let themedView template layout next ctx = fun (hash : Hash) -> task {
return! viewForTheme (deriveWebLogFromHash hash ctx).themePath template layout next ctx hash
}
/// The web log ID for the current request
let webLogId ctx = (WebLogCache.getByCtx ctx).id
let conn (ctx : HttpContext) = ctx.RequestServices.GetRequiredService<IConnection> ()
module Admin =
// GET /admin/
let dashboard : HttpHandler =
requiresAuthentication Error.notFound
>=> fun next ctx -> task {
let webLogId' = webLogId ctx
let conn' = conn ctx
let getCount (f : WebLogId -> IConnection -> Task<int>) = f webLogId' conn'
let! posts = Data.Post.countByStatus Published |> getCount
let! drafts = Data.Post.countByStatus Draft |> getCount
let! pages = Data.Page.countAll |> getCount
let! listed = Data.Page.countListed |> getCount
let! cats = Data.Category.countAll |> getCount
let! topCats = Data.Category.countTopLevel |> getCount
return!
Hash.FromAnonymousObject
{| page_title = "Dashboard"
model =
{ posts = posts
drafts = drafts
pages = pages
listedPages = listed
categories = cats
topLevelCategories = topCats
}
|}
|> viewForTheme "admin" "dashboard" None next ctx
} }
module User = module User =
open Microsoft.AspNetCore.Authentication;
open Microsoft.AspNetCore.Authentication.Cookies
open System.Security.Claims
open System.Security.Cryptography open System.Security.Cryptography
open System.Text open System.Text
@ -40,12 +143,73 @@ module User =
use alg = new Rfc2898DeriveBytes (plainText, allSalt, 2_048) use alg = new Rfc2898DeriveBytes (plainText, allSalt, 2_048)
Convert.ToBase64String(alg.GetBytes(64)) Convert.ToBase64String(alg.GetBytes(64))
// GET /user/log-on
let logOn : HttpHandler = fun next ctx -> task {
return!
Hash.FromAnonymousObject {| page_title = "Log On" |}
|> viewForTheme "admin" "log-on" None next ctx
}
// POST /user/log-on
let doLogOn : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel> ()
match! Data.WebLogUser.findByEmail model.emailAddress (webLogId ctx) (conn ctx) with
| Some user when user.passwordHash = hashedPassword model.password user.userName user.salt ->
let claims = seq {
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.id)
Claim (ClaimTypes.Name, $"{user.firstName} {user.lastName}")
Claim (ClaimTypes.GivenName, user.preferredName)
Claim (ClaimTypes.Role, user.authorizationLevel.ToString ())
}
let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity,
AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow))
// TODO: confirmation message
return! redirectTo false "/admin/" next ctx
| _ ->
// TODO: make error, not 404
return! Error.notFound next ctx
}
let logOff : HttpHandler = fun next ctx -> task {
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
// TODO: confirmation message
return! redirectTo false "/" next ctx
}
module CatchAll = module CatchAll =
// GET /
let home : HttpHandler = fun next ctx -> task {
let webLog = WebLogCache.getByCtx ctx
match webLog.defaultPage with
| "posts" ->
// TODO: page of posts
return! Error.notFound next ctx
| pageId ->
match! Data.Page.findById (PageId pageId) webLog.id (conn ctx) with
| Some page ->
return!
Hash.FromAnonymousObject {| page = page; page_title = page.title |}
|> themedView "single-page" page.template next ctx
| None -> return! Error.notFound next ctx
}
let catchAll : HttpHandler = fun next ctx -> task { let catchAll : HttpHandler = fun next ctx -> task {
let testPage = { Page.empty with text = "Howdy, folks!" } let webLog = WebLogCache.getByCtx ctx
return! themedView "single-page" { page = testPage; webLog = WebLogCache.getByCtx ctx } next ctx let pageId = PageId webLog.defaultPage
match! Data.Page.findById pageId webLog.id (conn ctx) with
| Some page ->
return!
Hash.FromAnonymousObject {| page = page; page_title = page.title |}
|> themedView "single-page" page.template next ctx
| None -> return! Error.notFound next ctx
} }
open Giraffe.EndpointRouting open Giraffe.EndpointRouting
@ -53,7 +217,20 @@ open Giraffe.EndpointRouting
/// The endpoints defined in the above handlers /// The endpoints defined in the above handlers
let endpoints = [ let endpoints = [
GET [ GET [
route "" CatchAll.catchAll route "/" CatchAll.home
]
subRoute "/admin" [
GET [
route "/" Admin.dashboard
]
]
subRoute "/user" [
GET [
route "/log-on" User.logOn
route "/log-off" User.logOff
]
POST [
route "/log-on" User.doLogOn
]
] ]
] ]

View File

@ -103,6 +103,8 @@ let initDb args sp = task {
return! System.Threading.Tasks.Task.CompletedTask return! System.Threading.Tasks.Task.CompletedTask
} }
open DotLiquid
open MyWebLog.ViewModels
[<EntryPoint>] [<EntryPoint>]
let main args = let main args =
@ -132,6 +134,12 @@ let main args =
} |> Async.AwaitTask |> Async.RunSynchronously } |> Async.AwaitTask |> Async.RunSynchronously
let _ = builder.Services.AddSingleton<IConnection> conn let _ = builder.Services.AddSingleton<IConnection> conn
// Set up DotLiquid
let all = [| "*" |]
Template.RegisterSafeType (typeof<Page>, all)
Template.RegisterSafeType (typeof<WebLog>, all)
Template.RegisterSafeType (typeof<DashboardModel>, all)
let app = builder.Build () let app = builder.Build ()
match args |> Array.tryHead with match args |> Array.tryHead with

View File

@ -0,0 +1,50 @@
<article class="container pt-3">
<div class="row">
<section class="col-lg-5 offset-lg-1 col-xl-4 offset-xl-2 pb-3">
<div class="card">
<header class="card-header text-white bg-primary">Posts</header>
<div class="card-body">
<h6 class="card-subtitle text-muted pb-3">
Published <span class="badge rounded-pill bg-secondary">{{ model.posts }}</span>
&nbsp; Drafts <span class="badge rounded-pill bg-secondary">{{ model.drafts }}</span>
</h6>
<a href="/posts/list" class="btn btn-secondary me-2">View All</a>
<a href="/post/new/edit" class="btn btn-primary">Write a New Post</a>
</div>
</div>
</section>
<section class="col-lg-5 col-xl-4 pb-3">
<div class="card">
<header class="card-header text-white bg-primary">Pages</header>
<div class="card-body">
<h6 class="card-subtitle text-muted pb-3">
All <span class="badge rounded-pill bg-secondary">{{ model.pages }}</span>
&nbsp; Shown in Page List <span class="badge rounded-pill bg-secondary">{{ model.listed_pages }}</span>
</h6>
<a href="/pages/list" class="btn btn-secondary me-2">View All</a>
<a href="/page/new/edit" class="btn btn-primary">Create a New Page</a>
</div>
</div>
</section>
</div>
<div class="row">
<section class="col-lg-5 offset-lg-1 col-xl-4 offset-xl-2 pb-3">
<div class="card">
<header class="card-header text-white bg-secondary">Categories</header>
<div class="card-body">
<h6 class="card-subtitle text-muted pb-3">
All <span class="badge rounded-pill bg-secondary">{{ model.categories }}</span>
&nbsp; Top Level <span class="badge rounded-pill bg-secondary">{{ model.top_level_categories }}</span>
</h6>
<a href="/categories/list" class="btn btn-secondary me-2">View All</a>
<a href="/category/new/edit" class="btn btn-secondary">Add a New Category</a>
</div>
</div>
</section>
</div>
<div class="row pb-3">
<div class="col text-end">
<a href="/admin/settings" class="btn btn-secondary">Modify Settings</a>
</div>
</div>
</article>

View File

@ -0,0 +1,47 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta name="viewport" content="width=device-width" />
<title>{{ page_title | escape }} &laquo; Admin &laquo; {{ web_log.name | escape }}</title>
<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css"
integrity="sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" crossorigin="anonymous">
<link rel="stylesheet" href="/themes/admin/admin.css">
</head>
<body>
<header>
<nav class="navbar navbar-dark bg-dark navbar-expand-md justify-content-start px-2">
<div class="container-fluid">
<a class="navbar-brand" href="/">{{ web_log.name }}</a>
<button class="navbar-toggler" type="button" data-bs-toggle="collapse" data-bs-target="#navbarText"
aria-controls="navbarText" aria-expanded="false" aria-label="Toggle navigation">
<span class="navbar-toggler-icon"></span>
</button>
<div class="collapse navbar-collapse" id="navbarText">
<span class="navbar-text">{{ page_title }}</span>
<ul class="navbar-nav flex-grow-1 justify-content-end">
{% if logged_on -%}
<li class="nav-item"><a class="nav-link" href="/admin/">Dashboard</a></li>
<li class="nav-item"><a class="nav-link" href="/user/log-off">Log Off</a></li>
{%- else -%}
<li class="nav-item"><a class="nav-link" href="/user/log-on">Log On</a></li>
{%- endif %}
</ul>
</div>
</div>
</nav>
</header>
<main>
{{ content }}
</main>
<footer>
<div class="container-fluid">
<div class="row">
<div class="col-xs-12 text-end"><img src="/img/logo-light.png" alt="myWebLog"></div>
</div>
</div>
</footer>
<script src="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js"
integrity="sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM"
crossorigin="anonymous"></script>
</body>
</html>

View File

@ -0,0 +1,26 @@
<h2 class="p-3 ">Log On to {{ web_log.name }}</h2>
<article class="pb-3">
<form action="/user/log-on" method="post">
<div class="container">
<div class="row pb-3">
<div class="col col-md-6 col-lg-4 offset-lg-2">
<div class="form-floating">
<input type="email" id="email" name="emailAddress" class="form-control" autofocus required>
<label for="email">E-mail Address</label>
</div>
</div>
<div class="col col-md-6 col-lg-4">
<div class="form-floating">
<input type="password" id="password" name="password" class="form-control" required>
<label for="password">Password</label>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col text-center">
<button type="submit" class="btn btn-primary">Log On</button>
</div>
</div>
</div>
</form>
</article>

View File

@ -1,11 +0,0 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<meta name="viewport" content="width=device-width">
<meta name="generator" content="myWebLog 2">
<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css"
integrity="sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" crossorigin="anonymous">
<link asp-theme="@Model.WebLog.ThemePath" />
<title>{{ title | escape }} &laquo; {{ web_log_name | escape }}</title>
</head>

View File

@ -1,6 +0,0 @@
<footer>
<hr>
<div class="container-fluid text-end">
<img src="/img/logo-dark.png" alt="myWebLog">
</div>
</footer>

View File

@ -1,18 +0,0 @@
<header>
<nav class="navbar navbar-light bg-light navbar-expand-md justify-content-start px-2">
<div class="container-fluid">
<a class="navbar-brand" href="~/">{{ web_log.name }}</a>
<button class="navbar-toggler" type="button" data-bs-toggle="collapse" data-bs-target="#navbarText"
aria-controls="navbarText" aria-expanded="false" aria-label="Toggle navigation">
<span class="navbar-toggler-icon"></span>
</button>
<div class="collapse navbar-collapse" id="navbarText">
{% if web_log.subtitle -%}
<span class="navbar-text">{{ web_log.subtitle | escape }}</span>
{%- endif %}
@* TODO: list pages for current web log *@
@await Html.PartialAsync("_LogOnOffPartial")
</div>
</div>
</nav>
</header>

View File

@ -0,0 +1,47 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<meta name="viewport" content="width=device-width">
<meta name="generator" content="myWebLog 2">
<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css"
integrity="sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" crossorigin="anonymous">
<link rel="stylesheet" href="/themes/{{ web_log.theme_path }}/style.css">
<title>{{ page_title | escape }} &laquo; {{ web_log.name | escape }}</title>
</head>
<body>
<header>
<nav class="navbar navbar-light bg-light navbar-expand-md justify-content-start px-2">
<div class="container-fluid">
<a class="navbar-brand" href="/">{{ web_log.name }}</a>
<button class="navbar-toggler" type="button" data-bs-toggle="collapse" data-bs-target="#navbarText"
aria-controls="navbarText" aria-expanded="false" aria-label="Toggle navigation">
<span class="navbar-toggler-icon"></span>
</button>
<div class="collapse navbar-collapse" id="navbarText">
{% if web_log.subtitle -%}
<span class="navbar-text">{{ web_log.subtitle | escape }}</span>
{%- endif %}
<ul class="navbar-nav flex-grow-1 justify-content-end">
{% if logged_on %}
<li class="nav-item"><a class="nav-link" href="/admin/">Dashboard</a></li>
<li class="nav-item"><a class="nav-link" href="/user/log-off">Log Off</a></li>
{% else %}
<li class="nav-item"><a class="nav-link" href="/user/log-on">Log On</a></li>
{% endif %}
</ul>
</div>
</div>
</nav>
</header>
<main>
{{ content }}
</main>
<footer>
<hr>
<div class="container-fluid text-end">
<img src="/img/logo-dark.png" alt="myWebLog">
</div>
</footer>
</body>
</html>

View File

@ -1,14 +1,4 @@
<!DOCTYPE html> <h2>{{ page.title }}</h2>
<html lang="en"> <article>
{{ render "_html-head", title: title, web_log_name: web_log.name }}
<body>
{{ render "_page-head", web_log: web_log }}
<main>
<h2>{{ page.title }}</h2>
<article>
{{ page.text }} {{ page.text }}
</article> </article>
</main>
{{ render "_page-foot" }}
</body>
</html>

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.0 KiB