diff --git a/src/MyWebLog.Data/Converters.fs b/src/MyWebLog.Data/Converters.fs index 0542f49..4c38c45 100644 --- a/src/MyWebLog.Data/Converters.fs +++ b/src/MyWebLog.Data/Converters.fs @@ -20,6 +20,13 @@ type CommentIdConverter () = override _.ReadJson (reader : JsonReader, _ : Type, _ : CommentId, _ : bool, _ : JsonSerializer) = (string >> CommentId) reader.Value +type MarkupTextConverter () = + inherit JsonConverter () + override _.WriteJson (writer : JsonWriter, value : MarkupText, _ : JsonSerializer) = + writer.WriteValue (MarkupText.toString value) + override _.ReadJson (reader : JsonReader, _ : Type, _ : MarkupText, _ : bool, _ : JsonSerializer) = + (string >> MarkupText.parse) reader.Value + type PermalinkConverter () = inherit JsonConverter () override _.WriteJson (writer : JsonWriter, value : Permalink, _ : JsonSerializer) = @@ -63,6 +70,7 @@ let all () : JsonConverter seq = // Our converters CategoryIdConverter () CommentIdConverter () + MarkupTextConverter () PermalinkConverter () PageIdConverter () PostIdConverter () diff --git a/src/MyWebLog.Data/Data.fs b/src/MyWebLog.Data/Data.fs index d969ac3..22b8b01 100644 --- a/src/MyWebLog.Data/Data.fs +++ b/src/MyWebLog.Data/Data.fs @@ -40,13 +40,13 @@ module Helpers = /// Verify that the web log ID matches before returning an item let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (f : IConnection -> Task<'T option>) = - fun conn -> task { + fun conn -> backgroundTask { match! f conn with Some it when (prop it) = webLogId -> return Some it | _ -> return None } /// Get the first item from a list, or None if the list is empty let tryFirst<'T> (f : IConnection -> Task<'T list>) = - fun conn -> task { + fun conn -> backgroundTask { let! results = f conn return results |> List.tryHead } @@ -59,82 +59,52 @@ open Microsoft.Extensions.Logging module Startup = /// Ensure field indexes exist, as well as special indexes for selected tables - let private ensureIndexes (log : ILogger) conn table fields = task { + let private ensureIndexes (log : ILogger) conn table fields = backgroundTask { let! indexes = rethink { withTable table; indexList; result; withRetryOnce conn } for field in fields do - match indexes |> List.contains field with - | true -> () - | false -> + if not (indexes |> List.contains field) then log.LogInformation($"Creating index {table}.{field}...") - let! _ = rethink { withTable table; indexCreate field; write; withRetryOnce conn } - () + do! rethink { withTable table; indexCreate field; write; withRetryOnce; ignoreResult conn } // Post and page need index by web log ID and permalink - match [ Table.Page; Table.Post ] |> List.contains table with - | true -> - match indexes |> List.contains "permalink" with - | true -> () - | false -> + if [ Table.Page; Table.Post ] |> List.contains table then + if not (indexes |> List.contains "permalink") then log.LogInformation($"Creating index {table}.permalink...") - let! _ = - rethink { - withTable table - indexCreate "permalink" (fun row -> r.Array(row.G "webLogId", row.G "permalink")) - write - withRetryOnce conn - } - () + do! rethink { + withTable table + indexCreate "permalink" (fun row -> r.Array(row.G "webLogId", row.G "permalink") :> obj) + write; withRetryOnce; ignoreResult conn + } // Prior permalinks are searched when a post or page permalink do not match the current URL - match indexes |> List.contains "priorPermalinks" with - | true -> () - | false -> + if not (indexes |> List.contains "priorPermalinks") then log.LogInformation($"Creating index {table}.priorPermalinks...") - let! _ = - rethink { - withTable table - indexCreate "priorPermalinks" - indexOption Multi - write - withRetryOnce conn - } - () - | false -> () + do! rethink { + withTable table + indexCreate "priorPermalinks" [ Multi ] + write; withRetryOnce; ignoreResult conn + } // Users log on with e-mail - match Table.WebLogUser = table with - | true -> - match indexes |> List.contains "logOn" with - | true -> () - | false -> - log.LogInformation($"Creating index {table}.logOn...") - let! _ = - rethink { - withTable table - indexCreate "logOn" (fun row -> r.Array(row.G "webLogId", row.G "userName")) - write - withRetryOnce conn - } - () - | false -> () + if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then + log.LogInformation($"Creating index {table}.logOn...") + do! rethink { + withTable table + indexCreate "logOn" (fun row -> r.Array(row.G "webLogId", row.G "userName") :> obj) + write; withRetryOnce; ignoreResult conn + } } /// Ensure all necessary tables and indexes exist let ensureDb (config : DataConfig) (log : ILogger) conn = task { let! dbs = rethink { dbList; result; withRetryOnce conn } - match dbs |> List.contains config.Database with - | true -> () - | false -> + if not (dbs |> List.contains config.Database) then log.LogInformation($"Creating database {config.Database}...") - let! _ = rethink { dbCreate config.Database; write; withRetryOnce conn } - () + do! rethink { dbCreate config.Database; write; withRetryOnce; ignoreResult conn } let! tables = rethink { tableList; result; withRetryOnce conn } for tbl in Table.all do - match tables |> List.contains tbl with - | true -> () - | false -> + if not (tables |> List.contains tbl) then log.LogInformation($"Creating table {tbl}...") - let! _ = rethink { tableCreate tbl; write; withRetryOnce conn } - () + do! rethink { tableCreate tbl; write; withRetryOnce; ignoreResult conn } let makeIdx = ensureIndexes log conn do! makeIdx Table.Category [ "webLogId" ] @@ -154,8 +124,7 @@ module Category = withTable Table.Category getAll [ webLogId ] (nameof webLogId) count - result - withRetryDefault + result; withRetryDefault } /// Count top-level categories for a web log @@ -165,8 +134,7 @@ module Category = getAll [ webLogId ] (nameof webLogId) filter "parentId" None count - result - withRetryDefault + result; withRetryDefault } @@ -178,9 +146,7 @@ module Page = rethink { withTable Table.Page insert page - write - withRetryDefault - ignoreResult + write; withRetryDefault; ignoreResult } /// Count all pages for a web log @@ -189,8 +155,7 @@ module Page = withTable Table.Page getAll [ webLogId ] (nameof webLogId) count - result - withRetryDefault + result; withRetryDefault } /// Count listed pages for a web log @@ -200,8 +165,7 @@ module Page = getAll [ webLogId ] (nameof webLogId) filter "showInPageList" true count - result - withRetryDefault + result; withRetryDefault } /// Retrieve all pages for a web log (excludes text, prior permalinks, and revisions) @@ -210,8 +174,7 @@ module Page = withTable Table.Page getAll [ webLogId ] (nameof webLogId) without [ "text", "priorPermalinks", "revisions" ] - result - withRetryDefault + result; withRetryDefault } /// Find a page by its ID (including prior permalinks and revisions) @@ -219,8 +182,7 @@ module Page = rethink { withTable Table.Page get pageId - resultOption - withRetryDefault + resultOption; withRetryDefault } |> verifyWebLog webLogId (fun it -> it.webLogId) @@ -230,8 +192,7 @@ module Page = withTable Table.Page get pageId without [ "priorPermalinks", "revisions" ] - resultOption - withRetryDefault + resultOption; withRetryDefault } |> verifyWebLog webLogId (fun it -> it.webLogId) @@ -242,8 +203,7 @@ module Page = getAll [ r.Array (webLogId, permalink) ] (nameof permalink) without [ "priorPermalinks", "revisions" ] limit 1 - result - withRetryDefault + result; withRetryDefault } |> tryFirst @@ -255,8 +215,7 @@ module Page = filter [ "webLogId", webLogId :> obj ] pluck [ "permalink" ] limit 1 - result - withRetryDefault + result; withRetryDefault } |> tryFirst @@ -268,8 +227,7 @@ module Page = filter [ "showInPageList", true :> obj ] without [ "text", "priorPermalinks", "revisions" ] orderBy "title" - result - withRetryDefault + result; withRetryDefault } /// Find a list of pages (displayed in admin area) @@ -281,8 +239,7 @@ module Page = orderBy "title" skip ((pageNbr - 1) * 25) limit 25 - result - withRetryDefault + result; withRetryDefault } /// Update a page @@ -299,9 +256,7 @@ module Page = "priorPermalinks", page.priorPermalinks "revisions", page.revisions ] - write - withRetryDefault - ignoreResult + write; withRetryDefault; ignoreResult } /// Functions to manipulate posts @@ -314,8 +269,7 @@ module Post = getAll [ webLogId ] (nameof webLogId) filter "status" status count - result - withRetryDefault + result; withRetryDefault } /// Find a post by its permalink @@ -325,8 +279,7 @@ module Post = getAll [ r.Array(permalink, webLogId) ] (nameof permalink) without [ "priorPermalinks", "revisions" ] limit 1 - result - withRetryDefault + result; withRetryDefault } |> tryFirst @@ -338,8 +291,7 @@ module Post = filter [ "webLogId", webLogId :> obj ] pluck [ "permalink" ] limit 1 - result - withRetryDefault + result; withRetryDefault } |> tryFirst @@ -353,8 +305,7 @@ module Post = orderBy "publishedOn" skip ((pageNbr - 1) * postsPerPage) limit postsPerPage - result - withRetryDefault + result; withRetryDefault } @@ -366,9 +317,7 @@ module WebLog = rethink { withTable Table.WebLog insert webLog - write - withRetryOnce - ignoreResult + write; withRetryOnce; ignoreResult } /// Retrieve a web log by the URL base @@ -377,8 +326,7 @@ module WebLog = withTable Table.WebLog getAll [ url ] "urlBase" limit 1 - result - withRetryDefault + result; withRetryDefault } |> tryFirst @@ -387,8 +335,7 @@ module WebLog = rethink { withTable Table.WebLog get webLogId - resultOption - withRetryDefault + resultOption; withRetryDefault } /// Update web log settings @@ -403,9 +350,7 @@ module WebLog = "postsPerPage", webLog.postsPerPage "timeZone", webLog.timeZone ] - write - withRetryDefault - ignoreResult + write; withRetryDefault; ignoreResult } @@ -417,9 +362,7 @@ module WebLogUser = rethink { withTable Table.WebLogUser insert user - write - withRetryDefault - ignoreResult + write; withRetryDefault; ignoreResult } /// Find a user by their e-mail address @@ -428,8 +371,7 @@ module WebLogUser = withTable Table.WebLogUser getAll [ r.Array (webLogId, email) ] "logOn" limit 1 - result - withRetryDefault + result; withRetryDefault } |> tryFirst \ No newline at end of file diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index 843542b..3ceef8f 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -6,7 +6,6 @@ - @@ -15,6 +14,7 @@ + diff --git a/src/MyWebLog.Domain/MyWebLog.Domain.fsproj b/src/MyWebLog.Domain/MyWebLog.Domain.fsproj index de029e7..9b62820 100644 --- a/src/MyWebLog.Domain/MyWebLog.Domain.fsproj +++ b/src/MyWebLog.Domain/MyWebLog.Domain.fsproj @@ -11,4 +11,8 @@ + + + + diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index 1c5f3ad..3edee60 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -1,6 +1,7 @@ namespace MyWebLog open System +open Markdig /// Support functions for domain definition [] @@ -54,21 +55,38 @@ type CommentStatus = | Spam -/// The source format for a revision -type RevisionSource = +/// Types of markup text +type MarkupText = /// Markdown text - | Markdown - /// HTML - | Html + | Markdown of string + /// HTML text + | Html of string -/// Functions to support revision sources -module RevisionSource = +/// Functions to support markup text +module MarkupText = - /// Convert a revision source to a string representation - let toString = function Markdown -> "Markdown" | Html -> "HTML" + /// Pipeline with most extensions enabled + let private _pipeline = MarkdownPipelineBuilder().UseSmartyPants().UseAdvancedExtensions().Build () + + /// Get the source type for the markup text + let sourceType = function Markdown _ -> "Markdown" | Html _ -> "HTML" - /// Convert a string to a revision source - let ofString = function "Markdown" -> Markdown | "HTML" -> Html | x -> invalidArg "string" x + /// Get the raw text, regardless of type + let text = function Markdown text -> text | Html text -> text + + /// Get the string representation of the markup text + let toString it = $"{sourceType it}: {text it}" + + /// Get the HTML representation of the markup text + let toHtml = function Markdown text -> Markdown.ToHtml (text, _pipeline) | Html text -> text + + /// Parse a string into a MarkupText instance + let parse (it : string) = + match it with + | text when text.StartsWith "Markdown: " -> Markdown (text.Substring 10) + | text when text.StartsWith "HTML: " -> Html (text.Substring 6) + | text -> invalidOp $"Cannot derive type of text ({text})" + /// A revision of a page or post [] @@ -76,11 +94,8 @@ type Revision = { /// When this revision was saved asOf : DateTime - /// The source language (Markdown or HTML) - sourceType : RevisionSource - /// The text of the revision - text : string + text : MarkupText } /// Functions to support revisions @@ -88,9 +103,8 @@ module Revision = /// An empty revision let empty = - { asOf = DateTime.UtcNow - sourceType = Html - text = "" + { asOf = DateTime.UtcNow + text = Html "" } diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index a53376e..ab94c5d 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -4,6 +4,7 @@ open MyWebLog open System /// Details about a page used to display page lists +[] type DisplayPage = { /// The ID of this page id : string @@ -40,7 +41,7 @@ type DisplayPage = /// The model to use to allow a user to log on -[] +[] type LogOnModel = { /// The user's e-mail address emailAddress : string @@ -51,6 +52,7 @@ type LogOnModel = /// The model used to display the admin dashboard +[] type DashboardModel = { /// The number of published posts posts : int @@ -73,7 +75,7 @@ type DashboardModel = /// View model to edit a page -[] +[] type EditPageModel = { /// The ID of the page being edited pageId : string @@ -84,6 +86,9 @@ type EditPageModel = /// The permalink for the page permalink : string + /// The template to use to display the page + template : string + /// Whether this page is shown in the page list isShownInPageList : bool @@ -99,17 +104,18 @@ type EditPageModel = match page.revisions |> List.sortByDescending (fun r -> r.asOf) |> List.tryHead with | Some rev -> rev | None -> Revision.empty - { pageId = PageId.toString page.id - title = page.title - permalink = Permalink.toString page.permalink + { pageId = PageId.toString page.id + title = page.title + permalink = Permalink.toString page.permalink + template = defaultArg page.template "" isShownInPageList = page.showInPageList - source = RevisionSource.toString latest.sourceType - text = latest.text + source = MarkupText.sourceType latest.text + text = MarkupText.text latest.text } /// View model for editing web log settings -[] +[] type SettingsModel = { /// The name of the web log name : string @@ -126,3 +132,34 @@ type SettingsModel = /// The time zone in which dates/times should be displayed timeZone : string } + + +[] +type UserMessage = + { /// The level of the message + level : string + + /// The message + message : string + + /// Further details about the message + detail : string option + } + +/// Functions to support user messages +module UserMessage = + + /// An empty user message (use one of the others for pre-filled level) + let empty = { level = ""; message = ""; detail = None } + + /// A blank success message + let success = { empty with level = "success" } + + /// A blank informational message + let info = { empty with level = "primary" } + + /// A blank warning message + let warning = { empty with level = "warning" } + + /// A blank error message + let error = { empty with level = "danger" } diff --git a/src/MyWebLog/Handlers.fs b/src/MyWebLog/Handlers.fs index 0e6b86e..3822884 100644 --- a/src/MyWebLog/Handlers.fs +++ b/src/MyWebLog/Handlers.fs @@ -36,13 +36,48 @@ module Error = setStatusCode 404 >=> text "Not found" +open System.Text.Json + +/// Session extensions to get and set objects +type ISession with + + /// Set an item in the session + member this.Set<'T> (key, item : 'T) = + this.SetString (key, JsonSerializer.Serialize item) + + /// Get an item from the session + member this.Get<'T> key = + match this.GetString key with + | null -> None + | item -> Some (JsonSerializer.Deserialize<'T> item) + + +open System.Collections.Generic + [] module private Helpers = - open Markdig open Microsoft.AspNetCore.Antiforgery open Microsoft.Extensions.DependencyInjection open System.Security.Claims + open System.IO + + /// Add a message to the user's session + let addMessage (ctx : HttpContext) message = task { + do! ctx.Session.LoadAsync () + let msg = match ctx.Session.Get "messages" with Some it -> it | None -> [] + ctx.Session.Set ("messages", message :: msg) + } + + /// Get any messages from the user's session, removing them in the process + let messages (ctx : HttpContext) = task { + do! ctx.Session.LoadAsync () + match ctx.Session.Get "messages" with + | Some msg -> + ctx.Session.Remove "messages" + return msg |> (List.rev >> Array.ofList) + | None -> return [||] + } /// Either get the web log from the hash, or get it from the cache and add it to the hash let private deriveWebLogFromHash (hash : Hash) ctx = @@ -57,9 +92,11 @@ module private Helpers = let viewForTheme theme template 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 + let! messages = messages ctx hash.Add ("logged_on", ctx.User.Identity.IsAuthenticated) hash.Add ("page_list", PageListCache.get ctx) hash.Add ("current_page", ctx.Request.Path.Value.Substring 1) + hash.Add ("messages", messages) // 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 @@ -105,16 +142,20 @@ module private Helpers = /// Require a user to be logged on let requireUser = requiresAuthentication Error.notAuthorized - /// Pipeline with most extensions enabled - let mdPipeline = - MarkdownPipelineBuilder().UseSmartyPants().UseAdvancedExtensions().Build () + /// Get the templates available for the current web log's theme (in a key/value pair list) + let templatesForTheme ctx (typ : string) = + seq { + KeyValuePair.Create ("", $"- Default (single-{typ}) -") + yield! + Directory.EnumerateFiles $"themes/{(WebLogCache.get ctx).themePath}/" + |> Seq.filter (fun it -> it.EndsWith $"{typ}.liquid") + |> Seq.map (fun it -> + let parts = it.Split Path.DirectorySeparatorChar + let template = parts[parts.Length - 1].Replace (".liquid", "") + KeyValuePair.Create (template, template)) + } + |> Array.ofSeq - /// Get the HTML representation of the text of a revision - let revisionToHtml (rev : Revision) = - match rev.sourceType with Html -> rev.text | Markdown -> Markdown.ToHtml (rev.text, mdPipeline) - - -open System.Collections.Generic /// Handlers to manipulate admin functions module Admin = @@ -191,8 +232,7 @@ module Admin = // Update cache WebLogCache.set ctx updated - // TODO: confirmation message - + do! addMessage ctx { UserMessage.success with message = "Web log settings saved successfully" } return! redirectTo false "/admin" next ctx | None -> return! Error.notFound next ctx } @@ -216,28 +256,24 @@ module Page = // GET /page/{id}/edit let edit pgId : HttpHandler = requireUser >=> fun next ctx -> task { - let! hash = task { + let! result = task { match pgId with - | "new" -> - return - Hash.FromAnonymousObject {| - csrf = csrfToken ctx - model = EditPageModel.fromPage { Page.empty with id = PageId "new" } - page_title = "Add a New Page" - |} |> Some + | "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new" }) | _ -> match! Data.Page.findByFullId (PageId pgId) (webLogId ctx) (conn ctx) with - | Some page -> - return - Hash.FromAnonymousObject {| - csrf = csrfToken ctx - model = EditPageModel.fromPage page - page_title = "Edit Page" - |} |> Some + | Some page -> return Some ("Edit Page", page) | None -> return None } - match hash with - | Some h -> return! viewForTheme "admin" "page-edit" next ctx h + match result with + | Some (title, page) -> + return! + Hash.FromAnonymousObject {| + csrf = csrfToken ctx + model = EditPageModel.fromPage page + page_title = title + templates = templatesForTheme ctx "page" + |} + |> viewForTheme "admin" "page-edit" next ctx | None -> return! Error.notFound next ctx } @@ -262,7 +298,7 @@ module Page = match pg with | Some page -> let updateList = page.showInPageList <> model.isShownInPageList - let revision = { asOf = now; sourceType = RevisionSource.ofString model.source; text = model.text } + let revision = { asOf = now; text = MarkupText.parse $"{model.source}: {model.text}" } // Detect a permalink change, and add the prior one to the prior list let page = match Permalink.toString page.permalink with @@ -275,12 +311,13 @@ module Page = permalink = Permalink model.permalink updatedOn = now showInPageList = model.isShownInPageList - text = revisionToHtml revision + template = match model.template with "" -> None | tmpl -> Some tmpl + text = MarkupText.toHtml revision.text revisions = revision :: page.revisions } do! (match model.pageId with "new" -> Data.Page.add | _ -> Data.Page.update) page conn if updateList then do! PageListCache.update ctx - // TODO: confirmation + do! addMessage ctx { UserMessage.success with message = "Page saved successfully" } return! redirectTo false $"/page/{PageId.toString page.id}/edit" next ctx | None -> return! Error.notFound next ctx } @@ -372,8 +409,9 @@ module User = // POST /user/log-on let doLogOn : HttpHandler = validateCsrf >=> fun next ctx -> task { - let! model = ctx.BindFormAsync () - match! Data.WebLogUser.findByEmail model.emailAddress (webLogId ctx) (conn ctx) with + let! model = ctx.BindFormAsync () + let webLog = WebLogCache.get ctx + match! Data.WebLogUser.findByEmail model.emailAddress webLog.id (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) @@ -385,20 +423,21 @@ module User = do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity, AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow)) - - // TODO: confirmation message - + do! addMessage ctx + { UserMessage.success with + message = "Logged on successfully" + detail = Some $"Welcome to {webLog.name}!" + } return! redirectTo false "/admin" next ctx | _ -> - // TODO: make error, not 404 - return! Error.notFound next ctx + do! addMessage ctx { UserMessage.error with message = "Log on attempt unsuccessful" } + return! logOn next ctx } + // GET /user/log-off let logOff : HttpHandler = fun next ctx -> task { do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme - - // TODO: confirmation message - + do! addMessage ctx { UserMessage.info with message = "Log off successful" } return! redirectTo false "/" next ctx } diff --git a/src/MyWebLog/MyWebLog.fsproj b/src/MyWebLog/MyWebLog.fsproj index ddb2839..2d45c30 100644 --- a/src/MyWebLog/MyWebLog.fsproj +++ b/src/MyWebLog/MyWebLog.fsproj @@ -16,7 +16,7 @@ - + diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index c7f6554..25cfcdf 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -60,80 +60,82 @@ module DotLiquidBespoke = |> Seq.iter result.WriteLine -/// Initialize a new database -let initDbValidated (args : string[]) (sp : IServiceProvider) = task { +/// Create the default information for a new web log +module NewWebLog = - let conn = sp.GetRequiredService () - - let timeZone = - let local = TimeZoneInfo.Local.Id - match TimeZoneInfo.Local.HasIanaId with - | true -> local - | false -> - match TimeZoneInfo.TryConvertWindowsIdToIanaId local with - | true, ianaId -> ianaId - | false, _ -> raise <| TimeZoneNotFoundException $"Cannot find IANA timezone for {local}" - - // Create the web log - let webLogId = WebLogId.create () - let userId = WebLogUserId.create () - let homePageId = PageId.create () - - do! Data.WebLog.add - { WebLog.empty with - id = webLogId - name = args[2] - urlBase = args[1] - defaultPage = PageId.toString homePageId - timeZone = timeZone - } conn - - // Create the admin user - let salt = Guid.NewGuid () - - do! Data.WebLogUser.add - { WebLogUser.empty with - id = userId - webLogId = webLogId - userName = args[3] - firstName = "Admin" - lastName = "User" - preferredName = "Admin" - passwordHash = Handlers.User.hashedPassword args[4] args[3] salt - salt = salt - authorizationLevel = Administrator - } conn + /// Create the web log information + let private createWebLog (args : string[]) (sp : IServiceProvider) = task { + + let conn = sp.GetRequiredService () + + let timeZone = + let local = TimeZoneInfo.Local.Id + match TimeZoneInfo.Local.HasIanaId with + | true -> local + | false -> + match TimeZoneInfo.TryConvertWindowsIdToIanaId local with + | true, ianaId -> ianaId + | false, _ -> raise <| TimeZoneNotFoundException $"Cannot find IANA timezone for {local}" + + // Create the web log + let webLogId = WebLogId.create () + let userId = WebLogUserId.create () + let homePageId = PageId.create () + + do! Data.WebLog.add + { WebLog.empty with + id = webLogId + name = args[2] + urlBase = args[1] + defaultPage = PageId.toString homePageId + timeZone = timeZone + } conn + + // Create the admin user + let salt = Guid.NewGuid () + + do! Data.WebLogUser.add + { WebLogUser.empty with + id = userId + webLogId = webLogId + userName = args[3] + firstName = "Admin" + lastName = "User" + preferredName = "Admin" + passwordHash = Handlers.User.hashedPassword args[4] args[3] salt + salt = salt + authorizationLevel = Administrator + } conn - // Create the default home page - do! Data.Page.add - { Page.empty with - id = homePageId - webLogId = webLogId - authorId = userId - title = "Welcome to myWebLog!" - permalink = Permalink "welcome-to-myweblog.html" - publishedOn = DateTime.UtcNow - updatedOn = DateTime.UtcNow - text = "

