bit-badger/myWebLog
1
0
Fork 0
Code Issues 2 Pull Requests Packages Projects Releases 11 Activity

WIP on messages

Browse Source
This commit is contained in:
Daniel J. Summers 2022-04-19 16:25:51 -04:00
parent 48e6d3edfa
commit a0573a348a
19 changed files with 372 additions and 264 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/MyWebLog.Data/Converters.fs
View File

@ -20,6 +20,13 @@ type CommentIdConverter () =
override _.ReadJson (reader : JsonReader, _ : Type, _ : CommentId, _ : bool, _ : JsonSerializer) = override _.ReadJson (reader : JsonReader, _ : Type, _ : CommentId, _ : bool, _ : JsonSerializer) =
(string >> CommentId) reader.Value (string >> CommentId) reader.Value
type MarkupTextConverter () =
inherit JsonConverter<MarkupText> ()
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 () = type PermalinkConverter () =
inherit JsonConverter<Permalink> () inherit JsonConverter<Permalink> ()
override _.WriteJson (writer : JsonWriter, value : Permalink, _ : JsonSerializer) = override _.WriteJson (writer : JsonWriter, value : Permalink, _ : JsonSerializer) =
@ -63,6 +70,7 @@ let all () : JsonConverter seq =
// Our converters // Our converters
CategoryIdConverter () CategoryIdConverter ()
CommentIdConverter () CommentIdConverter ()
MarkupTextConverter ()
PermalinkConverter () PermalinkConverter ()
PageIdConverter () PageIdConverter ()
PostIdConverter () PostIdConverter ()

162
src/MyWebLog.Data/Data.fs
View File

