From 8ce2d5a2ed397cdd3d71cc818d620b8f5c8fef48 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Mon, 18 Apr 2022 01:05:06 -0400 Subject: [PATCH] Add anti-CSRF; add settings page --- src/MyWebLog.Domain/ViewModels.fs | 42 +-- .../Features/Admin/AdminController.fs | 62 ----- .../Features/Admin/AdminTypes.fs | 76 ------ .../Features/Admin/Index.cshtml | 61 ----- .../Features/Pages/PageTypes.fs | 15 -- .../Features/Posts/PostController.fs | 65 ----- .../Features/Posts/PostTypes.fs | 11 - .../Features/Shared/SharedTypes.fs | 45 ---- src/MyWebLog.FS.Old/Handlers.fs | 2 - src/MyWebLog.FS.Old/MyWebLog.FS.Old.fsproj | 39 --- src/MyWebLog.FS.Old/Program.fs | 175 ------------ .../Properties/launchSettings.json | 28 -- src/MyWebLog.FS.Old/Resources.resx | 252 ------------------ src/MyWebLog.FS.Old/WebLogCache.fs | 27 -- .../appsettings.Development.json | 8 - src/MyWebLog.FS.Old/appsettings.json | 9 - src/MyWebLog.sln | 6 - src/MyWebLog/Handlers.fs | 224 ++++++++++++---- src/MyWebLog/Program.fs | 26 +- src/MyWebLog/themes/admin/log-on.liquid | 1 + src/MyWebLog/themes/admin/settings.liquid | 55 ++++ 21 files changed, 260 insertions(+), 969 deletions(-) delete mode 100644 src/MyWebLog.FS.Old/Features/Admin/AdminController.fs delete mode 100644 src/MyWebLog.FS.Old/Features/Admin/AdminTypes.fs delete mode 100644 src/MyWebLog.FS.Old/Features/Admin/Index.cshtml delete mode 100644 src/MyWebLog.FS.Old/Features/Pages/PageTypes.fs delete mode 100644 src/MyWebLog.FS.Old/Features/Posts/PostController.fs delete mode 100644 src/MyWebLog.FS.Old/Features/Posts/PostTypes.fs delete mode 100644 src/MyWebLog.FS.Old/Features/Shared/SharedTypes.fs delete mode 100644 src/MyWebLog.FS.Old/Handlers.fs delete mode 100644 src/MyWebLog.FS.Old/MyWebLog.FS.Old.fsproj delete mode 100644 src/MyWebLog.FS.Old/Program.fs delete mode 100644 src/MyWebLog.FS.Old/Properties/launchSettings.json delete mode 100644 src/MyWebLog.FS.Old/Resources.resx delete mode 100644 src/MyWebLog.FS.Old/WebLogCache.fs delete mode 100644 src/MyWebLog.FS.Old/appsettings.Development.json delete mode 100644 src/MyWebLog.FS.Old/appsettings.json create mode 100644 src/MyWebLog/themes/admin/settings.liquid diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index 227e460..a13c5c3 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -1,13 +1,5 @@ namespace MyWebLog.ViewModels -open MyWebLog - -/// Base model class for myWebLog views -type MyWebLogModel (webLog : WebLog) = - - /// The details for the web log - member val WebLog = webLog with get - /// The model to use to allow a user to log on [] @@ -20,18 +12,6 @@ type LogOnModel = } -/// The model used to render a single page -type SinglePageModel = - { /// The page to be rendered - page : Page - - /// The web log to which the page belongs - webLog : WebLog - } - /// 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 @@ -51,4 +31,24 @@ type DashboardModel = /// The top-level categories topLevelCategories : int - } \ No newline at end of file + } + + +/// View model for editing web log settings +[] +type SettingsModel = + { /// The name of the web log + name : string + + /// The subtitle of the web log + subtitle : string + + /// The default page + defaultPage : string + + /// How many posts should appear on index pages + postsPerPage : int + + /// The time zone in which dates/times should be displayed + timeZone : string + } diff --git a/src/MyWebLog.FS.Old/Features/Admin/AdminController.fs b/src/MyWebLog.FS.Old/Features/Admin/AdminController.fs deleted file mode 100644 index be3bdfb..0000000 --- a/src/MyWebLog.FS.Old/Features/Admin/AdminController.fs +++ /dev/null @@ -1,62 +0,0 @@ -namespace MyWebLog.Features.Admin - -open Microsoft.AspNetCore.Authorization -open Microsoft.AspNetCore.Mvc -open Microsoft.AspNetCore.Mvc.Rendering -open MyWebLog -open MyWebLog.Features.Shared -open RethinkDb.Driver.Net -open System.Threading.Tasks - -/// Controller for admin-specific displays and routes -[] -[] -type AdminController () = - inherit MyWebLogController () - - [] - member this.Index () = task { - let getCount (f : WebLogId -> IConnection -> Task) = f this.WebLog.id this.Db - 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 this.View (DashboardModel ( - this.WebLog, - Posts = posts, - Drafts = drafts, - Pages = pages, - ListedPages = listed, - Categories = cats, - TopLevelCategories = topCats - )) - } - - [] - member this.Settings() = task { - let! allPages = Data.Page.findAll this.WebLog.id this.Db - return this.View (SettingsModel ( - this.WebLog, - DefaultPages = - (Seq.singleton (SelectListItem ("- {Resources.FirstPageOfPosts} -", "posts")) - |> Seq.append (allPages |> Seq.map (fun p -> SelectListItem (p.title, PageId.toString p.id)))) - )) - } - - [] - member this.SaveSettings (model : SettingsModel) = task { - match! Data.WebLog.findByHost this.WebLog.urlBase this.Db with - | Some webLog -> - let updated = model.UpdateSettings webLog - do! Data.WebLog.updateSettings updated this.Db - - // Update cache - WebLogCache.set (WebLogCache.hostToDb this.HttpContext) updated - - // TODO: confirmation message - - return this.RedirectToAction (nameof this.Index); - | None -> return this.NotFound () - } diff --git a/src/MyWebLog.FS.Old/Features/Admin/AdminTypes.fs b/src/MyWebLog.FS.Old/Features/Admin/AdminTypes.fs deleted file mode 100644 index 951ce4a..0000000 --- a/src/MyWebLog.FS.Old/Features/Admin/AdminTypes.fs +++ /dev/null @@ -1,76 +0,0 @@ -namespace MyWebLog.Features.Admin - -open MyWebLog -open MyWebLog.Features.Shared - -/// The model used to display the dashboard -type DashboardModel (webLog) = - inherit MyWebLogModel (webLog) - - /// The number of published posts - member val Posts = 0 with get, set - - /// The number of post drafts - member val Drafts = 0 with get, set - - /// The number of pages - member val Pages = 0 with get, set - - /// The number of pages in the page list - member val ListedPages = 0 with get, set - - /// The number of categories - member val Categories = 0 with get, set - - /// The top-level categories - member val TopLevelCategories = 0 with get, set - - -open Microsoft.AspNetCore.Mvc.Rendering -open System.ComponentModel.DataAnnotations - -/// View model for editing web log settings -type SettingsModel (webLog) = - inherit MyWebLogModel (webLog) - - /// Default constructor - [] - new() = SettingsModel WebLog.empty - - /// The name of the web log - [] - [, Name = "Name")>] - member val Name = webLog.name with get, set - - /// The subtitle of the web log - [, Name = "Subtitle")>] - member val Subtitle = (defaultArg webLog.subtitle "") with get, set - - /// The default page - [] - [, Name = "DefaultPage")>] - member val DefaultPage = webLog.defaultPage with get, set - - /// How many posts should appear on index pages - [] - [, Name = "PostsPerPage")>] - [] - member val PostsPerPage = webLog.postsPerPage with get, set - - /// The time zone in which dates/times should be displayed - [] - [, Name = "TimeZone")>] - member val TimeZone = webLog.timeZone with get, set - - /// Possible values for the default page - member val DefaultPages = Seq.empty with get, set - - /// Update the settings object from the data in this form - member this.UpdateSettings (settings : WebLog) = - { settings with - name = this.Name - subtitle = (match this.Subtitle with "" -> None | sub -> Some sub) - defaultPage = this.DefaultPage - postsPerPage = this.PostsPerPage - timeZone = this.TimeZone - } diff --git a/src/MyWebLog.FS.Old/Features/Admin/Index.cshtml b/src/MyWebLog.FS.Old/Features/Admin/Index.cshtml deleted file mode 100644 index 72ef232..0000000 --- a/src/MyWebLog.FS.Old/Features/Admin/Index.cshtml +++ /dev/null @@ -1,61 +0,0 @@ -@model DashboardModel -@{ - Layout = "_AdminLayout"; - ViewBag.Title = Resources.Dashboard; -} -
-
-
-
-
@Resources.Posts
-
-
- @Resources.Published @Model.Posts -   @Resources.Drafts @Model.Drafts -
- @Resources.ViewAll - - @Resources.WriteANewPost - -
-
-
-
-
-
@Resources.Pages
-
-
- @Resources.All @Model.Pages -   @Resources.ShownInPageList @Model.ListedPages -
- @Resources.ViewAll - - @Resources.CreateANewPage - -
-
-
-
-
-
-
-
@Resources.Categories
-
-
- @Resources.All @Model.Categories -   @Resources.TopLevel @Model.TopLevelCategories -
- @Resources.ViewAll - - @Resources.AddANewCategory - -
-
-
-
-
-
- @Resources.ModifySettings -
-
-
diff --git a/src/MyWebLog.FS.Old/Features/Pages/PageTypes.fs b/src/MyWebLog.FS.Old/Features/Pages/PageTypes.fs deleted file mode 100644 index a9b4ad4..0000000 --- a/src/MyWebLog.FS.Old/Features/Pages/PageTypes.fs +++ /dev/null @@ -1,15 +0,0 @@ -namespace MyWebLog.Features.Pages - -open MyWebLog -open MyWebLog.Features.Shared - -/// The model used to render a single page -type SinglePageModel (page : Page, webLog) = - inherit MyWebLogModel (webLog) - - /// The page to be rendered - member _.Page with get () = page - - /// Is this the home page? - member _.IsHome with get() = PageId.toString page.id = webLog.defaultPage - diff --git a/src/MyWebLog.FS.Old/Features/Posts/PostController.fs b/src/MyWebLog.FS.Old/Features/Posts/PostController.fs deleted file mode 100644 index 7f0782e..0000000 --- a/src/MyWebLog.FS.Old/Features/Posts/PostController.fs +++ /dev/null @@ -1,65 +0,0 @@ -namespace MyWebLog.Features.Posts - -open Microsoft.AspNetCore.Authorization -open Microsoft.AspNetCore.Mvc -open MyWebLog -open MyWebLog.Features.Pages -open MyWebLog.Features.Shared -open System -open System.Threading.Tasks - -/// Handle post-related requests -[] -[] -type PostController () = - inherit MyWebLogController () - - [] - [] - member this.Index () = task { - match this.WebLog.defaultPage with - | "posts" -> return! this.PageOfPosts 1 - | pageId -> - match! Data.Page.findById (PageId pageId) this.WebLog.id this.Db with - | Some page -> - return this.ThemedView (defaultArg page.template "SinglePage", SinglePageModel (page, this.WebLog)) - | None -> return this.NotFound () - } - - [] - [] - member this.PageOfPosts (pageNbr : int) = task { - let! posts = Data.Post.findPageOfPublishedPosts this.WebLog.id pageNbr this.WebLog.postsPerPage this.Db - return this.ThemedView ("Index", MultiplePostModel (posts, this.WebLog)) - } - - [] - member this.CatchAll (link : string) = task { - let permalink = Permalink link - match! Data.Post.findByPermalink permalink this.WebLog.id this.Db with - | Some post -> return this.NotFound () - // TODO: return via single-post action - | None -> - match! Data.Page.findByPermalink permalink this.WebLog.id this.Db with - | Some page -> - return this.ThemedView (defaultArg page.template "SinglePage", SinglePageModel (page, this.WebLog)) - | None -> - - // TOOD: search prior permalinks for posts and pages - - // We tried, we really tried... - Console.Write($"Returning 404 for permalink |{permalink}|"); - return this.NotFound () - } - - [] - member this.All () = task { - do! Task.CompletedTask; - NotImplementedException () |> raise - } - - [] - member this.Edit(postId : string) = task { - do! Task.CompletedTask; - NotImplementedException () |> raise - } diff --git a/src/MyWebLog.FS.Old/Features/Posts/PostTypes.fs b/src/MyWebLog.FS.Old/Features/Posts/PostTypes.fs deleted file mode 100644 index df6f522..0000000 --- a/src/MyWebLog.FS.Old/Features/Posts/PostTypes.fs +++ /dev/null @@ -1,11 +0,0 @@ -namespace MyWebLog.Features.Posts - -open MyWebLog -open MyWebLog.Features.Shared - -/// The model used to render multiple posts -type MultiplePostModel (posts : Post seq, webLog) = - inherit MyWebLogModel (webLog) - - /// The posts to be rendered - member _.Posts with get () = posts diff --git a/src/MyWebLog.FS.Old/Features/Shared/SharedTypes.fs b/src/MyWebLog.FS.Old/Features/Shared/SharedTypes.fs deleted file mode 100644 index 239403f..0000000 --- a/src/MyWebLog.FS.Old/Features/Shared/SharedTypes.fs +++ /dev/null @@ -1,45 +0,0 @@ -namespace MyWebLog.Features.Shared - -open Microsoft.AspNetCore.Mvc -open Microsoft.Extensions.DependencyInjection -open MyWebLog -open RethinkDb.Driver.Net -open System.Security.Claims - -/// Base class for myWebLog controllers -type MyWebLogController () = - inherit Controller () - - /// The data context to use to fulfil this request - member this.Db with get () = this.HttpContext.RequestServices.GetRequiredService () - - /// The details for the current web log - member this.WebLog with get () = WebLogCache.getByCtx this.HttpContext - - /// The ID of the currently authenticated user - member this.UserId with get () = - this.User.Claims - |> Seq.tryFind (fun c -> c.Type = ClaimTypes.NameIdentifier) - |> Option.map (fun c -> c.Value) - |> Option.defaultValue "" - - /// Retern a themed view - member this.ThemedView (template : string, model : obj) : IActionResult = - // TODO: get actual version - this.ViewData["Version"] <- "2" - this.View (template, model) - - /// Return a 404 response - member _.NotFound () : IActionResult = - base.NotFound () - - /// Redirect to an action in this controller - member _.RedirectToAction action : IActionResult = - base.RedirectToAction action - - -/// Base model class for myWebLog views -type MyWebLogModel (webLog : WebLog) = - - /// The details for the web log - member _.WebLog with get () = webLog diff --git a/src/MyWebLog.FS.Old/Handlers.fs b/src/MyWebLog.FS.Old/Handlers.fs deleted file mode 100644 index 24e4bf5..0000000 --- a/src/MyWebLog.FS.Old/Handlers.fs +++ /dev/null @@ -1,2 +0,0 @@ -module MyWebLog.Handlers - diff --git a/src/MyWebLog.FS.Old/MyWebLog.FS.Old.fsproj b/src/MyWebLog.FS.Old/MyWebLog.FS.Old.fsproj deleted file mode 100644 index f2687b2..0000000 --- a/src/MyWebLog.FS.Old/MyWebLog.FS.Old.fsproj +++ /dev/null @@ -1,39 +0,0 @@ - - - - net6.0 - - - - - - - - - - - - - - - - - - - - - - True - True - Resources.resx - - - - - - ResXFileCodeGenerator - Resources.Designer.fs - - - - diff --git a/src/MyWebLog.FS.Old/Program.fs b/src/MyWebLog.FS.Old/Program.fs deleted file mode 100644 index 508449e..0000000 --- a/src/MyWebLog.FS.Old/Program.fs +++ /dev/null @@ -1,175 +0,0 @@ -open Microsoft.AspNetCore.Mvc.Razor -open System.Reflection - -/// Types to support feature folders -module FeatureSupport = - - open Microsoft.AspNetCore.Mvc.ApplicationModels - open System.Collections.Concurrent - - /// A controller model convention that identifies the feature in which a controller exists - type FeatureControllerModelConvention () = - - /// A cache of controller types to features - static let _features = ConcurrentDictionary () - - /// Derive the feature name from the controller's type - static let getFeatureName (typ : TypeInfo) : string option = - let cacheKey = Option.ofObj typ.FullName |> Option.defaultValue "" - match _features.ContainsKey cacheKey with - | true -> Some _features[cacheKey] - | false -> - let tokens = cacheKey.Split '.' - match tokens |> Array.contains "Features" with - | true -> - let feature = tokens |> Array.skipWhile (fun it -> it <> "Features") |> Array.skip 1 |> Array.tryHead - match feature with - | Some f -> - _features[cacheKey] <- f - feature - | None -> None - | false -> None - - interface IControllerModelConvention with - /// - member _.Apply (controller: ControllerModel) = - controller.Properties.Add("feature", getFeatureName controller.ControllerType) - - - open Microsoft.AspNetCore.Mvc.Controllers - - /// Expand the location token with the feature name - type FeatureViewLocationExpander () = - - interface IViewLocationExpander with - - /// - member _.ExpandViewLocations - (context : ViewLocationExpanderContext, viewLocations : string seq) : string seq = - if isNull context then nullArg (nameof context) - if isNull viewLocations then nullArg (nameof viewLocations) - match context.ActionContext.ActionDescriptor with - | :? ControllerActionDescriptor as descriptor -> - let feature = string descriptor.Properties["feature"] - viewLocations |> Seq.map (fun location -> location.Replace ("{2}", feature)) - | _ -> invalidArg "context" "ActionDescriptor not found" - - /// - member _.PopulateValues(_ : ViewLocationExpanderContext) = () - - -open MyWebLog - -/// Types to support themed views -module ThemeSupport = - - /// Expand the location token with the theme path - type ThemeViewLocationExpander () = - interface IViewLocationExpander with - - /// - member _.ExpandViewLocations - (context : ViewLocationExpanderContext, viewLocations : string seq) : string seq = - if isNull context then nullArg (nameof context) - if isNull viewLocations then nullArg (nameof viewLocations) - - viewLocations |> Seq.map (fun location -> location.Replace ("{3}", string context.Values["theme"])) - - /// - member _.PopulateValues (context : ViewLocationExpanderContext) = - if isNull context then nullArg (nameof context) - - context.Values["theme"] <- (WebLogCache.getByCtx context.ActionContext.HttpContext).themePath - - -open Microsoft.AspNetCore.Http -open Microsoft.Extensions.DependencyInjection - -/// Custom middleware for this application -module Middleware = - - open RethinkDb.Driver.Net - open System.Threading.Tasks - - /// Middleware to derive the current web log - type WebLogMiddleware (next : RequestDelegate) = - - member _.InvokeAsync (context : HttpContext) : Task = task { - let host = WebLogCache.hostToDb context - - match WebLogCache.exists host with - | true -> () - | false -> - let conn = context.RequestServices.GetRequiredService () - match! Data.WebLog.findByHost (context.Request.Host.ToUriComponent ()) conn with - | Some details -> WebLogCache.set host details - | None -> () - - match WebLogCache.exists host with - | true -> do! next.Invoke context - | false -> context.Response.StatusCode <- 404 - } - - -open Microsoft.AspNetCore.Authentication.Cookies -open Microsoft.AspNetCore.Builder -open Microsoft.Extensions.Hosting -open Microsoft.AspNetCore.Mvc -open System -open System.IO - -[] -let main args = - let builder = WebApplication.CreateBuilder(args) - let _ = - builder.Services - .AddMvc(fun opts -> - opts.Conventions.Add (FeatureSupport.FeatureControllerModelConvention ()) - opts.Filters.Add (AutoValidateAntiforgeryTokenAttribute ())) - .AddRazorOptions(fun opts -> - opts.ViewLocationFormats.Clear () - opts.ViewLocationFormats.Add "/Themes/{3}/{0}.cshtml" - opts.ViewLocationFormats.Add "/Themes/{3}/Shared/{0}.cshtml" - opts.ViewLocationFormats.Add "/Themes/Default/{0}.cshtml" - opts.ViewLocationFormats.Add "/Themes/Default/Shared/{0}.cshtml" - opts.ViewLocationFormats.Add "/Features/{2}/{1}/{0}.cshtml" - opts.ViewLocationFormats.Add "/Features/{2}/{0}.cshtml" - opts.ViewLocationFormats.Add "/Features/Shared/{0}.cshtml" - opts.ViewLocationExpanders.Add (FeatureSupport.FeatureViewLocationExpander ()) - opts.ViewLocationExpanders.Add (ThemeSupport.ThemeViewLocationExpander ())) - let _ = - builder.Services - .AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme) - .AddCookie(fun opts -> - opts.ExpireTimeSpan <- TimeSpan.FromMinutes 20. - opts.SlidingExpiration <- true - opts.AccessDeniedPath <- "/forbidden") - let _ = builder.Services.AddAuthorization() - let _ = builder.Services.AddSingleton () - (* builder.Services.AddDbContext(o => - { - // TODO: can get from DI? - var db = WebLogCache.HostToDb(new HttpContextAccessor().HttpContext!); - // "empty"; - o.UseSqlite($"Data Source=Db/{db}.db"); - }); *) - - // Load themes - Directory.GetFiles (Directory.GetCurrentDirectory (), "MyWebLog.Themes.*.dll") - |> Array.map Assembly.LoadFile - |> ignore - - let app = builder.Build () - - let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict)) - let _ = app.UseMiddleware () - let _ = app.UseAuthentication () - let _ = app.UseStaticFiles () - let _ = app.UseRouting () - let _ = app.UseAuthorization () - let _ = app.UseEndpoints (fun endpoints -> endpoints.MapControllers () |> ignore) - - app.Run() - - 0 // Exit code - diff --git a/src/MyWebLog.FS.Old/Properties/launchSettings.json b/src/MyWebLog.FS.Old/Properties/launchSettings.json deleted file mode 100644 index 0982978..0000000 --- a/src/MyWebLog.FS.Old/Properties/launchSettings.json +++ /dev/null @@ -1,28 +0,0 @@ -{ - "iisSettings": { - "windowsAuthentication": false, - "anonymousAuthentication": true, - "iisExpress": { - "applicationUrl": "http://localhost:29920", - "sslPort": 44344 - } - }, - "profiles": { - "MyWebLog.FS": { - "commandName": "Project", - "dotnetRunMessages": true, - "launchBrowser": true, - "applicationUrl": "https://localhost:7134;http://localhost:5134", - "environmentVariables": { - "ASPNETCORE_ENVIRONMENT": "Development" - } - }, - "IIS Express": { - "commandName": "IISExpress", - "launchBrowser": true, - "environmentVariables": { - "ASPNETCORE_ENVIRONMENT": "Development" - } - } - } -} diff --git a/src/MyWebLog.FS.Old/Resources.resx b/src/MyWebLog.FS.Old/Resources.resx deleted file mode 100644 index 1b52285..0000000 --- a/src/MyWebLog.FS.Old/Resources.resx +++ /dev/null @@ -1,252 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - text/microsoft-resx - - - 2.0 - - - System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - - System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - - Actions - - - Add a New Category - - - Add a New Page - - - Admin - - - All - - - Categories - - - Create a New Page - - - Dashboard - - - MMMM d, yyyy - - - Default Page - - - Drafts - - - Edit - - - Edit Page - - - E-mail Address - - - First Page of Posts - - - In List? - - - Last Updated - - - Log Off - - - Log On - - - Log On to - - - Modify Settings - - - Name - - - No - - - Pages - - - Page Text - - - Password - - - Permalink - - - Posts - - - Posts per Page - - - Published - - - Save Changes - - - Show in Page List - - - Shown in Page List - - - Subtitle - - - There are {0} categories - - - There are {0} pages - - - There are {0} published posts and {1} drafts - - - Time Zone - - - Title - - - Top Level - - - View All - - - Web Log Settings - - - Write a New Post - - - Yes - - \ No newline at end of file diff --git a/src/MyWebLog.FS.Old/WebLogCache.fs b/src/MyWebLog.FS.Old/WebLogCache.fs deleted file mode 100644 index e5ab9c7..0000000 --- a/src/MyWebLog.FS.Old/WebLogCache.fs +++ /dev/null @@ -1,27 +0,0 @@ -/// -/// In-memory cache of web log details -/// -/// This is filled by the middleware via the first request for each host, and can be updated via the web log -/// settings update page -module MyWebLog.WebLogCache - -open Microsoft.AspNetCore.Http -open System.Collections.Concurrent - -/// The cache of web log details -let private _cache = ConcurrentDictionary () - -/// Transform a hostname to a database name -let hostToDb (ctx : HttpContext) = ctx.Request.Host.ToUriComponent().Replace (':', '_') - -/// Does a host exist in the cache? -let exists host = _cache.ContainsKey host - -/// Get the details for a web log via its host -let getByHost host = _cache[host] - -/// Get the details for a web log via its host -let getByCtx ctx = _cache[hostToDb ctx] - -/// Set the details for a particular host -let set host details = _cache[host] <- details diff --git a/src/MyWebLog.FS.Old/appsettings.Development.json b/src/MyWebLog.FS.Old/appsettings.Development.json deleted file mode 100644 index 0c208ae..0000000 --- a/src/MyWebLog.FS.Old/appsettings.Development.json +++ /dev/null @@ -1,8 +0,0 @@ -{ - "Logging": { - "LogLevel": { - "Default": "Information", - "Microsoft.AspNetCore": "Warning" - } - } -} diff --git a/src/MyWebLog.FS.Old/appsettings.json b/src/MyWebLog.FS.Old/appsettings.json deleted file mode 100644 index 10f68b8..0000000 --- a/src/MyWebLog.FS.Old/appsettings.json +++ /dev/null @@ -1,9 +0,0 @@ -{ - "Logging": { - "LogLevel": { - "Default": "Information", - "Microsoft.AspNetCore": "Warning" - } - }, - "AllowedHosts": "*" -} diff --git a/src/MyWebLog.sln b/src/MyWebLog.sln index d3d3242..c7e1bce 100644 --- a/src/MyWebLog.sln +++ b/src/MyWebLog.sln @@ -13,8 +13,6 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "MyWebLog.Data", "MyWebLog.D EndProject Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "MyWebLog.CS", "MyWebLog.CS\MyWebLog.CS.csproj", "{B23A8093-28B1-4CB5-93F1-B4659516B74F}" EndProject -Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "MyWebLog.FS.Old", "MyWebLog.FS.Old\MyWebLog.FS.Old.fsproj", "{C0AD7194-572E-4112-87C4-5235987C90C1}" -EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyWebLog", "MyWebLog\MyWebLog.fsproj", "{5655B63D-429F-4CCD-A14C-FBD74D987ECB}" EndProject Global @@ -43,10 +41,6 @@ Global {B23A8093-28B1-4CB5-93F1-B4659516B74F}.Debug|Any CPU.Build.0 = Debug|Any CPU {B23A8093-28B1-4CB5-93F1-B4659516B74F}.Release|Any CPU.ActiveCfg = Release|Any CPU {B23A8093-28B1-4CB5-93F1-B4659516B74F}.Release|Any CPU.Build.0 = Release|Any CPU - {C0AD7194-572E-4112-87C4-5235987C90C1}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {C0AD7194-572E-4112-87C4-5235987C90C1}.Debug|Any CPU.Build.0 = Debug|Any CPU - {C0AD7194-572E-4112-87C4-5235987C90C1}.Release|Any CPU.ActiveCfg = Release|Any CPU - {C0AD7194-572E-4112-87C4-5235987C90C1}.Release|Any CPU.Build.0 = Release|Any CPU {5655B63D-429F-4CCD-A14C-FBD74D987ECB}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {5655B63D-429F-4CCD-A14C-FBD74D987ECB}.Debug|Any CPU.Build.0 = Debug|Any CPU {5655B63D-429F-4CCD-A14C-FBD74D987ECB}.Release|Any CPU.ActiveCfg = Release|Any CPU diff --git a/src/MyWebLog/Handlers.fs b/src/MyWebLog/Handlers.fs index 339f633..8addda5 100644 --- a/src/MyWebLog/Handlers.fs +++ b/src/MyWebLog/Handlers.fs @@ -1,6 +1,7 @@ [] module MyWebLog.Handlers +open System.Collections.Generic open DotLiquid open Giraffe open Microsoft.AspNetCore.Http @@ -40,6 +41,7 @@ module Error = [] module private Helpers = + open Microsoft.AspNetCore.Antiforgery open Microsoft.Extensions.DependencyInjection open System.Collections.Concurrent open System.IO @@ -97,38 +99,162 @@ module private Helpers = let webLogId ctx = (WebLogCache.getByCtx ctx).id let conn (ctx : HttpContext) = ctx.RequestServices.GetRequiredService () + + let private antiForgery (ctx : HttpContext) = ctx.RequestServices.GetRequiredService () + + /// Get the cross-site request forgery token set + let csrfToken (ctx : HttpContext) = + (antiForgery ctx).GetAndStoreTokens ctx + + /// Validate the cross-site request forgery token in the current request + let validateCsrf : HttpHandler = fun next ctx -> task { + match! (antiForgery ctx).IsRequestValidAsync ctx with + | true -> return! next ctx + | false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" next ctx + } + + /// Require a user to be logged on + let requireUser = requiresAuthentication Error.notAuthorized +/// Handlers to manipulate admin functions 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 - } + let dashboard : HttpHandler = requireUser >=> 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 + } + + // GET /admin/settings + let settings : HttpHandler = requireUser >=> fun next ctx -> task { + let webLog = WebLogCache.getByCtx ctx + let! allPages = Data.Page.findAll webLog.id (conn ctx) + return! + Hash.FromAnonymousObject + {| csrf = csrfToken ctx + model = + { name = webLog.name + subtitle = defaultArg webLog.subtitle "" + defaultPage = webLog.defaultPage + postsPerPage = webLog.postsPerPage + timeZone = webLog.timeZone + } + pages = + seq { + KeyValuePair.Create ("posts", "- First Page of Posts -") + yield! allPages + |> List.map (fun p -> KeyValuePair.Create (PageId.toString p.id, p.title)) + } + |> Array.ofSeq + web_log = webLog + page_title = "Web Log Settings" + |} + |> viewForTheme "admin" "settings" None next ctx + } + + // POST /admin/settings + let saveSettings : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { + let conn' = conn ctx + let! model = ctx.BindFormAsync () + match! Data.WebLog.findByHost (WebLogCache.getByCtx ctx).urlBase conn' with + | Some webLog -> + let updated = + { webLog with + name = model.name + subtitle = match model.subtitle with "" -> None | it -> Some it + defaultPage = model.defaultPage + postsPerPage = model.postsPerPage + timeZone = model.timeZone + } + do! Data.WebLog.updateSettings updated conn' + // Update cache + WebLogCache.set updated.urlBase updated + + // TODO: confirmation message + + return! redirectTo false "/admin/" next ctx + | None -> return! Error.notFound next ctx + } + + +/// Handlers to manipulate posts +module Post = + + // GET /page/{pageNbr} + let pageOfPosts (pageNbr : int) : HttpHandler = fun next ctx -> task { + let webLog = WebLogCache.getByCtx ctx + let! posts = Data.Post.findPageOfPublishedPosts webLog.id pageNbr webLog.postsPerPage (conn ctx) + let hash = Hash.FromAnonymousObject {| posts = posts |} + let title = + match pageNbr, webLog.defaultPage with + | 1, "posts" -> None + | _, "posts" -> Some $"Page {pageNbr}" + | _, _ -> Some $"Page {pageNbr} « Posts" + match title with Some ttl -> hash.Add ("page_title", ttl) | None -> () + return! themedView "index" None next ctx hash + } + + // GET / + let home : HttpHandler = fun next ctx -> task { + let webLog = WebLogCache.getByCtx ctx + match webLog.defaultPage with + | "posts" -> return! pageOfPosts 1 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 + } + + // GET * + let catchAll (link : string) : HttpHandler = fun next ctx -> task { + let webLog = WebLogCache.getByCtx ctx + let conn' = conn ctx + let permalink = Permalink link + match! Data.Post.findByPermalink permalink webLog.id conn' with + | Some post -> return! Error.notFound next ctx + // TODO: return via single-post action + | None -> + match! Data.Page.findByPermalink permalink webLog.id conn' with + | Some page -> + return! + Hash.FromAnonymousObject {| page = page; page_title = page.title |} + |> themedView "single-page" page.template next ctx + | None -> + + // TOOD: search prior permalinks for posts and pages + + // We tried, we really tried... + Console.Write($"Returning 404 for permalink |{permalink}|"); + return! Error.notFound next ctx + } + + +/// Handlers to manipulate users module User = open Microsoft.AspNetCore.Authentication; @@ -146,12 +272,12 @@ module User = // GET /user/log-on let logOn : HttpHandler = fun next ctx -> task { return! - Hash.FromAnonymousObject {| page_title = "Log On" |} + Hash.FromAnonymousObject {| page_title = "Log On"; csrf = (csrfToken ctx) |} |> viewForTheme "admin" "log-on" None next ctx } // POST /user/log-on - let doLogOn : HttpHandler = fun next ctx -> task { + let doLogOn : HttpHandler = validateCsrf >=> 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 -> @@ -181,47 +307,27 @@ module User = 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 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 /// The endpoints defined in the above handlers let endpoints = [ GET [ - route "/" CatchAll.home + route "/" Post.home ] subRoute "/admin" [ GET [ - route "/" Admin.dashboard + route "/" Admin.dashboard + route "/settings" Admin.settings + ] + POST [ + route "/settings" Admin.saveSettings + ] + ] + subRoute "/page" [ + GET [ + routef "/%d" Post.pageOfPosts ] ] subRoute "/user" [ diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index b1402f5..6f8a23f 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -1,13 +1,7 @@ -open Giraffe.EndpointRouting -open Microsoft.AspNetCore.Authentication.Cookies -open Microsoft.AspNetCore.Builder +open System.Collections.Generic open Microsoft.AspNetCore.Http -open Microsoft.Extensions.Configuration -open Microsoft.Extensions.Hosting open Microsoft.Extensions.DependencyInjection -open Microsoft.Extensions.Logging open MyWebLog -open RethinkDb.Driver.FSharp open RethinkDb.Driver.Net open System @@ -103,8 +97,17 @@ let initDb args sp = task { return! System.Threading.Tasks.Task.CompletedTask } + open DotLiquid +open Giraffe +open Giraffe.EndpointRouting +open Microsoft.AspNetCore.Antiforgery +open Microsoft.AspNetCore.Authentication.Cookies +open Microsoft.AspNetCore.Builder +open Microsoft.Extensions.Configuration +open Microsoft.Extensions.Logging open MyWebLog.ViewModels +open RethinkDb.Driver.FSharp [] let main args = @@ -118,7 +121,9 @@ let main args = opts.SlidingExpiration <- true opts.AccessDeniedPath <- "/forbidden") let _ = builder.Services.AddLogging () - let _ = builder.Services.AddAuthorization() + let _ = builder.Services.AddAuthorization () + let _ = builder.Services.AddAntiforgery () + let _ = builder.Services.AddGiraffe () // Configure RethinkDB's connection JsonConverters.all () |> Seq.iter Converter.Serializer.Converters.Add @@ -139,6 +144,11 @@ let main args = Template.RegisterSafeType (typeof, all) Template.RegisterSafeType (typeof, all) Template.RegisterSafeType (typeof, all) + Template.RegisterSafeType (typeof, all) + + Template.RegisterSafeType (typeof, all) + Template.RegisterSafeType (typeof>, all) // doesn't quite get the job done.... + Template.RegisterSafeType (typeof, all) let app = builder.Build () diff --git a/src/MyWebLog/themes/admin/log-on.liquid b/src/MyWebLog/themes/admin/log-on.liquid index ead975f..e9a2626 100644 --- a/src/MyWebLog/themes/admin/log-on.liquid +++ b/src/MyWebLog/themes/admin/log-on.liquid @@ -1,6 +1,7 @@ 

Log On to {{ web_log.name }}

+
diff --git a/src/MyWebLog/themes/admin/settings.liquid b/src/MyWebLog/themes/admin/settings.liquid new file mode 100644 index 0000000..8e6da4f --- /dev/null +++ b/src/MyWebLog/themes/admin/settings.liquid @@ -0,0 +1,55 @@ +
+ + +
+
+
+
+ + +
+
+
+
+ + +
+
+
+
+
+
+ + +
+
+
+
+ + +
+
+
+
+ + +
+
+
+
+
+ +
+
+
+ +