V2 #1
|
|
@ -20,6 +20,13 @@ type CommentIdConverter () =
|
|||
override _.ReadJson (reader : JsonReader, _ : Type, _ : CommentId, _ : bool, _ : JsonSerializer) =
|
||||
(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 () =
|
||||
inherit JsonConverter<Permalink> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : Permalink, _ : JsonSerializer) =
|
||||
|
|
@ -63,6 +70,7 @@ let all () : JsonConverter seq =
|
|||
// Our converters
|
||||
CategoryIdConverter ()
|
||||
CommentIdConverter ()
|
||||
MarkupTextConverter ()
|
||||
PermalinkConverter ()
|
||||
PageIdConverter ()
|
||||
PostIdConverter ()
|
||||
|
|
|
|||
|
|
@ -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<string list> { 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 {
|
||||
do! rethink {
|
||||
withTable table
|
||||
indexCreate "permalink" (fun row -> r.Array(row.G "webLogId", row.G "permalink"))
|
||||
write
|
||||
withRetryOnce conn
|
||||
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 {
|
||||
do! rethink {
|
||||
withTable table
|
||||
indexCreate "priorPermalinks"
|
||||
indexOption Multi
|
||||
write
|
||||
withRetryOnce conn
|
||||
indexCreate "priorPermalinks" [ Multi ]
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
()
|
||||
| false -> ()
|
||||
// Users log on with e-mail
|
||||
match Table.WebLogUser = table with
|
||||
| true ->
|
||||
match indexes |> List.contains "logOn" with
|
||||
| true -> ()
|
||||
| false ->
|
||||
if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then
|
||||
log.LogInformation($"Creating index {table}.logOn...")
|
||||
let! _ =
|
||||
rethink {
|
||||
do! rethink {
|
||||
withTable table
|
||||
indexCreate "logOn" (fun row -> r.Array(row.G "webLogId", row.G "userName"))
|
||||
write
|
||||
withRetryOnce conn
|
||||
indexCreate "logOn" (fun row -> r.Array(row.G "webLogId", row.G "userName") :> obj)
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
()
|
||||
| false -> ()
|
||||
}
|
||||
|
||||
/// Ensure all necessary tables and indexes exist
|
||||
let ensureDb (config : DataConfig) (log : ILogger) conn = task {
|
||||
|
||||
let! dbs = rethink<string list> { 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<string list> { 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<Page> {
|
||||
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<WebLog> {
|
||||
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
|
||||
|
||||
|
|
@ -6,7 +6,6 @@
|
|||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<ProjectReference Include="..\..\..\RethinkDb.Driver.FSharp\src\RethinkDb.Driver.FSharp\RethinkDb.Driver.FSharp.fsproj" />
|
||||
<ProjectReference Include="..\MyWebLog.Domain\MyWebLog.Domain.fsproj" />
|
||||
</ItemGroup>
|
||||
|
||||
|
|
@ -15,6 +14,7 @@
|
|||
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
|
||||
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
|
||||
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
|
||||
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.8.0-alpha-0003" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
|
|
|
|||
|
|
@ -11,4 +11,8 @@
|
|||
<Compile Include="ViewModels.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="Markdig" Version="0.28.1" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
namespace MyWebLog
|
||||
|
||||
open System
|
||||
open Markdig
|
||||
|
||||
/// Support functions for domain definition
|
||||
[<AutoOpen>]
|
||||
|
|
@ -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"
|
||||
|
||||
/// 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})"
|
||||
|
||||
/// Convert a string to a revision source
|
||||
let ofString = function "Markdown" -> Markdown | "HTML" -> Html | x -> invalidArg "string" x
|
||||
|
||||
/// A revision of a page or post
|
||||
[<CLIMutable; NoComparison; NoEquality>]
|
||||
|
|
@ -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
|
||||
|
|
@ -89,8 +104,7 @@ module Revision =
|
|||
/// An empty revision
|
||||
let empty =
|
||||
{ asOf = DateTime.UtcNow
|
||||
sourceType = Html
|
||||
text = ""
|
||||
text = Html ""
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ open MyWebLog
|
|||
open System
|
||||
|
||||
/// Details about a page used to display page lists
|
||||
[<NoComparison; NoEquality>]
|
||||
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
|
||||
[<CLIMutable>]
|
||||
[<CLIMutable; NoComparison; NoEquality>]
|
||||
type LogOnModel =
|
||||
{ /// The user's e-mail address
|
||||
emailAddress : string
|
||||
|
|
@ -51,6 +52,7 @@ type LogOnModel =
|
|||
|
||||
|
||||
/// The model used to display the admin dashboard
|
||||
[<NoComparison; NoEquality>]
|
||||
type DashboardModel =
|
||||
{ /// The number of published posts
|
||||
posts : int
|
||||
|
|
@ -73,7 +75,7 @@ type DashboardModel =
|
|||
|
||||
|
||||
/// View model to edit a page
|
||||
[<CLIMutable>]
|
||||
[<CLIMutable; NoComparison; NoEquality>]
|
||||
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
|
||||
|
||||
|
|
@ -102,14 +107,15 @@ type EditPageModel =
|
|||
{ 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
|
||||
[<CLIMutable>]
|
||||
[<CLIMutable; NoComparison; NoEquality>]
|
||||
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
|
||||
}
|
||||
|
||||
|
||||
[<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" }
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
[<AutoOpen>]
|
||||
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<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
|
||||
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
|
||||
| Some page -> return Some ("Edit Page", page)
|
||||
| None -> return None
|
||||
}
|
||||
match result with
|
||||
| Some (title, page) ->
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
csrf = csrfToken ctx
|
||||
model = EditPageModel.fromPage page
|
||||
page_title = "Edit Page"
|
||||
|} |> Some
|
||||
| None -> return None
|
||||
}
|
||||
match hash with
|
||||
| Some h -> return! viewForTheme "admin" "page-edit" next ctx h
|
||||
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
|
||||
}
|
||||
|
|
@ -373,7 +410,8 @@ module User =
|
|||
// POST /user/log-on
|
||||
let doLogOn : HttpHandler = validateCsrf >=> fun next ctx -> task {
|
||||
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 ->
|
||||
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
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@
|
|||
<ItemGroup>
|
||||
<PackageReference Include="DotLiquid" Version="2.2.610" />
|
||||
<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>
|
||||
|
|
|
|||
|
|
@ -60,8 +60,11 @@ 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 =
|
||||
|
||||
/// Create the web log information
|
||||
let private createWebLog (args : string[]) (sp : IServiceProvider) = task {
|
||||
|
||||
let conn = sp.GetRequiredService<IConnection> ()
|
||||
|
||||
|
|
@ -117,8 +120,7 @@ let initDbValidated (args : string[]) (sp : IServiceProvider) = task {
|
|||
text = "<p>This is your default home page.</p>"
|
||||
revisions = [
|
||||
{ asOf = DateTime.UtcNow
|
||||
sourceType = Html
|
||||
text = "<p>This is your default home page.</p>"
|
||||
text = Html "<p>This is your default home page.</p>"
|
||||
}
|
||||
]
|
||||
} conn
|
||||
|
|
@ -126,10 +128,10 @@ let initDbValidated (args : string[]) (sp : IServiceProvider) = task {
|
|||
Console.WriteLine($"Successfully initialized database for {args[2]} with URL base {args[1]}");
|
||||
}
|
||||
|
||||
/// Initialize a new database
|
||||
let initDb args sp = task {
|
||||
/// Create a new web log
|
||||
let create args sp = task {
|
||||
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]"
|
||||
return! System.Threading.Tasks.Task.CompletedTask
|
||||
|
|
@ -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
|
||||
|
||||
[<EntryPoint>]
|
||||
|
|
@ -177,6 +180,14 @@ let main args =
|
|||
} |> Async.AwaitTask |> Async.RunSynchronously
|
||||
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
|
||||
Template.RegisterFilter typeof<DotLiquidBespoke.NavLinkFilter>
|
||||
Template.RegisterTag<DotLiquidBespoke.UserLinksTag> "user_links"
|
||||
|
|
@ -189,6 +200,7 @@ let main args =
|
|||
Template.RegisterSafeType (typeof<DisplayPage>, all)
|
||||
Template.RegisterSafeType (typeof<SettingsModel>, all)
|
||||
Template.RegisterSafeType (typeof<EditPageModel>, all)
|
||||
Template.RegisterSafeType (typeof<UserMessage>, all)
|
||||
|
||||
Template.RegisterSafeType (typeof<AntiforgeryTokenSet>, all)
|
||||
Template.RegisterSafeType (typeof<string option>, 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<WebLogMiddleware> ()
|
||||
let _ = app.UseAuthentication ()
|
||||
let _ = app.UseStaticFiles ()
|
||||
let _ = app.UseRouting ()
|
||||
let _ = app.UseSession ()
|
||||
let _ = app.UseGiraffe Handlers.endpoints
|
||||
|
||||
app.Run()
|
||||
|
|
|
|||
|
|
@ -2,5 +2,11 @@
|
|||
"RethinkDB": {
|
||||
"hostname": "data02.bitbadger.solutions",
|
||||
"database": "myWebLog-dev"
|
||||
},
|
||||
"Logging": {
|
||||
"LogLevel": {
|
||||
"RethinkDB.DistributedCache": "Debug",
|
||||
"RethinkDb.Driver": "Debug"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
<h2 class="py-3">{{ web_log.name }} • Dashboard</h2>
|
||||
<h2 class="my-3">{{ web_log.name }} • Dashboard</h2>
|
||||
<article class="container">
|
||||
<div class="row">
|
||||
<section class="col-lg-5 offset-lg-1 col-xl-4 offset-xl-2 pb-3">
|
||||
|
|
|
|||
|
|
@ -37,6 +37,20 @@
|
|||
</nav>
|
||||
</header>
|
||||
<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 }}
|
||||
</main>
|
||||
<footer>
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
<h2 class="py-3">Log On to {{ web_log.name }}</h2>
|
||||
<article class="pb-3">
|
||||
<h2 class="my-3">Log On to {{ web_log.name }}</h2>
|
||||
<article class="py-3">
|
||||
<form action="/user/log-on" method="post">
|
||||
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
|
||||
<div class="container">
|
||||
|
|
|
|||
|
|
@ -1,27 +1,33 @@
|
|||
<h2 class="py-3">{{ page_title }}</h2>
|
||||
<h2 class="my-3">{{ page_title }}</h2>
|
||||
<article>
|
||||
<form action="/page/save" method="post">
|
||||
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
|
||||
<input type="hidden" name="pageId" value="{{ model.page_id }}">
|
||||
<div class="container">
|
||||
<div class="row mb-3">
|
||||
<div class="col">
|
||||
<div class="form-floating">
|
||||
<div class="col-9">
|
||||
<div class="form-floating pb-3">
|
||||
<input type="text" name="title" id="title" class="form-control" autofocus required
|
||||
value="{{ model.title }}">
|
||||
<label for="title">Title</label>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row mb-3">
|
||||
<div class="col-9">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="permalink" id="permalink" class="form-control" required
|
||||
value="{{ model.permalink }}">
|
||||
<label for="permalink">Permalink</label>
|
||||
</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">
|
||||
<input type="checkbox" name="isShownInPageList" id="showList" class="form-check-input" value="true"
|
||||
{%- if model.is_shown_in_page_list %} checked="checked"{% endif %}>
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
<h2 class="py-3">{{ page_title }}</h2>
|
||||
<h2 class="my-3">{{ page_title }}</h2>
|
||||
<article class="container">
|
||||
<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">
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
<h2 class="py-3">{{ web_log.name }} Settings</h2>
|
||||
<h2 class="my-3">{{ web_log.name }} Settings</h2>
|
||||
<article>
|
||||
<form action="/admin/settings" method="post">
|
||||
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
|
||||
|
|
|
|||
|
|
@ -35,6 +35,20 @@
|
|||
</nav>
|
||||
</header>
|
||||
<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 }}
|
||||
</main>
|
||||
<footer>
|
||||
|
|
@ -43,5 +57,8 @@
|
|||
<img src="/img/logo-dark.png" alt="myWebLog">
|
||||
</div>
|
||||
</footer>
|
||||
<script src="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js"
|
||||
integrity="sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM"
|
||||
crossorigin="anonymous"></script>
|
||||
</body>
|
||||
</html>
|
||||
|
|
|
|||
|
|
@ -3,3 +3,7 @@
|
|||
border-top: solid 1px black;
|
||||
color: white;
|
||||
}
|
||||
.messages {
|
||||
max-width: 60rem;
|
||||
margin: auto;
|
||||
}
|
||||
|
|
|
|||
4
src/MyWebLog/wwwroot/themes/default/style.css
Normal file
4
src/MyWebLog/wwwroot/themes/default/style.css
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
.messages {
|
||||
max-width: 60rem;
|
||||
margin: auto;
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user