@ -40,13 +40,13 @@ module Helpers =
/// Verify that the web log ID matches before returning an item /// Verify that the web log ID matches before returning an item
let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (f : IConnection -> Task<'T option>) = 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 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 /// Get the first item from a list, or None if the list is empty
let tryFirst<'T> (f : IConnection -> Task<'T list>) = let tryFirst<'T> (f : IConnection -> Task<'T list>) =
fun conn -> task { fun conn -> backgroundTask {
let! results = f conn let! results = f conn
return results |> List.tryHead return results |> List.tryHead
} }
@ -59,82 +59,52 @@ open Microsoft.Extensions.Logging
module Startup = module Startup =
/// Ensure field indexes exist, as well as special indexes for selected tables /// 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<string list> { withTable table; indexList; result; withRetryOnce conn } let! indexes = rethink<string list> { withTable table; indexList; result; withRetryOnce conn }
for field in fields do for field in fields do
match indexes |> List.contains field with if not (indexes |> List.contains field) then
| true -> ()
| false ->
log.LogInformation($"Creating index {table}.{field}...") 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 // Post and page need index by web log ID and permalink
match [ Table.Page; Table.Post ] |> List.contains table with if [ Table.Page; Table.Post ] |> List.contains table then
| true -> if not (indexes |> List.contains "permalink") then
match indexes |> List.contains "permalink" with
| true -> ()
| false ->
log.LogInformation($"Creating index {table}.permalink...") log.LogInformation($"Creating index {table}.permalink...")
let! _ = do! rethink {
rethink { withTable table
withTable table indexCreate "permalink" (fun row -> r.Array(row.G "webLogId", row.G "permalink") :> obj)
indexCreate "permalink" (fun row -> r.Array(row.G "webLogId", row.G "permalink")) write; withRetryOnce; ignoreResult conn
write }
withRetryOnce conn
}
()
// Prior permalinks are searched when a post or page permalink do not match the current URL // Prior permalinks are searched when a post or page permalink do not match the current URL
match indexes |> List.contains "priorPermalinks" with if not (indexes |> List.contains "priorPermalinks") then
| true -> ()
| false ->
log.LogInformation($"Creating index {table}.priorPermalinks...") log.LogInformation($"Creating index {table}.priorPermalinks...")
let! _ = do! rethink {
rethink { withTable table
withTable table indexCreate "priorPermalinks" [ Multi ]
indexCreate "priorPermalinks" write; withRetryOnce; ignoreResult conn
indexOption Multi }
write
withRetryOnce conn
}
()
| false -> ()
// Users log on with e-mail // Users log on with e-mail
match Table.WebLogUser = table with if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then
| true -> log.LogInformation($"Creating index {table}.logOn...")
match indexes |> List.contains "logOn" with do! rethink {
| true -> () withTable table
| false -> indexCreate "logOn" (fun row -> r.Array(row.G "webLogId", row.G "userName") :> obj)
log.LogInformation($"Creating index {table}.logOn...") write; withRetryOnce; ignoreResult conn
let! _ = }
rethink {
withTable table
indexCreate "logOn" (fun row -> r.Array(row.G "webLogId", row.G "userName"))
write
withRetryOnce conn
}
()
| false -> ()
} }
/// Ensure all necessary tables and indexes exist /// Ensure all necessary tables and indexes exist
let ensureDb (config : DataConfig) (log : ILogger) conn = task { let ensureDb (config : DataConfig) (log : ILogger) conn = task {
let! dbs = rethink<string list> { dbList; result; withRetryOnce conn } let! dbs = rethink<string list> { dbList; result; withRetryOnce conn }
match dbs |> List.contains config.Database with if not (dbs |> List.contains config.Database) then
| true -> ()
| false ->
log.LogInformation($"Creating database {config.Database}...") 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<string list> { tableList; result; withRetryOnce conn } let! tables = rethink<string list> { tableList; result; withRetryOnce conn }
for tbl in Table.all do for tbl in Table.all do
match tables |> List.contains tbl with if not (tables |> List.contains tbl) then
| true -> ()
| false ->
log.LogInformation($"Creating table {tbl}...") 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 let makeIdx = ensureIndexes log conn
do! makeIdx Table.Category [ "webLogId" ] do! makeIdx Table.Category [ "webLogId" ]
@ -154,8 +124,7 @@ module Category =
withTable Table.Category withTable Table.Category
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof webLogId)
count count
result result; withRetryDefault
withRetryDefault
} }
/// Count top-level categories for a web log /// Count top-level categories for a web log
@ -165,8 +134,7 @@ module Category =
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof webLogId)
filter "parentId" None filter "parentId" None
count count
result result; withRetryDefault
withRetryDefault
} }
@ -178,9 +146,7 @@ module Page =
rethink { rethink {
withTable Table.Page withTable Table.Page
insert page insert page
write write; withRetryDefault; ignoreResult
withRetryDefault
ignoreResult
} }
/// Count all pages for a web log /// Count all pages for a web log
@ -189,8 +155,7 @@ module Page =
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof webLogId)
count count
result result; withRetryDefault
withRetryDefault
} }
/// Count listed pages for a web log /// Count listed pages for a web log
@ -200,8 +165,7 @@ module Page =
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof webLogId)
filter "showInPageList" true filter "showInPageList" true
count count
result result; withRetryDefault
withRetryDefault
} }
/// Retrieve all pages for a web log (excludes text, prior permalinks, and revisions) /// Retrieve all pages for a web log (excludes text, prior permalinks, and revisions)
@ -210,8 +174,7 @@ module Page =
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof webLogId)
without [ "text", "priorPermalinks", "revisions" ] without [ "text", "priorPermalinks", "revisions" ]
result result; withRetryDefault
withRetryDefault
} }
/// Find a page by its ID (including prior permalinks and revisions) /// Find a page by its ID (including prior permalinks and revisions)
@ -219,8 +182,7 @@ module Page =
rethink<Page> { rethink<Page> {
withTable Table.Page withTable Table.Page
get pageId get pageId
resultOption resultOption; withRetryDefault
withRetryDefault
} }
|> verifyWebLog webLogId (fun it -> it.webLogId) |> verifyWebLog webLogId (fun it -> it.webLogId)
@ -230,8 +192,7 @@ module Page =
withTable Table.Page withTable Table.Page
get pageId get pageId
without [ "priorPermalinks", "revisions" ] without [ "priorPermalinks", "revisions" ]
resultOption resultOption; withRetryDefault
withRetryDefault
} }
|> verifyWebLog webLogId (fun it -> it.webLogId) |> verifyWebLog webLogId (fun it -> it.webLogId)
@ -242,8 +203,7 @@ module Page =
getAll [ r.Array (webLogId, permalink) ] (nameof permalink) getAll [ r.Array (webLogId, permalink) ] (nameof permalink)
without [ "priorPermalinks", "revisions" ] without [ "priorPermalinks", "revisions" ]
limit 1 limit 1
result result; withRetryDefault
withRetryDefault
} }
|> tryFirst |> tryFirst
@ -255,8 +215,7 @@ module Page =
filter [ "webLogId", webLogId :> obj ] filter [ "webLogId", webLogId :> obj ]
pluck [ "permalink" ] pluck [ "permalink" ]
limit 1 limit 1
result result; withRetryDefault
withRetryDefault
} }
|> tryFirst |> tryFirst
@ -268,8 +227,7 @@ module Page =
filter [ "showInPageList", true :> obj ] filter [ "showInPageList", true :> obj ]
without [ "text", "priorPermalinks", "revisions" ] without [ "text", "priorPermalinks", "revisions" ]
orderBy "title" orderBy "title"
result result; withRetryDefault
withRetryDefault
} }
/// Find a list of pages (displayed in admin area) /// Find a list of pages (displayed in admin area)
@ -281,8 +239,7 @@ module Page =
orderBy "title" orderBy "title"
skip ((pageNbr - 1) * 25) skip ((pageNbr - 1) * 25)
limit 25 limit 25
result result; withRetryDefault
withRetryDefault
} }
/// Update a page /// Update a page
@ -299,9 +256,7 @@ module Page =
"priorPermalinks", page.priorPermalinks "priorPermalinks", page.priorPermalinks
"revisions", page.revisions "revisions", page.revisions
] ]
write write; withRetryDefault; ignoreResult
withRetryDefault
ignoreResult
} }
/// Functions to manipulate posts /// Functions to manipulate posts
@ -314,8 +269,7 @@ module Post =
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof webLogId)
filter "status" status filter "status" status
count count
result result; withRetryDefault
withRetryDefault
} }
/// Find a post by its permalink /// Find a post by its permalink
@ -325,8 +279,7 @@ module Post =
getAll [ r.Array(permalink, webLogId) ] (nameof permalink) getAll [ r.Array(permalink, webLogId) ] (nameof permalink)
without [ "priorPermalinks", "revisions" ] without [ "priorPermalinks", "revisions" ]
limit 1 limit 1
result result; withRetryDefault
withRetryDefault
} }
|> tryFirst |> tryFirst
@ -338,8 +291,7 @@ module Post =
filter [ "webLogId", webLogId :> obj ] filter [ "webLogId", webLogId :> obj ]
pluck [ "permalink" ] pluck [ "permalink" ]
limit 1 limit 1
result result; withRetryDefault
withRetryDefault
} }
|> tryFirst |> tryFirst
@ -353,8 +305,7 @@ module Post =
orderBy "publishedOn" orderBy "publishedOn"
skip ((pageNbr - 1) * postsPerPage) skip ((pageNbr - 1) * postsPerPage)
limit postsPerPage limit postsPerPage
result result; withRetryDefault
withRetryDefault
} }
@ -366,9 +317,7 @@ module WebLog =
rethink { rethink {
withTable Table.WebLog withTable Table.WebLog
insert webLog insert webLog
write write; withRetryOnce; ignoreResult
withRetryOnce
ignoreResult
} }
/// Retrieve a web log by the URL base /// Retrieve a web log by the URL base
@ -377,8 +326,7 @@ module WebLog =
withTable Table.WebLog withTable Table.WebLog
getAll [ url ] "urlBase" getAll [ url ] "urlBase"
limit 1 limit 1
result result; withRetryDefault
withRetryDefault
} }
|> tryFirst |> tryFirst
@ -387,8 +335,7 @@ module WebLog =
rethink<WebLog> { rethink<WebLog> {
withTable Table.WebLog withTable Table.WebLog
get webLogId get webLogId
resultOption resultOption; withRetryDefault
withRetryDefault
} }
/// Update web log settings /// Update web log settings
@ -403,9 +350,7 @@ module WebLog =
"postsPerPage", webLog.postsPerPage "postsPerPage", webLog.postsPerPage
"timeZone", webLog.timeZone "timeZone", webLog.timeZone
] ]
write write; withRetryDefault; ignoreResult
withRetryDefault
ignoreResult
} }
@ -417,9 +362,7 @@ module WebLogUser =
rethink { rethink {
withTable Table.WebLogUser withTable Table.WebLogUser
insert user insert user
write write; withRetryDefault; ignoreResult
withRetryDefault
ignoreResult
} }
/// Find a user by their e-mail address /// Find a user by their e-mail address
@ -428,8 +371,7 @@ module WebLogUser =
withTable Table.WebLogUser withTable Table.WebLogUser
getAll [ r.Array (webLogId, email) ] "logOn" getAll [ r.Array (webLogId, email) ] "logOn"
limit 1 limit 1
result result; withRetryDefault
withRetryDefault
} }
|> tryFirst |> tryFirst

