diff --git a/src/MyWebLog.Data/Converters.fs b/src/MyWebLog.Data/Converters.fs new file mode 100644 index 0000000..803c955 --- /dev/null +++ b/src/MyWebLog.Data/Converters.fs @@ -0,0 +1,73 @@ +/// JSON.NET converters for discriminated union types +[] +module MyWebLog.JsonConverters + +open MyWebLog +open Newtonsoft.Json +open System + +type CategoryIdConverter () = + inherit JsonConverter () + override _.WriteJson (writer : JsonWriter, value : CategoryId, _ : JsonSerializer) = + writer.WriteValue (CategoryId.toString value) + override _.ReadJson (reader : JsonReader, _ : Type, _ : CategoryId, _ : bool, _ : JsonSerializer) = + (string >> CategoryId) reader.Value + +type CommentIdConverter () = + inherit JsonConverter () + override _.WriteJson (writer : JsonWriter, value : CommentId, _ : JsonSerializer) = + writer.WriteValue (CommentId.toString value) + override _.ReadJson (reader : JsonReader, _ : Type, _ : CommentId, _ : bool, _ : JsonSerializer) = + (string >> CommentId) reader.Value + +type PermalinkConverter () = + inherit JsonConverter () + override _.WriteJson (writer : JsonWriter, value : Permalink, _ : JsonSerializer) = + writer.WriteValue (Permalink.toString value) + override _.ReadJson (reader : JsonReader, _ : Type, _ : Permalink, _ : bool, _ : JsonSerializer) = + (string >> Permalink) reader.Value + +type PageIdConverter () = + inherit JsonConverter () + override _.WriteJson (writer : JsonWriter, value : PageId, _ : JsonSerializer) = + writer.WriteValue (PageId.toString value) + override _.ReadJson (reader : JsonReader, _ : Type, _ : PageId, _ : bool, _ : JsonSerializer) = + (string >> PageId) reader.Value + +type PostIdConverter () = + inherit JsonConverter () + override _.WriteJson (writer : JsonWriter, value : PostId, _ : JsonSerializer) = + writer.WriteValue (PostId.toString value) + override _.ReadJson (reader : JsonReader, _ : Type, _ : PostId, _ : bool, _ : JsonSerializer) = + (string >> PostId) reader.Value + +type WebLogIdConverter () = + inherit JsonConverter () + override _.WriteJson (writer : JsonWriter, value : WebLogId, _ : JsonSerializer) = + writer.WriteValue (WebLogId.toString value) + override _.ReadJson (reader : JsonReader, _ : Type, _ : WebLogId, _ : bool, _ : JsonSerializer) = + (string >> WebLogId) reader.Value + +type WebLogUserIdConverter () = + inherit JsonConverter () + override _.WriteJson (writer : JsonWriter, value : WebLogUserId, _ : JsonSerializer) = + writer.WriteValue (WebLogUserId.toString value) + override _.ReadJson (reader : JsonReader, _ : Type, _ : WebLogUserId, _ : bool, _ : JsonSerializer) = + (string >> WebLogUserId) reader.Value + +open Microsoft.FSharpLu.Json + +/// All converters to use for data conversion +let all () : JsonConverter seq = + seq { + CategoryIdConverter () + CommentIdConverter () + PermalinkConverter () + PageIdConverter () + PostIdConverter () + WebLogIdConverter () + WebLogUserIdConverter () + // Handles DUs with no associated data, as well as option fields + CompactUnionJsonConverter () + } + diff --git a/src/MyWebLog.Data/Data.fs b/src/MyWebLog.Data/Data.fs new file mode 100644 index 0000000..a9f3a9c --- /dev/null +++ b/src/MyWebLog.Data/Data.fs @@ -0,0 +1,298 @@ +[] +module MyWebLog.Data + +/// Table names +[] +module private Table = + + /// The category table + let Category = "Category" + + /// The comment table + let Comment = "Comment" + + /// The page table + let Page = "Page" + + /// The post table + let Post = "Post" + + /// The web log table + let WebLog = "WebLog" + + /// The web log user table + let WebLogUser = "WebLogUser" + + /// A list of all tables + let all = [ Category; Comment; Page; Post; WebLog; WebLogUser ] + + +/// Functions to assist with retrieving data +[] +module Helpers = + + open RethinkDb.Driver + open RethinkDb.Driver.Net + open System.Threading.Tasks + + /// Shorthand for the ReQL starting point + let r = RethinkDB.R + + /// 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 { + match! f conn with Some it when (prop it) = webLogId -> return Some it | _ -> return None + } + + +open RethinkDb.Driver.FSharp +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! indexes = rethink { withTable table; indexList; result; withRetryOnce conn } + for field in fields do + match indexes |> List.contains field with + | true -> () + | false -> + log.LogInformation($"Creating index {table}.{field}...") + let! _ = rethink { withTable table; indexCreate field; write; withRetryOnce 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 -> + 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 + } + () + | false -> () + // 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 "email")) + write + withRetryOnce conn + } + () + | false -> () + } + + /// 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 -> + log.LogInformation($"Creating database {config.Database}...") + let! _ = rethink { dbCreate config.Database; write; withRetryOnce conn } + () + + let! tables = rethink { tableList; result; withRetryOnce conn } + for tbl in Table.all do + match tables |> List.contains tbl with + | true -> () + | false -> + log.LogInformation($"Creating table {tbl}...") + let! _ = rethink { tableCreate tbl; write; withRetryOnce conn } + () + + let makeIdx = ensureIndexes log conn + do! makeIdx Table.Category [ "webLogId" ] + do! makeIdx Table.Comment [ "postId" ] + do! makeIdx Table.Page [ "webLogId"; "authorId" ] + do! makeIdx Table.Post [ "webLogId"; "authorId" ] + do! makeIdx Table.WebLog [ "urlBase" ] + do! makeIdx Table.WebLogUser [ "webLogId" ] + } + +/// Functions to manipulate categories +module Category = + + /// Count all categories for a web log + let countAll (webLogId : WebLogId) = + rethink { + withTable Table.Category + getAll [ webLogId ] (nameof webLogId) + count + result + withRetryDefault + } + + /// Count top-level categories for a web log + let countTopLevel (webLogId : WebLogId) = + rethink { + withTable Table.Category + getAll [ webLogId ] (nameof webLogId) + filter "parentId" None + count + result + withRetryDefault + } + + +/// Functions to manipulate pages +module Page = + + /// Count all pages for a web log + let countAll (webLogId : WebLogId) = + rethink { + withTable Table.Page + getAll [ webLogId ] (nameof webLogId) + count + result + withRetryDefault + } + + /// Count listed pages for a web log + let countListed (webLogId : WebLogId) = + rethink { + withTable Table.Page + getAll [ webLogId ] (nameof webLogId) + filter "showInPageList" true + count + result + withRetryDefault + } + + /// Retrieve all pages for a web log + let findAll (webLogId : WebLogId) = + rethink { + withTable Table.Page + getAll [ webLogId ] (nameof webLogId) + without [ "priorPermalinks", "revisions" ] + result + withRetryDefault + } + + /// Find a page by its ID + let findById (pageId : PageId) webLogId = + rethink { + withTable Table.Page + get pageId + without [ "priorPermalinks", "revisions" ] + resultOption + withRetryDefault + } + |> verifyWebLog webLogId (fun it -> it.webLogId) + + /// Find a page by its permalink + let findByPermalink (permalink : Permalink) (webLogId : WebLogId) = + rethink { + withTable Table.Page + getAll [ r.Array (webLogId, permalink) ] (nameof permalink) + without [ "priorPermalinks", "revisions" ] + limit 1 + resultOption + withRetryDefault + } + + /// Find a page by its ID (including permalinks and revisions) + let findByFullId (pageId : PageId) webLogId = + rethink { + withTable Table.Page + get pageId + resultOption + withRetryDefault + } + |> verifyWebLog webLogId (fun it -> it.webLogId) + + /// Find a list of pages (displayed in admin area) + let findPageOfPages (webLogId : WebLogId) pageNbr = + rethink { + withTable Table.Page + getAll [ webLogId ] (nameof webLogId) + without [ "priorPermalinks", "revisions" ] + orderBy "title" + skip ((pageNbr - 1) * 25) + limit 25 + result + withRetryDefault + } + +/// Functions to manipulate posts +module Post = + + /// Count posts for a web log by their status + let countByStatus (status : PostStatus) (webLogId : WebLogId) = + rethink { + withTable Table.Post + getAll [ webLogId ] (nameof webLogId) + filter "status" status + count + result + withRetryDefault + } + + /// Find a post by its permalink + let findByPermalink (permalink : Permalink) (webLogId : WebLogId) = + rethink { + withTable Table.Post + getAll [ r.Array(permalink, webLogId) ] (nameof permalink) + without [ "priorPermalinks", "revisions" ] + limit 1 + resultOption + withRetryDefault + } + + /// Find posts to be displayed on a page + let findPageOfPublishedPosts (webLogId : WebLogId) pageNbr postsPerPage = + rethink { + withTable Table.Post + getAll [ webLogId ] (nameof webLogId) + filter "status" Published + without [ "priorPermalinks", "revisions" ] + orderBy "publishedOn" + skip ((pageNbr - 1) * postsPerPage) + limit postsPerPage + result + withRetryDefault + } + + +/// Functions to manipulate web logs +module WebLog = + + /// Retrieve web log details by the URL base + let findByHost (url : string) = + rethink { + withTable Table.WebLog + getAll [ url ] "urlBase" + limit 1 + resultOption + withRetryDefault + } + + /// Update web log settings + let updateSettings (webLog : WebLog) = + rethink { + withTable Table.WebLog + get webLog.id + update [ + "name", webLog.name + "subtitle", webLog.subtitle + "defaultPage", webLog.defaultPage + "postsPerPage", webLog.postsPerPage + "timeZone", webLog.timeZone + ] + write + withRetryDefault + ignoreResult + } diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj new file mode 100644 index 0000000..843542b --- /dev/null +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -0,0 +1,25 @@ + + + + net6.0 + true + + + + + + + + + + + + + + + + + + + + diff --git a/src/MyWebLog.Data/Category.cs b/src/MyWebLog.DataCS/Category.cs similarity index 100% rename from src/MyWebLog.Data/Category.cs rename to src/MyWebLog.DataCS/Category.cs diff --git a/src/MyWebLog.Data/Comment.cs b/src/MyWebLog.DataCS/Comment.cs similarity index 100% rename from src/MyWebLog.Data/Comment.cs rename to src/MyWebLog.DataCS/Comment.cs diff --git a/src/MyWebLog.Data/Enums.cs b/src/MyWebLog.DataCS/Enums.cs similarity index 100% rename from src/MyWebLog.Data/Enums.cs rename to src/MyWebLog.DataCS/Enums.cs diff --git a/src/MyWebLog.Data/Extensions/CategoryExtensions.cs b/src/MyWebLog.DataCS/Extensions/CategoryExtensions.cs similarity index 100% rename from src/MyWebLog.Data/Extensions/CategoryExtensions.cs rename to src/MyWebLog.DataCS/Extensions/CategoryExtensions.cs diff --git a/src/MyWebLog.Data/Extensions/PageExtensions.cs b/src/MyWebLog.DataCS/Extensions/PageExtensions.cs similarity index 100% rename from src/MyWebLog.Data/Extensions/PageExtensions.cs rename to src/MyWebLog.DataCS/Extensions/PageExtensions.cs diff --git a/src/MyWebLog.Data/Extensions/PostExtensions.cs b/src/MyWebLog.DataCS/Extensions/PostExtensions.cs similarity index 100% rename from src/MyWebLog.Data/Extensions/PostExtensions.cs rename to src/MyWebLog.DataCS/Extensions/PostExtensions.cs diff --git a/src/MyWebLog.Data/Extensions/WebLogDetailsExtensions.cs b/src/MyWebLog.DataCS/Extensions/WebLogDetailsExtensions.cs similarity index 100% rename from src/MyWebLog.Data/Extensions/WebLogDetailsExtensions.cs rename to src/MyWebLog.DataCS/Extensions/WebLogDetailsExtensions.cs diff --git a/src/MyWebLog.Data/Extensions/WebLogUserExtensions.cs b/src/MyWebLog.DataCS/Extensions/WebLogUserExtensions.cs similarity index 100% rename from src/MyWebLog.Data/Extensions/WebLogUserExtensions.cs rename to src/MyWebLog.DataCS/Extensions/WebLogUserExtensions.cs diff --git a/src/MyWebLog.Data/Migrations/20220307034307_Initial.Designer.cs b/src/MyWebLog.DataCS/Migrations/20220307034307_Initial.Designer.cs similarity index 100% rename from src/MyWebLog.Data/Migrations/20220307034307_Initial.Designer.cs rename to src/MyWebLog.DataCS/Migrations/20220307034307_Initial.Designer.cs diff --git a/src/MyWebLog.Data/Migrations/20220307034307_Initial.cs b/src/MyWebLog.DataCS/Migrations/20220307034307_Initial.cs similarity index 100% rename from src/MyWebLog.Data/Migrations/20220307034307_Initial.cs rename to src/MyWebLog.DataCS/Migrations/20220307034307_Initial.cs diff --git a/src/MyWebLog.Data/Migrations/WebLogDbContextModelSnapshot.cs b/src/MyWebLog.DataCS/Migrations/WebLogDbContextModelSnapshot.cs similarity index 100% rename from src/MyWebLog.Data/Migrations/WebLogDbContextModelSnapshot.cs rename to src/MyWebLog.DataCS/Migrations/WebLogDbContextModelSnapshot.cs diff --git a/src/MyWebLog.Data/MyWebLog.Data.csproj b/src/MyWebLog.DataCS/MyWebLog.DataCS.csproj similarity index 94% rename from src/MyWebLog.Data/MyWebLog.Data.csproj rename to src/MyWebLog.DataCS/MyWebLog.DataCS.csproj index 4231758..3f95143 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.csproj +++ b/src/MyWebLog.DataCS/MyWebLog.DataCS.csproj @@ -1,4 +1,4 @@ - + net6.0 diff --git a/src/MyWebLog.Data/Page.cs b/src/MyWebLog.DataCS/Page.cs similarity index 100% rename from src/MyWebLog.Data/Page.cs rename to src/MyWebLog.DataCS/Page.cs diff --git a/src/MyWebLog.Data/Permalink.cs b/src/MyWebLog.DataCS/Permalink.cs similarity index 100% rename from src/MyWebLog.Data/Permalink.cs rename to src/MyWebLog.DataCS/Permalink.cs diff --git a/src/MyWebLog.Data/Post.cs b/src/MyWebLog.DataCS/Post.cs similarity index 100% rename from src/MyWebLog.Data/Post.cs rename to src/MyWebLog.DataCS/Post.cs diff --git a/src/MyWebLog.Data/Revision.cs b/src/MyWebLog.DataCS/Revision.cs similarity index 100% rename from src/MyWebLog.Data/Revision.cs rename to src/MyWebLog.DataCS/Revision.cs diff --git a/src/MyWebLog.Data/Tag.cs b/src/MyWebLog.DataCS/Tag.cs similarity index 100% rename from src/MyWebLog.Data/Tag.cs rename to src/MyWebLog.DataCS/Tag.cs diff --git a/src/MyWebLog.Data/WebLogDbContext.cs b/src/MyWebLog.DataCS/WebLogDbContext.cs similarity index 100% rename from src/MyWebLog.Data/WebLogDbContext.cs rename to src/MyWebLog.DataCS/WebLogDbContext.cs diff --git a/src/MyWebLog.Data/WebLogDetails.cs b/src/MyWebLog.DataCS/WebLogDetails.cs similarity index 100% rename from src/MyWebLog.Data/WebLogDetails.cs rename to src/MyWebLog.DataCS/WebLogDetails.cs diff --git a/src/MyWebLog.Data/WebLogUser.cs b/src/MyWebLog.DataCS/WebLogUser.cs similarity index 100% rename from src/MyWebLog.Data/WebLogUser.cs rename to src/MyWebLog.DataCS/WebLogUser.cs diff --git a/src/MyWebLog.Domain/DataTypes.fs b/src/MyWebLog.Domain/DataTypes.fs new file mode 100644 index 0000000..d840820 --- /dev/null +++ b/src/MyWebLog.Domain/DataTypes.fs @@ -0,0 +1,309 @@ +namespace MyWebLog + +open System + +/// A category under which a post may be identfied +[] +type Category = + { /// The ID of the category + id : CategoryId + + /// The ID of the web log to which the category belongs + webLogId : WebLogId + + /// The displayed name + name : string + + /// The slug (used in category URLs) + slug : string + + /// A longer description of the category + description : string option + + /// The parent ID of this category (if a subcategory) + parentId : CategoryId option + } + +/// Functions to support categories +module Category = + + /// An empty category + let empty = + { id = CategoryId.empty + webLogId = WebLogId.empty + name = "" + slug = "" + description = None + parentId = None + } + + +/// A comment on a post +[] +type Comment = + { /// The ID of the comment + id : CommentId + + /// The ID of the post to which this comment applies + postId : PostId + + /// The ID of the comment to which this comment is a reply + inReplyToId : CommentId option + + /// The name of the commentor + name : string + + /// The e-mail address of the commentor + email : string + + /// The URL of the commentor's personal website + url : string option + + /// The status of the comment + status : CommentStatus + + /// When the comment was posted + postedOn : DateTime + + /// The text of the comment + text : string + } + +/// Functions to support comments +module Comment = + + /// An empty comment + let empty = + { id = CommentId.empty + postId = PostId.empty + inReplyToId = None + name = "" + email = "" + url = None + status = Pending + postedOn = DateTime.UtcNow + text = "" + } + + +/// A page (text not associated with a date/time) +[] +type Page = + { /// The ID of this page + id : PageId + + /// The ID of the web log to which this page belongs + webLogId : WebLogId + + /// The ID of the author of this page + authorId : WebLogUserId + + /// The title of the page + title : string + + /// The link at which this page is displayed + permalink : Permalink + + /// When this page was published + publishedOn : DateTime + + /// When this page was last updated + updatedOn : DateTime + + /// Whether this page shows as part of the web log's navigation + showInPageList : bool + + /// The template to use when rendering this page + template : string option + + /// The current text of the page + text : string + + /// Permalinks at which this page may have been previously served (useful for migrated content) + priorPermalinks : string list + + /// Revisions of this page + revisions : Revision list + } + +/// Functions to support pages +module Page = + + /// An empty page + let empty = + { id = PageId.empty + webLogId = WebLogId.empty + authorId = WebLogUserId.empty + title = "" + permalink = Permalink.empty + publishedOn = DateTime.MinValue + updatedOn = DateTime.MinValue + showInPageList = false + template = None + text = "" + priorPermalinks = [] + revisions = [] + } + + +/// A web log post +[] +type Post = + { /// The ID of this post + id : PostId + + /// The ID of the web log to which this post belongs + webLogId : WebLogId + + /// The ID of the author of this post + authorId : WebLogUserId + + /// The status + status : PostStatus + + /// The title + title : string + + /// The link at which the post resides + permalink : Permalink + + /// The instant on which the post was originally published + publishedOn : DateTime option + + /// The instant on which the post was last updated + updatedOn : DateTime + + /// The text of the post in HTML (ready to display) format + text : string + + /// The Ids of the categories to which this is assigned + categoryIds : CategoryId list + + /// The tags for the post + tags : string list + + /// Permalinks at which this post may have been previously served (useful for migrated content) + priorPermalinks : Permalink list + + /// The revisions for this post + revisions : Revision list + } + +/// Functions to support posts +module Post = + + /// An empty post + let empty = + { id = PostId.empty + webLogId = WebLogId.empty + authorId = WebLogUserId.empty + status = Draft + title = "" + permalink = Permalink.empty + publishedOn = None + updatedOn = DateTime.MinValue + text = "" + categoryIds = [] + tags = [] + priorPermalinks = [] + revisions = [] + } + + +/// A web log +[] +type WebLog = + { /// The ID of the web log + id : WebLogId + + /// The name of the web log + name : string + + /// A subtitle for the web log + subtitle : string option + + /// The default page ("posts" or a page Id) + defaultPage : string + + /// The number of posts to display on pages of posts + postsPerPage : int + + /// The path of the theme (within /views/themes) + themePath : string + + /// The URL base + urlBase : string + + /// The time zone in which dates/times should be displayed + timeZone : string + } + +/// Functions to support web logs +module WebLog = + + /// An empty set of web logs + let empty = + { id = WebLogId.empty + name = "" + subtitle = None + defaultPage = "" + postsPerPage = 10 + themePath = "Default" + urlBase = "" + timeZone = "" + } + + /// Convert a permalink to an absolute URL + let absoluteUrl webLog = function Permalink link -> $"{webLog.urlBase}{link}" + + +/// A user of the web log +[] +type WebLogUser = + { /// The ID of the user + id : WebLogUserId + + /// The ID of the web log to which this user belongs + webLogId : WebLogId + + /// The user name (e-mail address) + userName : string + + /// The user's first name + firstName : string + + /// The user's last name + lastName : string + + /// The user's preferred name + preferredName : string + + /// The hash of the user's password + passwordHash : string + + /// Salt used to calculate the user's password hash + salt : Guid + + /// The URL of the user's personal site + url : string option + + /// The user's authorization level + authorizationLevel : AuthorizationLevel + } + +/// Functions to support web log users +module WebLogUser = + + /// An empty web log user + let empty = + { id = WebLogUserId.empty + webLogId = WebLogId.empty + userName = "" + firstName = "" + lastName = "" + preferredName = "" + passwordHash = "" + salt = Guid.Empty + url = None + authorizationLevel = User + } diff --git a/src/MyWebLog.Domain/MyWebLog.Domain.fsproj b/src/MyWebLog.Domain/MyWebLog.Domain.fsproj new file mode 100644 index 0000000..409e3bc --- /dev/null +++ b/src/MyWebLog.Domain/MyWebLog.Domain.fsproj @@ -0,0 +1,13 @@ + + + + net6.0 + true + + + + + + + + diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs new file mode 100644 index 0000000..fa0a1af --- /dev/null +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -0,0 +1,181 @@ +namespace MyWebLog + +open System + +/// Support functions for domain definition +[] +module private Helpers = + + /// Create a new ID (short GUID) + // https://www.madskristensen.net/blog/A-shorter-and-URL-friendly-GUID + let newId() = + Convert.ToBase64String(Guid.NewGuid().ToByteArray()).Replace('/', '_').Replace('+', '-')[..22] + + +/// An identifier for a category +type CategoryId = CategoryId of string + +/// Functions to support category IDs +module CategoryId = + + /// An empty category ID + let empty = CategoryId "" + + /// Convert a category ID to a string + let toString = function CategoryId ci -> ci + + /// Create a new category ID + let create () = CategoryId (newId ()) + + +/// An identifier for a comment +type CommentId = CommentId of string + +/// Functions to support comment IDs +module CommentId = + + /// An empty comment ID + let empty = CommentId "" + + /// Convert a comment ID to a string + let toString = function CommentId ci -> ci + + /// Create a new comment ID + let create () = CommentId (newId ()) + + +/// Statuses for post comments +type CommentStatus = + /// The comment is approved + | Approved + /// The comment has yet to be approved + | Pending + /// The comment was unsolicited and unwelcome + | Spam + + +/// The source format for a revision +type RevisionSource = + /// Markdown text + | Markdown + /// HTML + | Html + + +/// A revision of a page or post +[] +type Revision = + { /// When this revision was saved + asOf : DateTime + + /// The source language (Markdown or HTML) + sourceType : RevisionSource + + /// The text of the revision + text : string + } + +/// Functions to support revisions +module Revision = + + /// An empty revision + let empty = + { asOf = DateTime.UtcNow + sourceType = Html + text = "" + } + + +/// A permanent link +type Permalink = Permalink of string + +/// Functions to support permalinks +module Permalink = + + /// An empty permalink + let empty = Permalink "" + + /// Convert a permalink to a string + let toString = function Permalink p -> p + + +/// An identifier for a page +type PageId = PageId of string + +/// Functions to support page IDs +module PageId = + + /// An empty page ID + let empty = PageId "" + + /// Convert a page ID to a string + let toString = function PageId pi -> pi + + /// Create a new page ID + let create () = PageId (newId ()) + + +/// Statuses for posts +type PostStatus = + /// The post should not be publicly available + | Draft + /// The post is publicly viewable + | Published + + +/// An identifier for a post +type PostId = PostId of string + +/// Functions to support post IDs +module PostId = + + /// An empty post ID + let empty = PostId "" + + /// Convert a post ID to a string + let toString = function PostId pi -> pi + + /// Create a new post ID + let create () = PostId (newId ()) + + +/// An identifier for a web log +type WebLogId = WebLogId of string + +/// Functions to support web log IDs +module WebLogId = + + /// An empty web log ID + let empty = WebLogId "" + + /// Convert a web log ID to a string + let toString = function WebLogId wli -> wli + + /// Create a new web log ID + let create () = WebLogId (newId ()) + + +/// A level of authorization for a given web log +type AuthorizationLevel = + /// The user may administer all aspects of a web log + | Administrator + /// The user is a known user of a web log + | User + + +/// An identifier for a web log user +type WebLogUserId = WebLogUserId of string + +/// Functions to support web log user IDs +module WebLogUserId = + + /// An empty web log user ID + let empty = WebLogUserId "" + + /// Convert a web log user ID to a string + let toString = function WebLogUserId wli -> wli + + /// Create a new web log user ID + let create () = WebLogUserId (newId ()) + + diff --git a/src/MyWebLog.FS/Features/Admin/AdminController.fs b/src/MyWebLog.FS/Features/Admin/AdminController.fs new file mode 100644 index 0000000..32898f0 --- /dev/null +++ b/src/MyWebLog.FS/Features/Admin/AdminController.fs @@ -0,0 +1,63 @@ +namespace MyWebLog.Features.Admin + +open Microsoft.AspNetCore.Authorization +open Microsoft.AspNetCore.Mvc +open Microsoft.AspNetCore.Mvc.Rendering +open MyWebLog +open MyWebLog.Features.Shared +open RethinkDb.Driver.Net +open System.Threading.Tasks + +/// Controller for admin-specific displays and routes +[] +[] +type AdminController () = + inherit MyWebLogController () + + [] + member this.Index () = task { + let getCount (f : WebLogId -> IConnection -> Task) = f this.WebLog.id this.Db + let! posts = Data.Post.countByStatus Published |> getCount + let! drafts = Data.Post.countByStatus Draft |> getCount + let! pages = Data.Page.countAll |> getCount + let! pages = Data.Page.countAll |> getCount + let! listed = Data.Page.countListed |> getCount + let! cats = Data.Category.countAll |> getCount + let! topCats = Data.Category.countTopLevel |> getCount + return this.View (DashboardModel ( + this.WebLog, + Posts = posts, + Drafts = drafts, + Pages = pages, + ListedPages = listed, + Categories = cats, + TopLevelCategories = topCats + )) + } + + [] + member this.Settings() = task { + let! allPages = Data.Page.findAll this.WebLog.id this.Db + return this.View (SettingsModel ( + this.WebLog, + DefaultPages = + (Seq.singleton (SelectListItem ("- {Resources.FirstPageOfPosts} -", "posts")) + |> Seq.append (allPages |> Seq.map (fun p -> SelectListItem (p.title, PageId.toString p.id)))) + )) + } + + [] + member this.SaveSettings (model : SettingsModel) = task { + match! Data.WebLog.findByHost this.WebLog.urlBase this.Db with + | Some webLog -> + let updated = model.UpdateSettings webLog + do! Data.WebLog.updateSettings updated this.Db + + // Update cache + WebLogCache.set (WebLogCache.hostToDb this.HttpContext) updated + + // TODO: confirmation message + + return this.RedirectToAction (nameof this.Index); + | None -> return this.NotFound () + } diff --git a/src/MyWebLog.FS/Features/Admin/AdminTypes.fs b/src/MyWebLog.FS/Features/Admin/AdminTypes.fs new file mode 100644 index 0000000..951ce4a --- /dev/null +++ b/src/MyWebLog.FS/Features/Admin/AdminTypes.fs @@ -0,0 +1,76 @@ +namespace MyWebLog.Features.Admin + +open MyWebLog +open MyWebLog.Features.Shared + +/// The model used to display the dashboard +type DashboardModel (webLog) = + inherit MyWebLogModel (webLog) + + /// The number of published posts + member val Posts = 0 with get, set + + /// The number of post drafts + member val Drafts = 0 with get, set + + /// The number of pages + member val Pages = 0 with get, set + + /// The number of pages in the page list + member val ListedPages = 0 with get, set + + /// The number of categories + member val Categories = 0 with get, set + + /// The top-level categories + member val TopLevelCategories = 0 with get, set + + +open Microsoft.AspNetCore.Mvc.Rendering +open System.ComponentModel.DataAnnotations + +/// View model for editing web log settings +type SettingsModel (webLog) = + inherit MyWebLogModel (webLog) + + /// Default constructor + [] + new() = SettingsModel WebLog.empty + + /// The name of the web log + [] + [, Name = "Name")>] + member val Name = webLog.name with get, set + + /// The subtitle of the web log + [, Name = "Subtitle")>] + member val Subtitle = (defaultArg webLog.subtitle "") with get, set + + /// The default page + [] + [, Name = "DefaultPage")>] + member val DefaultPage = webLog.defaultPage with get, set + + /// How many posts should appear on index pages + [] + [, Name = "PostsPerPage")>] + [] + member val PostsPerPage = webLog.postsPerPage with get, set + + /// The time zone in which dates/times should be displayed + [] + [, Name = "TimeZone")>] + member val TimeZone = webLog.timeZone with get, set + + /// Possible values for the default page + member val DefaultPages = Seq.empty with get, set + + /// Update the settings object from the data in this form + member this.UpdateSettings (settings : WebLog) = + { settings with + name = this.Name + subtitle = (match this.Subtitle with "" -> None | sub -> Some sub) + defaultPage = this.DefaultPage + postsPerPage = this.PostsPerPage + timeZone = this.TimeZone + } diff --git a/src/MyWebLog.FS/Features/Admin/Index.cshtml b/src/MyWebLog.FS/Features/Admin/Index.cshtml new file mode 100644 index 0000000..72ef232 --- /dev/null +++ b/src/MyWebLog.FS/Features/Admin/Index.cshtml @@ -0,0 +1,61 @@ +@model DashboardModel +@{ + Layout = "_AdminLayout"; + ViewBag.Title = Resources.Dashboard; +} +
+
+
+
+
@Resources.Posts
+
+
+ @Resources.Published @Model.Posts +   @Resources.Drafts @Model.Drafts +
+ @Resources.ViewAll + + @Resources.WriteANewPost + +
+
+
+
+
+
@Resources.Pages
+
+
+ @Resources.All @Model.Pages +   @Resources.ShownInPageList @Model.ListedPages +
+ @Resources.ViewAll + + @Resources.CreateANewPage + +
+
+
+
+
+
+
+
@Resources.Categories
+
+
+ @Resources.All @Model.Categories +   @Resources.TopLevel @Model.TopLevelCategories +
+ @Resources.ViewAll + + @Resources.AddANewCategory + +
+
+
+
+
+
+ @Resources.ModifySettings +
+
+
diff --git a/src/MyWebLog.FS/Features/Pages/PageTypes.fs b/src/MyWebLog.FS/Features/Pages/PageTypes.fs new file mode 100644 index 0000000..a9b4ad4 --- /dev/null +++ b/src/MyWebLog.FS/Features/Pages/PageTypes.fs @@ -0,0 +1,15 @@ +namespace MyWebLog.Features.Pages + +open MyWebLog +open MyWebLog.Features.Shared + +/// The model used to render a single page +type SinglePageModel (page : Page, webLog) = + inherit MyWebLogModel (webLog) + + /// The page to be rendered + member _.Page with get () = page + + /// Is this the home page? + member _.IsHome with get() = PageId.toString page.id = webLog.defaultPage + diff --git a/src/MyWebLog.FS/Features/Posts/PostController.fs b/src/MyWebLog.FS/Features/Posts/PostController.fs new file mode 100644 index 0000000..7f0782e --- /dev/null +++ b/src/MyWebLog.FS/Features/Posts/PostController.fs @@ -0,0 +1,65 @@ +namespace MyWebLog.Features.Posts + +open Microsoft.AspNetCore.Authorization +open Microsoft.AspNetCore.Mvc +open MyWebLog +open MyWebLog.Features.Pages +open MyWebLog.Features.Shared +open System +open System.Threading.Tasks + +/// Handle post-related requests +[] +[] +type PostController () = + inherit MyWebLogController () + + [] + [] + member this.Index () = task { + match this.WebLog.defaultPage with + | "posts" -> return! this.PageOfPosts 1 + | pageId -> + match! Data.Page.findById (PageId pageId) this.WebLog.id this.Db with + | Some page -> + return this.ThemedView (defaultArg page.template "SinglePage", SinglePageModel (page, this.WebLog)) + | None -> return this.NotFound () + } + + [] + [] + member this.PageOfPosts (pageNbr : int) = task { + let! posts = Data.Post.findPageOfPublishedPosts this.WebLog.id pageNbr this.WebLog.postsPerPage this.Db + return this.ThemedView ("Index", MultiplePostModel (posts, this.WebLog)) + } + + [] + member this.CatchAll (link : string) = task { + let permalink = Permalink link + match! Data.Post.findByPermalink permalink this.WebLog.id this.Db with + | Some post -> return this.NotFound () + // TODO: return via single-post action + | None -> + match! Data.Page.findByPermalink permalink this.WebLog.id this.Db with + | Some page -> + return this.ThemedView (defaultArg page.template "SinglePage", SinglePageModel (page, this.WebLog)) + | None -> + + // TOOD: search prior permalinks for posts and pages + + // We tried, we really tried... + Console.Write($"Returning 404 for permalink |{permalink}|"); + return this.NotFound () + } + + [] + member this.All () = task { + do! Task.CompletedTask; + NotImplementedException () |> raise + } + + [] + member this.Edit(postId : string) = task { + do! Task.CompletedTask; + NotImplementedException () |> raise + } diff --git a/src/MyWebLog.FS/Features/Posts/PostTypes.fs b/src/MyWebLog.FS/Features/Posts/PostTypes.fs new file mode 100644 index 0000000..df6f522 --- /dev/null +++ b/src/MyWebLog.FS/Features/Posts/PostTypes.fs @@ -0,0 +1,11 @@ +namespace MyWebLog.Features.Posts + +open MyWebLog +open MyWebLog.Features.Shared + +/// The model used to render multiple posts +type MultiplePostModel (posts : Post seq, webLog) = + inherit MyWebLogModel (webLog) + + /// The posts to be rendered + member _.Posts with get () = posts diff --git a/src/MyWebLog.FS/Features/Shared/SharedTypes.fs b/src/MyWebLog.FS/Features/Shared/SharedTypes.fs new file mode 100644 index 0000000..239403f --- /dev/null +++ b/src/MyWebLog.FS/Features/Shared/SharedTypes.fs @@ -0,0 +1,45 @@ +namespace MyWebLog.Features.Shared + +open Microsoft.AspNetCore.Mvc +open Microsoft.Extensions.DependencyInjection +open MyWebLog +open RethinkDb.Driver.Net +open System.Security.Claims + +/// Base class for myWebLog controllers +type MyWebLogController () = + inherit Controller () + + /// The data context to use to fulfil this request + member this.Db with get () = this.HttpContext.RequestServices.GetRequiredService () + + /// The details for the current web log + member this.WebLog with get () = WebLogCache.getByCtx this.HttpContext + + /// The ID of the currently authenticated user + member this.UserId with get () = + this.User.Claims + |> Seq.tryFind (fun c -> c.Type = ClaimTypes.NameIdentifier) + |> Option.map (fun c -> c.Value) + |> Option.defaultValue "" + + /// Retern a themed view + member this.ThemedView (template : string, model : obj) : IActionResult = + // TODO: get actual version + this.ViewData["Version"] <- "2" + this.View (template, model) + + /// Return a 404 response + member _.NotFound () : IActionResult = + base.NotFound () + + /// Redirect to an action in this controller + member _.RedirectToAction action : IActionResult = + base.RedirectToAction action + + +/// Base model class for myWebLog views +type MyWebLogModel (webLog : WebLog) = + + /// The details for the web log + member _.WebLog with get () = webLog diff --git a/src/MyWebLog.FS/MyWebLog.FS.fsproj b/src/MyWebLog.FS/MyWebLog.FS.fsproj new file mode 100644 index 0000000..d809981 --- /dev/null +++ b/src/MyWebLog.FS/MyWebLog.FS.fsproj @@ -0,0 +1,38 @@ + + + + net6.0 + + + + + + + + + + + + + + + + + + + + + True + True + Resources.resx + + + + + + ResXFileCodeGenerator + Resources.Designer.fs + + + + diff --git a/src/MyWebLog.FS/Program.fs b/src/MyWebLog.FS/Program.fs new file mode 100644 index 0000000..508449e --- /dev/null +++ b/src/MyWebLog.FS/Program.fs @@ -0,0 +1,175 @@ +open Microsoft.AspNetCore.Mvc.Razor +open System.Reflection + +/// Types to support feature folders +module FeatureSupport = + + open Microsoft.AspNetCore.Mvc.ApplicationModels + open System.Collections.Concurrent + + /// A controller model convention that identifies the feature in which a controller exists + type FeatureControllerModelConvention () = + + /// A cache of controller types to features + static let _features = ConcurrentDictionary () + + /// Derive the feature name from the controller's type + static let getFeatureName (typ : TypeInfo) : string option = + let cacheKey = Option.ofObj typ.FullName |> Option.defaultValue "" + match _features.ContainsKey cacheKey with + | true -> Some _features[cacheKey] + | false -> + let tokens = cacheKey.Split '.' + match tokens |> Array.contains "Features" with + | true -> + let feature = tokens |> Array.skipWhile (fun it -> it <> "Features") |> Array.skip 1 |> Array.tryHead + match feature with + | Some f -> + _features[cacheKey] <- f + feature + | None -> None + | false -> None + + interface IControllerModelConvention with + /// + member _.Apply (controller: ControllerModel) = + controller.Properties.Add("feature", getFeatureName controller.ControllerType) + + + open Microsoft.AspNetCore.Mvc.Controllers + + /// Expand the location token with the feature name + type FeatureViewLocationExpander () = + + interface IViewLocationExpander with + + /// + member _.ExpandViewLocations + (context : ViewLocationExpanderContext, viewLocations : string seq) : string seq = + if isNull context then nullArg (nameof context) + if isNull viewLocations then nullArg (nameof viewLocations) + match context.ActionContext.ActionDescriptor with + | :? ControllerActionDescriptor as descriptor -> + let feature = string descriptor.Properties["feature"] + viewLocations |> Seq.map (fun location -> location.Replace ("{2}", feature)) + | _ -> invalidArg "context" "ActionDescriptor not found" + + /// + member _.PopulateValues(_ : ViewLocationExpanderContext) = () + + +open MyWebLog + +/// Types to support themed views +module ThemeSupport = + + /// Expand the location token with the theme path + type ThemeViewLocationExpander () = + interface IViewLocationExpander with + + /// + member _.ExpandViewLocations + (context : ViewLocationExpanderContext, viewLocations : string seq) : string seq = + if isNull context then nullArg (nameof context) + if isNull viewLocations then nullArg (nameof viewLocations) + + viewLocations |> Seq.map (fun location -> location.Replace ("{3}", string context.Values["theme"])) + + /// + member _.PopulateValues (context : ViewLocationExpanderContext) = + if isNull context then nullArg (nameof context) + + context.Values["theme"] <- (WebLogCache.getByCtx context.ActionContext.HttpContext).themePath + + +open Microsoft.AspNetCore.Http +open Microsoft.Extensions.DependencyInjection + +/// Custom middleware for this application +module Middleware = + + open RethinkDb.Driver.Net + open System.Threading.Tasks + + /// Middleware to derive the current web log + type WebLogMiddleware (next : RequestDelegate) = + + member _.InvokeAsync (context : HttpContext) : Task = task { + let host = WebLogCache.hostToDb context + + match WebLogCache.exists host with + | true -> () + | false -> + let conn = context.RequestServices.GetRequiredService () + match! Data.WebLog.findByHost (context.Request.Host.ToUriComponent ()) conn with + | Some details -> WebLogCache.set host details + | None -> () + + match WebLogCache.exists host with + | true -> do! next.Invoke context + | false -> context.Response.StatusCode <- 404 + } + + +open Microsoft.AspNetCore.Authentication.Cookies +open Microsoft.AspNetCore.Builder +open Microsoft.Extensions.Hosting +open Microsoft.AspNetCore.Mvc +open System +open System.IO + +[] +let main args = + let builder = WebApplication.CreateBuilder(args) + let _ = + builder.Services + .AddMvc(fun opts -> + opts.Conventions.Add (FeatureSupport.FeatureControllerModelConvention ()) + opts.Filters.Add (AutoValidateAntiforgeryTokenAttribute ())) + .AddRazorOptions(fun opts -> + opts.ViewLocationFormats.Clear () + opts.ViewLocationFormats.Add "/Themes/{3}/{0}.cshtml" + opts.ViewLocationFormats.Add "/Themes/{3}/Shared/{0}.cshtml" + opts.ViewLocationFormats.Add "/Themes/Default/{0}.cshtml" + opts.ViewLocationFormats.Add "/Themes/Default/Shared/{0}.cshtml" + opts.ViewLocationFormats.Add "/Features/{2}/{1}/{0}.cshtml" + opts.ViewLocationFormats.Add "/Features/{2}/{0}.cshtml" + opts.ViewLocationFormats.Add "/Features/Shared/{0}.cshtml" + opts.ViewLocationExpanders.Add (FeatureSupport.FeatureViewLocationExpander ()) + opts.ViewLocationExpanders.Add (ThemeSupport.ThemeViewLocationExpander ())) + let _ = + builder.Services + .AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme) + .AddCookie(fun opts -> + opts.ExpireTimeSpan <- TimeSpan.FromMinutes 20. + opts.SlidingExpiration <- true + opts.AccessDeniedPath <- "/forbidden") + let _ = builder.Services.AddAuthorization() + let _ = builder.Services.AddSingleton () + (* builder.Services.AddDbContext(o => + { + // TODO: can get from DI? + var db = WebLogCache.HostToDb(new HttpContextAccessor().HttpContext!); + // "empty"; + o.UseSqlite($"Data Source=Db/{db}.db"); + }); *) + + // Load themes + Directory.GetFiles (Directory.GetCurrentDirectory (), "MyWebLog.Themes.*.dll") + |> Array.map Assembly.LoadFile + |> ignore + + let app = builder.Build () + + let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict)) + let _ = app.UseMiddleware () + let _ = app.UseAuthentication () + let _ = app.UseStaticFiles () + let _ = app.UseRouting () + let _ = app.UseAuthorization () + let _ = app.UseEndpoints (fun endpoints -> endpoints.MapControllers () |> ignore) + + app.Run() + + 0 // Exit code + diff --git a/src/MyWebLog.FS/Properties/launchSettings.json b/src/MyWebLog.FS/Properties/launchSettings.json new file mode 100644 index 0000000..0982978 --- /dev/null +++ b/src/MyWebLog.FS/Properties/launchSettings.json @@ -0,0 +1,28 @@ +{ + "iisSettings": { + "windowsAuthentication": false, + "anonymousAuthentication": true, + "iisExpress": { + "applicationUrl": "http://localhost:29920", + "sslPort": 44344 + } + }, + "profiles": { + "MyWebLog.FS": { + "commandName": "Project", + "dotnetRunMessages": true, + "launchBrowser": true, + "applicationUrl": "https://localhost:7134;http://localhost:5134", + "environmentVariables": { + "ASPNETCORE_ENVIRONMENT": "Development" + } + }, + "IIS Express": { + "commandName": "IISExpress", + "launchBrowser": true, + "environmentVariables": { + "ASPNETCORE_ENVIRONMENT": "Development" + } + } + } +} diff --git a/src/MyWebLog.FS/Resources.resx b/src/MyWebLog.FS/Resources.resx new file mode 100644 index 0000000..1b52285 --- /dev/null +++ b/src/MyWebLog.FS/Resources.resx @@ -0,0 +1,252 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + text/microsoft-resx + + + 2.0 + + + System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + Actions + + + Add a New Category + + + Add a New Page + + + Admin + + + All + + + Categories + + + Create a New Page + + + Dashboard + + + MMMM d, yyyy + + + Default Page + + + Drafts + + + Edit + + + Edit Page + + + E-mail Address + + + First Page of Posts + + + In List? + + + Last Updated + + + Log Off + + + Log On + + + Log On to + + + Modify Settings + + + Name + + + No + + + Pages + + + Page Text + + + Password + + + Permalink + + + Posts + + + Posts per Page + + + Published + + + Save Changes + + + Show in Page List + + + Shown in Page List + + + Subtitle + + + There are {0} categories + + + There are {0} pages + + + There are {0} published posts and {1} drafts + + + Time Zone + + + Title + + + Top Level + + + View All + + + Web Log Settings + + + Write a New Post + + + Yes + + \ No newline at end of file diff --git a/src/MyWebLog.FS/WebLogCache.fs b/src/MyWebLog.FS/WebLogCache.fs new file mode 100644 index 0000000..e5ab9c7 --- /dev/null +++ b/src/MyWebLog.FS/WebLogCache.fs @@ -0,0 +1,27 @@ +/// +/// In-memory cache of web log details +/// +/// This is filled by the middleware via the first request for each host, and can be updated via the web log +/// settings update page +module MyWebLog.WebLogCache + +open Microsoft.AspNetCore.Http +open System.Collections.Concurrent + +/// The cache of web log details +let private _cache = ConcurrentDictionary () + +/// Transform a hostname to a database name +let hostToDb (ctx : HttpContext) = ctx.Request.Host.ToUriComponent().Replace (':', '_') + +/// Does a host exist in the cache? +let exists host = _cache.ContainsKey host + +/// Get the details for a web log via its host +let getByHost host = _cache[host] + +/// Get the details for a web log via its host +let getByCtx ctx = _cache[hostToDb ctx] + +/// Set the details for a particular host +let set host details = _cache[host] <- details diff --git a/src/MyWebLog.FS/appsettings.Development.json b/src/MyWebLog.FS/appsettings.Development.json new file mode 100644 index 0000000..0c208ae --- /dev/null +++ b/src/MyWebLog.FS/appsettings.Development.json @@ -0,0 +1,8 @@ +{ + "Logging": { + "LogLevel": { + "Default": "Information", + "Microsoft.AspNetCore": "Warning" + } + } +} diff --git a/src/MyWebLog.FS/appsettings.json b/src/MyWebLog.FS/appsettings.json new file mode 100644 index 0000000..10f68b8 --- /dev/null +++ b/src/MyWebLog.FS/appsettings.json @@ -0,0 +1,9 @@ +{ + "Logging": { + "LogLevel": { + "Default": "Information", + "Microsoft.AspNetCore": "Warning" + } + }, + "AllowedHosts": "*" +} diff --git a/src/MyWebLog.Themes.BitBadger/MyWebLog.Themes.BitBadger.csproj b/src/MyWebLog.Themes.BitBadger/MyWebLog.Themes.BitBadger.csproj new file mode 100644 index 0000000..617ddca --- /dev/null +++ b/src/MyWebLog.Themes.BitBadger/MyWebLog.Themes.BitBadger.csproj @@ -0,0 +1,32 @@ + + + + net6.0 + enable + enable + true + true + + + + + + + + + + + + + + + + + false + runtime + + + + + + diff --git a/src/MyWebLog/Themes/BitBadger/Shared/_AppSidebar.cshtml b/src/MyWebLog.Themes.BitBadger/Themes/BitBadger/Shared/_AppSidebar.cshtml similarity index 100% rename from src/MyWebLog/Themes/BitBadger/Shared/_AppSidebar.cshtml rename to src/MyWebLog.Themes.BitBadger/Themes/BitBadger/Shared/_AppSidebar.cshtml diff --git a/src/MyWebLog/Themes/BitBadger/Shared/_Layout.cshtml b/src/MyWebLog.Themes.BitBadger/Themes/BitBadger/Shared/_Layout.cshtml similarity index 100% rename from src/MyWebLog/Themes/BitBadger/Shared/_Layout.cshtml rename to src/MyWebLog.Themes.BitBadger/Themes/BitBadger/Shared/_Layout.cshtml diff --git a/src/MyWebLog/Themes/BitBadger/SinglePage.cshtml b/src/MyWebLog.Themes.BitBadger/Themes/BitBadger/SinglePage.cshtml similarity index 100% rename from src/MyWebLog/Themes/BitBadger/SinglePage.cshtml rename to src/MyWebLog.Themes.BitBadger/Themes/BitBadger/SinglePage.cshtml diff --git a/src/MyWebLog/Themes/BitBadger/SolutionInfo.cs b/src/MyWebLog.Themes.BitBadger/Themes/BitBadger/SolutionInfo.cs similarity index 100% rename from src/MyWebLog/Themes/BitBadger/SolutionInfo.cs rename to src/MyWebLog.Themes.BitBadger/Themes/BitBadger/SolutionInfo.cs diff --git a/src/MyWebLog/Themes/BitBadger/Solutions.cshtml b/src/MyWebLog.Themes.BitBadger/Themes/BitBadger/Solutions.cshtml similarity index 100% rename from src/MyWebLog/Themes/BitBadger/Solutions.cshtml rename to src/MyWebLog.Themes.BitBadger/Themes/BitBadger/Solutions.cshtml diff --git a/src/MyWebLog/Themes/BitBadger/solutions.json b/src/MyWebLog.Themes.BitBadger/Themes/BitBadger/solutions.json similarity index 100% rename from src/MyWebLog/Themes/BitBadger/solutions.json rename to src/MyWebLog.Themes.BitBadger/Themes/BitBadger/solutions.json diff --git a/src/MyWebLog.Themes.BitBadger/Themes/_ViewImports.cshtml b/src/MyWebLog.Themes.BitBadger/Themes/_ViewImports.cshtml new file mode 100644 index 0000000..6c82c1f --- /dev/null +++ b/src/MyWebLog.Themes.BitBadger/Themes/_ViewImports.cshtml @@ -0,0 +1,6 @@ +@namespace MyWebLog.Themes + +@using MyWebLog.Features.Shared +@using MyWebLog.Properties + +@addTagHelper *, MyWebLog diff --git a/src/MyWebLog/wwwroot/css/BitBadger/style.css b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/css/style.css similarity index 100% rename from src/MyWebLog/wwwroot/css/BitBadger/style.css rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/css/style.css diff --git a/src/MyWebLog/wwwroot/img/BitBadger/bit-badger-auth.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/bit-badger-auth.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/bit-badger-auth.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/bit-badger-auth.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/bitbadger.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/bitbadger.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/bitbadger.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/bitbadger.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/facebook.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/facebook.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/facebook.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/facebook.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/favicon.ico b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/favicon.ico similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/favicon.ico rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/favicon.ico diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/bay-vista.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/bay-vista.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/bay-vista.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/bay-vista.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/cassy-fiano.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/cassy-fiano.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/cassy-fiano.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/cassy-fiano.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/dr-melissa-clouthier.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/dr-melissa-clouthier.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/dr-melissa-clouthier.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/dr-melissa-clouthier.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/emerald-mountain-christian-school.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/emerald-mountain-christian-school.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/emerald-mountain-christian-school.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/emerald-mountain-christian-school.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/futility-closet.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/futility-closet.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/futility-closet.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/futility-closet.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/hard-corps-wife.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/hard-corps-wife.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/hard-corps-wife.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/hard-corps-wife.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/liberty-pundits.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/liberty-pundits.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/liberty-pundits.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/liberty-pundits.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/mindy-mackenzie.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/mindy-mackenzie.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/mindy-mackenzie.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/mindy-mackenzie.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/my-prayer-journal.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/my-prayer-journal.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/my-prayer-journal.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/my-prayer-journal.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/nsx.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/nsx.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/nsx.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/nsx.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/olivet-baptist.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/olivet-baptist.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/olivet-baptist.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/olivet-baptist.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/photography-by-michelle.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/photography-by-michelle.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/photography-by-michelle.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/photography-by-michelle.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/prayer-tracker.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/prayer-tracker.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/prayer-tracker.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/prayer-tracker.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/riehl-world-news.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/riehl-world-news.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/riehl-world-news.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/riehl-world-news.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/tcms.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/tcms.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/tcms.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/tcms.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/tech-blog.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/tech-blog.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/tech-blog.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/tech-blog.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/the-shark-tank.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/the-shark-tank.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/the-shark-tank.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/the-shark-tank.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/screenshots/virtual-prayer-room.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/virtual-prayer-room.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/screenshots/virtual-prayer-room.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/screenshots/virtual-prayer-room.png diff --git a/src/MyWebLog/wwwroot/img/BitBadger/twitter.png b/src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/twitter.png similarity index 100% rename from src/MyWebLog/wwwroot/img/BitBadger/twitter.png rename to src/MyWebLog.Themes.BitBadger/wwwroot/BitBadger/img/twitter.png diff --git a/src/MyWebLog.sln b/src/MyWebLog.sln index be8542f..cef5a9c 100644 --- a/src/MyWebLog.sln +++ b/src/MyWebLog.sln @@ -3,9 +3,17 @@ Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio Version 17 VisualStudioVersion = 17.1.32210.238 MinimumVisualStudioVersion = 10.0.40219.1 -Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "MyWebLog.Data", "MyWebLog.Data\MyWebLog.Data.csproj", "{0177C744-F913-4352-A0EC-478B4B0388C3}" +Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "MyWebLog", "MyWebLog\MyWebLog.csproj", "{3139DA09-C999-465A-BC98-02FEC3BD7E88}" EndProject -Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "MyWebLog", "MyWebLog\MyWebLog.csproj", "{3139DA09-C999-465A-BC98-02FEC3BD7E88}" +Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "MyWebLog.Themes.BitBadger", "MyWebLog.Themes.BitBadger\MyWebLog.Themes.BitBadger.csproj", "{729F7AB3-2300-4390-B972-71D32FBBBF50}" +EndProject +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "MyWebLog.FS", "MyWebLog.FS\MyWebLog.FS.fsproj", "{4D62F235-73BA-42A6-8AA1-29D0D046E115}" +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyWebLog.Domain", "MyWebLog.Domain\MyWebLog.Domain.fsproj", "{8CA99122-888A-4524-8C1B-685F0A4B7B4B}" +EndProject +Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "MyWebLog.DataCS", "MyWebLog.DataCS\MyWebLog.DataCS.csproj", "{C9129BED-E4AE-41BB-BDB2-5418B7F924CC}" +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyWebLog.Data", "MyWebLog.Data\MyWebLog.Data.fsproj", "{D284584D-2CB2-40C8-B605-6D0FD84D9D3D}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution @@ -13,14 +21,30 @@ Global Release|Any CPU = Release|Any CPU EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution - {0177C744-F913-4352-A0EC-478B4B0388C3}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {0177C744-F913-4352-A0EC-478B4B0388C3}.Debug|Any CPU.Build.0 = Debug|Any CPU - {0177C744-F913-4352-A0EC-478B4B0388C3}.Release|Any CPU.ActiveCfg = Release|Any CPU - {0177C744-F913-4352-A0EC-478B4B0388C3}.Release|Any CPU.Build.0 = Release|Any CPU {3139DA09-C999-465A-BC98-02FEC3BD7E88}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {3139DA09-C999-465A-BC98-02FEC3BD7E88}.Debug|Any CPU.Build.0 = Debug|Any CPU {3139DA09-C999-465A-BC98-02FEC3BD7E88}.Release|Any CPU.ActiveCfg = Release|Any CPU {3139DA09-C999-465A-BC98-02FEC3BD7E88}.Release|Any CPU.Build.0 = Release|Any CPU + {729F7AB3-2300-4390-B972-71D32FBBBF50}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {729F7AB3-2300-4390-B972-71D32FBBBF50}.Debug|Any CPU.Build.0 = Debug|Any CPU + {729F7AB3-2300-4390-B972-71D32FBBBF50}.Release|Any CPU.ActiveCfg = Release|Any CPU + {729F7AB3-2300-4390-B972-71D32FBBBF50}.Release|Any CPU.Build.0 = Release|Any CPU + {4D62F235-73BA-42A6-8AA1-29D0D046E115}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {4D62F235-73BA-42A6-8AA1-29D0D046E115}.Debug|Any CPU.Build.0 = Debug|Any CPU + {4D62F235-73BA-42A6-8AA1-29D0D046E115}.Release|Any CPU.ActiveCfg = Release|Any CPU + {4D62F235-73BA-42A6-8AA1-29D0D046E115}.Release|Any CPU.Build.0 = Release|Any CPU + {8CA99122-888A-4524-8C1B-685F0A4B7B4B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {8CA99122-888A-4524-8C1B-685F0A4B7B4B}.Debug|Any CPU.Build.0 = Debug|Any CPU + {8CA99122-888A-4524-8C1B-685F0A4B7B4B}.Release|Any CPU.ActiveCfg = Release|Any CPU + {8CA99122-888A-4524-8C1B-685F0A4B7B4B}.Release|Any CPU.Build.0 = Release|Any CPU + {C9129BED-E4AE-41BB-BDB2-5418B7F924CC}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {C9129BED-E4AE-41BB-BDB2-5418B7F924CC}.Debug|Any CPU.Build.0 = Debug|Any CPU + {C9129BED-E4AE-41BB-BDB2-5418B7F924CC}.Release|Any CPU.ActiveCfg = Release|Any CPU + {C9129BED-E4AE-41BB-BDB2-5418B7F924CC}.Release|Any CPU.Build.0 = Release|Any CPU + {D284584D-2CB2-40C8-B605-6D0FD84D9D3D}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {D284584D-2CB2-40C8-B605-6D0FD84D9D3D}.Debug|Any CPU.Build.0 = Debug|Any CPU + {D284584D-2CB2-40C8-B605-6D0FD84D9D3D}.Release|Any CPU.ActiveCfg = Release|Any CPU + {D284584D-2CB2-40C8-B605-6D0FD84D9D3D}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE diff --git a/src/MyWebLog.v2/Data.fs b/src/MyWebLog.v2/Data.fs new file mode 100644 index 0000000..e69de29 diff --git a/src/MyWebLog.v2/Domain.fs b/src/MyWebLog.v2/Domain.fs new file mode 100644 index 0000000..b12b397 --- /dev/null +++ b/src/MyWebLog.v2/Domain.fs @@ -0,0 +1,490 @@ +namespace MyWebLog.Domain + +// -- Supporting Types -- + +/// Types of markup text supported +type MarkupText = + /// Text in Markdown format + | Markdown of string + /// Text in HTML format + | Html of string + +/// Functions to support maniuplating markup text +module MarkupText = + /// Get the string representation of this markup text + let toString it = + match it with + | Markdown x -> "Markdown", x + | Html x -> "HTML", x + ||> sprintf "%s: %s" + /// Get the HTML value of the text + let toHtml = function + | Markdown it -> sprintf "TODO: convert to HTML - %s" it + | Html it -> it + /// Parse a string representation to markup text + let ofString (it : string) = + match true with + | _ when it.StartsWith "Markdown: " -> it.Substring 10 |> Markdown + | _ when it.StartsWith "HTML: " -> it.Substring 6 |> Html + | _ -> sprintf "Cannot determine text type - %s" it |> invalidOp + + +/// Authorization levels +type AuthorizationLevel = + /// Authorization to administer a weblog + | Administrator + /// Authorization to comment on a weblog + | User + +/// Functions to support authorization levels +module AuthorizationLevel = + /// Get the string reprsentation of an authorization level + let toString = function Administrator -> "Administrator" | User -> "User" + /// Create an authorization level from a string + let ofString it = + match it with + | "Administrator" -> Administrator + | "User" -> User + | _ -> sprintf "%s is not an authorization level" it |> invalidOp + + +/// Post statuses +type PostStatus = + /// Post has not been released for public consumption + | Draft + /// Post is released + | Published + +/// Functions to support post statuses +module PostStatus = + /// Get the string representation of a post status + let toString = function Draft -> "Draft" | Published -> "Published" + /// Create a post status from a string + let ofString it = + match it with + | "Draft" -> Draft + | "Published" -> Published + | _ -> sprintf "%s is not a post status" it |> invalidOp + + +/// Comment statuses +type CommentStatus = + /// Comment is approved + | Approved + /// Comment has yet to be approved + | Pending + /// Comment was flagged as spam + | Spam + +/// Functions to support comment statuses +module CommentStatus = + /// Get the string representation of a comment status + let toString = function Approved -> "Approved" | Pending -> "Pending" | Spam -> "Spam" + /// Create a comment status from a string + let ofString it = + match it with + | "Approved" -> Approved + | "Pending" -> Pending + | "Spam" -> Spam + | _ -> sprintf "%s is not a comment status" it |> invalidOp + + +/// Seconds since the Unix epoch +type UnixSeconds = UnixSeconds of int64 + +/// Functions to support Unix seconds +module UnixSeconds = + /// Get the long (int64) representation of Unix seconds + let toLong = function UnixSeconds it -> it + /// Zero seconds past the epoch + let none = UnixSeconds 0L + + +// -- IDs -- + +open System + +// See https://www.madskristensen.net/blog/A-shorter-and-URL-friendly-GUID for info on "short GUIDs" + +/// A short GUID +type ShortGuid = ShortGuid of Guid + +/// Functions to support short GUIDs +module ShortGuid = + /// Encode a GUID into a short GUID + let toString = function + | ShortGuid guid -> + Convert.ToBase64String(guid.ToByteArray ()) + .Replace("/", "_") + .Replace("+", "-") + .Substring (0, 22) + /// Decode a short GUID into a GUID + let ofString (it : string) = + it.Replace("_", "/").Replace ("-", "+") + |> (sprintf "%s==" >> Convert.FromBase64String >> Guid >> ShortGuid) + /// Create a new short GUID + let create () = (Guid.NewGuid >> ShortGuid) () + /// The empty short GUID + let empty = ShortGuid Guid.Empty + + +/// The ID of a category +type CategoryId = CategoryId of ShortGuid + +/// Functions to support category IDs +module CategoryId = + /// Get the string representation of a page ID + let toString = function CategoryId it -> ShortGuid.toString it + /// Create a category ID from its string representation + let ofString = ShortGuid.ofString >> CategoryId + /// An empty category ID + let empty = CategoryId ShortGuid.empty + + +/// The ID of a comment +type CommentId = CommentId of ShortGuid + +/// Functions to support comment IDs +module CommentId = + /// Get the string representation of a comment ID + let toString = function CommentId it -> ShortGuid.toString it + /// Create a comment ID from its string representation + let ofString = ShortGuid.ofString >> CommentId + /// An empty comment ID + let empty = CommentId ShortGuid.empty + + +/// The ID of a page +type PageId = PageId of ShortGuid + +/// Functions to support page IDs +module PageId = + /// Get the string representation of a page ID + let toString = function PageId it -> ShortGuid.toString it + /// Create a page ID from its string representation + let ofString = ShortGuid.ofString >> PageId + /// An empty page ID + let empty = PageId ShortGuid.empty + + +/// The ID of a post +type PostId = PostId of ShortGuid + +/// Functions to support post IDs +module PostId = + /// Get the string representation of a post ID + let toString = function PostId it -> ShortGuid.toString it + /// Create a post ID from its string representation + let ofString = ShortGuid.ofString >> PostId + /// An empty post ID + let empty = PostId ShortGuid.empty + + +/// The ID of a user +type UserId = UserId of ShortGuid + +/// Functions to support user IDs +module UserId = + /// Get the string representation of a user ID + let toString = function UserId it -> ShortGuid.toString it + /// Create a user ID from its string representation + let ofString = ShortGuid.ofString >> UserId + /// An empty user ID + let empty = UserId ShortGuid.empty + + +/// The ID of a web log +type WebLogId = WebLogId of ShortGuid + +/// Functions to support web log IDs +module WebLogId = + /// Get the string representation of a web log ID + let toString = function WebLogId it -> ShortGuid.toString it + /// Create a web log ID from its string representation + let ofString = ShortGuid.ofString >> WebLogId + /// An empty web log ID + let empty = WebLogId ShortGuid.empty + + +// -- Domain Entities -- +// fsharplint:disable RecordFieldNames + +/// A revision of a post or page +type Revision = { + /// The instant which this revision was saved + asOf : UnixSeconds + /// The text + text : MarkupText + } +with + /// An empty revision + static member empty = + { asOf = UnixSeconds.none + text = Markdown "" + } + + +/// A page with static content +[] +type Page = { + /// The Id + id : PageId + /// The Id of the web log to which this page belongs + webLogId : WebLogId + /// The Id of the author of this page + authorId : UserId + /// The title of the page + title : string + /// The link at which this page is displayed + permalink : string + /// The instant this page was published + publishedOn : UnixSeconds + /// The instant this page was last updated + updatedOn : UnixSeconds + /// Whether this page shows as part of the web log's navigation + showInPageList : bool + /// The current text of the page + text : MarkupText + /// Revisions of this page + revisions : Revision list + } +with + static member empty = + { id = PageId.empty + webLogId = WebLogId.empty + authorId = UserId.empty + title = "" + permalink = "" + publishedOn = UnixSeconds.none + updatedOn = UnixSeconds.none + showInPageList = false + text = Markdown "" + revisions = [] + } + + +/// An entry in the list of pages displayed as part of the web log (derived via query) +type PageListEntry = { + /// The permanent link for the page + permalink : string + /// The title of the page + title : string + } + + +/// A web log +[] +type WebLog = { + /// The Id + id : WebLogId + /// The name + name : string + /// The subtitle + subtitle : string option + /// The default page ("posts" or a page Id) + defaultPage : string + /// The path of the theme (within /views/themes) + themePath : string + /// The URL base + urlBase : string + /// The time zone in which dates/times should be displayed + timeZone : string + /// A list of pages to be rendered as part of the site navigation (not stored) + pageList : PageListEntry list + } +with + /// An empty web log + static member empty = + { id = WebLogId.empty + name = "" + subtitle = None + defaultPage = "" + themePath = "default" + urlBase = "" + timeZone = "America/New_York" + pageList = [] + } + + +/// An authorization between a user and a web log +type Authorization = { + /// The Id of the web log to which this authorization grants access + webLogId : WebLogId + /// The level of access granted by this authorization + level : AuthorizationLevel +} + + +/// A user of myWebLog +[] +type User = { + /// The Id + id : UserId + /// The user name (e-mail address) + userName : string + /// The first name + firstName : string + /// The last name + lastName : string + /// The user's preferred name + preferredName : string + /// The hash of the user's password + passwordHash : string + /// The URL of the user's personal site + url : string option + /// The user's authorizations + authorizations : Authorization list + } +with + /// An empty user + static member empty = + { id = UserId.empty + userName = "" + firstName = "" + lastName = "" + preferredName = "" + passwordHash = "" + url = None + authorizations = [] + } + +/// Functions supporting users +module User = + /// Claims for this user + let claims user = + user.authorizations + |> List.map (fun a -> sprintf "%s|%s" (WebLogId.toString a.webLogId) (AuthorizationLevel.toString a.level)) + + +/// A category to which posts may be assigned +[] +type Category = { + /// The Id + id : CategoryId + /// The Id of the web log to which this category belongs + webLogId : WebLogId + /// The displayed name + name : string + /// The slug (used in category URLs) + slug : string + /// A longer description of the category + description : string option + /// The parent Id of this category (if a subcategory) + parentId : CategoryId option + /// The categories for which this category is the parent + children : CategoryId list + } +with + /// An empty category + static member empty = + { id = CategoryId.empty + webLogId = WebLogId.empty + name = "" + slug = "" + description = None + parentId = None + children = [] + } + + +/// A comment (applies to a post) +[] +type Comment = { + /// The Id + id : CommentId + /// The Id of the post to which this comment applies + postId : PostId + /// The Id of the comment to which this comment is a reply + inReplyToId : CommentId option + /// The name of the commentor + name : string + /// The e-mail address of the commentor + email : string + /// The URL of the commentor's personal website + url : string option + /// The status of the comment + status : CommentStatus + /// The instant the comment was posted + postedOn : UnixSeconds + /// The text of the comment + text : string + } +with + static member empty = + { id = CommentId.empty + postId = PostId.empty + inReplyToId = None + name = "" + email = "" + url = None + status = Pending + postedOn = UnixSeconds.none + text = "" + } + + +/// A post +[] +type Post = { + /// The Id + id : PostId + /// The Id of the web log to which this post belongs + webLogId : WebLogId + /// The Id of the author of this post + authorId : UserId + /// The status + status : PostStatus + /// The title + title : string + /// The link at which the post resides + permalink : string + /// The instant on which the post was originally published + publishedOn : UnixSeconds + /// The instant on which the post was last updated + updatedOn : UnixSeconds + /// The text of the post + text : MarkupText + /// The Ids of the categories to which this is assigned + categoryIds : CategoryId list + /// The tags for the post + tags : string list + /// The permalinks at which this post may have once resided + priorPermalinks : string list + /// Revisions of this post + revisions : Revision list + /// The categories to which this is assigned (not stored in database) + categories : Category list + /// The comments (not stored in database) + comments : Comment list + } +with + static member empty = + { id = PostId.empty + webLogId = WebLogId.empty + authorId = UserId.empty + status = Draft + title = "" + permalink = "" + publishedOn = UnixSeconds.none + updatedOn = UnixSeconds.none + text = Markdown "" + categoryIds = [] + tags = [] + priorPermalinks = [] + revisions = [] + categories = [] + comments = [] + } + + +// --- UI Support --- + +/// Counts of items displayed on the admin dashboard +type DashboardCounts = { + /// The number of pages for the web log + pages : int + /// The number of pages for the web log + posts : int + /// The number of categories for the web log + categories : int + } diff --git a/src/MyWebLog.v2/MyWebLog.fsproj b/src/MyWebLog.v2/MyWebLog.fsproj new file mode 100644 index 0000000..e11ac96 --- /dev/null +++ b/src/MyWebLog.v2/MyWebLog.fsproj @@ -0,0 +1,28 @@ + + + + Exe + net6.0 + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/MyWebLog.v2/Program.fs b/src/MyWebLog.v2/Program.fs new file mode 100644 index 0000000..139a10e --- /dev/null +++ b/src/MyWebLog.v2/Program.fs @@ -0,0 +1,4 @@ +open MyWebLog +open Suave + +startWebServer defaultConfig (Successful.OK (Strings.get "LastUpdated")) diff --git a/src/MyWebLog.v2/Resources/en-US.json b/src/MyWebLog.v2/Resources/en-US.json new file mode 100644 index 0000000..be2715a --- /dev/null +++ b/src/MyWebLog.v2/Resources/en-US.json @@ -0,0 +1,83 @@ +{ + "Action": "Action", + "Added": "Added", + "AddNew": "Add New", + "AddNewCategory": "Add New Category", + "AddNewPage": "Add New Page", + "AddNewPost": "Add New Post", + "Admin": "Admin", + "AndPublished": " and Published", + "andXMore": "and {0} more...", + "at": "at", + "BackToCategoryList": "Back to Category List", + "BackToPageList": "Back to Page List", + "BackToPostList": "Back to Post List", + "Categories": "Categories", + "Category": "Category", + "CategoryDeleteWarning": "Are you sure you wish to delete the category", + "Close": "Close", + "Comments": "Comments", + "Dashboard": "Dashboard", + "Date": "Date", + "Delete": "Delete", + "Description": "Description", + "Edit": "Edit", + "EditCategory": "Edit Category", + "EditPage": "Edit Page", + "EditPost": "Edit Post", + "EmailAddress": "E-mail Address", + "ErrBadAppConfig": "Could not convert config.json to myWebLog configuration", + "ErrBadLogOnAttempt": "Invalid e-mail address or password", + "ErrDataConfig": "Could not convert data-config.json to RethinkDB connection", + "ErrNotConfigured": "is not properly configured for myWebLog", + "Error": "Error", + "LastUpdated": "Last Updated", + "LastUpdatedDate": "Last Updated Date", + "ListAll": "List All", + "LoadedIn": "Loaded in", + "LogOff": "Log Off", + "LogOn": "Log On", + "MsgCategoryDeleted": "Deleted category {0} successfully", + "MsgCategoryEditSuccess": "{0} category successfully", + "MsgLogOffSuccess": "Log off successful | Have a nice day!", + "MsgLogOnSuccess": "Log on successful | Welcome to myWebLog!", + "MsgPageDeleted": "Deleted page successfully", + "MsgPageEditSuccess": "{0} page successfully", + "MsgPostEditSuccess": "{0}{1} post successfully", + "Name": "Name", + "NewerPosts": "Newer Posts", + "NextPost": "Next Post", + "NoComments": "No Comments", + "NoParent": "No Parent", + "OlderPosts": "Older Posts", + "OneComment": "1 Comment", + "PageDeleteWarning": "Are you sure you wish to delete the page", + "PageDetails": "Page Details", + "PageHash": "Page #", + "Pages": "Pages", + "ParentCategory": "Parent Category", + "Password": "Password", + "Permalink": "Permalink", + "PermanentLinkTo": "Permanent Link to", + "PostDetails": "Post Details", + "Posts": "Posts", + "PostsTagged": "Posts Tagged", + "PostStatus": "Post Status", + "PoweredBy": "Powered by", + "PreviousPost": "Previous Post", + "PublishedDate": "Published Date", + "PublishThisPost": "Publish This Post", + "Save": "Save", + "Seconds": "Seconds", + "ShowInPageList": "Show in Page List", + "Slug": "Slug", + "startingWith": "starting with", + "Status": "Status", + "Tags": "Tags", + "Time": "Time", + "Title": "Title", + "Updated": "Updated", + "View": "View", + "Warning": "Warning", + "XComments": "{0} Comments" +} diff --git a/src/MyWebLog.v2/Strings.fs b/src/MyWebLog.v2/Strings.fs new file mode 100644 index 0000000..55a725b --- /dev/null +++ b/src/MyWebLog.v2/Strings.fs @@ -0,0 +1,40 @@ +module MyWebLog.Strings + +open System.Collections.Generic +open System.Globalization +open System.IO +open System.Reflection +open System.Text.Json + +/// The locales we'll try to load +let private supportedLocales = [ "en-US" ] + +/// The fallback locale, if a key is not found in a non-default locale +let private fallbackLocale = "en-US" + +/// Get an embedded JSON file as a string +let private getEmbedded locale = + let str = sprintf "MyWebLog.Resources.%s.json" locale |> Assembly.GetExecutingAssembly().GetManifestResourceStream + use rdr = new StreamReader (str) + rdr.ReadToEnd() + +/// The dictionary of localized strings +let private strings = + supportedLocales + |> List.map (fun loc -> loc, getEmbedded loc |> JsonSerializer.Deserialize>) + |> dict + +/// Get a key from the resources file for the given locale +let getForLocale locale key = + let getString thisLocale = + match strings.ContainsKey thisLocale && strings.[thisLocale].ContainsKey key with + | true -> Some strings.[thisLocale].[key] + | false -> None + match getString locale with + | Some xlat -> Some xlat + | None when locale <> fallbackLocale -> getString fallbackLocale + | None -> None + |> function Some xlat -> xlat | None -> sprintf "%s.%s" locale key + +/// Translate the key for the current locale +let get key = getForLocale CultureInfo.CurrentCulture.Name key diff --git a/src/MyWebLog/Features/Shared/TagHelpers/ImageTagHelper.cs b/src/MyWebLog/Features/Shared/TagHelpers/ImageTagHelper.cs index db07dae..c1ae230 100644 --- a/src/MyWebLog/Features/Shared/TagHelpers/ImageTagHelper.cs +++ b/src/MyWebLog/Features/Shared/TagHelpers/ImageTagHelper.cs @@ -31,7 +31,7 @@ public class ImageTagHelper : Microsoft.AspNetCore.Mvc.TagHelpers.ImageTagHelper return; } - output.Attributes.SetAttribute("src", $"~/img/{Theme}/{context.AllAttributes["src"]?.Value}"); + output.Attributes.SetAttribute("src", $"~/{Theme}/img/{context.AllAttributes["src"]?.Value}"); ProcessUrlAttribute("src", output); } } diff --git a/src/MyWebLog/Features/Shared/TagHelpers/LinkTagHelper.cs b/src/MyWebLog/Features/Shared/TagHelpers/LinkTagHelper.cs index dc25fa2..0889f24 100644 --- a/src/MyWebLog/Features/Shared/TagHelpers/LinkTagHelper.cs +++ b/src/MyWebLog/Features/Shared/TagHelpers/LinkTagHelper.cs @@ -43,11 +43,11 @@ public class LinkTagHelper : Microsoft.AspNetCore.Mvc.TagHelpers.LinkTagHelper switch (context.AllAttributes["rel"]?.Value.ToString()) { case "stylesheet": - output.Attributes.SetAttribute("href", $"~/css/{Theme}/{Style}.css"); + output.Attributes.SetAttribute("href", $"~/{Theme}/css/{Style}.css"); break; case "icon": output.Attributes.SetAttribute("type", "image/x-icon"); - output.Attributes.SetAttribute("href", $"~/img/{Theme}/favicon.ico"); + output.Attributes.SetAttribute("href", $"~/{Theme}/img/favicon.ico"); break; } ProcessUrlAttribute("href", output); diff --git a/src/MyWebLog/MyWebLog.csproj b/src/MyWebLog/MyWebLog.csproj index 31a7042..b1c1626 100644 --- a/src/MyWebLog/MyWebLog.csproj +++ b/src/MyWebLog/MyWebLog.csproj @@ -6,14 +6,6 @@ enable - - - - - - - - @@ -27,7 +19,7 @@ - + diff --git a/src/MyWebLog/Program.cs b/src/MyWebLog/Program.cs index c27e550..03c9b0e 100644 --- a/src/MyWebLog/Program.cs +++ b/src/MyWebLog/Program.cs @@ -4,6 +4,7 @@ using Microsoft.EntityFrameworkCore; using MyWebLog; using MyWebLog.Features; using MyWebLog.Features.Users; +using System.Reflection; if (args.Length > 0 && args[0] == "init") { @@ -47,6 +48,10 @@ builder.Services.AddDbContext(o => o.UseSqlite($"Data Source=Db/{db}.db"); }); +// Load themes +Array.ForEach(Directory.GetFiles(Directory.GetCurrentDirectory(), "MyWebLog.Themes.*.dll"), + it => { Assembly.LoadFile(it); }); + var app = builder.Build(); app.UseCookiePolicy(new CookiePolicyOptions { MinimumSameSitePolicy = SameSiteMode.Strict });