diff --git a/src/MyWebLog.Data/Data.fs b/src/MyWebLog.Data/Data.fs index b2b734a..71e1d59 100644 --- a/src/MyWebLog.Data/Data.fs +++ b/src/MyWebLog.Data/Data.fs @@ -94,7 +94,7 @@ module Startup = let! _ = rethink { 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 withRetryOnce conn } @@ -341,4 +341,15 @@ module WebLogUser = withRetryDefault ignoreResult } + + /// Find a user by their e-mail address + let findByEmail (email : string) (webLogId : WebLogId) = + rethink { + withTable Table.WebLogUser + getAll [ r.Array (webLogId, email) ] "logOn" + limit 1 + result + withRetryDefault + } + |> tryFirst \ No newline at end of file diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index 3d421f0..227e460 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -30,3 +30,25 @@ type SinglePageModel = } /// Is this the home page? 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 + } \ No newline at end of file diff --git a/src/MyWebLog/Handlers.fs b/src/MyWebLog/Handlers.fs index 262e2b7..339f633 100644 --- a/src/MyWebLog/Handlers.fs +++ b/src/MyWebLog/Handlers.fs @@ -1,36 +1,139 @@ [] module MyWebLog.Handlers +open DotLiquid open Giraffe +open Microsoft.AspNetCore.Http open MyWebLog open MyWebLog.ViewModels +open RethinkDb.Driver.Net 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 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" + [] module private Helpers = - open DotLiquid + open Microsoft.Extensions.DependencyInjection open System.Collections.Concurrent open System.IO /// Cache for parsed templates - let private themeViews = ConcurrentDictionary () + module private TemplateCache = + + /// Cache of parsed templates + let private views = ConcurrentDictionary () + + /// Get a template for the given web log + let get (theme : string) (templateName : string) = task { + let templatePath = $"themes/{theme}/{templateName}" + match views.ContainsKey templatePath with + | true -> () + | false -> + let! file = File.ReadAllTextAsync $"{templatePath}.liquid" + views[templatePath] <- Template.Parse (file, SyntaxCompatibility.DotLiquid22) + return views[templatePath] + } - /// Return a view for a theme - let themedView<'T> (template : string) (model : obj) : HttpHandler = fun next ctx -> task { - let webLog = WebLogCache.getByCtx ctx - let templatePath = $"themes/{webLog.themePath}/{template}" - match themeViews.ContainsKey templatePath with - | true -> () + /// 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! file = File.ReadAllTextAsync $"{templatePath}.liquid" - themeViews[templatePath] <- Template.Parse file - let view = themeViews[templatePath].Render (Hash.FromAnonymousObject model) - return! htmlString view next ctx + 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 () + + +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) = 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 = + open Microsoft.AspNetCore.Authentication; + open Microsoft.AspNetCore.Authentication.Cookies + open System.Security.Claims open System.Security.Cryptography open System.Text @@ -39,13 +142,74 @@ module User = let allSalt = Array.concat [ salt.ToByteArray(); (Encoding.UTF8.GetBytes email) ] use alg = new Rfc2898DeriveBytes (plainText, allSalt, 2_048) 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 () + 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 = + // 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 testPage = { Page.empty with text = "Howdy, folks!" } - return! themedView "single-page" { page = testPage; webLog = WebLogCache.getByCtx ctx } next ctx + let webLog = WebLogCache.getByCtx 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 @@ -53,7 +217,20 @@ open Giraffe.EndpointRouting /// The endpoints defined in the above handlers let endpoints = [ 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 + ] ] ] - \ No newline at end of file diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 6f89575..b1402f5 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -103,6 +103,8 @@ let initDb args sp = task { return! System.Threading.Tasks.Task.CompletedTask } +open DotLiquid +open MyWebLog.ViewModels [] let main args = @@ -131,6 +133,12 @@ let main args = return conn } |> Async.AwaitTask |> Async.RunSynchronously let _ = builder.Services.AddSingleton conn + + // Set up DotLiquid + let all = [| "*" |] + Template.RegisterSafeType (typeof, all) + Template.RegisterSafeType (typeof, all) + Template.RegisterSafeType (typeof, all) let app = builder.Build () diff --git a/src/MyWebLog/themes/admin/dashboard.liquid b/src/MyWebLog/themes/admin/dashboard.liquid new file mode 100644 index 0000000..7347437 --- /dev/null +++ b/src/MyWebLog/themes/admin/dashboard.liquid @@ -0,0 +1,50 @@ + diff --git a/src/MyWebLog/themes/admin/layout.liquid b/src/MyWebLog/themes/admin/layout.liquid new file mode 100644 index 0000000..88e2929 --- /dev/null +++ b/src/MyWebLog/themes/admin/layout.liquid @@ -0,0 +1,47 @@ + + + + + {{ page_title | escape }} « Admin « {{ web_log.name | escape }} + + + + +
+ +
+
+ {{ content }} +
+
+
+
+
myWebLog
+
+
+
+ + + diff --git a/src/MyWebLog/themes/admin/log-on.liquid b/src/MyWebLog/themes/admin/log-on.liquid new file mode 100644 index 0000000..ead975f --- /dev/null +++ b/src/MyWebLog/themes/admin/log-on.liquid @@ -0,0 +1,26 @@ +