2
src/MyWebLog.Data/MyWebLog.Data.fsproj
View File

@ -6,7 +6,6 @@
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<ProjectReference Include="..\..\..\RethinkDb.Driver.FSharp\src\RethinkDb.Driver.FSharp\RethinkDb.Driver.FSharp.fsproj" />
<ProjectReference Include="..\MyWebLog.Domain\MyWebLog.Domain.fsproj" /> <ProjectReference Include="..\MyWebLog.Domain\MyWebLog.Domain.fsproj" />
</ItemGroup> </ItemGroup>
@ -15,6 +14,7 @@
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" /> <PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" /> <PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" /> <PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.8.0-alpha-0003" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

4
src/MyWebLog.Domain/MyWebLog.Domain.fsproj
View File

@ -11,4 +11,8 @@
<Compile Include="ViewModels.fs" /> <Compile Include="ViewModels.fs" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<PackageReference Include="Markdig" Version="0.28.1" />
</ItemGroup>
</Project> </Project>

50
src/MyWebLog.Domain/SupportTypes.fs
View File

@ -1,6 +1,7 @@
namespace MyWebLog namespace MyWebLog
open System open System
open Markdig
/// Support functions for domain definition /// Support functions for domain definition
[<AutoOpen>] [<AutoOpen>]
@ -54,21 +55,38 @@ type CommentStatus =
| Spam | Spam
/// The source format for a revision /// Types of markup text
type RevisionSource = type MarkupText =
/// Markdown text /// Markdown text
| Markdown | Markdown of string
/// HTML /// HTML text
| Html | Html of string
/// Functions to support revision sources /// Functions to support markup text
module RevisionSource = module MarkupText =
/// Convert a revision source to a string representation /// Pipeline with most extensions enabled
let toString = function Markdown -> "Markdown" | Html -> "HTML" 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 /// Get the raw text, regardless of type
let ofString = function "Markdown" -> Markdown | "HTML" -> Html | x -> invalidArg "string" x 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 /// A revision of a page or post
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
@ -76,11 +94,8 @@ type Revision =
{ /// When this revision was saved { /// When this revision was saved
asOf : DateTime asOf : DateTime
/// The source language (Markdown or HTML)
sourceType : RevisionSource
/// The text of the revision /// The text of the revision
text : string text : MarkupText
} }
/// Functions to support revisions /// Functions to support revisions
@ -88,9 +103,8 @@ module Revision =
/// An empty revision /// An empty revision
let empty = let empty =
{ asOf = DateTime.UtcNow { asOf = DateTime.UtcNow
sourceType = Html text = Html ""
text = ""
} }