This is your default home page.

" - revisions = [ - { asOf = DateTime.UtcNow - sourceType = Html - text = "

This is your default home page.

" - } - ] - } conn + // Create the default home page + do! Data.Page.add + { Page.empty with + id = homePageId + webLogId = webLogId + authorId = userId + title = "Welcome to myWebLog!" + permalink = Permalink "welcome-to-myweblog.html" + publishedOn = DateTime.UtcNow + updatedOn = DateTime.UtcNow + text = "

This is your default home page.

" + revisions = [ + { asOf = DateTime.UtcNow + text = Html "

This is your default home page.

" + } + ] + } conn - Console.WriteLine($"Successfully initialized database for {args[2]} with URL base {args[1]}"); -} + Console.WriteLine($"Successfully initialized database for {args[2]} with URL base {args[1]}"); + } -/// Initialize a new database -let initDb args sp = task { - match args |> Array.length with - | 5 -> return! initDbValidated args sp - | _ -> - Console.WriteLine "Usage: MyWebLog init [url] [name] [admin-email] [admin-pw]" - return! System.Threading.Tasks.Task.CompletedTask -} + /// Create a new web log + let create args sp = task { + match args |> Array.length with + | 5 -> return! createWebLog args sp + | _ -> + Console.WriteLine "Usage: MyWebLog init [url] [name] [admin-email] [admin-pw]" + return! System.Threading.Tasks.Task.CompletedTask + } open DotLiquid @@ -145,6 +147,7 @@ open Microsoft.AspNetCore.Builder open Microsoft.Extensions.Configuration open Microsoft.Extensions.Logging open MyWebLog.ViewModels +open RethinkDB.DistributedCache open RethinkDb.Driver.FSharp [] @@ -177,6 +180,14 @@ let main args = } |> Async.AwaitTask |> Async.RunSynchronously let _ = builder.Services.AddSingleton conn + let _ = builder.Services.AddDistributedRethinkDBCache (fun opts -> + opts.Database <- rethinkCfg.Database + opts.Connection <- conn) + let _ = builder.Services.AddSession(fun opts -> + opts.IdleTimeout <- TimeSpan.FromMinutes 30 + opts.Cookie.HttpOnly <- true + opts.Cookie.IsEssential <- true) + // Set up DotLiquid Template.RegisterFilter typeof Template.RegisterTag "user_links" @@ -189,6 +200,7 @@ 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) @@ -197,13 +209,14 @@ let main args = let app = builder.Build () match args |> Array.tryHead with - | Some it when it = "init" -> initDb args app.Services |> Async.AwaitTask |> Async.RunSynchronously + | Some it when it = "init" -> NewWebLog.create args app.Services |> Async.AwaitTask |> Async.RunSynchronously | _ -> let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict)) let _ = app.UseMiddleware () let _ = app.UseAuthentication () let _ = app.UseStaticFiles () let _ = app.UseRouting () + let _ = app.UseSession () let _ = app.UseGiraffe Handlers.endpoints app.Run() diff --git a/src/MyWebLog/appsettings.json b/src/MyWebLog/appsettings.json index faf242d..a636102 100644 --- a/src/MyWebLog/appsettings.json +++ b/src/MyWebLog/appsettings.json @@ -2,5 +2,11 @@ "RethinkDB": { "hostname": "data02.bitbadger.solutions", "database": "myWebLog-dev" + }, + "Logging": { + "LogLevel": { + "RethinkDB.DistributedCache": "Debug", + "RethinkDb.Driver": "Debug" + } } } diff --git a/src/MyWebLog/themes/admin/dashboard.liquid b/src/MyWebLog/themes/admin/dashboard.liquid index 1c62b29..f110158 100644 --- a/src/MyWebLog/themes/admin/dashboard.liquid +++ b/src/MyWebLog/themes/admin/dashboard.liquid @@ -1,4 +1,4 @@ -

{{ web_log.name }} • Dashboard

+

{{ web_log.name }} • Dashboard

diff --git a/src/MyWebLog/themes/admin/layout.liquid b/src/MyWebLog/themes/admin/layout.liquid index 8672d52..b1ffb6d 100644 --- a/src/MyWebLog/themes/admin/layout.liquid +++ b/src/MyWebLog/themes/admin/layout.liquid @@ -37,6 +37,20 @@
+ {% if messages %} +
+ {% for msg in messages %} + + {% endfor %} +
+ {% endif %} {{ content }}