Log On to {{ web_log.name }}

+
+
+
+
+
+
+ + +
+
+
+
+ + +
+
+
+
+
+ +
+
+
+
+
diff --git a/src/MyWebLog/themes/default/_html-head.liquid b/src/MyWebLog/themes/default/_html-head.liquid deleted file mode 100644 index 68400c0..0000000 --- a/src/MyWebLog/themes/default/_html-head.liquid +++ /dev/null @@ -1,11 +0,0 @@ - - - - - - - - - {{ title | escape }} « {{ web_log_name | escape }} - diff --git a/src/MyWebLog/themes/default/_page-foot.liquid b/src/MyWebLog/themes/default/_page-foot.liquid deleted file mode 100644 index f96fc6f..0000000 --- a/src/MyWebLog/themes/default/_page-foot.liquid +++ /dev/null @@ -1,6 +0,0 @@ -
-
-
- myWebLog -
-
diff --git a/src/MyWebLog/themes/default/_page-head.liquid b/src/MyWebLog/themes/default/_page-head.liquid deleted file mode 100644 index 7a3ebcd..0000000 --- a/src/MyWebLog/themes/default/_page-head.liquid +++ /dev/null @@ -1,18 +0,0 @@ -
- -
diff --git a/src/MyWebLog/themes/default/layout.liquid b/src/MyWebLog/themes/default/layout.liquid new file mode 100644 index 0000000..893d41a --- /dev/null +++ b/src/MyWebLog/themes/default/layout.liquid @@ -0,0 +1,47 @@ + + + + + + + + + {{ page_title | escape }} « {{ web_log.name | escape }} + + +
+ +
+
+ {{ content }} +
+
+
+
+ myWebLog +
+
+ + diff --git a/src/MyWebLog/themes/default/single-page.liquid b/src/MyWebLog/themes/default/single-page.liquid index 9b6f6a4..58d0cc2 100644 --- a/src/MyWebLog/themes/default/single-page.liquid +++ b/src/MyWebLog/themes/default/single-page.liquid @@ -1,14 +1,4 @@ - - - {{ render "_html-head", title: title, web_log_name: web_log.name }} - - {{ render "_page-head", web_log: web_log }} -
-

{{ page.title }}

-
- {{ page.text }} -
-
- {{ render "_page-foot" }} - - +

{{ page.title }}

+
+ {{ page.text }} +
diff --git a/src/MyWebLog/wwwroot/img/logo-dark.png b/src/MyWebLog/wwwroot/img/logo-dark.png new file mode 100644 index 0000000..19bdcca Binary files /dev/null and b/src/MyWebLog/wwwroot/img/logo-dark.png differ diff --git a/src/MyWebLog/wwwroot/img/logo-light.png b/src/MyWebLog/wwwroot/img/logo-light.png new file mode 100644 index 0000000..c2d3357 Binary files /dev/null and b/src/MyWebLog/wwwroot/img/logo-light.png differ diff --git a/src/MyWebLog/wwwroot/admin/admin.css b/src/MyWebLog/wwwroot/themes/admin/admin.css similarity index 100% rename from src/MyWebLog/wwwroot/admin/admin.css rename to src/MyWebLog/wwwroot/themes/admin/admin.css