53
src/MyWebLog.Domain/ViewModels.fs
View File

@ -4,6 +4,7 @@ open MyWebLog
open System open System
/// Details about a page used to display page lists /// Details about a page used to display page lists
[<NoComparison; NoEquality>]
type DisplayPage = type DisplayPage =
{ /// The ID of this page { /// The ID of this page
id : string id : string
@ -40,7 +41,7 @@ type DisplayPage =
/// The model to use to allow a user to log on /// The model to use to allow a user to log on
[<CLIMutable>] [<CLIMutable; NoComparison; NoEquality>]
type LogOnModel = type LogOnModel =
{ /// The user's e-mail address { /// The user's e-mail address
emailAddress : string emailAddress : string
@ -51,6 +52,7 @@ type LogOnModel =
/// The model used to display the admin dashboard /// The model used to display the admin dashboard
[<NoComparison; NoEquality>]
type DashboardModel = type DashboardModel =
{ /// The number of published posts { /// The number of published posts
posts : int posts : int
@ -73,7 +75,7 @@ type DashboardModel =
/// View model to edit a page /// View model to edit a page
[<CLIMutable>] [<CLIMutable; NoComparison; NoEquality>]
type EditPageModel = type EditPageModel =
{ /// The ID of the page being edited { /// The ID of the page being edited
pageId : string pageId : string
@ -84,6 +86,9 @@ type EditPageModel =
/// The permalink for the page /// The permalink for the page
permalink : string permalink : string
/// The template to use to display the page
template : string
/// Whether this page is shown in the page list /// Whether this page is shown in the page list
isShownInPageList : bool isShownInPageList : bool
@ -99,17 +104,18 @@ type EditPageModel =
match page.revisions |> List.sortByDescending (fun r -> r.asOf) |> List.tryHead with match page.revisions |> List.sortByDescending (fun r -> r.asOf) |> List.tryHead with
| Some rev -> rev | Some rev -> rev
| None -> Revision.empty | None -> Revision.empty
{ pageId = PageId.toString page.id { pageId = PageId.toString page.id
title = page.title title = page.title
permalink = Permalink.toString page.permalink permalink = Permalink.toString page.permalink
template = defaultArg page.template ""
isShownInPageList = page.showInPageList isShownInPageList = page.showInPageList
source = RevisionSource.toString latest.sourceType source = MarkupText.sourceType latest.text
text = latest.text text = MarkupText.text latest.text
} }
/// View model for editing web log settings /// View model for editing web log settings
[<CLIMutable>] [<CLIMutable; NoComparison; NoEquality>]
type SettingsModel = type SettingsModel =
{ /// The name of the web log { /// The name of the web log
name : string name : string
@ -126,3 +132,34 @@ type SettingsModel =
/// The time zone in which dates/times should be displayed /// The time zone in which dates/times should be displayed
timeZone : string timeZone : string
} }
[<CLIMutable; NoComparison; NoEquality>]
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" }

123
src/MyWebLog/Handlers.fs
View File

@ -36,13 +36,48 @@ module Error =
setStatusCode 404 >=> text "Not found" 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
[<AutoOpen>] [<AutoOpen>]
module private Helpers = module private Helpers =
open Markdig
open Microsoft.AspNetCore.Antiforgery open Microsoft.AspNetCore.Antiforgery
open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.DependencyInjection
open System.Security.Claims 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<UserMessage list> "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<UserMessage list> "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 /// 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 = let private deriveWebLogFromHash (hash : Hash) ctx =
@ -57,9 +92,11 @@ module private Helpers =
let viewForTheme theme template next ctx = fun (hash : Hash) -> task { 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 // Don't need the web log, but this adds it to the hash if the function is called directly
let _ = deriveWebLogFromHash hash ctx let _ = deriveWebLogFromHash hash ctx
let! messages = messages ctx
hash.Add ("logged_on", ctx.User.Identity.IsAuthenticated) hash.Add ("logged_on", ctx.User.Identity.IsAuthenticated)
hash.Add ("page_list", PageListCache.get ctx) hash.Add ("page_list", PageListCache.get ctx)
hash.Add ("current_page", ctx.Request.Path.Value.Substring 1) 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 // 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; 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 /// Require a user to be logged on
let requireUser = requiresAuthentication Error.notAuthorized let requireUser = requiresAuthentication Error.notAuthorized
/// Pipeline with most extensions enabled /// Get the templates available for the current web log's theme (in a key/value pair list)
let mdPipeline = let templatesForTheme ctx (typ : string) =
MarkdownPipelineBuilder().UseSmartyPants().UseAdvancedExtensions().Build () 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 /// Handlers to manipulate admin functions
module Admin = module Admin =
@ -191,8 +232,7 @@ module Admin =
// Update cache // Update cache
WebLogCache.set ctx updated 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 return! redirectTo false "/admin" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -216,28 +256,24 @@ module Page =
// GET /page/{id}/edit // GET /page/{id}/edit
let edit pgId : HttpHandler = requireUser >=> fun next ctx -> task { let edit pgId : HttpHandler = requireUser >=> fun next ctx -> task {
let! hash = task { let! result = task {
match pgId with match pgId with
| "new" -> | "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new" })
return
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = EditPageModel.fromPage { Page.empty with id = PageId "new" }
page_title = "Add a New Page"
|} |> Some
| _ -> | _ ->
match! Data.Page.findByFullId (PageId pgId) (webLogId ctx) (conn ctx) with match! Data.Page.findByFullId (PageId pgId) (webLogId ctx) (conn ctx) with
| Some page -> | Some page -> return Some ("Edit Page", page)
return
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = EditPageModel.fromPage page
page_title = "Edit Page"
|} |> Some
| None -> return None | None -> return None
} }
match hash with match result with
| Some h -> return! viewForTheme "admin" "page-edit" next ctx h | 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 | None -> return! Error.notFound next ctx
} }
@ -262,7 +298,7 @@ module Page =
match pg with match pg with
| Some page -> | Some page ->
let updateList = page.showInPageList <> model.isShownInPageList 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 // Detect a permalink change, and add the prior one to the prior list
let page = let page =
match Permalink.toString page.permalink with match Permalink.toString page.permalink with
@ -275,12 +311,13 @@ module Page =
permalink = Permalink model.permalink permalink = Permalink model.permalink
updatedOn = now updatedOn = now
showInPageList = model.isShownInPageList showInPageList = model.isShownInPageList
text = revisionToHtml revision template = match model.template with "" -> None | tmpl -> Some tmpl
text = MarkupText.toHtml revision.text
revisions = revision :: page.revisions revisions = revision :: page.revisions
} }
do! (match model.pageId with "new" -> Data.Page.add | _ -> Data.Page.update) page conn do! (match model.pageId with "new" -> Data.Page.add | _ -> Data.Page.update) page conn
if updateList then do! PageListCache.update ctx 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 return! redirectTo false $"/page/{PageId.toString page.id}/edit" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -372,8 +409,9 @@ module User =
// POST /user/log-on // POST /user/log-on
let doLogOn : HttpHandler = validateCsrf >=> fun next ctx -> task { let doLogOn : HttpHandler = validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel> () let! model = ctx.BindFormAsync<LogOnModel> ()
match! Data.WebLogUser.findByEmail model.emailAddress (webLogId ctx) (conn ctx) with 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 -> | Some user when user.passwordHash = hashedPassword model.password user.userName user.salt ->
let claims = seq { let claims = seq {
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.id) Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.id)
@ -385,20 +423,21 @@ module User =
do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity, do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity,
AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow)) AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow))
do! addMessage ctx
// TODO: confirmation message { UserMessage.success with
message = "Logged on successfully"
detail = Some $"Welcome to {webLog.name}!"
}
return! redirectTo false "/admin" next ctx return! redirectTo false "/admin" next ctx
| _ -> | _ ->
// TODO: make error, not 404 do! addMessage ctx { UserMessage.error with message = "Log on attempt unsuccessful" }
return! Error.notFound next ctx return! logOn next ctx
} }
// GET /user/log-off
let logOff : HttpHandler = fun next ctx -> task { let logOff : HttpHandler = fun next ctx -> task {
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
do! addMessage ctx { UserMessage.info with message = "Log off successful" }
// TODO: confirmation message
return! redirectTo false "/" next ctx return! redirectTo false "/" next ctx
} }

2
src/MyWebLog/MyWebLog.fsproj
View File

@ -16,7 +16,7 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="DotLiquid" Version="2.2.610" /> <PackageReference Include="DotLiquid" Version="2.2.610" />
<PackageReference Include="Giraffe" Version="6.0.0" /> <PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Markdig" Version="0.28.1" /> <PackageReference Include="RethinkDB.DistributedCache" Version="0.9.0-alpha02" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

155
src/MyWebLog/Program.fs
View File

@ -60,80 +60,82 @@ module DotLiquidBespoke =
|> Seq.iter result.WriteLine |> Seq.iter result.WriteLine
/// Initialize a new database /// Create the default information for a new web log
let initDbValidated (args : string[]) (sp : IServiceProvider) = task { module NewWebLog =
let conn = sp.GetRequiredService<IConnection> () /// Create the web log information
let private createWebLog (args : string[]) (sp : IServiceProvider) = task {
let timeZone =
let local = TimeZoneInfo.Local.Id let conn = sp.GetRequiredService<IConnection> ()
match TimeZoneInfo.Local.HasIanaId with
| true -> local let timeZone =
| false -> let local = TimeZoneInfo.Local.Id
match TimeZoneInfo.TryConvertWindowsIdToIanaId local with match TimeZoneInfo.Local.HasIanaId with
| true, ianaId -> ianaId | true -> local
| false, _ -> raise <| TimeZoneNotFoundException $"Cannot find IANA timezone for {local}" | false ->
match TimeZoneInfo.TryConvertWindowsIdToIanaId local with
// Create the web log | true, ianaId -> ianaId
let webLogId = WebLogId.create () | false, _ -> raise <| TimeZoneNotFoundException $"Cannot find IANA timezone for {local}"
let userId = WebLogUserId.create ()
let homePageId = PageId.create () // Create the web log
let webLogId = WebLogId.create ()
do! Data.WebLog.add let userId = WebLogUserId.create ()
{ WebLog.empty with let homePageId = PageId.create ()
id = webLogId
name = args[2] do! Data.WebLog.add
urlBase = args[1] { WebLog.empty with
defaultPage = PageId.toString homePageId id = webLogId
timeZone = timeZone name = args[2]
} conn urlBase = args[1]
defaultPage = PageId.toString homePageId
// Create the admin user timeZone = timeZone
let salt = Guid.NewGuid () } conn
do! Data.WebLogUser.add // Create the admin user
{ WebLogUser.empty with let salt = Guid.NewGuid ()
id = userId
webLogId = webLogId do! Data.WebLogUser.add
userName = args[3] { WebLogUser.empty with
firstName = "Admin" id = userId
lastName = "User" webLogId = webLogId
preferredName = "Admin" userName = args[3]
passwordHash = Handlers.User.hashedPassword args[4] args[3] salt firstName = "Admin"
salt = salt lastName = "User"
authorizationLevel = Administrator preferredName = "Admin"
} conn passwordHash = Handlers.User.hashedPassword args[4] args[3] salt
salt = salt
authorizationLevel = Administrator
} conn
// Create the default home page // Create the default home page
do! Data.Page.add do! Data.Page.add
{ Page.empty with { Page.empty with
id = homePageId id = homePageId
webLogId = webLogId webLogId = webLogId
authorId = userId authorId = userId
title = "Welcome to myWebLog!" title = "Welcome to myWebLog!"
permalink = Permalink "welcome-to-myweblog.html" permalink = Permalink "welcome-to-myweblog.html"
publishedOn = DateTime.UtcNow publishedOn = DateTime.UtcNow
updatedOn = DateTime.UtcNow updatedOn = DateTime.UtcNow
text = "<p>This is your default home page.</p>" text = "<p>This is your default home page.</p>"
revisions = [ revisions = [
{ asOf = DateTime.UtcNow { asOf = DateTime.UtcNow
sourceType = Html text = Html "<p>This is your default home page.</p>"
text = "<p>This is your default home page.</p>" }
} ]
] } conn
} 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 /// Create a new web log
let initDb args sp = task { let create args sp = task {
match args |> Array.length with match args |> Array.length with
| 5 -> return! initDbValidated args sp | 5 -> return! createWebLog args sp
| _ -> | _ ->
Console.WriteLine "Usage: MyWebLog init [url] [name] [admin-email] [admin-pw]" Console.WriteLine "Usage: MyWebLog init [url] [name] [admin-email] [admin-pw]"
return! System.Threading.Tasks.Task.CompletedTask return! System.Threading.Tasks.Task.CompletedTask
} }
open DotLiquid open DotLiquid
@ -145,6 +147,7 @@ open Microsoft.AspNetCore.Builder
open Microsoft.Extensions.Configuration open Microsoft.Extensions.Configuration
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog.ViewModels open MyWebLog.ViewModels
open RethinkDB.DistributedCache
open RethinkDb.Driver.FSharp open RethinkDb.Driver.FSharp
[<EntryPoint>] [<EntryPoint>]
@ -177,6 +180,14 @@ let main args =
} |> Async.AwaitTask |> Async.RunSynchronously } |> Async.AwaitTask |> Async.RunSynchronously
let _ = builder.Services.AddSingleton<IConnection> conn let _ = builder.Services.AddSingleton<IConnection> 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 // Set up DotLiquid
Template.RegisterFilter typeof<DotLiquidBespoke.NavLinkFilter> Template.RegisterFilter typeof<DotLiquidBespoke.NavLinkFilter>
Template.RegisterTag<DotLiquidBespoke.UserLinksTag> "user_links" Template.RegisterTag<DotLiquidBespoke.UserLinksTag> "user_links"
@ -189,6 +200,7 @@ let main args =
Template.RegisterSafeType (typeof<DisplayPage>, all) Template.RegisterSafeType (typeof<DisplayPage>, all)
Template.RegisterSafeType (typeof<SettingsModel>, all) Template.RegisterSafeType (typeof<SettingsModel>, all)
Template.RegisterSafeType (typeof<EditPageModel>, all) Template.RegisterSafeType (typeof<EditPageModel>, all)
Template.RegisterSafeType (typeof<UserMessage>, all)
Template.RegisterSafeType (typeof<AntiforgeryTokenSet>, all) Template.RegisterSafeType (typeof<AntiforgeryTokenSet>, all)
Template.RegisterSafeType (typeof<string option>, all) Template.RegisterSafeType (typeof<string option>, all)
@ -197,13 +209,14 @@ let main args =
let app = builder.Build () let app = builder.Build ()
match args |> Array.tryHead with 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.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
let _ = app.UseMiddleware<WebLogMiddleware> () let _ = app.UseMiddleware<WebLogMiddleware> ()
let _ = app.UseAuthentication () let _ = app.UseAuthentication ()
let _ = app.UseStaticFiles () let _ = app.UseStaticFiles ()
let _ = app.UseRouting () let _ = app.UseRouting ()
let _ = app.UseSession ()
let _ = app.UseGiraffe Handlers.endpoints let _ = app.UseGiraffe Handlers.endpoints
app.Run() app.Run()

6
src/MyWebLog/appsettings.json
View File

@ -2,5 +2,11 @@
"RethinkDB": { "RethinkDB": {
"hostname": "data02.bitbadger.solutions", "hostname": "data02.bitbadger.solutions",
"database": "myWebLog-dev" "database": "myWebLog-dev"
},
"Logging": {
"LogLevel": {
"RethinkDB.DistributedCache": "Debug",
"RethinkDb.Driver": "Debug"
}
} }
} }

2
src/MyWebLog/themes/admin/dashboard.liquid
View File

@ -1,4 +1,4 @@
<h2 class="py-3">{{ web_log.name }} &bull; Dashboard</h2> <h2 class="my-3">{{ web_log.name }} &bull; Dashboard</h2>
<article class="container"> <article class="container">
<div class="row"> <div class="row">
<section class="col-lg-5 offset-lg-1 col-xl-4 offset-xl-2 pb-3"> <section class="col-lg-5 offset-lg-1 col-xl-4 offset-xl-2 pb-3">

14
src/MyWebLog/themes/admin/layout.liquid
View File

@ -37,6 +37,20 @@
</nav> </nav>
</header> </header>
<main class="mx-3"> <main class="mx-3">
{% if messages %}
<div class="messages mt-2">
{% for msg in messages %}
<div role="alert" class="alert alert-{{ msg.level }} alert-dismissible fade show">
{{ msg.message }}
<button type="button" class="btn-close" data-bs-dismiss="alert" aria-label="Close"></button>
{% if msg.detail %}
<hr>
<p>{{ msg.detail.value }}</p>
{% endif %}
</div>
{% endfor %}
</div>
{% endif %}
{{ content }} {{ content }}
</main> </main>
<footer> <footer>

4
src/MyWebLog/themes/admin/log-on.liquid
View File

@ -1,5 +1,5 @@
<h2 class="py-3">Log On to {{ web_log.name }}</h2> <h2 class="my-3">Log On to {{ web_log.name }}</h2>
<article class="pb-3"> <article class="py-3">
<form action="/user/log-on" method="post"> <form action="/user/log-on" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="container"> <div class="container">

22
src/MyWebLog/themes/admin/page-edit.liquid
View File

@ -1,27 +1,33 @@
<h2 class="py-3">{{ page_title }}</h2> <h2 class="my-3">{{ page_title }}</h2>
<article> <article>
<form action="/page/save" method="post"> <form action="/page/save" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="pageId" value="{{ model.page_id }}"> <input type="hidden" name="pageId" value="{{ model.page_id }}">
<div class="container"> <div class="container">
<div class="row mb-3"> <div class="row mb-3">
<div class="col"> <div class="col-9">
<div class="form-floating"> <div class="form-floating pb-3">
<input type="text" name="title" id="title" class="form-control" autofocus required <input type="text" name="title" id="title" class="form-control" autofocus required
value="{{ model.title }}"> value="{{ model.title }}">
<label for="title">Title</label> <label for="title">Title</label>
</div> </div>
</div>
</div>
<div class="row mb-3">
<div class="col-9">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="permalink" id="permalink" class="form-control" required <input type="text" name="permalink" id="permalink" class="form-control" required
value="{{ model.permalink }}"> value="{{ model.permalink }}">
<label for="permalink">Permalink</label> <label for="permalink">Permalink</label>
</div> </div>
</div> </div>
<div class="col-3 align-self-center"> <div class="col-3">
<div class="form-floating pb-3">
<select name="template" id="template" class="form-control">
{% for tmpl in templates -%}
<option value="{{ tmpl[0] }}"{% if model.template == tmpl %} selected="selected"{% endif %}>
{{ tmpl[1] }}
</option>
{%- endfor %}
</select>
<label for="template">Page Template</label>
</div>
<div class="form-check form-switch"> <div class="form-check form-switch">
<input type="checkbox" name="isShownInPageList" id="showList" class="form-check-input" value="true" <input type="checkbox" name="isShownInPageList" id="showList" class="form-check-input" value="true"
{%- if model.is_shown_in_page_list %} checked="checked"{% endif %}> {%- if model.is_shown_in_page_list %} checked="checked"{% endif %}>

2
src/MyWebLog/themes/admin/page-list.liquid
View File

@ -1,4 +1,4 @@
<h2 class="py-3">{{ page_title }}</h2> <h2 class="my-3">{{ page_title }}</h2>
<article class="container"> <article class="container">
<a href="/page/new/edit" class="btn btn-primary btn-sm my-3">Create a New Page</a> <a href="/page/new/edit" class="btn btn-primary btn-sm my-3">Create a New Page</a>
<table class="table table-sm table-striped table-hover"> <table class="table table-sm table-striped table-hover">

2
src/MyWebLog/themes/admin/settings.liquid
View File

@ -1,4 +1,4 @@
<h2 class="py-3">{{ web_log.name }} Settings</h2> <h2 class="my-3">{{ web_log.name }} Settings</h2>
<article> <article>
<form action="/admin/settings" method="post"> <form action="/admin/settings" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">

17
src/MyWebLog/themes/default/layout.liquid
View File

@ -35,6 +35,20 @@
</nav> </nav>
</header> </header>
<main class="mx-3"> <main class="mx-3">
{% if messages %}
<div class="messages">
{% for msg in messages %}
<div role="alert" class="alert alert-{{ msg.level }} alert-dismissible fade show">
{{ msg.message }}
<button type="button" class="btn-close" data-bs-dismiss="alert" aria-label="Close"></button>
{% if msg.detail %}
<hr>
<p>{{ msg.detail.value }}</p>
{% endif %}
</div>
{% endfor %}
</div>
{% endif %}
{{ content }} {{ content }}
</main> </main>
<footer> <footer>
@ -43,5 +57,8 @@
<img src="/img/logo-dark.png" alt="myWebLog"> <img src="/img/logo-dark.png" alt="myWebLog">
</div> </div>
</footer> </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> </body>
</html> </html>

4
src/MyWebLog/wwwroot/themes/admin/admin.css
View File

@ -3,3 +3,7 @@
border-top: solid 1px black; border-top: solid 1px black;
color: white; color: white;
} }
.messages {
max-width: 60rem;
margin: auto;
}

4
src/MyWebLog/wwwroot/themes/default/style.css Normal file
View File

@ -0,0 +1,4 @@
.messages {
max-width: 60rem;
margin: auto;
}