bit-badger/myWebLog
1
0
Fork 0
Code Issues4 Pull Requests Packages Projects Releases11 Activity

Compare commits

...

27 Commits
main ... version-th

Author SHA1 Message Date
Daniel J. Summers
7374440621 WIP on OpenGraph form; first cut done () 2025-08-03 22:03:07 -04:00
Daniel J. Summers
60a22747ac WIP on OpenGraph form; add media files () 2025-08-03 21:08:34 -04:00
Daniel J. Summers
9b295263f9 WIP on OpenGraph form; items field complete () 2025-08-03 17:01:02 -04:00
Daniel J. Summers
bc1d17d916 WIP on OpenGraph edit form () 2025-08-02 20:57:29 -04:00
Daniel J. Summers
cba1bbfa28 Support relative URLs in OpenGraph properties () 2025-08-01 22:16:19 -04:00
Daniel J. Summers
8b190a6c23 Add tests for OpenGraph view model properties 2025-07-26 20:33:30 -04:00
Daniel J. Summers
e33966b3df WIP on OpenGraph post/page model () 
- Removed SecureUrl prop; will generate if URL starts with https:
 2025-07-15 23:38:02 -04:00
Daniel J. Summers
3ad6b5a521 Move OpenGraph property generation to models () 
- Add auto-OpenGraph field to web log
- Only generate properties for posts/pages without them if this flag is set
- Set flag to yes on v3 database migration
- Add JSON converter for OpenGraph type
- Add tests for models
 2025-07-10 23:03:16 -04:00
Daniel J. Summers
210dd41cee Add OG types to page/post, add rendering in page head () 2025-07-09 22:04:37 -04:00
Daniel J. Summers
fa4e1d327a WIP on OpenGraph types () 2025-07-06 22:09:36 -04:00
Daniel J. Summers
c19f92889e Return client refresh from redir rule if htmx () 2025-07-05 18:32:46 -04:00
Daniel J. Summers
1f7d415868 Add model alias for payload () 
- Update post/page canonical URLs for Fluid
 2025-07-05 16:48:15 -04:00
Daniel J. Summers
ba5e27e011 Simplify catch-all route; bump admin theme version 2025-07-05 13:40:06 -04:00
Daniel J. Summers
161a61823f Remove CSRF from admin/upload delete endpoints 2025-07-05 12:07:58 -04:00
Daniel J. Summers
d1840f63e5 Remove CSRF from page, post, category delete routes () 
- Chapter delete swap target needs work
 2025-07-04 22:24:32 -04:00
Daniel J. Summers
87fbb1a8c7 Vendor htmx 2.0.6 () 2025-07-04 18:18:13 -04:00
Daniel J. Summers
e8953d6072 Update deps; fix SQLite web log delete query 2025-07-04 11:06:34 -04:00
Daniel J. Summers
dc30716b83 Update deps; WIP on comments 2025-01-23 22:11:12 -05:00
Daniel J. Summers
88841fd3f8 Update to .NET 8/9; minor tweaks 2024-12-23 21:16:34 -05:00
Daniel J. Summers
870f87cb17 Update for v4-rc5 of doc library 2024-09-18 19:54:45 -04:00
Daniel J. Summers
0032d15c0a Update for doc lib v4-rc4 2024-09-17 08:05:30 -04:00
Daniel J. Summers
95be82cc84 WIP on Fluid model/filters 2024-08-26 21:42:47 -04:00
Daniel J. Summers
d047035173 WIP: conversion to Fluid () 2024-08-24 20:47:23 -04:00
Daniel J. Summers
cc3e41ddc5 Incorporate doc lib v4 ordering 2024-08-22 23:00:25 -04:00
Daniel J. Summers
d4c0e4e26c Tweak PostgreSQL calls 2024-08-19 22:45:14 -04:00
Daniel J. Summers
fbc4e891bd Integrate v4 document library for SQLite 
- Eliminate warnings for PostgreSQL
 2024-08-19 22:23:22 -04:00
Daniel J. Summers
cd450a05e5 Update to new doc library 
Still need to remove deprecated calls
 2024-08-19 20:30:33 -04:00
60 changed files with 4268 additions and 2403 deletions

2
build.fs

@ -33,7 +33,7 @@ let zipTheme (name : string) (_ : TargetParameter) =
|> Zip.zipSpec $"{releasePath}/{name}-theme.zip" |> Zip.zipSpec $"{releasePath}/{name}-theme.zip"
/// Frameworks supported by this build /// Frameworks supported by this build
let frameworks = [ "net6.0"; "net8.0" ] let frameworks = [ "net8.0"; "net9.0" ]
/// Publish the project for the given runtime ID /// Publish the project for the given runtime ID
let publishFor rid (_ : TargetParameter) = let publishFor rid (_ : TargetParameter) =

10
src/Directory.Build.props

@ -1,9 +1,11 @@
<Project> <Project>
<PropertyGroup> <PropertyGroup>
<TargetFrameworks>net6.0;net8.0</TargetFrameworks> <TargetFrameworks>net8.0;net9.0</TargetFrameworks>
<DebugType>embedded</DebugType> <DebugType>embedded</DebugType>
<AssemblyVersion>2.2.0.0</AssemblyVersion> <GenerateDocumentationFile>true</GenerateDocumentationFile>
<FileVersion>2.2.0.0</FileVersion> <AssemblyVersion>3.0.0.0</AssemblyVersion>
<Version>2.2.0</Version> <FileVersion>3.0.0.0</FileVersion>
<Version>3.0.0</Version>
<VersionSuffix>beta1</VersionSuffix>
</PropertyGroup> </PropertyGroup>
</Project> </Project>

40
src/MyWebLog.Data/Converters.fs

@ -1,14 +1,15 @@
/// Converters for discriminated union types /// <summary>Converters for discriminated union types</summary>
module MyWebLog.Converters module MyWebLog.Converters
open MyWebLog open MyWebLog
open System open System
/// JSON.NET converters for discriminated union types /// <summary>JSON.NET converters for discriminated union types</summary>
module Json = module Json =
open Newtonsoft.Json open Newtonsoft.Json
/// <summary>Converter for the <see cref="CategoryId" /> type</summary>
type CategoryIdConverter() = type CategoryIdConverter() =
inherit JsonConverter<CategoryId>() inherit JsonConverter<CategoryId>()
override _.WriteJson(writer: JsonWriter, value: CategoryId, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: CategoryId, _: JsonSerializer) =
@ -16,6 +17,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: CategoryId, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: CategoryId, _: bool, _: JsonSerializer) =
(string >> CategoryId) reader.Value (string >> CategoryId) reader.Value
/// <summary>Converter for the <see cref="CommentId" /> type</summary>
type CommentIdConverter() = type CommentIdConverter() =
inherit JsonConverter<CommentId>() inherit JsonConverter<CommentId>()
override _.WriteJson(writer: JsonWriter, value: CommentId, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: CommentId, _: JsonSerializer) =
@ -23,6 +25,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: CommentId, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: CommentId, _: bool, _: JsonSerializer) =
(string >> CommentId) reader.Value (string >> CommentId) reader.Value
/// <summary>Converter for the <see cref="CommentStatus" /> type</summary>
type CommentStatusConverter() = type CommentStatusConverter() =
inherit JsonConverter<CommentStatus>() inherit JsonConverter<CommentStatus>()
override _.WriteJson(writer: JsonWriter, value: CommentStatus, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: CommentStatus, _: JsonSerializer) =
@ -30,6 +33,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: CommentStatus, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: CommentStatus, _: bool, _: JsonSerializer) =
(string >> CommentStatus.Parse) reader.Value (string >> CommentStatus.Parse) reader.Value
/// <summary>Converter for the <see cref="CustomFeedId" /> type</summary>
type CustomFeedIdConverter() = type CustomFeedIdConverter() =
inherit JsonConverter<CustomFeedId>() inherit JsonConverter<CustomFeedId>()
override _.WriteJson(writer: JsonWriter, value: CustomFeedId, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: CustomFeedId, _: JsonSerializer) =
@ -37,6 +41,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: CustomFeedId, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: CustomFeedId, _: bool, _: JsonSerializer) =
(string >> CustomFeedId) reader.Value (string >> CustomFeedId) reader.Value
/// <summary>Converter for the <see cref="CustomFeedSource" /> type</summary>
type CustomFeedSourceConverter() = type CustomFeedSourceConverter() =
inherit JsonConverter<CustomFeedSource>() inherit JsonConverter<CustomFeedSource>()
override _.WriteJson(writer: JsonWriter, value: CustomFeedSource, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: CustomFeedSource, _: JsonSerializer) =
@ -44,6 +49,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: CustomFeedSource, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: CustomFeedSource, _: bool, _: JsonSerializer) =
(string >> CustomFeedSource.Parse) reader.Value (string >> CustomFeedSource.Parse) reader.Value
/// <summary>Converter for the <see cref="ExplicitRating" /> type</summary>
type ExplicitRatingConverter() = type ExplicitRatingConverter() =
inherit JsonConverter<ExplicitRating>() inherit JsonConverter<ExplicitRating>()
override _.WriteJson(writer: JsonWriter, value: ExplicitRating, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: ExplicitRating, _: JsonSerializer) =
@ -51,6 +57,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: ExplicitRating, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: ExplicitRating, _: bool, _: JsonSerializer) =
(string >> ExplicitRating.Parse) reader.Value (string >> ExplicitRating.Parse) reader.Value
/// <summary>Converter for the <see cref="MarkupText" /> type</summary>
type MarkupTextConverter() = type MarkupTextConverter() =
inherit JsonConverter<MarkupText>() inherit JsonConverter<MarkupText>()
override _.WriteJson(writer: JsonWriter, value: MarkupText, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: MarkupText, _: JsonSerializer) =
@ -58,6 +65,15 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: MarkupText, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: MarkupText, _: bool, _: JsonSerializer) =
(string >> MarkupText.Parse) reader.Value (string >> MarkupText.Parse) reader.Value
/// <summary>Converter for the <see cref="OpenGraphType" /> type</summary>
type OpenGraphTypeConverter() =
inherit JsonConverter<OpenGraphType>()
override _.WriteJson(writer: JsonWriter, value: OpenGraphType, _: JsonSerializer) =
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: OpenGraphType, _: bool, _: JsonSerializer) =
(string >> OpenGraphType.Parse) reader.Value
/// <summary>Converter for the <see cref="Permalink" /> type</summary>
type PermalinkConverter() = type PermalinkConverter() =
inherit JsonConverter<Permalink>() inherit JsonConverter<Permalink>()
override _.WriteJson(writer: JsonWriter, value: Permalink, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: Permalink, _: JsonSerializer) =
@ -65,6 +81,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: Permalink, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: Permalink, _: bool, _: JsonSerializer) =
(string >> Permalink) reader.Value (string >> Permalink) reader.Value
/// <summary>Converter for the <see cref="PageId" /> type</summary>
type PageIdConverter() = type PageIdConverter() =
inherit JsonConverter<PageId>() inherit JsonConverter<PageId>()
override _.WriteJson(writer: JsonWriter, value: PageId, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: PageId, _: JsonSerializer) =
@ -72,6 +89,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: PageId, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: PageId, _: bool, _: JsonSerializer) =
(string >> PageId) reader.Value (string >> PageId) reader.Value
/// <summary>Converter for the <see cref="PodcastMedium" /> type</summary>
type PodcastMediumConverter() = type PodcastMediumConverter() =
inherit JsonConverter<PodcastMedium>() inherit JsonConverter<PodcastMedium>()
override _.WriteJson(writer: JsonWriter, value: PodcastMedium, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: PodcastMedium, _: JsonSerializer) =
@ -79,6 +97,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: PodcastMedium, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: PodcastMedium, _: bool, _: JsonSerializer) =
(string >> PodcastMedium.Parse) reader.Value (string >> PodcastMedium.Parse) reader.Value
/// <summary>Converter for the <see cref="PostId" /> type</summary>
type PostIdConverter() = type PostIdConverter() =
inherit JsonConverter<PostId>() inherit JsonConverter<PostId>()
override _.WriteJson(writer: JsonWriter, value: PostId, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: PostId, _: JsonSerializer) =
@ -86,6 +105,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: PostId, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: PostId, _: bool, _: JsonSerializer) =
(string >> PostId) reader.Value (string >> PostId) reader.Value
/// <summary>Converter for the <see cref="TagMapId" /> type</summary>
type TagMapIdConverter() = type TagMapIdConverter() =
inherit JsonConverter<TagMapId>() inherit JsonConverter<TagMapId>()
override _.WriteJson(writer: JsonWriter, value: TagMapId, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: TagMapId, _: JsonSerializer) =
@ -93,6 +113,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: TagMapId, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: TagMapId, _: bool, _: JsonSerializer) =
(string >> TagMapId) reader.Value (string >> TagMapId) reader.Value
/// <summary>Converter for the <see cref="ThemeAssetId" /> type</summary>
type ThemeAssetIdConverter() = type ThemeAssetIdConverter() =
inherit JsonConverter<ThemeAssetId>() inherit JsonConverter<ThemeAssetId>()
override _.WriteJson(writer: JsonWriter, value: ThemeAssetId, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: ThemeAssetId, _: JsonSerializer) =
@ -100,6 +121,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: ThemeAssetId, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: ThemeAssetId, _: bool, _: JsonSerializer) =
(string >> ThemeAssetId.Parse) reader.Value (string >> ThemeAssetId.Parse) reader.Value
/// <summary>Converter for the <see cref="ThemeId" /> type</summary>
type ThemeIdConverter() = type ThemeIdConverter() =
inherit JsonConverter<ThemeId>() inherit JsonConverter<ThemeId>()
override _.WriteJson(writer: JsonWriter, value: ThemeId, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: ThemeId, _: JsonSerializer) =
@ -107,6 +129,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: ThemeId, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: ThemeId, _: bool, _: JsonSerializer) =
(string >> ThemeId) reader.Value (string >> ThemeId) reader.Value
/// <summary>Converter for the <see cref="UploadId" /> type</summary>
type UploadIdConverter() = type UploadIdConverter() =
inherit JsonConverter<UploadId>() inherit JsonConverter<UploadId>()
override _.WriteJson(writer: JsonWriter, value: UploadId, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: UploadId, _: JsonSerializer) =
@ -114,6 +137,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: UploadId, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: UploadId, _: bool, _: JsonSerializer) =
(string >> UploadId) reader.Value (string >> UploadId) reader.Value
/// <summary>Converter for the <see cref="WebLogId" /> type</summary>
type WebLogIdConverter() = type WebLogIdConverter() =
inherit JsonConverter<WebLogId>() inherit JsonConverter<WebLogId>()
override _.WriteJson(writer: JsonWriter, value: WebLogId, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: WebLogId, _: JsonSerializer) =
@ -121,6 +145,7 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: WebLogId, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: WebLogId, _: bool, _: JsonSerializer) =
(string >> WebLogId) reader.Value (string >> WebLogId) reader.Value
/// <summary>Converter for the <see cref="WebLogUserId" /> type</summary>
type WebLogUserIdConverter() = type WebLogUserIdConverter() =
inherit JsonConverter<WebLogUserId> () inherit JsonConverter<WebLogUserId> ()
override _.WriteJson(writer: JsonWriter, value: WebLogUserId, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: WebLogUserId, _: JsonSerializer) =
@ -132,8 +157,8 @@ module Json =
open NodaTime open NodaTime
open NodaTime.Serialization.JsonNet open NodaTime.Serialization.JsonNet
/// Configure a serializer to use these converters /// <summary>Configure a serializer to use these converters (and other settings)</summary>
let configure (ser : JsonSerializer) = let configure (ser: JsonSerializer) =
// Our converters // Our converters
[ CategoryIdConverter() :> JsonConverter [ CategoryIdConverter() :> JsonConverter
CommentIdConverter() CommentIdConverter()
@ -142,6 +167,7 @@ module Json =
CustomFeedSourceConverter() CustomFeedSourceConverter()
ExplicitRatingConverter() ExplicitRatingConverter()
MarkupTextConverter() MarkupTextConverter()
OpenGraphTypeConverter()
PermalinkConverter() PermalinkConverter()
PageIdConverter() PageIdConverter()
PodcastMediumConverter() PodcastMediumConverter()
@ -164,8 +190,10 @@ module Json =
/// Serializer settings extracted from a JsonSerializer (a property sure would be nice...) /// Serializer settings extracted from a JsonSerializer (a property sure would be nice...)
let mutable private serializerSettings : JsonSerializerSettings option = None let mutable private serializerSettings : JsonSerializerSettings option = None
/// Extract settings from the serializer to be used in JsonConvert calls /// <summary>Extract settings from the serializer to be used in <c>JsonConvert</c> calls</summary>
let settings (ser : JsonSerializer) = /// <param name="ser">The serializer from which settings will be extracted if required</param>
/// <returns>The serializer settings to use for <c>JsonConvert</c> calls</returns>
let settings (ser: JsonSerializer) =
if Option.isNone serializerSettings then if Option.isNone serializerSettings then
serializerSettings <- JsonSerializerSettings ( serializerSettings <- JsonSerializerSettings (
ConstructorHandling = ser.ConstructorHandling, ConstructorHandling = ser.ConstructorHandling,

16
src/MyWebLog.Data/MyWebLog.Data.fsproj

@ -5,17 +5,17 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="BitBadger.Documents.Postgres" Version="3.1.0" /> <PackageReference Include="BitBadger.Documents.Postgres" Version="4.1.0" />
<PackageReference Include="BitBadger.Documents.Sqlite" Version="3.1.0" /> <PackageReference Include="BitBadger.Documents.Sqlite" Version="4.1.0" />
<PackageReference Include="Microsoft.Data.Sqlite" Version="8.0.6" /> <PackageReference Include="Microsoft.Data.Sqlite" Version="9.0.6" />
<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="8.0.0" /> <PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="9.0.6" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="8.0.0" /> <PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="9.0.6" />
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" /> <PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" /> <PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.2.0" />
<PackageReference Include="Npgsql.NodaTime" Version="8.0.3" /> <PackageReference Include="Npgsql.NodaTime" Version="9.0.3" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" /> <PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" /> <PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
<PackageReference Update="FSharp.Core" Version="8.0.300" /> <PackageReference Update="FSharp.Core" Version="9.0.300" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

52
src/MyWebLog.Data/Postgres/PostgresCategoryData.fs

@ -19,38 +19,41 @@ type PostgresCategoryData(log: ILogger) =
let countTopLevel webLogId = let countTopLevel webLogId =
log.LogTrace "Category.countTopLevel" log.LogTrace "Category.countTopLevel"
Custom.scalar Custom.scalar
$"""{Query.Count.byContains Table.Category} $"""{Query.byContains (Query.count Table.Category)}
AND {Query.whereByField (Field.NEX (nameof Category.Empty.ParentId)) ""}""" AND {Query.whereByFields Any [ Field.NotExists (nameof Category.Empty.ParentId) ]}"""
[ webLogContains webLogId ] [ webLogContains webLogId ]
toCount toCount
/// Find all categories for the given web log
let findByWebLog webLogId =
log.LogTrace "Category.findByWebLog"
Find.byContains<Category> Table.Category (webLogDoc webLogId)
/// Retrieve all categories for the given web log in a DotLiquid-friendly format /// Retrieve all categories for the given web log in a DotLiquid-friendly format
let findAllForView webLogId = backgroundTask { let findAllForView webLogId = backgroundTask {
log.LogTrace "Category.findAllForView" log.LogTrace "Category.findAllForView"
let! cats = let! cats = findByWebLog webLogId
Custom.list let ordered = Utils.orderByHierarchy (cats |> List.sortBy _.Name.ToLowerInvariant()) None None []
$"{selectWithCriteria Table.Category} ORDER BY LOWER(data ->> '{nameof Category.Empty.Name}')" let counts =
[ webLogContains webLogId ]
fromData<Category>
let ordered = Utils.orderByHierarchy cats None None []
let counts =
ordered ordered
|> Seq.map (fun it -> |> Seq.map (fun it ->
// Parent category post counts include posts in subcategories // Parent category post counts include posts in subcategories
let catIdSql, catIdParams = let catIdField =
ordered ordered
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name) |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|> Seq.map _.Id |> Seq.map _.Id
|> Seq.append (Seq.singleton it.Id) |> Seq.append (Seq.singleton it.Id)
|> List.ofSeq |> Field.InArray (nameof Post.Empty.CategoryIds) Table.Post
|> arrayContains (nameof Post.Empty.CategoryIds) id let query =
(Query.statementWhere
(Query.count Table.Post)
$"""{Query.whereDataContains "@criteria"} AND {Query.whereByFields All [ catIdField ]}""")
.Replace("(*)", $"(DISTINCT data->>'{nameof Post.Empty.Id}')")
let postCount = let postCount =
Custom.scalar Custom.scalar
$"""SELECT COUNT(DISTINCT data ->> '{nameof Post.Empty.Id}') AS it query
FROM {Table.Post} (addFieldParams
WHERE {Query.whereDataContains "@criteria"} [ catIdField ] [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |} ])
AND {catIdSql}"""
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; catIdParams ]
toCount toCount
|> Async.AwaitTask |> Async.AwaitTask
|> Async.RunSynchronously |> Async.RunSynchronously
@ -71,11 +74,6 @@ type PostgresCategoryData(log: ILogger) =
log.LogTrace "Category.findById" log.LogTrace "Category.findById"
Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId webLogId Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId webLogId
/// Find all categories for the given web log
let findByWebLog webLogId =
log.LogTrace "Category.findByWebLog"
Document.findByWebLog<Category> Table.Category webLogId
/// Delete a category /// Delete a category
let delete catId webLogId = backgroundTask { let delete catId webLogId = backgroundTask {
log.LogTrace "Category.delete" log.LogTrace "Category.delete"
@ -87,14 +85,14 @@ type PostgresCategoryData(log: ILogger) =
if hasChildren then if hasChildren then
let childQuery, childParams = let childQuery, childParams =
if cat.ParentId.IsSome then if cat.ParentId.IsSome then
Query.Patch.byId Table.Category, Query.byId (Query.patch Table.Category) "",
children children
|> List.map (fun child -> [ idParam child.Id; jsonParam "@data" {| ParentId = cat.ParentId |} ]) |> List.map (fun child -> [ idParam child.Id; jsonParam "@data" {| ParentId = cat.ParentId |} ])
else else
Query.RemoveFields.byId Table.Category, Query.byId (Query.removeFields Table.Category) "",
children children
|> List.map (fun child -> |> List.map (fun child ->
[ idParam child.Id; fieldNameParam [ nameof Category.Empty.ParentId ] ]) [ idParam child.Id; fieldNameParams [ nameof Category.Empty.ParentId ] ])
let! _ = let! _ =
Configuration.dataSource () Configuration.dataSource ()
|> Sql.fromDataSource |> Sql.fromDataSource
@ -103,7 +101,7 @@ type PostgresCategoryData(log: ILogger) =
// Delete the category off all posts where it is assigned // Delete the category off all posts where it is assigned
let! posts = let! posts =
Custom.list Custom.list
$"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.Empty.CategoryIds}' @> @id" $"SELECT data FROM {Table.Post} WHERE data->'{nameof Post.Empty.CategoryIds}' @> @id"
[ jsonParam "@id" [| string catId |] ] [ jsonParam "@id" [| string catId |] ]
fromData<Post> fromData<Post>
if not (List.isEmpty posts) then if not (List.isEmpty posts) then
@ -111,7 +109,7 @@ type PostgresCategoryData(log: ILogger) =
Configuration.dataSource () Configuration.dataSource ()
|> Sql.fromDataSource |> Sql.fromDataSource
|> Sql.executeTransactionAsync |> Sql.executeTransactionAsync
[ Query.Patch.byId Table.Post, [ Query.byId (Query.patch Table.Post) "",
posts posts
|> List.map (fun post -> |> List.map (fun post ->
[ idParam post.Id [ idParam post.Id

31
src/MyWebLog.Data/Postgres/PostgresHelpers.fs

@ -83,28 +83,7 @@ let webLogContains webLogId =
/// A SQL string to select data from a table with the given JSON document contains criteria /// A SQL string to select data from a table with the given JSON document contains criteria
let selectWithCriteria tableName = let selectWithCriteria tableName =
$"""{Query.selectFromTable tableName} WHERE {Query.whereDataContains "@criteria"}""" Query.byContains (Query.find tableName)
/// Create the SQL and parameters for an IN clause
let inClause<'T> colNameAndPrefix paramName (items: 'T list) =
if List.isEmpty items then "", []
else
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS}, @%s{paramName}{idx}", ($"@%s{paramName}{idx}", Sql.string (string it)) :: itemP)
(Seq.ofList items
|> Seq.map (fun it ->
$"%s{colNameAndPrefix} IN (@%s{paramName}0", [ $"@%s{paramName}0", Sql.string (string it) ])
|> Seq.head)
|> function sql, ps -> $"{sql})", ps
/// Create the SQL and parameters for match-any array query
let arrayContains<'T> name (valueFunc: 'T -> string) (items: 'T list) =
$"data['{name}'] ?| @{name}Values",
($"@{name}Values", Sql.stringArray (items |> List.map valueFunc |> Array.ofList))
/// Get the first result of the given query /// Get the first result of the given query
let tryHead<'T> (query: Task<'T list>) = backgroundTask { let tryHead<'T> (query: Task<'T list>) = backgroundTask {
@ -162,14 +141,10 @@ module Document =
/// Find a document by its ID for the given web log /// Find a document by its ID for the given web log
let findByIdAndWebLog<'TKey, 'TDoc> table (key: 'TKey) webLogId = let findByIdAndWebLog<'TKey, 'TDoc> table (key: 'TKey) webLogId =
Custom.single Custom.single
$"""{Query.selectFromTable table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"}""" $"""{Query.find table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"}"""
[ "@id", Sql.string (string key); webLogContains webLogId ] [ "@id", Sql.string (string key); webLogContains webLogId ]
fromData<'TDoc> fromData<'TDoc>
/// Find documents for the given web log
let findByWebLog<'TDoc> table webLogId : Task<'TDoc list> =
Find.byContains table (webLogDoc webLogId)
/// Functions to support revisions /// Functions to support revisions
module Revisions = module Revisions =
@ -186,7 +161,7 @@ module Revisions =
Custom.list Custom.list
$"""SELECT pr.* $"""SELECT pr.*
FROM %s{revTable} pr FROM %s{revTable} pr
INNER JOIN %s{entityTable} p ON p.data ->> '{nameof Post.Empty.Id}' = pr.{entityTable}_id INNER JOIN %s{entityTable} p ON p.data->>'{nameof Post.Empty.Id}' = pr.{entityTable}_id
WHERE p.{Query.whereDataContains "@criteria"} WHERE p.{Query.whereDataContains "@criteria"}
ORDER BY as_of DESC""" ORDER BY as_of DESC"""
[ webLogContains webLogId ] [ webLogContains webLogId ]

36
src/MyWebLog.Data/Postgres/PostgresPageData.fs

@ -33,6 +33,10 @@ type PostgresPageData(log: ILogger) =
log.LogTrace "Page.pageExists" log.LogTrace "Page.pageExists"
Document.existsByWebLog Table.Page pageId webLogId Document.existsByWebLog Table.Page pageId webLogId
/// The query to get all pages ordered by title
let sortedPages =
selectWithCriteria Table.Page + Query.orderBy [ Field.Named $"i:{nameof Page.Empty.Title}" ] PostgreSQL
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Add a page /// Add a page
@ -47,7 +51,7 @@ type PostgresPageData(log: ILogger) =
let all webLogId = let all webLogId =
log.LogTrace "Page.all" log.LogTrace "Page.all"
Custom.list Custom.list
$"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.Empty.Title}')" sortedPages
[ webLogContains webLogId ] [ webLogContains webLogId ]
(fun row -> { fromData<Page> row with Text = ""; Metadata = []; PriorPermalinks = [] }) (fun row -> { fromData<Page> row with Text = ""; Metadata = []; PriorPermalinks = [] })
@ -86,8 +90,8 @@ type PostgresPageData(log: ILogger) =
match! pageExists pageId webLogId with match! pageExists pageId webLogId with
| true -> | true ->
do! Custom.nonQuery do! Custom.nonQuery
$"""DELETE FROM {Table.PageRevision} WHERE page_id = @id; $"""{Query.delete Table.PageRevision} WHERE page_id = @id;
DELETE FROM {Table.Page} WHERE {Query.whereById "@id"}""" {Query.delete Table.Page} WHERE {Query.whereById "@id"}"""
[ idParam pageId ] [ idParam pageId ]
return true return true
| false -> return false | false -> return false
@ -107,21 +111,19 @@ type PostgresPageData(log: ILogger) =
log.LogTrace "Page.findCurrentPermalink" log.LogTrace "Page.findCurrentPermalink"
if List.isEmpty permalinks then return None if List.isEmpty permalinks then return None
else else
let linkSql, linkParam = arrayContains (nameof Page.Empty.PriorPermalinks) string permalinks let linkField = Field.InArray (nameof Page.Empty.PriorPermalinks) Table.Page (List.map string permalinks)
return! let query =
Custom.single (Query.statementWhere
$"""SELECT data ->> '{nameof Page.Empty.Permalink}' AS permalink (Query.find Table.Page)
FROM page $"""{Query.whereDataContains "@criteria"} AND {Query.whereByFields All [ linkField ]}""")
WHERE {Query.whereDataContains "@criteria"} .Replace("SELECT data", $"SELECT data->>'{nameof Page.Empty.Permalink}' AS permalink")
AND {linkSql}""" return! Custom.single query (addFieldParams [ linkField ] [ webLogContains webLogId ]) Map.toPermalink
[ webLogContains webLogId; linkParam ]
Map.toPermalink
} }
/// Get all complete pages for the given web log /// Get all complete pages for the given web log
let findFullByWebLog webLogId = backgroundTask { let findFullByWebLog webLogId = backgroundTask {
log.LogTrace "Page.findFullByWebLog" log.LogTrace "Page.findFullByWebLog"
let! pages = Document.findByWebLog<Page> Table.Page webLogId let! pages = Find.byContains<Page> Table.Page (webLogDoc webLogId)
let! revisions = Revisions.findByWebLog Table.PageRevision Table.Page PageId webLogId let! revisions = Revisions.findByWebLog Table.PageRevision Table.Page PageId webLogId
return return
pages pages
@ -133,17 +135,13 @@ type PostgresPageData(log: ILogger) =
let findListed webLogId = let findListed webLogId =
log.LogTrace "Page.findListed" log.LogTrace "Page.findListed"
Custom.list Custom.list
$"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.Empty.Title}')" sortedPages [ jsonParam "@criteria" {| webLogDoc webLogId with IsInPageList = true |} ] pageWithoutText
[ jsonParam "@criteria" {| webLogDoc webLogId with IsInPageList = true |} ]
pageWithoutText
/// Get a page of pages for the given web log (without revisions) /// Get a page of pages for the given web log (without revisions)
let findPageOfPages webLogId pageNbr = let findPageOfPages webLogId pageNbr =
log.LogTrace "Page.findPageOfPages" log.LogTrace "Page.findPageOfPages"
Custom.list Custom.list
$"{selectWithCriteria Table.Page} $"{sortedPages} LIMIT @pageSize OFFSET @toSkip"
ORDER BY LOWER(data->>'{nameof Page.Empty.Title}')
LIMIT @pageSize OFFSET @toSkip"
[ webLogContains webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ] [ webLogContains webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
(fun row -> { fromData<Page> row with Metadata = []; PriorPermalinks = [] }) (fun row -> { fromData<Page> row with Metadata = []; PriorPermalinks = [] })

69
src/MyWebLog.Data/Postgres/PostgresPostData.fs

@ -84,9 +84,9 @@ type PostgresPostData(log: ILogger) =
match! postExists postId webLogId with match! postExists postId webLogId with
| true -> | true ->
do! Custom.nonQuery do! Custom.nonQuery
$"""DELETE FROM {Table.PostComment} WHERE {Query.whereDataContains "@criteria"}; $"""{Query.delete Table.PostComment} WHERE {Query.whereDataContains "@criteria"};
DELETE FROM {Table.PostRevision} WHERE post_id = @id; {Query.delete Table.PostRevision} WHERE post_id = @id;
DELETE FROM {Table.Post} WHERE {Query.whereById "@id"}""" {Query.delete Table.Post} WHERE {Query.whereById "@id"}"""
[ idParam postId; jsonParam "@criteria" {| PostId = postId |} ] [ idParam postId; jsonParam "@criteria" {| PostId = postId |} ]
return true return true
| false -> return false | false -> return false
@ -97,21 +97,19 @@ type PostgresPostData(log: ILogger) =
log.LogTrace "Post.findCurrentPermalink" log.LogTrace "Post.findCurrentPermalink"
if List.isEmpty permalinks then return None if List.isEmpty permalinks then return None
else else
let linkSql, linkParam = arrayContains (nameof Post.Empty.PriorPermalinks) string permalinks let linkField = Field.InArray (nameof Post.Empty.PriorPermalinks) Table.Post (List.map string permalinks)
return! let query =
Custom.single (Query.statementWhere
$"""SELECT data ->> '{nameof Post.Empty.Permalink}' AS permalink (Query.find Table.Post)
FROM {Table.Post} $"""{Query.whereDataContains "@criteria"} AND {Query.whereByFields All [ linkField ]}""")
WHERE {Query.whereDataContains "@criteria"} .Replace("SELECT data", $"SELECT data->>'{nameof Post.Empty.Permalink}' AS permalink")
AND {linkSql}""" return! Custom.single query (addFieldParams [ linkField ] [ webLogContains webLogId ]) Map.toPermalink
[ webLogContains webLogId; linkParam ]
Map.toPermalink
} }
/// Get all complete posts for the given web log /// Get all complete posts for the given web log
let findFullByWebLog webLogId = backgroundTask { let findFullByWebLog webLogId = backgroundTask {
log.LogTrace "Post.findFullByWebLog" log.LogTrace "Post.findFullByWebLog"
let! posts = Document.findByWebLog<Post> Table.Post webLogId let! posts = Find.byContains<Post> Table.Post (webLogDoc webLogId)
let! revisions = Revisions.findByWebLog Table.PostRevision Table.Post PostId webLogId let! revisions = Revisions.findByWebLog Table.PostRevision Table.Post PostId webLogId
return return
posts posts
@ -122,23 +120,26 @@ type PostgresPostData(log: ILogger) =
/// Get a page of categorized posts for the given web log (excludes revisions) /// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage = let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage =
log.LogTrace "Post.findPageOfCategorizedPosts" log.LogTrace "Post.findPageOfCategorizedPosts"
let catSql, catParam = arrayContains (nameof Post.Empty.CategoryIds) string categoryIds let catIdField = Field.InArray (nameof Post.Empty.CategoryIds) Table.Post (List.map string categoryIds)
Custom.list Custom.list
$"{selectWithCriteria Table.Post} $"""{selectWithCriteria Table.Post}
AND {catSql} AND {Query.whereByFields All [ catIdField ]}
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC {Query.orderBy [ Field.Named $"{nameof Post.Empty.PublishedOn} DESC" ] PostgreSQL}
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; catParam ] (addFieldParams [ catIdField] [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |} ])
postWithoutLinks postWithoutLinks
/// Get a page of posts for the given web log (excludes text and revisions) /// Get a page of posts for the given web log (excludes text and revisions)
let findPageOfPosts webLogId pageNbr postsPerPage = let findPageOfPosts webLogId pageNbr postsPerPage =
log.LogTrace "Post.findPageOfPosts" log.LogTrace "Post.findPageOfPosts"
let order =
Query.orderBy
[ Field.Named $"{nameof Post.Empty.PublishedOn} DESC NULLS FIRST"
Field.Named (nameof Post.Empty.UpdatedOn) ]
PostgreSQL
Custom.list Custom.list
$"{selectWithCriteria Table.Post} $"{selectWithCriteria Table.Post}{order}
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC NULLS FIRST, LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
data ->> '{nameof Post.Empty.UpdatedOn}'
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ webLogContains webLogId ] [ webLogContains webLogId ]
postWithoutText postWithoutText
@ -146,9 +147,9 @@ type PostgresPostData(log: ILogger) =
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
log.LogTrace "Post.findPageOfPublishedPosts" log.LogTrace "Post.findPageOfPublishedPosts"
Custom.list Custom.list
$"{selectWithCriteria Table.Post} $"""{selectWithCriteria Table.Post}
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC {Query.orderBy [ Field.Named $"{nameof Post.Empty.PublishedOn} DESC" ] PostgreSQL}
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |} ] [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |} ]
postWithoutLinks postWithoutLinks
@ -156,10 +157,10 @@ type PostgresPostData(log: ILogger) =
let findPageOfTaggedPosts webLogId (tag: string) pageNbr postsPerPage = let findPageOfTaggedPosts webLogId (tag: string) pageNbr postsPerPage =
log.LogTrace "Post.findPageOfTaggedPosts" log.LogTrace "Post.findPageOfTaggedPosts"
Custom.list Custom.list
$"{selectWithCriteria Table.Post} $"""{selectWithCriteria Table.Post}
AND data['{nameof Post.Empty.Tags}'] @> @tag AND data['{nameof Post.Empty.Tags}'] @> @tag
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC {Query.orderBy [ Field.Named $"{nameof Post.Empty.PublishedOn} DESC" ] PostgreSQL}
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; jsonParam "@tag" [| tag |] ] [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; jsonParam "@tag" [| tag |] ]
postWithoutLinks postWithoutLinks
@ -170,10 +171,10 @@ type PostgresPostData(log: ILogger) =
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |} [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}
"@publishedOn", Sql.timestamptz (publishedOn.ToDateTimeOffset()) ] "@publishedOn", Sql.timestamptz (publishedOn.ToDateTimeOffset()) ]
let query op direction = let query op direction =
$"{selectWithCriteria Table.Post} $"""{selectWithCriteria Table.Post}
AND (data ->> '{nameof Post.Empty.PublishedOn}')::timestamp with time zone %s{op} @publishedOn AND (data->>'{nameof Post.Empty.PublishedOn}')::timestamp with time zone %s{op} @publishedOn
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' %s{direction} {Query.orderBy [ Field.Named $"{nameof Post.Empty.PublishedOn} %s{direction}" ] PostgreSQL}
LIMIT 1" LIMIT 1"""
let! older = Custom.list (query "<" "DESC") (queryParams ()) postWithoutLinks let! older = Custom.list (query "<" "DESC") (queryParams ()) postWithoutLinks
let! newer = Custom.list (query ">" "") (queryParams ()) postWithoutLinks let! newer = Custom.list (query ">" "") (queryParams ()) postWithoutLinks
return List.tryHead older, List.tryHead newer return List.tryHead older, List.tryHead newer

13
src/MyWebLog.Data/Postgres/PostgresTagMapData.fs

@ -33,18 +33,15 @@ type PostgresTagMapData(log: ILogger) =
/// Get all tag mappings for the given web log /// Get all tag mappings for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
log.LogTrace "TagMap.findByWebLog" log.LogTrace "TagMap.findByWebLog"
Custom.list Find.byContainsOrdered<TagMap> Table.TagMap (webLogDoc webLogId) [ Field.Named (nameof TagMap.Empty.Tag) ]
$"{selectWithCriteria Table.TagMap} ORDER BY data ->> 'tag'"
[ webLogContains webLogId ]
fromData<TagMap>
/// Find any tag mappings in a list of tags for the given web log /// Find any tag mappings in a list of tags for the given web log
let findMappingForTags tags webLogId = let findMappingForTags (tags: string list) webLogId =
log.LogTrace "TagMap.findMappingForTags" log.LogTrace "TagMap.findMappingForTags"
let tagSql, tagParam = arrayContains (nameof TagMap.Empty.Tag) id tags let tagField = Field.InArray (nameof TagMap.Empty.Tag) Table.TagMap tags
Custom.list Custom.list
$"{selectWithCriteria Table.TagMap} AND {tagSql}" $"{selectWithCriteria Table.TagMap} AND {Query.whereByFields All [ tagField ]}"
[ webLogContains webLogId; tagParam ] (addFieldParams [ tagField ] [ webLogContains webLogId ])
fromData<TagMap> fromData<TagMap>
/// Save a tag mapping /// Save a tag mapping

16
src/MyWebLog.Data/Postgres/PostgresThemeData.fs

@ -17,11 +17,11 @@ type PostgresThemeData(log: ILogger) =
/// Retrieve all themes (except 'admin'; excludes template text) /// Retrieve all themes (except 'admin'; excludes template text)
let all () = let all () =
log.LogTrace "Theme.all" log.LogTrace "Theme.all"
let fields = [ Field.NotEqual (nameof Theme.Empty.Id) "admin" ]
Custom.list Custom.list
$"{Query.selectFromTable Table.Theme} (Query.byFields (Query.find Table.Theme) Any fields
WHERE data ->> '{nameof Theme.Empty.Id}' <> 'admin' + Query.orderBy [ Field.Named (nameof Theme.Empty.Id) ] PostgreSQL)
ORDER BY data ->> '{nameof Theme.Empty.Id}'" (addFieldParams fields [])
[]
withoutTemplateText withoutTemplateText
/// Does a given theme exist? /// Does a given theme exist?
@ -37,7 +37,7 @@ type PostgresThemeData(log: ILogger) =
/// Find a theme by its ID (excludes the text of templates) /// Find a theme by its ID (excludes the text of templates)
let findByIdWithoutText (themeId: ThemeId) = let findByIdWithoutText (themeId: ThemeId) =
log.LogTrace "Theme.findByIdWithoutText" log.LogTrace "Theme.findByIdWithoutText"
Custom.single (Query.Find.byId Table.Theme) [ idParam themeId ] withoutTemplateText Custom.single (Query.byId (Query.find Table.Theme) (string themeId)) [ idParam themeId ] withoutTemplateText
/// Delete a theme by its ID /// Delete a theme by its ID
let delete themeId = backgroundTask { let delete themeId = backgroundTask {
@ -45,8 +45,8 @@ type PostgresThemeData(log: ILogger) =
match! exists themeId with match! exists themeId with
| true -> | true ->
do! Custom.nonQuery do! Custom.nonQuery
$"""DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id; $"""{Query.delete Table.ThemeAsset} WHERE theme_id = @id;
DELETE FROM {Table.Theme} WHERE {Query.whereById "@id"}""" {Query.delete Table.Theme} WHERE {Query.whereById "@id"}"""
[ idParam themeId ] [ idParam themeId ]
return true return true
| false -> return false | false -> return false
@ -77,7 +77,7 @@ type PostgresThemeAssetData(log: ILogger) =
/// Delete all assets for the given theme /// Delete all assets for the given theme
let deleteByTheme (themeId: ThemeId) = let deleteByTheme (themeId: ThemeId) =
log.LogTrace "ThemeAsset.deleteByTheme" log.LogTrace "ThemeAsset.deleteByTheme"
Custom.nonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ] Custom.nonQuery $"{Query.delete Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ]
/// Find a theme asset by its ID /// Find a theme asset by its ID
let findById assetId = let findById assetId =

32
src/MyWebLog.Data/Postgres/PostgresWebLogData.fs

@ -23,22 +23,22 @@ type PostgresWebLogData(log: ILogger) =
let delete webLogId = let delete webLogId =
log.LogTrace "WebLog.delete" log.LogTrace "WebLog.delete"
Custom.nonQuery Custom.nonQuery
$"""DELETE FROM {Table.PostComment} $"""{Query.delete Table.PostComment}
WHERE data ->> '{nameof Comment.Empty.PostId}' WHERE data->>'{nameof Comment.Empty.PostId}'
IN (SELECT data ->> '{nameof Post.Empty.Id}' IN (SELECT data->>'{nameof Post.Empty.Id}'
FROM {Table.Post} FROM {Table.Post}
WHERE {Query.whereDataContains "@criteria"}); WHERE {Query.whereDataContains "@criteria"});
DELETE FROM {Table.PostRevision} {Query.delete Table.PostRevision}
WHERE post_id IN (SELECT data ->> 'Id' FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"}); WHERE post_id IN (SELECT data->>'Id' FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"});
DELETE FROM {Table.PageRevision} {Query.delete Table.PageRevision}
WHERE page_id IN (SELECT data ->> 'Id' FROM {Table.Page} WHERE {Query.whereDataContains "@criteria"}); WHERE page_id IN (SELECT data->>'Id' FROM {Table.Page} WHERE {Query.whereDataContains "@criteria"});
{Query.Delete.byContains Table.Post}; {Query.byContains (Query.delete Table.Post)};
{Query.Delete.byContains Table.Page}; {Query.byContains (Query.delete Table.Page)};
{Query.Delete.byContains Table.Category}; {Query.byContains (Query.delete Table.Category)};
{Query.Delete.byContains Table.TagMap}; {Query.byContains (Query.delete Table.TagMap)};
{Query.Delete.byContains Table.WebLogUser}; {Query.byContains (Query.delete Table.WebLogUser)};
DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId; {Query.delete Table.Upload} WHERE web_log_id = @webLogId;
DELETE FROM {Table.WebLog} WHERE {Query.whereById "@webLogId"}""" {Query.delete Table.WebLog} WHERE data->>'Id' = @webLogId"""
[ webLogIdParam webLogId; webLogContains webLogId ] [ webLogIdParam webLogId; webLogContains webLogId ]
/// Find a web log by its host (URL base) /// Find a web log by its host (URL base)

12
src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs

@ -49,19 +49,17 @@ type PostgresWebLogUserData(log: ILogger) =
/// Get all users for the given web log /// Get all users for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
log.LogTrace "WebLogUser.findByWebLog" log.LogTrace "WebLogUser.findByWebLog"
Custom.list Find.byContainsOrdered<WebLogUser>
$"{selectWithCriteria Table.WebLogUser} ORDER BY LOWER(data ->> '{nameof WebLogUser.Empty.PreferredName}')" Table.WebLogUser (webLogDoc webLogId) [ Field.Named $"i:{nameof WebLogUser.Empty.PreferredName}" ]
[ webLogContains webLogId ]
fromData<WebLogUser>
/// Find the names of users by their IDs for the given web log /// Find the names of users by their IDs for the given web log
let findNames webLogId (userIds: WebLogUserId list) = backgroundTask { let findNames webLogId (userIds: WebLogUserId list) = backgroundTask {
log.LogTrace "WebLogUser.findNames" log.LogTrace "WebLogUser.findNames"
let idSql, idParams = inClause $"AND data ->> '{nameof WebLogUser.Empty.Id}'" "id" userIds let idField = Field.In (nameof WebLogUser.Empty.Id) (List.map string userIds)
let! users = let! users =
Custom.list Custom.list
$"{selectWithCriteria Table.WebLogUser} {idSql}" $"{selectWithCriteria Table.WebLogUser} AND {Query.whereByFields All [ idField ]}"
(webLogContains webLogId :: idParams) (addFieldParams [ idField ] [ webLogContains webLogId ])
fromData<WebLogUser> fromData<WebLogUser>
return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName }) return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName })
} }

55
src/MyWebLog.Data/PostgresData.fs

@ -25,7 +25,7 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
// Theme tables // Theme tables
if needsTable Table.Theme then if needsTable Table.Theme then
Query.Definition.ensureTable Table.Theme Query.Definition.ensureTable Table.Theme
Query.Definition.ensureKey Table.Theme Query.Definition.ensureKey Table.Theme PostgreSQL
if needsTable Table.ThemeAsset then if needsTable Table.ThemeAsset then
$"CREATE TABLE {Table.ThemeAsset} ( $"CREATE TABLE {Table.ThemeAsset} (
theme_id TEXT NOT NULL, theme_id TEXT NOT NULL,
@ -37,28 +37,28 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
// Web log table // Web log table
if needsTable Table.WebLog then if needsTable Table.WebLog then
Query.Definition.ensureTable Table.WebLog Query.Definition.ensureTable Table.WebLog
Query.Definition.ensureKey Table.WebLog Query.Definition.ensureKey Table.WebLog PostgreSQL
Query.Definition.ensureDocumentIndex Table.WebLog Optimized Query.Definition.ensureDocumentIndex Table.WebLog Optimized
// Category table // Category table
if needsTable Table.Category then if needsTable Table.Category then
Query.Definition.ensureTable Table.Category Query.Definition.ensureTable Table.Category
Query.Definition.ensureKey Table.Category Query.Definition.ensureKey Table.Category PostgreSQL
Query.Definition.ensureDocumentIndex Table.Category Optimized Query.Definition.ensureDocumentIndex Table.Category Optimized
// Web log user table // Web log user table
if needsTable Table.WebLogUser then if needsTable Table.WebLogUser then
Query.Definition.ensureTable Table.WebLogUser Query.Definition.ensureTable Table.WebLogUser
Query.Definition.ensureKey Table.WebLogUser Query.Definition.ensureKey Table.WebLogUser PostgreSQL
Query.Definition.ensureDocumentIndex Table.WebLogUser Optimized Query.Definition.ensureDocumentIndex Table.WebLogUser Optimized
// Page tables // Page tables
if needsTable Table.Page then if needsTable Table.Page then
Query.Definition.ensureTable Table.Page Query.Definition.ensureTable Table.Page
Query.Definition.ensureKey Table.Page Query.Definition.ensureKey Table.Page PostgreSQL
Query.Definition.ensureIndexOn Table.Page "author" [ nameof Page.Empty.AuthorId ] Query.Definition.ensureIndexOn Table.Page "author" [ nameof Page.Empty.AuthorId ] PostgreSQL
Query.Definition.ensureIndexOn Query.Definition.ensureIndexOn
Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ] Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ] PostgreSQL
if needsTable Table.PageRevision then if needsTable Table.PageRevision then
$"CREATE TABLE {Table.PageRevision} ( $"CREATE TABLE {Table.PageRevision} (
page_id TEXT NOT NULL, page_id TEXT NOT NULL,
@ -69,14 +69,15 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
// Post tables // Post tables
if needsTable Table.Post then if needsTable Table.Post then
Query.Definition.ensureTable Table.Post Query.Definition.ensureTable Table.Post
Query.Definition.ensureKey Table.Post Query.Definition.ensureKey Table.Post PostgreSQL
Query.Definition.ensureIndexOn Table.Post "author" [ nameof Post.Empty.AuthorId ] Query.Definition.ensureIndexOn Table.Post "author" [ nameof Post.Empty.AuthorId ] PostgreSQL
Query.Definition.ensureIndexOn Query.Definition.ensureIndexOn
Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ] Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ] PostgreSQL
Query.Definition.ensureIndexOn Query.Definition.ensureIndexOn
Table.Post Table.Post
"status" "status"
[ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ] [ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ]
PostgreSQL
$"CREATE INDEX idx_post_category ON {Table.Post} USING GIN ((data['{nameof Post.Empty.CategoryIds}']))" $"CREATE INDEX idx_post_category ON {Table.Post} USING GIN ((data['{nameof Post.Empty.CategoryIds}']))"
$"CREATE INDEX idx_post_tag ON {Table.Post} USING GIN ((data['{nameof Post.Empty.Tags}']))" $"CREATE INDEX idx_post_tag ON {Table.Post} USING GIN ((data['{nameof Post.Empty.Tags}']))"
if needsTable Table.PostRevision then if needsTable Table.PostRevision then
@ -87,13 +88,13 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
PRIMARY KEY (post_id, as_of))" PRIMARY KEY (post_id, as_of))"
if needsTable Table.PostComment then if needsTable Table.PostComment then
Query.Definition.ensureTable Table.PostComment Query.Definition.ensureTable Table.PostComment
Query.Definition.ensureKey Table.PostComment Query.Definition.ensureKey Table.PostComment PostgreSQL
Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ] Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ] PostgreSQL
// Tag map table // Tag map table
if needsTable Table.TagMap then if needsTable Table.TagMap then
Query.Definition.ensureTable Table.TagMap Query.Definition.ensureTable Table.TagMap
Query.Definition.ensureKey Table.TagMap Query.Definition.ensureKey Table.TagMap PostgreSQL
Query.Definition.ensureDocumentIndex Table.TagMap Optimized Query.Definition.ensureDocumentIndex Table.TagMap Optimized
// Uploaded file table // Uploaded file table
@ -153,7 +154,8 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
Table.WebLogUser ] Table.WebLogUser ]
Utils.Migration.logStep log migration "Adding unique indexes on ID fields" Utils.Migration.logStep log migration "Adding unique indexes on ID fields"
do! Custom.nonQuery (tables |> List.map Query.Definition.ensureKey |> String.concat "; ") [] do! Custom.nonQuery
(tables |> List.map (fun it -> Query.Definition.ensureKey it PostgreSQL) |> String.concat "; ") []
Utils.Migration.logStep log migration "Removing constraints" Utils.Migration.logStep log migration "Removing constraints"
let fkToDrop = let fkToDrop =
@ -187,24 +189,25 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
Utils.Migration.logStep log migration "Adding new indexes" Utils.Migration.logStep log migration "Adding new indexes"
let newIdx = let newIdx =
[ yield! tables |> List.map Query.Definition.ensureKey [ yield! tables |> List.map (fun it -> Query.Definition.ensureKey it PostgreSQL)
Query.Definition.ensureDocumentIndex Table.Category Optimized Query.Definition.ensureDocumentIndex Table.Category Optimized
Query.Definition.ensureDocumentIndex Table.TagMap Optimized Query.Definition.ensureDocumentIndex Table.TagMap Optimized
Query.Definition.ensureDocumentIndex Table.WebLog Optimized Query.Definition.ensureDocumentIndex Table.WebLog Optimized
Query.Definition.ensureDocumentIndex Table.WebLogUser Optimized Query.Definition.ensureDocumentIndex Table.WebLogUser Optimized
Query.Definition.ensureIndexOn Table.Page "author" [ nameof Page.Empty.AuthorId ] Query.Definition.ensureIndexOn Table.Page "author" [ nameof Page.Empty.AuthorId ] PostgreSQL
Query.Definition.ensureIndexOn Query.Definition.ensureIndexOn
Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ] Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ] PostgreSQL
Query.Definition.ensureIndexOn Table.Post "author" [ nameof Post.Empty.AuthorId ] Query.Definition.ensureIndexOn Table.Post "author" [ nameof Post.Empty.AuthorId ] PostgreSQL
Query.Definition.ensureIndexOn Query.Definition.ensureIndexOn
Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ] Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ] PostgreSQL
Query.Definition.ensureIndexOn Query.Definition.ensureIndexOn
Table.Post Table.Post
"status" "status"
[ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ] [ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ]
PostgreSQL
$"CREATE INDEX idx_post_category ON {Table.Post} USING GIN ((data['{nameof Post.Empty.CategoryIds}']))" $"CREATE INDEX idx_post_category ON {Table.Post} USING GIN ((data['{nameof Post.Empty.CategoryIds}']))"
$"CREATE INDEX idx_post_tag ON {Table.Post} USING GIN ((data['{nameof Post.Empty.Tags}']))" $"CREATE INDEX idx_post_tag ON {Table.Post} USING GIN ((data['{nameof Post.Empty.Tags}']))"
Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ] ] Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ] PostgreSQL ]
do! Custom.nonQuery (newIdx |> String.concat "; ") [] do! Custom.nonQuery (newIdx |> String.concat "; ") []
Utils.Migration.logStep log migration "Setting database to version 2.1.1" Utils.Migration.logStep log migration "Setting database to version 2.1.1"
@ -221,6 +224,14 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
return! setDbVersion "v2.2" return! setDbVersion "v2.2"
} }
/// Migrate from v2.2 to v3
let migrateV2point2ToV3 () = backgroundTask {
Utils.Migration.logStep log "v2.2 to v3" "Adding auto-OpenGraph flag to all web logs"
do! Patch.byFields Table.WebLog Any [ Field.Exists (nameof WebLog.Empty.Id) ] {| AutoOpenGraph = true |}
Utils.Migration.logStep log "v2.2 to v3" "Setting database version to v3"
return! setDbVersion "v3"
}
/// Do required data migration between versions /// Do required data migration between versions
let migrate version = backgroundTask { let migrate version = backgroundTask {
let mutable v = defaultArg version "" let mutable v = defaultArg version ""
@ -240,6 +251,10 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
let! ver = migrateV2point1point1ToV2point2 () let! ver = migrateV2point1point1ToV2point2 ()
v <- ver v <- ver
if v = "v2.2" then
let! ver = migrateV2point2ToV3 ()
v <- ver
if v <> Utils.Migration.currentDbVersion then if v <> Utils.Migration.currentDbVersion then
log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}" log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}"
let! _ = setDbVersion Utils.Migration.currentDbVersion let! _ = setDbVersion Utils.Migration.currentDbVersion

27
src/MyWebLog.Data/RethinkDbData.fs

@ -256,6 +256,18 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
do! setDbVersion "v2.2" do! setDbVersion "v2.2"
} }
/// Migrate from v2.2 to v3
let migrateV2point2ToV3 () = backgroundTask {
Utils.Migration.logStep log "v2.2 to v3" "Adding auto-OpenGraph flag to all web logs"
do! rethink {
withTable Table.WebLog
update [ nameof WebLog.Empty.AutoOpenGraph, true :> obj ]
write; withRetryOnce; ignoreResult conn
}
Utils.Migration.logStep log "v2.2 to v3" "Setting database version to v3"
do! setDbVersion "v3"
}
/// Migrate data between versions /// Migrate data between versions
let migrate version = backgroundTask { let migrate version = backgroundTask {
let mutable v = defaultArg version "" let mutable v = defaultArg version ""
@ -280,6 +292,10 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
do! migrateV2point1point1ToV2point2 () do! migrateV2point1point1ToV2point2 ()
v <- "v2.2" v <- "v2.2"
if v = "v2.2" then
do! migrateV2point2ToV3 ()
v <- "v3"
if v <> Utils.Migration.currentDbVersion then if v <> Utils.Migration.currentDbVersion then
log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}" log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}"
do! setDbVersion Utils.Migration.currentDbVersion do! setDbVersion Utils.Migration.currentDbVersion
@ -1234,8 +1250,15 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
log.LogInformation $"Creating table {tbl}..." log.LogInformation $"Creating table {tbl}..."
do! rethink { tableCreate tbl [ PrimaryKey "Id" ]; write; withRetryOnce; ignoreResult conn } do! rethink { tableCreate tbl [ PrimaryKey "Id" ]; write; withRetryOnce; ignoreResult conn }
if not (List.contains Table.DbVersion tables) then if List.isEmpty tables then
// Version table added in v2-rc2; this will flag that migration to be run // New install; set version to current version
do! rethink {
withTable Table.DbVersion
insert {| Id = Utils.Migration.currentDbVersion |}
write; withRetryOnce; ignoreResult conn
}
elif not (List.contains Table.DbVersion tables) then
// Other tables, but not version, added in v2-rc2; this will flag that migration to be run
do! rethink { do! rethink {
withTable Table.DbVersion withTable Table.DbVersion
insert {| Id = "v2-rc1" |} insert {| Id = "v2-rc1" |}

61
src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs

@ -16,22 +16,23 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer, log: ILogge
let parentIdField = nameof Category.Empty.ParentId let parentIdField = nameof Category.Empty.ParentId
/// Count all categories for the given web log /// Count all categories for the given web log
let countAll webLogId = let countAll webLogId = backgroundTask {
log.LogTrace "Category.countAll" log.LogTrace "Category.countAll"
Document.countByWebLog Table.Category webLogId conn let! count = conn.countByFields Table.Category Any [ webLogField webLogId ]
return int count
}
/// Count all top-level categories for the given web log /// Count all top-level categories for the given web log
let countTopLevel webLogId = let countTopLevel webLogId = backgroundTask {
log.LogTrace "Category.countTopLevel" log.LogTrace "Category.countTopLevel"
conn.customScalar let! count = conn.countByFields Table.Category All [ webLogField webLogId; Field.NotExists parentIdField ]
$"{Document.Query.countByWebLog Table.Category} AND data ->> '{parentIdField}' IS NULL" return int count
[ webLogParam webLogId ] }
(toCount >> int)
/// Find all categories for the given web log /// Find all categories for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
log.LogTrace "Category.findByWebLog" log.LogTrace "Category.findByWebLog"
Document.findByWebLog<Category> Table.Category webLogId conn conn.findByFields<Category> Table.Category Any [ webLogField webLogId ]
/// Retrieve all categories for the given web log in a DotLiquid-friendly format /// Retrieve all categories for the given web log in a DotLiquid-friendly format
let findAllForView webLogId = backgroundTask { let findAllForView webLogId = backgroundTask {
@ -42,20 +43,18 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer, log: ILogge
ordered ordered
|> Seq.map (fun it -> backgroundTask { |> Seq.map (fun it -> backgroundTask {
// Parent category post counts include posts in subcategories // Parent category post counts include posts in subcategories
let catSql, catParams = let childField =
ordered ordered
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name) |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|> Seq.map _.Id |> Seq.map _.Id
|> Seq.append (Seq.singleton it.Id) |> Seq.append (Seq.singleton it.Id)
|> List.ofSeq |> Field.InArray (nameof Post.Empty.CategoryIds) Table.Post
|> inJsonArray Table.Post (nameof Post.Empty.CategoryIds) "catId" let fields =
let query = $""" [ webLogField webLogId; Field.Equal (nameof Post.Empty.Status) (string Published); childField ]
SELECT COUNT(DISTINCT data ->> '{nameof Post.Empty.Id}') let query =
FROM {Table.Post} (Query.statementWhere (Query.count Table.Post) (Query.whereByFields All fields))
WHERE {Document.Query.whereByWebLog} .Replace("(*)", $"(DISTINCT data->>'{nameof Post.Empty.Id}')")
AND {Query.whereByField (Field.EQ (nameof Post.Empty.Status) "") $"'{string Published}'"} let! postCount = conn.customScalar query (addFieldParams fields []) toCount
AND {catSql}"""
let! postCount = conn.customScalar query (webLogParam webLogId :: catParams) toCount
return it.Id, int postCount return it.Id, int postCount
}) })
|> Task.WhenAll |> Task.WhenAll
@ -69,9 +68,9 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer, log: ILogge
} }
/// Find a category by its ID for the given web log /// Find a category by its ID for the given web log
let findById catId webLogId = let findById (catId: CategoryId) webLogId =
log.LogTrace "Category.findById" log.LogTrace "Category.findById"
Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId webLogId conn conn.findFirstByFields<Category> Table.Category All [ idField catId; webLogField webLogId ]
/// Delete a category /// Delete a category
let delete catId webLogId = backgroundTask { let delete catId webLogId = backgroundTask {
@ -79,24 +78,22 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer, log: ILogge
match! findById catId webLogId with match! findById catId webLogId with
| Some cat -> | Some cat ->
// Reassign any children to the category's parent category // Reassign any children to the category's parent category
let! children = conn.countByField Table.Category (Field.EQ parentIdField (string catId)) let! children = conn.countByFields Table.Category Any [ Field.Equal parentIdField (string catId) ]
if children > 0L then if children > 0L then
let parent = Field.EQ parentIdField (string catId) let parent = [ Field.Equal parentIdField (string catId) ]
match cat.ParentId with match cat.ParentId with
| Some _ -> do! conn.patchByField Table.Category parent {| ParentId = cat.ParentId |} | Some _ -> do! conn.patchByFields Table.Category Any parent {| ParentId = cat.ParentId |}
| None -> do! conn.removeFieldsByField Table.Category parent [ parentIdField ] | None -> do! conn.removeFieldsByFields Table.Category Any parent [ parentIdField ]
// Delete the category off all posts where it is assigned, and the category itself // Delete the category off all posts where it is assigned, and the category itself
let catIdField = nameof Post.Empty.CategoryIds let catIdField = nameof Post.Empty.CategoryIds
let fields = [ webLogField webLogId; Field.InArray catIdField Table.Post [ string catId ] ]
let query =
(Query.statementWhere (Query.find Table.Post) (Query.whereByFields All fields))
.Replace("SELECT data", $"SELECT data->>'{nameof Post.Empty.Id}', data->'{catIdField}'")
let! posts = let! posts =
conn.customList conn.customList
$"SELECT data ->> '{nameof Post.Empty.Id}', data -> '{catIdField}' query
FROM {Table.Post} (addFieldParams fields [])
WHERE {Document.Query.whereByWebLog}
AND EXISTS
(SELECT 1
FROM json_each({Table.Post}.data -> '{catIdField}')
WHERE json_each.value = @id)"
[ idParam catId; webLogParam webLogId ]
(fun rdr -> rdr.GetString 0, Utils.deserialize<string list> ser (rdr.GetString 1)) (fun rdr -> rdr.GetString 0, Utils.deserialize<string list> ser (rdr.GetString 1))
for postId, cats in posts do for postId, cats in posts do
do! conn.patchById do! conn.patchById

104
src/MyWebLog.Data/SQLite/SQLiteHelpers.fs

@ -82,39 +82,6 @@ let instantParam =
let maybeInstant = let maybeInstant =
Option.map instantParam >> maybe Option.map instantParam >> maybe
/// Create the SQL and parameters for an EXISTS applied to a JSON array
let inJsonArray<'T> table jsonField paramName (items: 'T list) =
if List.isEmpty items then "", []
else
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS}, @%s{paramName}{idx}", (SqliteParameter($"@%s{paramName}{idx}", string it) :: itemP))
(Seq.ofList items
|> Seq.map (fun it -> $"(@%s{paramName}0", [ SqliteParameter($"@%s{paramName}0", string it) ])
|> Seq.head)
|> function
sql, ps ->
$"EXISTS (SELECT 1 FROM json_each(%s{table}.data, '$.%s{jsonField}') WHERE value IN {sql}))", ps
/// Create the SQL and parameters for an IN clause
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items: 'T list) =
if List.isEmpty items then "", []
else
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS}, @%s{paramName}{idx}", (SqliteParameter ($"@%s{paramName}{idx}", valueFunc it) :: itemP))
(Seq.ofList items
|> Seq.map (fun it ->
$"%s{colNameAndPrefix} IN (@%s{paramName}0", [ SqliteParameter ($"@%s{paramName}0", valueFunc it) ])
|> Seq.head)
|> function sql, ps -> $"{sql})", ps
/// Functions to map domain items from a data reader /// Functions to map domain items from a data reader
module Map = module Map =
@ -218,6 +185,8 @@ module Map =
Data = data } Data = data }
open BitBadger.Documents
/// Create a named parameter /// Create a named parameter
let sqlParam name (value: obj) = let sqlParam name (value: obj) =
SqliteParameter(name, value) SqliteParameter(name, value)
@ -226,82 +195,47 @@ let sqlParam name (value: obj) =
let webLogParam (webLogId: WebLogId) = let webLogParam (webLogId: WebLogId) =
sqlParam "@webLogId" (string webLogId) sqlParam "@webLogId" (string webLogId)
/// Create a field for an ID value
let idField<'T> (idValue: 'T) =
{ Field.Equal "Id" (string idValue) with ParameterName = Some "@id" }
/// Create a web log field
let webLogField (webLogId: WebLogId) =
{ Field.Equal "WebLogId" (string webLogId) with ParameterName = Some "@webLogId" }
open BitBadger.Documents
open BitBadger.Documents.Sqlite open BitBadger.Documents.Sqlite
open BitBadger.Documents.Sqlite.WithConn
/// Functions for manipulating documents
module Document =
/// Queries to assist with document manipulation
module Query =
/// Fragment to add a web log ID condition to a WHERE clause (parameter @webLogId)
let whereByWebLog =
Query.whereByField (Field.EQ "WebLogId" "") "@webLogId"
/// A SELECT query to count documents for a given web log ID
let countByWebLog table =
$"{Query.Count.all table} WHERE {whereByWebLog}"
/// A query to select from a table by the document's ID and its web log ID
let selectByIdAndWebLog table =
$"{Query.Find.byId table} AND {whereByWebLog}"
/// A query to select from a table by its web log ID
let selectByWebLog table =
$"{Query.selectFromTable table} WHERE {whereByWebLog}"
/// Count documents for the given web log ID
let countByWebLog table (webLogId: WebLogId) conn = backgroundTask {
let! count = Count.byField table (Field.EQ "WebLogId" (string webLogId)) conn
return int count
}
/// Find a document by its ID and web log ID
let findByIdAndWebLog<'TKey, 'TDoc> table (key: 'TKey) webLogId conn =
Custom.single (Query.selectByIdAndWebLog table) [ idParam key; webLogParam webLogId ] fromData<'TDoc> conn
/// Find documents for the given web log
let findByWebLog<'TDoc> table (webLogId: WebLogId) conn =
Find.byField<'TDoc> table (Field.EQ "WebLogId" (string webLogId)) conn
/// Functions to support revisions /// Functions to support revisions
module Revisions = module Revisions =
/// Find all revisions for the given entity /// Find all revisions for the given entity
let findByEntityId<'TKey> revTable entityTable (key: 'TKey) conn = let findByEntityId<'TKey> revTable entityTable (key: 'TKey) (conn: SqliteConnection) =
Custom.list conn.customList
$"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC" $"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC"
[ idParam key ] [ idParam key ]
Map.toRevision Map.toRevision
conn
/// Find all revisions for all posts for the given web log /// Find all revisions for all posts for the given web log
let findByWebLog<'TKey> revTable entityTable (keyFunc: string -> 'TKey) webLogId conn = let findByWebLog<'TKey> revTable entityTable (keyFunc: string -> 'TKey) webLogId (conn: SqliteConnection) =
Custom.list conn.customList
$"SELECT pr.* $"SELECT pr.*
FROM %s{revTable} pr FROM %s{revTable} pr
INNER JOIN %s{entityTable} p ON p.data ->> 'Id' = pr.{entityTable}_id INNER JOIN %s{entityTable} p ON p.data->>'Id' = pr.{entityTable}_id
WHERE p.{Document.Query.whereByWebLog} WHERE p.{Query.whereByFields Any [ webLogField webLogId ]}
ORDER BY as_of DESC" ORDER BY as_of DESC"
[ webLogParam webLogId ] [ webLogParam webLogId ]
(fun rdr -> keyFunc (Map.getString $"{entityTable}_id" rdr), Map.toRevision rdr) (fun rdr -> keyFunc (Map.getString $"{entityTable}_id" rdr), Map.toRevision rdr)
conn
/// Update a page or post's revisions /// Update a page or post's revisions
let update<'TKey> revTable entityTable (key: 'TKey) oldRevs newRevs conn = backgroundTask { let update<'TKey> revTable entityTable (key: 'TKey) oldRevs newRevs (conn: SqliteConnection) = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
for delRev in toDelete do for delRev in toDelete do
do! Custom.nonQuery do! conn.customNonQuery
$"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf" $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf"
[ idParam key; sqlParam "@asOf" (instantParam delRev.AsOf) ] [ idParam key; sqlParam "@asOf" (instantParam delRev.AsOf) ]
conn
for addRev in toAdd do for addRev in toAdd do
do! Custom.nonQuery do! conn.customNonQuery
$"INSERT INTO {revTable} VALUES (@id, @asOf, @text)" $"INSERT INTO {revTable} VALUES (@id, @asOf, @text)"
[ idParam key; sqlParam "asOf" (instantParam addRev.AsOf); sqlParam "@text" (string addRev.Text) ] [ idParam key; sqlParam "asOf" (instantParam addRev.AsOf); sqlParam "@text" (string addRev.Text) ]
conn
} }

70
src/MyWebLog.Data/SQLite/SQLitePageData.fs

@ -17,8 +17,10 @@ type SQLitePageData(conn: SqliteConnection, log: ILogger) =
/// The JSON field name for the "is in page list" flag /// The JSON field name for the "is in page list" flag
let pgListName = nameof Page.Empty.IsInPageList let pgListName = nameof Page.Empty.IsInPageList
/// The JSON field for the title of the page /// Query to return pages sorted by title
let titleField = $"data ->> '{nameof Page.Empty.Title}'" let sortedPages fields =
Query.byFields (Query.find Table.Page) All fields
+ Query.orderBy [ Field.Named $"i:{nameof Page.Empty.Title}" ] SQLite
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
@ -50,36 +52,38 @@ type SQLitePageData(conn: SqliteConnection, log: ILogger) =
/// Get all pages for a web log (without text, metadata, revisions, or prior permalinks) /// Get all pages for a web log (without text, metadata, revisions, or prior permalinks)
let all webLogId = let all webLogId =
log.LogTrace "Page.all" log.LogTrace "Page.all"
let field = [ webLogField webLogId ]
conn.customList conn.customList
$"{Query.selectFromTable Table.Page} WHERE {Document.Query.whereByWebLog} ORDER BY LOWER({titleField})" (sortedPages field)
[ webLogParam webLogId ] (addFieldParams field [])
(fun rdr -> { fromData<Page> rdr with Text = ""; Metadata = []; PriorPermalinks = [] }) (fun rdr -> { fromData<Page> rdr with Text = ""; Metadata = []; PriorPermalinks = [] })
/// Count all pages for the given web log /// Count all pages for the given web log
let countAll webLogId = let countAll webLogId = backgroundTask {
log.LogTrace "Page.countAll" log.LogTrace "Page.countAll"
Document.countByWebLog Table.Page webLogId conn let! count = conn.countByFields Table.Page Any [ webLogField webLogId ]
return int count
}
/// Count all pages shown in the page list for the given web log /// Count all pages shown in the page list for the given web log
let countListed webLogId = let countListed webLogId = backgroundTask {
log.LogTrace "Page.countListed" log.LogTrace "Page.countListed"
conn.customScalar let! count = conn.countByFields Table.Page All [ webLogField webLogId; Field.Equal pgListName true ]
$"""{Document.Query.countByWebLog Table.Page} AND {Query.whereByField (Field.EQ pgListName "") "true"}""" return int count
[ webLogParam webLogId ] }
(toCount >> int)
/// Find a page by its ID (without revisions and prior permalinks) /// Find a page by its ID (without revisions and prior permalinks)
let findById pageId webLogId = backgroundTask { let findById (pageId: PageId) webLogId = backgroundTask {
log.LogTrace "Page.findById" log.LogTrace "Page.findById"
match! Document.findByIdAndWebLog<PageId, Page> Table.Page pageId webLogId conn with match! conn.findFirstByFields<Page> Table.Page All [ idField pageId; webLogField webLogId ] with
| Some page -> return Some { page with PriorPermalinks = [] } | Some page -> return Some { page with PriorPermalinks = [] }
| None -> return None | None -> return None
} }
/// Find a complete page by its ID /// Find a complete page by its ID
let findFullById pageId webLogId = backgroundTask { let findFullById (pageId: PageId) webLogId = backgroundTask {
log.LogTrace "Page.findFullById" log.LogTrace "Page.findFullById"
match! Document.findByIdAndWebLog<PageId, Page> Table.Page pageId webLogId conn with match! conn.findFirstByFields<Page> Table.Page All [ idField pageId; webLogField webLogId ] with
| Some page -> | Some page ->
let! page = appendPageRevisions page let! page = appendPageRevisions page
return Some page return Some page
@ -93,7 +97,8 @@ type SQLitePageData(conn: SqliteConnection, log: ILogger) =
match! findById pageId webLogId with match! findById pageId webLogId with
| Some _ -> | Some _ ->
do! conn.customNonQuery do! conn.customNonQuery
$"DELETE FROM {Table.PageRevision} WHERE page_id = @id; {Query.Delete.byId Table.Page}" $"{Query.delete Table.PageRevision} WHERE page_id = @id;
{Query.byId (Query.delete Table.Page) (string pageId)}"
[ idParam pageId ] [ idParam pageId ]
return true return true
| None -> return false | None -> return false
@ -102,27 +107,25 @@ type SQLitePageData(conn: SqliteConnection, log: ILogger) =
/// Find a page by its permalink for the given web log /// Find a page by its permalink for the given web log
let findByPermalink (permalink: Permalink) webLogId = let findByPermalink (permalink: Permalink) webLogId =
log.LogTrace "Page.findByPermalink" log.LogTrace "Page.findByPermalink"
let linkParam = Field.EQ linkName (string permalink) let fields = [ webLogField webLogId; Field.Equal linkName (string permalink) ]
conn.customSingle conn.customSingle
$"""{Document.Query.selectByWebLog Table.Page} AND {Query.whereByField linkParam "@link"}""" (Query.byFields (Query.find Table.Page) All fields) (addFieldParams fields []) pageWithoutLinks
(addFieldParam "@link" linkParam [ webLogParam webLogId ])
pageWithoutLinks
/// Find the current permalink within a set of potential prior permalinks for the given web log /// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink (permalinks: Permalink list) webLogId = let findCurrentPermalink (permalinks: Permalink list) webLogId =
log.LogTrace "Page.findCurrentPermalink" log.LogTrace "Page.findCurrentPermalink"
let linkSql, linkParams = inJsonArray Table.Page (nameof Page.Empty.PriorPermalinks) "link" permalinks let fields =
conn.customSingle [ webLogField webLogId
$"SELECT data ->> '{linkName}' AS permalink Field.InArray (nameof Page.Empty.PriorPermalinks) Table.Page (List.map string permalinks) ]
FROM {Table.Page} let query =
WHERE {Document.Query.whereByWebLog} AND {linkSql}" (Query.statementWhere (Query.find Table.Page) (Query.whereByFields All fields))
(webLogParam webLogId :: linkParams) .Replace("SELECT data", $"SELECT data->>'{linkName}' AS permalink")
Map.toPermalink conn.customSingle query (addFieldParams fields []) Map.toPermalink
/// Get all complete pages for the given web log /// Get all complete pages for the given web log
let findFullByWebLog webLogId = backgroundTask { let findFullByWebLog webLogId = backgroundTask {
log.LogTrace "Page.findFullByWebLog" log.LogTrace "Page.findFullByWebLog"
let! pages = Document.findByWebLog<Page> Table.Page webLogId conn let! pages = conn.findByFields<Page> Table.Page Any [ webLogField webLogId ]
let! withRevs = pages |> List.map appendPageRevisions |> Task.WhenAll let! withRevs = pages |> List.map appendPageRevisions |> Task.WhenAll
return List.ofArray withRevs return List.ofArray withRevs
} }
@ -130,18 +133,17 @@ type SQLitePageData(conn: SqliteConnection, log: ILogger) =
/// Get all listed pages for the given web log (without revisions or text) /// Get all listed pages for the given web log (without revisions or text)
let findListed webLogId = let findListed webLogId =
log.LogTrace "Page.findListed" log.LogTrace "Page.findListed"
let fields = [ webLogField webLogId; Field.Equal pgListName true ]
conn.customList conn.customList
$"""{Document.Query.selectByWebLog Table.Page} AND {Query.whereByField (Field.EQ pgListName "") "true"} (sortedPages fields) (addFieldParams fields []) (fun rdr -> { fromData<Page> rdr with Text = "" })
ORDER BY LOWER({titleField})"""
[ webLogParam webLogId ]
(fun rdr -> { fromData<Page> rdr with Text = "" })
/// Get a page of pages for the given web log (without revisions) /// Get a page of pages for the given web log (without revisions)
let findPageOfPages webLogId pageNbr = let findPageOfPages webLogId pageNbr =
log.LogTrace "Page.findPageOfPages" log.LogTrace "Page.findPageOfPages"
let field = [ webLogField webLogId ]
conn.customList conn.customList
$"{Document.Query.selectByWebLog Table.Page} ORDER BY LOWER({titleField}) LIMIT @pageSize OFFSET @toSkip" $"{sortedPages field} LIMIT @pageSize OFFSET @toSkip"
[ webLogParam webLogId; SqliteParameter("@pageSize", 26); SqliteParameter("@toSkip", (pageNbr - 1) * 25) ] (addFieldParams field [ sqlParam "@pageSize" 26; sqlParam "@toSkip" ((pageNbr - 1) * 25) ])
(fun rdr -> { pageWithoutLinks rdr with Metadata = [] }) (fun rdr -> { pageWithoutLinks rdr with Metadata = [] })
/// Update a page /// Update a page

109
src/MyWebLog.Data/SQLite/SQLitePostData.fs

@ -16,7 +16,7 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
let linkName = nameof Post.Empty.Permalink let linkName = nameof Post.Empty.Permalink
/// The JSON field for when the post was published /// The JSON field for when the post was published
let publishField = $"data ->> '{nameof Post.Empty.PublishedOn}'" let publishName = nameof Post.Empty.PublishedOn
/// The name of the JSON field for the post's status /// The name of the JSON field for the post's status
let statName = nameof Post.Empty.Status let statName = nameof Post.Empty.Status
@ -31,7 +31,10 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
} }
/// The SELECT statement to retrieve posts with a web log ID parameter /// The SELECT statement to retrieve posts with a web log ID parameter
let postByWebLog = Document.Query.selectByWebLog Table.Post let postByWebLog =
Query.statementWhere
(Query.find Table.Post)
(Query.whereByFields Any [ { Field.Equal "WebLogId" "" with ParameterName = Some "@webLogId" } ])
/// Return a post with no revisions or prior permalinks /// Return a post with no revisions or prior permalinks
let postWithoutLinks rdr = let postWithoutLinks rdr =
@ -43,7 +46,7 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
/// The SELECT statement to retrieve published posts with a web log ID parameter /// The SELECT statement to retrieve published posts with a web log ID parameter
let publishedPostByWebLog = let publishedPostByWebLog =
$"""{postByWebLog} AND {Query.whereByField (Field.EQ statName "") $"'{string Published}'"}""" $"{postByWebLog} AND data->>'{statName}' = '{string Published}'"
/// Update a post's revisions /// Update a post's revisions
let updatePostRevisions (postId: PostId) oldRevs newRevs = let updatePostRevisions (postId: PostId) oldRevs newRevs =
@ -60,18 +63,16 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
} }
/// Count posts in a status for the given web log /// Count posts in a status for the given web log
let countByStatus (status: PostStatus) webLogId = let countByStatus (status: PostStatus) webLogId = backgroundTask {
log.LogTrace "Post.countByStatus" log.LogTrace "Post.countByStatus"
let statParam = Field.EQ statName (string status) let! count = conn.countByFields Table.Post All [ webLogField webLogId; Field.Equal statName (string status) ]
conn.customScalar return int count
$"""{Document.Query.countByWebLog Table.Post} AND {Query.whereByField statParam "@status"}""" }
(addFieldParam "@status" statParam [ webLogParam webLogId ])
(toCount >> int)
/// Find a post by its ID for the given web log (excluding revisions) /// Find a post by its ID for the given web log (excluding revisions)
let findById postId webLogId = backgroundTask { let findById (postId: PostId) webLogId = backgroundTask {
log.LogTrace "Post.findById" log.LogTrace "Post.findById"
match! Document.findByIdAndWebLog<PostId, Post> Table.Post postId webLogId conn with match! conn.findFirstByFields<Post> Table.Post All [ idField postId; webLogField webLogId ] with
| Some post -> return Some { post with PriorPermalinks = [] } | Some post -> return Some { post with PriorPermalinks = [] }
| None -> return None | None -> return None
} }
@ -79,16 +80,14 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
/// Find a post by its permalink for the given web log (excluding revisions) /// Find a post by its permalink for the given web log (excluding revisions)
let findByPermalink (permalink: Permalink) webLogId = let findByPermalink (permalink: Permalink) webLogId =
log.LogTrace "Post.findByPermalink" log.LogTrace "Post.findByPermalink"
let linkParam = Field.EQ linkName (string permalink) let fields = [ webLogField webLogId; Field.Equal linkName (string permalink) ]
conn.customSingle conn.customSingle
$"""{Document.Query.selectByWebLog Table.Post} AND {Query.whereByField linkParam "@link"}""" (Query.byFields (Query.find Table.Post) All fields) (addFieldParams fields []) postWithoutLinks
(addFieldParam "@link" linkParam [ webLogParam webLogId ])
postWithoutLinks
/// Find a complete post by its ID for the given web log /// Find a complete post by its ID for the given web log
let findFullById postId webLogId = backgroundTask { let findFullById postId webLogId = backgroundTask {
log.LogTrace "Post.findFullById" log.LogTrace "Post.findFullById"
match! Document.findByIdAndWebLog<PostId, Post> Table.Post postId webLogId conn with match! conn.findFirstByFields<Post> Table.Post All [ idField postId; webLogField webLogId ] with
| Some post -> | Some post ->
let! post = appendPostRevisions post let! post = appendPostRevisions post
return Some post return Some post
@ -101,10 +100,12 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
match! findById postId webLogId with match! findById postId webLogId with
| Some _ -> | Some _ ->
do! conn.customNonQuery do! conn.customNonQuery
$"""DELETE FROM {Table.PostRevision} WHERE post_id = @id; $"""{Query.delete Table.PostRevision} WHERE post_id = @id;
DELETE FROM {Table.PostComment} {Query.byFields
WHERE {Query.whereByField (Field.EQ (nameof Comment.Empty.PostId) "") "@id"}; (Query.delete Table.PostComment)
{Query.Delete.byId Table.Post}""" Any
[ { Field.EQ (nameof Comment.Empty.PostId) postId with ParameterName = Some "@id" }]};
{Query.byId (Query.delete Table.Post) (string postId)}"""
[ idParam postId ] [ idParam postId ]
return true return true
| None -> return false | None -> return false
@ -113,18 +114,18 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
/// Find the current permalink from a list of potential prior permalinks for the given web log /// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink (permalinks: Permalink list) webLogId = let findCurrentPermalink (permalinks: Permalink list) webLogId =
log.LogTrace "Post.findCurrentPermalink" log.LogTrace "Post.findCurrentPermalink"
let linkSql, linkParams = inJsonArray Table.Post (nameof Post.Empty.PriorPermalinks) "link" permalinks let fields =
conn.customSingle [ webLogField webLogId
$"SELECT data ->> '{linkName}' AS permalink Field.InArray (nameof Post.Empty.PriorPermalinks) Table.Post (List.map string permalinks) ]
FROM {Table.Post} let query =
WHERE {Document.Query.whereByWebLog} AND {linkSql}" (Query.statementWhere (Query.find Table.Post) (Query.whereByFields All fields))
(webLogParam webLogId :: linkParams) .Replace("SELECT data", $"SELECT data->>'{linkName}' AS permalink")
Map.toPermalink conn.customSingle query (addFieldParams fields []) Map.toPermalink
/// Get all complete posts for the given web log /// Get all complete posts for the given web log
let findFullByWebLog webLogId = backgroundTask { let findFullByWebLog webLogId = backgroundTask {
log.LogTrace "Post.findFullByWebLog" log.LogTrace "Post.findFullByWebLog"
let! posts = Document.findByWebLog<Post> Table.Post webLogId conn let! posts = conn.findByFields<Post> Table.Post Any [ webLogField webLogId ]
let! withRevs = posts |> List.map appendPostRevisions |> Task.WhenAll let! withRevs = posts |> List.map appendPostRevisions |> Task.WhenAll
return List.ofArray withRevs return List.ofArray withRevs
} }
@ -132,21 +133,22 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
/// Get a page of categorized posts for the given web log (excludes revisions) /// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage = let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage =
log.LogTrace "Post.findPageOfCategorizedPosts" log.LogTrace "Post.findPageOfCategorizedPosts"
let catSql, catParams = inJsonArray Table.Post (nameof Post.Empty.CategoryIds) "catId" categoryIds let catIdField = Field.InArray (nameof Post.Empty.CategoryIds) Table.Post (List.map string categoryIds)
conn.customList conn.customList
$"{publishedPostByWebLog} AND {catSql} $"""{publishedPostByWebLog} AND {Query.whereByFields Any [ catIdField ]}
ORDER BY {publishField} DESC {Query.orderBy [ Field.Named $"{publishName} DESC" ] SQLite}
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
(webLogParam webLogId :: catParams) (addFieldParams [ webLogField webLogId; catIdField ] [])
postWithoutLinks postWithoutLinks
/// Get a page of posts for the given web log (excludes text and revisions) /// Get a page of posts for the given web log (excludes text and revisions)
let findPageOfPosts webLogId pageNbr postsPerPage = let findPageOfPosts webLogId pageNbr postsPerPage =
log.LogTrace "Post.findPageOfPosts" log.LogTrace "Post.findPageOfPosts"
let order =
Query.orderBy
[ Field.Named $"{publishName} DESC NULLS FIRST"; Field.Named (nameof Post.Empty.UpdatedOn) ] SQLite
conn.customList conn.customList
$"{postByWebLog} $"{postByWebLog}{order} LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
ORDER BY {publishField} DESC NULLS FIRST, data ->> '{nameof Post.Empty.UpdatedOn}'
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ webLogParam webLogId ] [ webLogParam webLogId ]
postWithoutText postWithoutText
@ -154,36 +156,39 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
log.LogTrace "Post.findPageOfPublishedPosts" log.LogTrace "Post.findPageOfPublishedPosts"
conn.customList conn.customList
$"{publishedPostByWebLog} $"""{publishedPostByWebLog}
ORDER BY {publishField} DESC {Query.orderBy [ Field.Named $"{publishName} DESC" ] SQLite}
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
[ webLogParam webLogId ] [ webLogParam webLogId ]
postWithoutLinks postWithoutLinks
/// Get a page of tagged posts for the given web log (excludes revisions) /// Get a page of tagged posts for the given web log (excludes revisions)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage =
log.LogTrace "Post.findPageOfTaggedPosts" log.LogTrace "Post.findPageOfTaggedPosts"
let tagSql, tagParams = inJsonArray Table.Post (nameof Post.Empty.Tags) "tag" [ tag ] let tagField = Field.InArray (nameof Post.Empty.Tags) Table.Post [ tag ]
conn.customList conn.customList
$"{publishedPostByWebLog} AND {tagSql} $"""{publishedPostByWebLog} AND {Query.whereByFields Any [ tagField ]}
ORDER BY {publishField} DESC {Query.orderBy [ Field.Named $"{publishName} DESC" ] SQLite}
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
(webLogParam webLogId :: tagParams) (addFieldParams [ webLogField webLogId; tagField ] [])
postWithoutLinks postWithoutLinks
/// Find the next newest and oldest post from a publish date for the given web log /// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask { let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask {
log.LogTrace "Post.findSurroundingPosts" log.LogTrace "Post.findSurroundingPosts"
let! older = let adjacent op order =
let fields = [
webLogField webLogId
Field.Equal (nameof Post.Empty.Status) (string Published)
(if op = "<" then Field.Less else Field.Greater) publishName (instantParam publishedOn)
]
conn.customSingle conn.customSingle
$"{publishedPostByWebLog} AND {publishField} < @publishedOn ORDER BY {publishField} DESC LIMIT 1" (Query.byFields (Query.find Table.Post) All fields
[ webLogParam webLogId; SqliteParameter("@publishedOn", instantParam publishedOn) ] + Query.orderBy [ Field.Named (publishName + order) ] SQLite + " LIMIT 1")
postWithoutLinks (addFieldParams fields [])
let! newer =
conn.customSingle
$"{publishedPostByWebLog} AND {publishField} > @publishedOn ORDER BY {publishField} LIMIT 1"
[ webLogParam webLogId; SqliteParameter("@publishedOn", instantParam publishedOn) ]
postWithoutLinks postWithoutLinks
let! older = adjacent "<" " DESC"
let! newer = adjacent ">" ""
return older, newer return older, newer
} }

19
src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs

@ -11,9 +11,9 @@ open MyWebLog.Data
type SQLiteTagMapData(conn: SqliteConnection, log: ILogger) = type SQLiteTagMapData(conn: SqliteConnection, log: ILogger) =
/// Find a tag mapping by its ID for the given web log /// Find a tag mapping by its ID for the given web log
let findById tagMapId webLogId = let findById (tagMapId: TagMapId) webLogId =
log.LogTrace "TagMap.findById" log.LogTrace "TagMap.findById"
Document.findByIdAndWebLog<TagMapId, TagMap> Table.TagMap tagMapId webLogId conn conn.findFirstByFields<TagMap> Table.TagMap All [ idField tagMapId; webLogField webLogId ]
/// Delete a tag mapping for the given web log /// Delete a tag mapping for the given web log
let delete tagMapId webLogId = backgroundTask { let delete tagMapId webLogId = backgroundTask {
@ -28,25 +28,18 @@ type SQLiteTagMapData(conn: SqliteConnection, log: ILogger) =
/// Find a tag mapping by its URL value for the given web log /// Find a tag mapping by its URL value for the given web log
let findByUrlValue (urlValue: string) webLogId = let findByUrlValue (urlValue: string) webLogId =
log.LogTrace "TagMap.findByUrlValue" log.LogTrace "TagMap.findByUrlValue"
let urlParam = Field.EQ (nameof TagMap.Empty.UrlValue) urlValue conn.findFirstByFields<TagMap>
conn.customSingle Table.TagMap All [ webLogField webLogId; Field.Equal (nameof TagMap.Empty.UrlValue) urlValue ]
$"""{Document.Query.selectByWebLog Table.TagMap} AND {Query.whereByField urlParam "@urlValue"}"""
(addFieldParam "@urlValue" urlParam [ webLogParam webLogId ])
fromData<TagMap>
/// Get all tag mappings for the given web log /// Get all tag mappings for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
log.LogTrace "TagMap.findByWebLog" log.LogTrace "TagMap.findByWebLog"
Document.findByWebLog<TagMap> Table.TagMap webLogId conn conn.findByFields<TagMap> Table.TagMap Any [ webLogField webLogId ]
/// Find any tag mappings in a list of tags for the given web log /// Find any tag mappings in a list of tags for the given web log
let findMappingForTags (tags: string list) webLogId = let findMappingForTags (tags: string list) webLogId =
log.LogTrace "TagMap.findMappingForTags" log.LogTrace "TagMap.findMappingForTags"
let mapSql, mapParams = inClause $"AND data ->> '{nameof TagMap.Empty.Tag}'" "tag" id tags conn.findByFields<TagMap> Table.TagMap All [ webLogField webLogId; Field.In (nameof TagMap.Empty.Tag) tags ]
conn.customList
$"{Document.Query.selectByWebLog Table.TagMap} {mapSql}"
(webLogParam webLogId :: mapParams)
fromData<TagMap>
/// Save a tag mapping /// Save a tag mapping
let save (tagMap: TagMap) = let save (tagMap: TagMap) =

16
src/MyWebLog.Data/SQLite/SQLiteThemeData.fs

@ -10,8 +10,8 @@ open MyWebLog.Data
/// SQLite myWebLog theme data implementation /// SQLite myWebLog theme data implementation
type SQLiteThemeData(conn : SqliteConnection, log: ILogger) = type SQLiteThemeData(conn : SqliteConnection, log: ILogger) =
/// The JSON field for the theme ID /// The name of the theme ID field
let idField = $"data ->> '{nameof Theme.Empty.Id}'" let idName = nameof Theme.Empty.Id
/// Convert a document to a theme with no template text /// Convert a document to a theme with no template text
let withoutTemplateText (rdr: SqliteDataReader) = let withoutTemplateText (rdr: SqliteDataReader) =
@ -25,9 +25,10 @@ type SQLiteThemeData(conn : SqliteConnection, log: ILogger) =
/// Retrieve all themes (except 'admin'; excludes template text) /// Retrieve all themes (except 'admin'; excludes template text)
let all () = let all () =
log.LogTrace "Theme.all" log.LogTrace "Theme.all"
let fields = [ Field.NE idName "admin" ]
conn.customList conn.customList
$"{Query.selectFromTable Table.Theme} WHERE {idField} <> 'admin' ORDER BY {idField}" (Query.byFields (Query.find Table.Theme) Any fields + Query.orderBy [ Field.Named idName ] SQLite)
[] (addFieldParams fields [])
withoutTemplateText withoutTemplateText
/// Does a given theme exist? /// Does a given theme exist?
@ -43,7 +44,7 @@ type SQLiteThemeData(conn : SqliteConnection, log: ILogger) =
/// Find a theme by its ID (excludes the text of templates) /// Find a theme by its ID (excludes the text of templates)
let findByIdWithoutText (themeId: ThemeId) = let findByIdWithoutText (themeId: ThemeId) =
log.LogTrace "Theme.findByIdWithoutText" log.LogTrace "Theme.findByIdWithoutText"
conn.customSingle (Query.Find.byId Table.Theme) [ idParam themeId ] withoutTemplateText conn.customSingle (Query.byId (Query.find Table.Theme) (string themeId)) [ idParam themeId ] withoutTemplateText
/// Delete a theme by its ID /// Delete a theme by its ID
let delete themeId = backgroundTask { let delete themeId = backgroundTask {
@ -51,7 +52,8 @@ type SQLiteThemeData(conn : SqliteConnection, log: ILogger) =
match! findByIdWithoutText themeId with match! findByIdWithoutText themeId with
| Some _ -> | Some _ ->
do! conn.customNonQuery do! conn.customNonQuery
$"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id; {Query.Delete.byId Table.Theme}" $"{Query.delete Table.ThemeAsset} WHERE theme_id = @id;
{Query.byId (Query.delete Table.Theme) (string themeId)}"
[ idParam themeId ] [ idParam themeId ]
return true return true
| None -> return false | None -> return false
@ -89,7 +91,7 @@ type SQLiteThemeAssetData(conn : SqliteConnection, log: ILogger) =
/// Delete all assets for the given theme /// Delete all assets for the given theme
let deleteByTheme (themeId: ThemeId) = let deleteByTheme (themeId: ThemeId) =
log.LogTrace "ThemeAsset.deleteByTheme" log.LogTrace "ThemeAsset.deleteByTheme"
conn.customNonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ] conn.customNonQuery $"{Query.delete Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ]
/// Find a theme asset by its ID /// Find a theme asset by its ID
let findById assetId = let findById assetId =

27
src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs

@ -23,25 +23,26 @@ type SQLiteWebLogData(conn: SqliteConnection, log: ILogger) =
/// Delete a web log by its ID /// Delete a web log by its ID
let delete webLogId = let delete webLogId =
log.LogTrace "WebLog.delete" log.LogTrace "WebLog.delete"
let webLogMatches = Query.whereByField (Field.EQ "WebLogId" "") "@webLogId" let webLogMatches =
let subQuery table = $"(SELECT data ->> 'Id' FROM {table} WHERE {webLogMatches})" Query.whereByFields Any [ { Field.Equal "WebLogId" "" with ParameterName = Some "@webLogId" } ]
let subQuery table = $"(SELECT data->>'Id' FROM {table} WHERE {webLogMatches})"
Custom.nonQuery Custom.nonQuery
$"""DELETE FROM {Table.PostComment} WHERE data ->> 'PostId' IN {subQuery Table.Post}; $"""{Query.delete Table.PostComment} WHERE data ->> 'PostId' IN {subQuery Table.Post};
DELETE FROM {Table.PostRevision} WHERE post_id IN {subQuery Table.Post}; {Query.delete Table.PostRevision} WHERE post_id IN {subQuery Table.Post};
DELETE FROM {Table.PageRevision} WHERE page_id IN {subQuery Table.Page}; {Query.delete Table.PageRevision} WHERE page_id IN {subQuery Table.Page};
DELETE FROM {Table.Post} WHERE {webLogMatches}; {Query.delete Table.Post} WHERE {webLogMatches};
DELETE FROM {Table.Page} WHERE {webLogMatches}; {Query.delete Table.Page} WHERE {webLogMatches};
DELETE FROM {Table.Category} WHERE {webLogMatches}; {Query.delete Table.Category} WHERE {webLogMatches};
DELETE FROM {Table.TagMap} WHERE {webLogMatches}; {Query.delete Table.TagMap} WHERE {webLogMatches};
DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId; {Query.delete Table.WebLogUser} WHERE {webLogMatches};
DELETE FROM {Table.WebLogUser} WHERE {webLogMatches}; {Query.delete Table.Upload} WHERE web_log_id = @webLogId;
DELETE FROM {Table.WebLog} WHERE {Query.whereById "@webLogId"}""" {Query.delete Table.WebLog} WHERE data->>'Id' = @webLogId"""
[ webLogParam webLogId ] [ webLogParam webLogId ]
/// Find a web log by its host (URL base) /// Find a web log by its host (URL base)
let findByHost (url: string) = let findByHost (url: string) =
log.LogTrace "WebLog.findByHost" log.LogTrace "WebLog.findByHost"
conn.findFirstByField<WebLog> Table.WebLog (Field.EQ (nameof WebLog.Empty.UrlBase) url) conn.findFirstByFields<WebLog> Table.WebLog Any [ Field.Equal (nameof WebLog.Empty.UrlBase) url ]
/// Find a web log by its ID /// Find a web log by its ID
let findById webLogId = let findById webLogId =

26
src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs

@ -16,17 +16,18 @@ type SQLiteWebLogUserData(conn: SqliteConnection, log: ILogger) =
conn.insert<WebLogUser> Table.WebLogUser user conn.insert<WebLogUser> Table.WebLogUser user
/// Find a user by their ID for the given web log /// Find a user by their ID for the given web log
let findById userId webLogId = let findById (userId: WebLogUserId) webLogId =
log.LogTrace "WebLogUser.findById" log.LogTrace "WebLogUser.findById"
Document.findByIdAndWebLog<WebLogUserId, WebLogUser> Table.WebLogUser userId webLogId conn conn.findFirstByFields<WebLogUser> Table.WebLogUser All [ idField userId; webLogField webLogId ]
/// Delete a user if they have no posts or pages /// Delete a user if they have no posts or pages
let delete userId webLogId = backgroundTask { let delete userId webLogId = backgroundTask {
log.LogTrace "WebLogUser.delete" log.LogTrace "WebLogUser.delete"
match! findById userId webLogId with match! findById userId webLogId with
| Some _ -> | Some _ ->
let! pageCount = conn.countByField Table.Page (Field.EQ (nameof Page.Empty.AuthorId) (string userId)) let author = [ Field.Equal (nameof Page.Empty.AuthorId) (string userId) ]
let! postCount = conn.countByField Table.Post (Field.EQ (nameof Post.Empty.AuthorId) (string userId)) let! pageCount = conn.countByFields Table.Page Any author
let! postCount = conn.countByFields Table.Post Any author
if pageCount + postCount > 0 then if pageCount + postCount > 0 then
return Error "User has pages or posts; cannot delete" return Error "User has pages or posts; cannot delete"
else else
@ -38,27 +39,24 @@ type SQLiteWebLogUserData(conn: SqliteConnection, log: ILogger) =
/// Find a user by their e-mail address for the given web log /// Find a user by their e-mail address for the given web log
let findByEmail (email: string) webLogId = let findByEmail (email: string) webLogId =
log.LogTrace "WebLogUser.findByEmail" log.LogTrace "WebLogUser.findByEmail"
let emailParam = Field.EQ (nameof WebLogUser.Empty.Email) email conn.findFirstByFields
conn.customSingle Table.WebLogUser All [ webLogField webLogId; Field.Equal (nameof WebLogUser.Empty.Email) email ]
$"""{Document.Query.selectByWebLog Table.WebLogUser}
AND {Query.whereByField emailParam "@email"}"""
(addFieldParam "@email" emailParam [ webLogParam webLogId ])
fromData<WebLogUser>
/// Get all users for the given web log /// Get all users for the given web log
let findByWebLog webLogId = backgroundTask { let findByWebLog webLogId = backgroundTask {
log.LogTrace "WebLogUser.findByWebLog" log.LogTrace "WebLogUser.findByWebLog"
let! users = Document.findByWebLog<WebLogUser> Table.WebLogUser webLogId conn let! users = conn.findByFields<WebLogUser> Table.WebLogUser Any [ webLogField webLogId ]
return users |> List.sortBy _.PreferredName.ToLowerInvariant() return users |> List.sortBy _.PreferredName.ToLowerInvariant()
} }
/// Find the names of users by their IDs for the given web log /// Find the names of users by their IDs for the given web log
let findNames webLogId (userIds: WebLogUserId list) = let findNames webLogId (userIds: WebLogUserId list) =
log.LogTrace "WebLogUser.findNames" log.LogTrace "WebLogUser.findNames"
let nameSql, nameParams = inClause $"AND data ->> '{nameof WebLogUser.Empty.Id}'" "id" string userIds let fields = [ webLogField webLogId; Field.In (nameof WebLogUser.Empty.Id) (List.map string userIds) ]
let query = Query.statementWhere (Query.find Table.WebLogUser) (Query.whereByFields All fields)
conn.customList conn.customList
$"{Document.Query.selectByWebLog Table.WebLogUser} {nameSql}" query
(webLogParam webLogId :: nameParams) (addFieldParams fields [])
(fun rdr -> (fun rdr ->
let user = fromData<WebLogUser> rdr let user = fromData<WebLogUser> rdr
{ Name = string user.Id; Value = user.DisplayName }) { Name = string user.Id; Value = user.DisplayName })

148
src/MyWebLog.Data/SQLiteData.fs

@ -1,7 +1,6 @@
namespace MyWebLog.Data namespace MyWebLog.Data
open System open System
open System.Threading.Tasks
open BitBadger.Documents open BitBadger.Documents
open BitBadger.Documents.Sqlite open BitBadger.Documents.Sqlite
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
@ -24,98 +23,107 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
let needsTable table = let needsTable table =
not (List.contains table tables) not (List.contains table tables)
let jsonTable table = let creatingTable = "Creating {Table} table..."
$"{Query.Definition.ensureTable table}; {Query.Definition.ensureKey table}"
let tasks = // Theme tables
seq { if needsTable Table.Theme then
// Theme tables log.LogInformation(creatingTable, Table.Theme)
if needsTable Table.Theme then jsonTable Table.Theme do! conn.ensureTable Table.Theme
if needsTable Table.ThemeAsset then
if needsTable Table.ThemeAsset then
log.LogInformation(creatingTable, Table.ThemeAsset)
do! conn.customNonQuery
$"CREATE TABLE {Table.ThemeAsset} ( $"CREATE TABLE {Table.ThemeAsset} (
theme_id TEXT NOT NULL, theme_id TEXT NOT NULL,
path TEXT NOT NULL, path TEXT NOT NULL,
updated_on TEXT NOT NULL, updated_on TEXT NOT NULL,
data BLOB NOT NULL, data BLOB NOT NULL,
PRIMARY KEY (theme_id, path))" PRIMARY KEY (theme_id, path))" []
// Web log table // Web log table
if needsTable Table.WebLog then jsonTable Table.WebLog if needsTable Table.WebLog then
log.LogInformation(creatingTable, Table.WebLog)
do! conn.ensureTable Table.WebLog
// Category table // Category table
if needsTable Table.Category then if needsTable Table.Category then
$"""{jsonTable Table.Category}; log.LogInformation(creatingTable, Table.Category)
{Query.Definition.ensureIndexOn Table.Category "web_log" [ nameof Category.Empty.WebLogId ]}""" do! conn.ensureTable Table.Category
do! conn.ensureFieldIndex Table.Category "web_log" [ nameof Category.Empty.WebLogId ]
// Web log user table // Web log user table
if needsTable Table.WebLogUser then if needsTable Table.WebLogUser then
$"""{jsonTable Table.WebLogUser}; log.LogInformation(creatingTable, Table.WebLogUser)
{Query.Definition.ensureIndexOn do! conn.ensureTable Table.WebLogUser
Table.WebLogUser do! conn.ensureFieldIndex
"email" Table.WebLogUser "email" [ nameof WebLogUser.Empty.WebLogId; nameof WebLogUser.Empty.Email ]
[ nameof WebLogUser.Empty.WebLogId; nameof WebLogUser.Empty.Email ]}"""
// Page tables // Page tables
if needsTable Table.Page then if needsTable Table.Page then
$"""{jsonTable Table.Page}; log.LogInformation(creatingTable, Table.Page)
{Query.Definition.ensureIndexOn Table.Page "author" [ nameof Page.Empty.AuthorId ]}; do! conn.ensureTable Table.Page
{Query.Definition.ensureIndexOn do! conn.ensureFieldIndex Table.Page "author" [ nameof Page.Empty.AuthorId ]
Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ]}""" do! conn.ensureFieldIndex Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ]
if needsTable Table.PageRevision then
if needsTable Table.PageRevision then
log.LogInformation(creatingTable, Table.PageRevision)
do! conn.customNonQuery
$"CREATE TABLE {Table.PageRevision} ( $"CREATE TABLE {Table.PageRevision} (
page_id TEXT NOT NULL, page_id TEXT NOT NULL,
as_of TEXT NOT NULL, as_of TEXT NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (page_id, as_of))" PRIMARY KEY (page_id, as_of))" []
// Post tables // Post tables
if needsTable Table.Post then if needsTable Table.Post then
$"""{jsonTable Table.Post}; log.LogInformation(creatingTable, Table.Post)
{Query.Definition.ensureIndexOn Table.Post "author" [ nameof Post.Empty.AuthorId ]}; do! conn.ensureTable Table.Post
{Query.Definition.ensureIndexOn do! conn.ensureFieldIndex Table.Post "author" [ nameof Post.Empty.AuthorId ]
Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ]}; do! conn.ensureFieldIndex Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ]
{Query.Definition.ensureIndexOn do! conn.ensureFieldIndex
Table.Post Table.Post
"status" "status"
[ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ]}""" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ]
// TODO: index categories by post? // TODO: index categories by post?
if needsTable Table.PostRevision then
if needsTable Table.PostRevision then
log.LogInformation(creatingTable, Table.PostRevision)
do! conn.customNonQuery
$"CREATE TABLE {Table.PostRevision} ( $"CREATE TABLE {Table.PostRevision} (
post_id TEXT NOT NULL, post_id TEXT NOT NULL,
as_of TEXT NOT NULL, as_of TEXT NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (post_id, as_of))" PRIMARY KEY (post_id, as_of))" []
if needsTable Table.PostComment then
$"""{jsonTable Table.PostComment};
{Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ]}"""
// Tag map table if needsTable Table.PostComment then
if needsTable Table.TagMap then log.LogInformation(creatingTable, Table.PostComment)
$"""{jsonTable Table.TagMap}; do! conn.ensureTable Table.PostComment
{Query.Definition.ensureIndexOn do! conn.ensureFieldIndex Table.PostComment "post" [ nameof Comment.Empty.PostId ]
Table.TagMap "url" [ nameof TagMap.Empty.WebLogId; nameof TagMap.Empty.UrlValue ]}"""
// Uploaded file table // Tag map table
if needsTable Table.Upload then if needsTable Table.TagMap then
log.LogInformation(creatingTable, Table.TagMap)
do! conn.ensureTable Table.TagMap
do! conn.ensureFieldIndex Table.TagMap "url" [ nameof TagMap.Empty.WebLogId; nameof TagMap.Empty.UrlValue ]
// Uploaded file table
if needsTable Table.Upload then
log.LogInformation(creatingTable, Table.Upload)
do! conn.customNonQuery
$"CREATE TABLE {Table.Upload} ( $"CREATE TABLE {Table.Upload} (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL, web_log_id TEXT NOT NULL,
path TEXT NOT NULL, path TEXT NOT NULL,
updated_on TEXT NOT NULL, updated_on TEXT NOT NULL,
data BLOB NOT NULL); data BLOB NOT NULL);
CREATE INDEX idx_{Table.Upload}_path ON {Table.Upload} (web_log_id, path)" CREATE INDEX idx_{Table.Upload}_path ON {Table.Upload} (web_log_id, path)" []
// Database version table // Database version table
if needsTable Table.DbVersion then if needsTable Table.DbVersion then
log.LogInformation(creatingTable, Table.DbVersion)
do! conn.customNonQuery
$"CREATE TABLE {Table.DbVersion} (id TEXT PRIMARY KEY); $"CREATE TABLE {Table.DbVersion} (id TEXT PRIMARY KEY);
INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')" INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')" []
}
|> Seq.map (fun sql ->
log.LogInformation $"""Creating {(sql.Replace("IF NOT EXISTS ", "").Split ' ')[2]} table..."""
conn.customNonQuery sql [])
let! _ = Task.WhenAll tasks
()
} }
/// Set the database version to the specified version /// Set the database version to the specified version
@ -444,6 +452,14 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
do! setDbVersion "v2.2" do! setDbVersion "v2.2"
} }
/// Migrate from v2.2 to v3
let migrateV2point2ToV3 () = backgroundTask {
Utils.Migration.logStep log "v2.2 to v3" "Adding auto-OpenGraph flag to all web logs"
do! Patch.byFields Table.WebLog Any [ Field.Exists (nameof WebLog.Empty.Id) ] {| AutoOpenGraph = true |}
Utils.Migration.logStep log "v2.2 to v3" "Setting database version to v3"
do! setDbVersion "v3"
}
/// Migrate data among versions (up only) /// Migrate data among versions (up only)
let migrate version = backgroundTask { let migrate version = backgroundTask {
let mutable v = defaultArg version "" let mutable v = defaultArg version ""
@ -468,6 +484,10 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
do! migrateV2point1point1ToV2point2 () do! migrateV2point1point1ToV2point2 ()
v <- "v2.2" v <- "v2.2"
if v = "v2.2" then
do! migrateV2point2ToV3 ()
v <- "v3"
if v <> Utils.Migration.currentDbVersion then if v <> Utils.Migration.currentDbVersion then
log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}" log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}"
do! setDbVersion Utils.Migration.currentDbVersion do! setDbVersion Utils.Migration.currentDbVersion

57
src/MyWebLog.Data/Utils.fs

@ -1,11 +1,16 @@
/// Utility functions for manipulating data /// <summary>Utility functions for manipulating data</summary>
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal MyWebLog.Data.Utils module internal MyWebLog.Data.Utils
open MyWebLog open MyWebLog
open MyWebLog.ViewModels open MyWebLog.ViewModels
/// Create a category hierarchy from the given list of categories /// <summary>Create a category hierarchy from the given list of categories</summary>
/// <param name="cats">The categories from which the list should be generated</param>
/// <param name="parentId">The ID of the parent category for this list</param>
/// <param name="slugBase">The base URL to use in slugs for categories at this level</param>
/// <param name="parentNames">The names of parent categories for this level</param>
/// <returns>An array of <c>DisplayCategory</c> instances sorted alphabetically by parent category</returns>
let rec orderByHierarchy (cats: Category list) parentId slugBase parentNames = seq { let rec orderByHierarchy (cats: Category list) parentId slugBase parentNames = seq {
for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do
let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug
@ -19,48 +24,75 @@ let rec orderByHierarchy (cats: Category list) parentId slugBase parentNames = s
yield! orderByHierarchy cats (Some cat.Id) (Some fullSlug) ([ cat.Name ] |> List.append parentNames) yield! orderByHierarchy cats (Some cat.Id) (Some fullSlug) ([ cat.Name ] |> List.append parentNames)
} }
/// Get lists of items removed from and added to the given lists /// <summary>Get lists of items removed from and added to the given lists</summary>
/// <typeparam name="T">The type of items in the list</typeparam>
/// <typeparam name="U">The return type of the comparision function</typeparam>
/// <param name="oldItems">The prior list</param>
/// <param name="newItems">The current list</param>
/// <param name="f">The function to use when comparing items in the list</param>
/// <returns>A tuple with <c>fst</c> being added items and <c>snd</c> being removed items</returns>
let diffLists<'T, 'U when 'U: equality> oldItems newItems (f: 'T -> 'U) = let diffLists<'T, 'U when 'U: equality> oldItems newItems (f: 'T -> 'U) =
let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other)) let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other))
List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems
/// Find the revisions added and removed /// <summary>Find the revisions added and removed</summary>
/// <param name="oldRevs">The previous revisions</param>
/// <param name="newRevs">The current revisions</param>
/// <returns>A tuple with <c>fst</c> being added revisions and <c>snd</c> being removed revisions</returns>
let diffRevisions (oldRevs: Revision list) newRevs = let diffRevisions (oldRevs: Revision list) newRevs =
diffLists oldRevs newRevs (fun rev -> $"{rev.AsOf.ToUnixTimeTicks()}|{rev.Text}") diffLists oldRevs newRevs (fun rev -> $"{rev.AsOf.ToUnixTimeTicks()}|{rev.Text}")
open MyWebLog.Converters open MyWebLog.Converters
open Newtonsoft.Json open Newtonsoft.Json
/// Serialize an object to JSON /// <summary>Serialize an object to JSON</summary>
/// <typeparam name="T">The type of the item being serialized</typeparam>
/// <param name="ser">The JSON serializer whose settings should be used</param>
/// <param name="item">The item to be serialized</param>
/// <returns>A string with the given object serialized to JSON</returns>
let serialize<'T> ser (item: 'T) = let serialize<'T> ser (item: 'T) =
JsonConvert.SerializeObject(item, Json.settings ser) JsonConvert.SerializeObject(item, Json.settings ser)
/// Deserialize a JSON string /// <summary>Deserialize a JSON string</summary>
/// <typeparam name="T">The type of the item being deserialized</typeparam>
/// <param name="ser">The JSON serializer whose settings should be used</param>
/// <param name="value">The string with the JSON representation of the item</param>
/// <returns>The item deserialized from JSON</returns>
let deserialize<'T> (ser: JsonSerializer) value = let deserialize<'T> (ser: JsonSerializer) value =
JsonConvert.DeserializeObject<'T>(value, Json.settings ser) JsonConvert.DeserializeObject<'T>(value, Json.settings ser)
open BitBadger.Documents open BitBadger.Documents
/// Create a document serializer using the given JsonSerializer /// <summary>Create a document serializer using the given JsonSerializer</summary>
/// <param name="ser">The JSON.NET serializer on which the document serializer should be based</param>
/// <returns>A document serializer instance</returns>
let createDocumentSerializer ser = let createDocumentSerializer ser =
{ new IDocumentSerializer with { new IDocumentSerializer with
member _.Serialize<'T>(it: 'T) : string = serialize ser it member _.Serialize<'T>(it: 'T) : string = serialize ser it
member _.Deserialize<'T>(it: string) : 'T = deserialize ser it member _.Deserialize<'T>(it: string) : 'T = deserialize ser it
} }
/// Data migration utilities /// <summary>Data migration utilities</summary>
module Migration = module Migration =
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
/// The current database version /// <summary>The current database version</summary>
let currentDbVersion = "v2.2" let currentDbVersion = "v3"
/// Log a migration step /// <summary>Log a migration step</summary>
/// <param name="log">The logger to which the message should be logged</param>
/// <param name="migration">The migration being run</param>
/// <param name="message">The log message</param>
let logStep<'T> (log: ILogger<'T>) migration message = let logStep<'T> (log: ILogger<'T>) migration message =
log.LogInformation $"Migrating %s{migration}: %s{message}" log.LogInformation $"Migrating %s{migration}: %s{message}"
/// Notify the user that a backup/restore /// <summary>Notify the user that a backup/restore is required to migrate</summary>
/// <param name="log">The logger to which the message should be logged</param>
/// <param name="oldVersion">The old (current) version of the database</param>
/// <param name="newVersion">The new (application) version required</param>
/// <param name="webLogs">All web logs contained in the database</param>
let backupAndRestoreRequired log oldVersion newVersion webLogs = let backupAndRestoreRequired log oldVersion newVersion webLogs =
logStep log $"%s{oldVersion} to %s{newVersion}" "Requires Using Action" logStep log $"%s{oldVersion} to %s{newVersion}" "Requires Using Action"
@ -77,4 +109,3 @@ module Migration =
log.LogCritical "myWebLog will now exit" log.LogCritical "myWebLog will now exit"
exit 1 |> ignore exit 1 |> ignore

248
src/MyWebLog.Domain/DataTypes.fs

@ -3,29 +3,29 @@
open MyWebLog open MyWebLog
open NodaTime open NodaTime
/// A category under which a post may be identified /// <summary>A category under which a post may be identified</summary>
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Category = { type Category = {
/// The ID of the category /// <summary>The ID of the category</summary>
Id: CategoryId Id: CategoryId
/// The ID of the web log to which the category belongs /// <summary>The ID of the web log to which the category belongs</summary>
WebLogId: WebLogId WebLogId: WebLogId
/// The displayed name /// <summary>The displayed name</summary>
Name: string Name: string
/// The slug (used in category URLs) /// <summary>The slug (used in category URLs)</summary>
Slug: string Slug: string
/// A longer description of the category /// <summary>A longer description of the category</summary>
Description: string option Description: string option
/// The parent ID of this category (if a subcategory) /// <summary>The parent ID of this category (if a subcategory)</summary>
ParentId: CategoryId option ParentId: CategoryId option
} with } with
/// An empty category /// <summary>An empty category</summary>
static member Empty = static member Empty =
{ Id = CategoryId.Empty { Id = CategoryId.Empty
WebLogId = WebLogId.Empty WebLogId = WebLogId.Empty
@ -35,38 +35,38 @@ type Category = {
ParentId = None } ParentId = None }
/// A comment on a post /// <summary>A comment on a post</summary>
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Comment = { type Comment = {
/// The ID of the comment /// <summary>The ID of the comment</summary>
Id: CommentId Id: CommentId
/// The ID of the post to which this comment applies /// <summary>The ID of the post to which this comment applies</summary>
PostId: PostId PostId: PostId
/// The ID of the comment to which this comment is a reply /// <summary>The ID of the comment to which this comment is a reply</summary>
InReplyToId: CommentId option InReplyToId: CommentId option
/// The name of the commentor /// <summary>The name of the commentor</summary>
Name: string Name: string
/// The e-mail address of the commentor /// <summary>The e-mail address of the commentor</summary>
Email: string Email: string
/// The URL of the commentor's personal website /// <summary>The URL of the commentor's personal website</summary>
Url: string option Url: string option
/// The status of the comment /// <summary>The status of the comment</summary>
Status: CommentStatus Status: CommentStatus
/// When the comment was posted /// <summary>When the comment was posted</summary>
PostedOn: Instant PostedOn: Instant
/// The text of the comment /// <summary>The text of the comment</summary>
Text: string Text: string
} with } with
/// An empty comment /// <summary>An empty comment</summary>
static member Empty = static member Empty =
{ Id = CommentId.Empty { Id = CommentId.Empty
PostId = PostId.Empty PostId = PostId.Empty
@ -79,50 +79,53 @@ type Comment = {
Text = "" } Text = "" }
/// A page (text not associated with a date/time) /// <summary>A page (text not associated with a date/time)</summary>
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Page = { type Page = {
/// The ID of this page /// <summary>The ID of this page</summary>
Id: PageId Id: PageId
/// The ID of the web log to which this page belongs /// <summary>The ID of the web log to which this page belongs</summary>
WebLogId: WebLogId WebLogId: WebLogId
/// The ID of the author of this page /// <summary>The ID of the author of this page</summary>
AuthorId: WebLogUserId AuthorId: WebLogUserId
/// The title of the page /// <summary>The title of the page</summary>
Title: string Title: string
/// The link at which this page is displayed /// <summary>The link at which this page is displayed</summary>
Permalink: Permalink Permalink: Permalink
/// When this page was published /// <summary>When this page was published</summary>
PublishedOn: Instant PublishedOn: Instant
/// When this page was last updated /// <summary>When this page was last updated</summary>
UpdatedOn: Instant UpdatedOn: Instant
/// Whether this page shows as part of the web log's navigation /// <summary>Whether this page shows as part of the web log's navigation</summary>
IsInPageList: bool IsInPageList: bool
/// The template to use when rendering this page /// <summary>The template to use when rendering this page</summary>
Template: string option Template: string option
/// The current text of the page /// <summary>The current text of the page</summary>
Text: string Text: string
/// Metadata for this page /// <summary>Metadata for this page</summary>
Metadata: MetaItem list Metadata: MetaItem list
/// Permalinks at which this page may have been previously served (useful for migrated content) /// <summary>Permalinks at which this page may have been previously served (useful for migrated content)</summary>
PriorPermalinks: Permalink list PriorPermalinks: Permalink list
/// Revisions of this page /// <summary>Revisions of this page</summary>
Revisions: Revision list Revisions: Revision list
/// <summary>Common OpenGraph information for this post</summary>
OpenGraph: OpenGraphProperties option
} with } with
/// An empty page /// <summary>An empty page</summary>
static member Empty = static member Empty =
{ Id = PageId.Empty { Id = PageId.Empty
WebLogId = WebLogId.Empty WebLogId = WebLogId.Empty
@ -136,62 +139,66 @@ type Page = {
Text = "" Text = ""
Metadata = [] Metadata = []
PriorPermalinks = [] PriorPermalinks = []
Revisions = [] } Revisions = []
OpenGraph = None }
/// A web log post /// <summary>A web log post</summary>
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Post = { type Post = {
/// The ID of this post /// <summary>The ID of this post</summary>
Id: PostId Id: PostId
/// The ID of the web log to which this post belongs /// <summary>The ID of the web log to which this post belongs</summary>
WebLogId: WebLogId WebLogId: WebLogId
/// The ID of the author of this post /// <summary>The ID of the author of this post</summary>
AuthorId: WebLogUserId AuthorId: WebLogUserId
/// The status /// <summary>The status</summary>
Status: PostStatus Status: PostStatus
/// The title /// <summary>The title</summary>
Title: string Title: string
/// The link at which the post resides /// <summary>The link at which the post resides</summary>
Permalink: Permalink Permalink: Permalink
/// The instant on which the post was originally published /// <summary>The instant on which the post was originally published</summary>
PublishedOn: Instant option PublishedOn: Instant option
/// The instant on which the post was last updated /// <summary>The instant on which the post was last updated</summary>
UpdatedOn: Instant UpdatedOn: Instant
/// The template to use in displaying the post /// <summary>The template to use in displaying the post</summary>
Template: string option Template: string option
/// The text of the post in HTML (ready to display) format /// <summary>The text of the post in HTML (ready to display) format</summary>
Text: string Text: string
/// The Ids of the categories to which this is assigned /// <summary>The Ids of the categories to which this is assigned</summary>
CategoryIds: CategoryId list CategoryIds: CategoryId list
/// The tags for the post /// <summary>The tags for the post</summary>
Tags: string list Tags: string list
/// Podcast episode information for this post /// <summary>Podcast episode information for this post</summary>
Episode: Episode option Episode: Episode option
/// Metadata for the post /// <summary>Metadata for the post</summary>
Metadata: MetaItem list Metadata: MetaItem list
/// Permalinks at which this post may have been previously served (useful for migrated content) /// <summary>Permalinks at which this post may have been previously served (useful for migrated content)</summary>
PriorPermalinks: Permalink list PriorPermalinks: Permalink list
/// The revisions for this post /// <summary>The revisions for this post</summary>
Revisions: Revision list Revisions: Revision list
/// <summary>OpenGraph information for this post</summary>
OpenGraph: OpenGraphProperties option
} with } with
/// An empty post /// <summary>An empty post</summary>
static member Empty = static member Empty =
{ Id = PostId.Empty { Id = PostId.Empty
WebLogId = WebLogId.Empty WebLogId = WebLogId.Empty
@ -208,139 +215,145 @@ type Post = {
Episode = None Episode = None
Metadata = [] Metadata = []
PriorPermalinks = [] PriorPermalinks = []
Revisions = [] } Revisions = []
OpenGraph = None }
/// <summary>
/// A mapping between a tag and its URL value, used to translate restricted characters (ex. "#1" -> "number-1") /// A mapping between a tag and its URL value, used to translate restricted characters (ex. "#1" -> "number-1")
/// </summary>
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type TagMap = { type TagMap = {
/// The ID of this tag mapping /// <summary>The ID of this tag mapping</summary>
Id: TagMapId Id: TagMapId
/// The ID of the web log to which this tag mapping belongs /// <summary>The ID of the web log to which this tag mapping belongs</summary>
WebLogId: WebLogId WebLogId: WebLogId
/// The tag which should be mapped to a different value in links /// <summary>The tag which should be mapped to a different value in links</summary>
Tag: string Tag: string
/// The value by which the tag should be linked /// <summary>The value by which the tag should be linked</summary>
UrlValue: string UrlValue: string
} with } with
/// An empty tag mapping /// <summary>An empty tag mapping</summary>
static member Empty = static member Empty =
{ Id = TagMapId.Empty; WebLogId = WebLogId.Empty; Tag = ""; UrlValue = "" } { Id = TagMapId.Empty; WebLogId = WebLogId.Empty; Tag = ""; UrlValue = "" }
/// A theme /// <summary>A theme</summary>
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Theme = { type Theme = {
/// The ID / path of the theme /// <summary>The ID / path of the theme</summary>
Id: ThemeId Id: ThemeId
/// A long name of the theme /// <summary>A long name of the theme</summary>
Name: string Name: string
/// The version of the theme /// <summary>The version of the theme</summary>
Version: string Version: string
/// The templates for this theme /// <summary>The templates for this theme</summary>
Templates: ThemeTemplate list Templates: ThemeTemplate list
} with } with
/// An empty theme /// <summary>An empty theme</summary>
static member Empty = static member Empty =
{ Id = ThemeId.Empty; Name = ""; Version = ""; Templates = [] } { Id = ThemeId.Empty; Name = ""; Version = ""; Templates = [] }
/// A theme asset (a file served as part of a theme, at /themes/[theme]/[asset-path]) /// <summary>A theme asset (a file served as part of a theme, at /themes/[theme]/[asset-path])</summary>
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type ThemeAsset = { type ThemeAsset = {
/// The ID of the asset (consists of theme and path) /// <summary>The ID of the asset (consists of theme and path)</summary>
Id: ThemeAssetId Id: ThemeAssetId
/// The updated date (set from the file date from the ZIP archive) /// <summary>The updated date (set from the file date from the ZIP archive)</summary>
UpdatedOn: Instant UpdatedOn: Instant
/// The data for the asset /// <summary>The data for the asset</summary>
Data: byte array Data: byte array
} with } with
/// An empty theme asset /// <summary>An empty theme asset</summary>
static member Empty = static member Empty =
{ Id = ThemeAssetId.Empty; UpdatedOn = Noda.epoch; Data = [||] } { Id = ThemeAssetId.Empty; UpdatedOn = Noda.epoch; Data = [||] }
/// An uploaded file /// <summary>An uploaded file</summary>
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Upload = { type Upload = {
/// The ID of the upload /// <summary>The ID of the upload</summary>
Id: UploadId Id: UploadId
/// The ID of the web log to which this upload belongs /// <summary>The ID of the web log to which this upload belongs</summary>
WebLogId: WebLogId WebLogId: WebLogId
/// The link at which this upload is served /// <summary>The link at which this upload is served</summary>
Path: Permalink Path: Permalink
/// The updated date/time for this upload /// <summary>The updated date/time for this upload</summary>
UpdatedOn: Instant UpdatedOn: Instant
/// The data for the upload /// <summary>The data for the upload</summary>
Data: byte array Data: byte array
} with } with
/// An empty upload /// <summary>An empty upload</summary>
static member Empty = static member Empty =
{ Id = UploadId.Empty; WebLogId = WebLogId.Empty; Path = Permalink.Empty; UpdatedOn = Noda.epoch; Data = [||] } { Id = UploadId.Empty; WebLogId = WebLogId.Empty; Path = Permalink.Empty; UpdatedOn = Noda.epoch; Data = [||] }
open Newtonsoft.Json open Newtonsoft.Json
/// A web log /// <summary>A web log</summary>
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type WebLog = { type WebLog = {
/// The ID of the web log /// <summary>The ID of the web log</summary>
Id: WebLogId Id: WebLogId
/// The name of the web log /// <summary>The name of the web log</summary>
Name: string Name: string
/// The slug of the web log /// <summary>The slug of the web log</summary>
Slug: string Slug: string
/// A subtitle for the web log /// <summary>A subtitle for the web log</summary>
Subtitle: string option Subtitle: string option
/// The default page ("posts" or a page Id) /// <summary>The default page ("posts" or a page Id)</summary>
DefaultPage: string DefaultPage: string
/// The number of posts to display on pages of posts /// <summary>The number of posts to display on pages of posts</summary>
PostsPerPage: int PostsPerPage: int
/// The ID of the theme (also the path within /themes) /// <summary>The ID of the theme (also the path within /themes)</summary>
ThemeId: ThemeId ThemeId: ThemeId
/// The URL base /// <summary>The URL base</summary>
UrlBase: string UrlBase: string
/// The time zone in which dates/times should be displayed /// <summary>The time zone in which dates/times should be displayed</summary>
TimeZone: string TimeZone: string
/// The RSS options for this web log /// <summary>The RSS options for this web log</summary>
Rss: RssOptions Rss: RssOptions
/// Whether to automatically load htmx /// <summary>Whether to automatically load htmx</summary>
AutoHtmx: bool AutoHtmx: bool
/// Where uploads are placed /// <summary>Where uploads are placed</summary>
Uploads: UploadDestination Uploads: UploadDestination
/// Redirect rules for this weblog /// <summary>Redirect rules for this weblog</summary>
RedirectRules: RedirectRule list RedirectRules: RedirectRule list
/// <summary>Whether to automatically apply OpenGraph properties to all pages / posts</summary>
AutoOpenGraph: bool
} with } with
/// An empty web log /// <summary>An empty web log</summary>
static member Empty = static member Empty =
{ Id = WebLogId.Empty { Id = WebLogId.Empty
Name = "" Name = ""
@ -354,9 +367,12 @@ type WebLog = {
Rss = RssOptions.Empty Rss = RssOptions.Empty
AutoHtmx = false AutoHtmx = false
Uploads = Database Uploads = Database
RedirectRules = [] } RedirectRules = []
AutoOpenGraph = true }
/// <summary>
/// Any extra path where this web log is hosted (blank if web log is hosted at the root of the domain) /// Any extra path where this web log is hosted (blank if web log is hosted at the root of the domain)
/// </summary>
[<JsonIgnore>] [<JsonIgnore>]
member this.ExtraPath = member this.ExtraPath =
let pathParts = this.UrlBase.Split "://" let pathParts = this.UrlBase.Split "://"
@ -366,15 +382,27 @@ type WebLog = {
let path = pathParts[1].Split "/" let path = pathParts[1].Split "/"
if path.Length > 1 then $"""/{path |> Array.skip 1 |> String.concat "/"}""" else "" if path.Length > 1 then $"""/{path |> Array.skip 1 |> String.concat "/"}""" else ""
/// Generate an absolute URL for the given link /// <summary>Generate an absolute URL for the given link</summary>
/// <param name="permalink">The permalink for which an absolute URL should be generated</param>
/// <returns>An absolute URL for the given link</returns>
member this.AbsoluteUrl(permalink: Permalink) = member this.AbsoluteUrl(permalink: Permalink) =
$"{this.UrlBase}/{permalink}" $"{this.UrlBase}/{permalink}"
/// Generate a relative URL for the given link /// <summary>Convert a string URL to an absolute URL for this web log if required</summary>
/// <param name="url">The URL which may be translated to an absolute one</param>
/// <returns>The given URL if it was already absolute, or a corresponding absolute URL if not</returns>
member this.UrlToAbsolute(url: string) =
if url.StartsWith "http" then url else this.AbsoluteUrl(Permalink url)
/// <summary>Generate a relative URL for the given link</summary>
/// <param name="permalink">The permalink for which a relative URL should be generated</param>
/// <returns>A relative URL for the given link</returns>
member this.RelativeUrl(permalink: Permalink) = member this.RelativeUrl(permalink: Permalink) =
$"{this.ExtraPath}/{permalink}" $"{this.ExtraPath}/{permalink}"
/// Convert an Instant (UTC reference) to the web log's local date/time /// <summary>Convert an Instant (UTC reference) to the web log's local date/time</summary>
/// <param name="date">The UTC <c>Instant</c> to be converted</param>
/// <returns>The local date/time for this web log</returns>
member this.LocalTime(date: Instant) = member this.LocalTime(date: Instant) =
DateTimeZoneProviders.Tzdb.GetZoneOrNull this.TimeZone DateTimeZoneProviders.Tzdb.GetZoneOrNull this.TimeZone
|> Option.ofObj |> Option.ofObj
@ -382,44 +410,44 @@ type WebLog = {
|> Option.defaultValue (date.ToDateTimeUtc()) |> Option.defaultValue (date.ToDateTimeUtc())
/// A user of the web log /// <summary>A user of the web log</summary>
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type WebLogUser = { type WebLogUser = {
/// The ID of the user /// <summary>The ID of the user</summary>
Id: WebLogUserId Id: WebLogUserId
/// The ID of the web log to which this user belongs /// <summary>The ID of the web log to which this user belongs</summary>
WebLogId: WebLogId WebLogId: WebLogId
/// The user name (e-mail address) /// <summary>The user name (e-mail address)</summary>
Email: string Email: string
/// The user's first name /// <summary>The user's first name</summary>
FirstName: string FirstName: string
/// The user's last name /// <summary>The user's last name</summary>
LastName: string LastName: string
/// The user's preferred name /// <summary>The user's preferred name</summary>
PreferredName: string PreferredName: string
/// The hash of the user's password /// <summary>The hash of the user's password</summary>
PasswordHash: string PasswordHash: string
/// The URL of the user's personal site /// <summary>The URL of the user's personal site</summary>
Url: string option Url: string option
/// The user's access level /// <summary>The user's access level</summary>
AccessLevel: AccessLevel AccessLevel: AccessLevel
/// When the user was created /// <summary>When the user was created</summary>
CreatedOn: Instant CreatedOn: Instant
/// When the user last logged on /// <summary>When the user last logged on</summary>
LastSeenOn: Instant option LastSeenOn: Instant option
} with } with
/// An empty web log user /// <summary>An empty web log user</summary>
static member Empty = static member Empty =
{ Id = WebLogUserId.Empty { Id = WebLogUserId.Empty
WebLogId = WebLogId.Empty WebLogId = WebLogId.Empty
@ -433,7 +461,7 @@ type WebLogUser = {
CreatedOn = Noda.epoch CreatedOn = Noda.epoch
LastSeenOn = None } LastSeenOn = None }
/// Get the user's displayed name /// <summary>Get the user's displayed name</summary>
[<JsonIgnore>] [<JsonIgnore>]
member this.DisplayName = member this.DisplayName =
(seq { (match this.PreferredName with "" -> this.FirstName | n -> n); " "; this.LastName } (seq { (match this.PreferredName with "" -> this.FirstName | n -> n); " "; this.LastName }

8
src/MyWebLog.Domain/MyWebLog.Domain.fsproj

@ -7,11 +7,11 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Markdig" Version="0.37.0" /> <PackageReference Include="Markdig" Version="0.41.3" />
<PackageReference Include="Markdown.ColorCode" Version="2.2.2" /> <PackageReference Include="Markdown.ColorCode" Version="3.0.0" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.3" /> <PackageReference Include="Newtonsoft.Json" Version="13.0.3" />
<PackageReference Include="NodaTime" Version="3.1.11" /> <PackageReference Include="NodaTime" Version="3.2.2" />
<PackageReference Update="FSharp.Core" Version="8.0.300" /> <PackageReference Update="FSharp.Core" Version="9.0.300" />
</ItemGroup> </ItemGroup>
</Project> </Project>

719
src/MyWebLog.Domain/SupportTypes.fs

File diff suppressed because it is too large Load Diff

787
src/MyWebLog.Domain/ViewModels.fs

File diff suppressed because it is too large Load Diff

18
src/MyWebLog.Tests/Data/ConvertersTests.fs

@ -90,7 +90,7 @@ let explicitRatingConverterTests = testList "ExplicitRatingConverter" [
} }
] ]
/// Unit tests for the MarkupText type /// Unit tests for the MarkupTextConverter type
let markupTextConverterTests = testList "MarkupTextConverter" [ let markupTextConverterTests = testList "MarkupTextConverter" [
let opts = JsonSerializerSettings() let opts = JsonSerializerSettings()
opts.Converters.Add(MarkupTextConverter()) opts.Converters.Add(MarkupTextConverter())
@ -104,6 +104,20 @@ let markupTextConverterTests = testList "MarkupTextConverter" [
} }
] ]
/// Unit tests for the OpenGraphTypeConverter type
let openGraphTypeConverterTests = testList "OpenGraphTypeConverter" [
let opts = JsonSerializerSettings()
opts.Converters.Add(OpenGraphTypeConverter())
test "succeeds when serializing" {
let after = JsonConvert.SerializeObject(VideoTvShow, opts)
Expect.equal after "\"video.tv_show\"" "OpenGraph type serialized incorrectly"
}
test "succeeds when deserializing" {
let after = JsonConvert.DeserializeObject<OpenGraphType>("\"book\"", opts)
Expect.equal after Book "OpenGraph type deserialized incorrectly"
}
]
/// Unit tests for the PermalinkConverter type /// Unit tests for the PermalinkConverter type
let permalinkConverterTests = testList "PermalinkConverter" [ let permalinkConverterTests = testList "PermalinkConverter" [
let opts = JsonSerializerSettings() let opts = JsonSerializerSettings()
@ -257,6 +271,7 @@ let configureTests = test "Json.configure succeeds" {
Expect.hasCountOf ser.Converters 1u (has typeof<CustomFeedSourceConverter>) "Custom feed source converter not found" Expect.hasCountOf ser.Converters 1u (has typeof<CustomFeedSourceConverter>) "Custom feed source converter not found"
Expect.hasCountOf ser.Converters 1u (has typeof<ExplicitRatingConverter>) "Explicit rating converter not found" Expect.hasCountOf ser.Converters 1u (has typeof<ExplicitRatingConverter>) "Explicit rating converter not found"
Expect.hasCountOf ser.Converters 1u (has typeof<MarkupTextConverter>) "Markup text converter not found" Expect.hasCountOf ser.Converters 1u (has typeof<MarkupTextConverter>) "Markup text converter not found"
Expect.hasCountOf ser.Converters 1u (has typeof<OpenGraphTypeConverter>) "OpenGraph type converter not found"
Expect.hasCountOf ser.Converters 1u (has typeof<PermalinkConverter>) "Permalink converter not found" Expect.hasCountOf ser.Converters 1u (has typeof<PermalinkConverter>) "Permalink converter not found"
Expect.hasCountOf ser.Converters 1u (has typeof<PageIdConverter>) "Page ID converter not found" Expect.hasCountOf ser.Converters 1u (has typeof<PageIdConverter>) "Page ID converter not found"
Expect.hasCountOf ser.Converters 1u (has typeof<PodcastMediumConverter>) "Podcast medium converter not found" Expect.hasCountOf ser.Converters 1u (has typeof<PodcastMediumConverter>) "Podcast medium converter not found"
@ -282,6 +297,7 @@ let all = testList "Converters" [
customFeedSourceConverterTests customFeedSourceConverterTests
explicitRatingConverterTests explicitRatingConverterTests
markupTextConverterTests markupTextConverterTests
openGraphTypeConverterTests
permalinkConverterTests permalinkConverterTests
pageIdConverterTests pageIdConverterTests
podcastMediumConverterTests podcastMediumConverterTests

4
src/MyWebLog.Tests/Data/PageDataTests.fs

@ -35,7 +35,8 @@ let ``Add succeeds`` (data: IData) = task {
Text = "<h1>A new page</h1>" Text = "<h1>A new page</h1>"
Metadata = [ { Name = "Meta Item"; Value = "Meta Value" } ] Metadata = [ { Name = "Meta Item"; Value = "Meta Value" } ]
PriorPermalinks = [ Permalink "2024/the-new-page.htm" ] PriorPermalinks = [ Permalink "2024/the-new-page.htm" ]
Revisions = [ { AsOf = Noda.epoch + Duration.FromDays 3; Text = Html "<h1>A new page</h1>" } ] } Revisions = [ { AsOf = Noda.epoch + Duration.FromDays 3; Text = Html "<h1>A new page</h1>" } ]
OpenGraph = Some { OpenGraphProperties.Empty with Type = Book } }
do! data.Page.Add page do! data.Page.Add page
let! stored = data.Page.FindFullById (PageId "added-page") (WebLogId "test") let! stored = data.Page.FindFullById (PageId "added-page") (WebLogId "test")
Expect.isSome stored "The page should have been added" Expect.isSome stored "The page should have been added"
@ -53,6 +54,7 @@ let ``Add succeeds`` (data: IData) = task {
Expect.equal pg.Metadata page.Metadata "Metadata not saved properly" Expect.equal pg.Metadata page.Metadata "Metadata not saved properly"
Expect.equal pg.PriorPermalinks page.PriorPermalinks "Prior permalinks not saved properly" Expect.equal pg.PriorPermalinks page.PriorPermalinks "Prior permalinks not saved properly"
Expect.equal pg.Revisions page.Revisions "Revisions not saved properly" Expect.equal pg.Revisions page.Revisions "Revisions not saved properly"
Expect.equal pg.OpenGraph page.OpenGraph "OpenGraph properties not saved properly"
} }
let ``All succeeds`` (data: IData) = task { let ``All succeeds`` (data: IData) = task {

4
src/MyWebLog.Tests/Data/PostDataTests.fs

@ -66,7 +66,8 @@ let ``Add succeeds`` (data: IData) = task {
Episode = Some { Episode.Empty with Media = "test-ep.mp3" } Episode = Some { Episode.Empty with Media = "test-ep.mp3" }
Metadata = [ { Name = "Meta"; Value = "Data" } ] Metadata = [ { Name = "Meta"; Value = "Data" } ]
PriorPermalinks = [ Permalink "2020/test-post-a.html" ] PriorPermalinks = [ Permalink "2020/test-post-a.html" ]
Revisions = [ { AsOf = Noda.epoch + Duration.FromMinutes 1L; Text = Html "<p>Test text here" } ] } Revisions = [ { AsOf = Noda.epoch + Duration.FromMinutes 1L; Text = Html "<p>Test text here" } ]
OpenGraph = Some { OpenGraphProperties.Empty with Type = VideoMovie } }
do! data.Post.Add post do! data.Post.Add post
let! stored = data.Post.FindFullById post.Id post.WebLogId let! stored = data.Post.FindFullById post.Id post.WebLogId
Expect.isSome stored "The added post should have been retrieved" Expect.isSome stored "The added post should have been retrieved"
@ -87,6 +88,7 @@ let ``Add succeeds`` (data: IData) = task {
Expect.equal it.Metadata post.Metadata "Metadata items not saved properly" Expect.equal it.Metadata post.Metadata "Metadata items not saved properly"
Expect.equal it.PriorPermalinks post.PriorPermalinks "Prior permalinks not saved properly" Expect.equal it.PriorPermalinks post.PriorPermalinks "Prior permalinks not saved properly"
Expect.equal it.Revisions post.Revisions "Revisions not saved properly" Expect.equal it.Revisions post.Revisions "Revisions not saved properly"
Expect.equal it.OpenGraph post.OpenGraph "OpenGraph properties not saved correctly"
} }
let ``CountByStatus succeeds`` (data: IData) = task { let ``CountByStatus succeeds`` (data: IData) = task {

4
src/MyWebLog.Tests/Data/WebLogDataTests.fs

@ -32,7 +32,8 @@ let ``Add succeeds`` (data: IData) = task {
CustomFeeds = [] } CustomFeeds = [] }
AutoHtmx = true AutoHtmx = true
Uploads = Disk Uploads = Disk
RedirectRules = [ { From = "/here"; To = "/there"; IsRegex = false } ] } RedirectRules = [ { From = "/here"; To = "/there"; IsRegex = false } ]
AutoOpenGraph = false }
let! webLog = data.WebLog.FindById (WebLogId "new-weblog") let! webLog = data.WebLog.FindById (WebLogId "new-weblog")
Expect.isSome webLog "The web log should have been returned" Expect.isSome webLog "The web log should have been returned"
let it = webLog.Value let it = webLog.Value
@ -48,6 +49,7 @@ let ``Add succeeds`` (data: IData) = task {
Expect.isTrue it.AutoHtmx "Auto htmx flag is incorrect" Expect.isTrue it.AutoHtmx "Auto htmx flag is incorrect"
Expect.equal it.Uploads Disk "Upload destination is incorrect" Expect.equal it.Uploads Disk "Upload destination is incorrect"
Expect.equal it.RedirectRules [ { From = "/here"; To = "/there"; IsRegex = false } ] "Redirect rules are incorrect" Expect.equal it.RedirectRules [ { From = "/here"; To = "/there"; IsRegex = false } ] "Redirect rules are incorrect"
Expect.isFalse it.AutoOpenGraph "Auto OpenGraph flag is incorrect"
let rss = it.Rss let rss = it.Rss
Expect.isTrue rss.IsFeedEnabled "Is feed enabled flag is incorrect" Expect.isTrue rss.IsFeedEnabled "Is feed enabled flag is incorrect"
Expect.equal rss.FeedName "my-feed.xml" "Feed name is incorrect" Expect.equal rss.FeedName "my-feed.xml" "Feed name is incorrect"

12
src/MyWebLog.Tests/Domain/DataTypesTests.fs

@ -34,6 +34,18 @@ let webLogTests = testList "WebLog" [
"https://my.site/blog/page.html" "https://my.site/blog/page.html"
"Absolute URL is incorrect" "Absolute URL is incorrect"
} }
testList "UrlToAbsolute" [
test "succeeds for relative URL" {
Expect.equal
({ WebLog.Empty with UrlBase = "https://my.site" }.UrlToAbsolute "blog/page.html")
"https://my.site/blog/page.html"
"Absolute URL is incorrect"
}
test "succeeds for absolute URL" {
Expect.equal
(WebLog.Empty.UrlToAbsolute "https://test.units") "https://test.units" "Absolute URL is incorrect"
}
]
testList "RelativeUrl" [ testList "RelativeUrl" [
test "succeeds for domain root URL" { test "succeeds for domain root URL" {
Expect.equal Expect.equal

382
src/MyWebLog.Tests/Domain/SupportTypesTests.fs

@ -257,6 +257,383 @@ let markupTextTests = testList "MarkupText" [
] ]
] ]
/// Unit tests for the OpenGraphAudio type
let openGraphAudioTests = testList "OpenGraphAudio" [
let webLog = { WebLog.Empty with UrlBase = "https://unit.test/taco" }
let transform = webLog.UrlToAbsolute
testList "ToProperties" [
test "succeeds with minimum required" {
let props = Array.ofSeq ({ OpenGraphAudio.Empty with Url = "http://test.this" }.ToProperties transform)
Expect.hasLength props 1 "There should be one property"
Expect.equal props[0] ("og:audio", "http://test.this") "The URL was not written correctly"
}
test "succeeds with secure URL" {
let props = Array.ofSeq ({ OpenGraphAudio.Empty with Url = "https://test.this" }.ToProperties transform)
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[0] ("og:audio", "https://test.this") "The URL was not written correctly"
Expect.equal
props[1] ("og:audio:secure_url", "https://test.this") "The Secure URL was not written correctly"
}
test "succeeds with all properties filled" {
let props = Array.ofSeq ({ Url = "http://test.this"; Type = Some "audio/mpeg" }.ToProperties transform)
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[0] ("og:audio", "http://test.this") "The URL was not written correctly"
Expect.equal props[1] ("og:audio:type", "audio/mpeg") "The MIME type was not written correctly"
}
test "succeeds when deriving AAC and transforming URL" {
let props = Array.ofSeq ({ OpenGraphAudio.Empty with Url = "this/cool.file.aac" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal
props[0]
("og:audio", "https://unit.test/taco/this/cool.file.aac")
"The URL was not transformed correctly"
Expect.equal
props[1]
("og:audio:secure_url", "https://unit.test/taco/this/cool.file.aac")
"The URL was not transformed correctly"
Expect.equal props[2] ("og:audio:type", "audio/aac") "The MIME type for AAC was not derived correctly"
}
test "succeeds when deriving MP3" {
let props = Array.ofSeq ({ OpenGraphAudio.Empty with Url = "an.other/song.mp3" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[2] ("og:audio:type", "audio/mpeg") "The MIME type for MP3 was not derived correctly"
}
test "succeeds when deriving OGA" {
let props = Array.ofSeq ({ OpenGraphAudio.Empty with Url = "talks/speex.oga" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[2] ("og:audio:type", "audio/ogg") "The MIME type for OGA was not derived correctly"
}
test "succeeds when deriving WAV" {
let props = Array.ofSeq ({ OpenGraphAudio.Empty with Url = "some/old.school.wav" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[2] ("og:audio:type", "audio/wav") "The MIME type for WAV was not derived correctly"
}
test "succeeds when deriving WEBA" {
let props = Array.ofSeq ({ OpenGraphAudio.Empty with Url = "new/format/file.weba" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[2] ("og:audio:type", "audio/webm") "The MIME type for WEBA was not derived correctly"
}
test "succeeds when type cannot be derived" {
let props = Array.ofSeq ({ OpenGraphAudio.Empty with Url = "profile.jpg" }.ToProperties transform)
Expect.hasLength props 2 "There should be two properties (only URLs; no type derived)"
}
]
]
/// Tests for the OpenGraphImage type
let openGraphImageTests = testList "OpenGraphImage" [
let webLog = { WebLog.Empty with UrlBase = "https://unit.test/taco" }
let transform = webLog.UrlToAbsolute
testList "ToProperties" [
test "succeeds with minimum required" {
let props = Array.ofSeq ({ OpenGraphImage.Empty with Url = "http://test.url" }.ToProperties transform)
Expect.hasLength props 1 "There should be one property"
Expect.equal props[0] ("og:image", "http://test.url") "The URL was not written correctly"
}
test "succeeds with secure URL" {
let props = Array.ofSeq ({ OpenGraphImage.Empty with Url = "https://secure.url" }.ToProperties transform)
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[0] ("og:image", "https://secure.url") "The URL was not written correctly"
Expect.equal
props[1] ("og:image:secure_url", "https://secure.url") "The Secure URL was not written correctly"
}
test "succeeds with all properties filled" {
let props =
{ Url = "http://test.this"
Type = Some "image/jpeg"
Width = Some 400
Height = Some 600
Alt = Some "This ought to be good" }.ToProperties transform
|> Array.ofSeq
Expect.hasLength props 5 "There should be five properties"
Expect.equal props[0] ("og:image", "http://test.this") "The URL was not written correctly"
Expect.equal props[1] ("og:image:type", "image/jpeg") "The MIME type was not written correctly"
Expect.equal props[2] ("og:image:width", "400") "The width was not written correctly"
Expect.equal props[3] ("og:image:height", "600") "The height was not written correctly"
Expect.equal props[4] ("og:image:alt", "This ought to be good") "The alt text was not written correctly"
}
test "succeeds when deriving BMP and transforming URL" {
let props = Array.ofSeq ({ OpenGraphImage.Empty with Url = "old/windows.bmp" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal
props[0] ("og:image", "https://unit.test/taco/old/windows.bmp") "The URL was not transformed correctly"
Expect.equal
props[1]
("og:image:secure_url", "https://unit.test/taco/old/windows.bmp")
"The URL was not transformed correctly"
Expect.equal props[2] ("og:image:type", "image/bmp") "The MIME type for BMP was not derived correctly"
}
test "succeeds when deriving GIF" {
let props = Array.ofSeq ({ OpenGraphImage.Empty with Url = "its.a.soft.g.gif" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[2] ("og:image:type", "image/gif") "The MIME type for GIF was not derived correctly"
}
test "succeeds when deriving ICO" {
let props = Array.ofSeq ({ OpenGraphImage.Empty with Url = "favicon.ico" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal
props[2] ("og:image:type", "image/vnd.microsoft.icon") "The MIME type for ICO was not derived correctly"
}
test "succeeds when deriving JPEG" {
let props = Array.ofSeq ({ OpenGraphImage.Empty with Url = "big/name/photo.jpeg" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[2] ("og:image:type", "image/jpeg") "The MIME type for JPEG was not derived correctly"
}
test "succeeds when deriving PNG" {
let props = Array.ofSeq ({ OpenGraphImage.Empty with Url = "some/nice/graphic.png" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[2] ("og:image:type", "image/png") "The MIME type for PNG was not derived correctly"
}
test "succeeds when deriving SVG" {
let props = Array.ofSeq ({ OpenGraphImage.Empty with Url = "fancy-new-vector.svg" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[2] ("og:image:type", "image/svg+xml") "The MIME type for SVG was not derived correctly"
}
test "succeeds when deriving TIF" {
let props = Array.ofSeq ({ OpenGraphImage.Empty with Url = "tagged/file.tif" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[2] ("og:image:type", "image/tiff") "The MIME type for TIF was not derived correctly"
}
test "succeeds when deriving TIFF" {
let props = Array.ofSeq ({ OpenGraphImage.Empty with Url = "tagged/file.two.tiff" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[2] ("og:image:type", "image/tiff") "The MIME type for TIFF was not derived correctly"
}
test "succeeds when deriving WEBP" {
let props = Array.ofSeq ({ OpenGraphImage.Empty with Url = "modern/photo.webp" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[2] ("og:image:type", "image/webp") "The MIME type for WEBP was not derived correctly"
}
test "succeeds when type cannot be derived" {
let props = Array.ofSeq ({ OpenGraphImage.Empty with Url = "intro.mp3" }.ToProperties transform)
Expect.hasLength props 2 "There should be two properties (only URLs; no type derived)"
}
]
]
/// Unit tests for the OpenGraphVideo type
let openGraphVideoTests = testList "OpenGraphVideo" [
let webLog = { WebLog.Empty with UrlBase = "https://unit.test/taco" }
let transform = webLog.UrlToAbsolute
testList "ToProperties" [
test "succeeds with minimum required" {
let props = Array.ofSeq ({ OpenGraphVideo.Empty with Url = "http://url.test" }.ToProperties transform)
Expect.hasLength props 1 "There should be one property"
Expect.equal props[0] ("og:video", "http://url.test") "The URL was not written correctly"
}
test "succeeds with secure URL" {
let props = Array.ofSeq ({ OpenGraphVideo.Empty with Url = "https://url.secure" }.ToProperties transform)
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[0] ("og:video", "https://url.secure") "The URL was not written correctly"
Expect.equal
props[1] ("og:video:secure_url", "https://url.secure") "The Secure URL was not written correctly"
}
test "succeeds with all properties filled" {
let props =
{ Url = "http://test.this"
Type = Some "video/mpeg"
Width = Some 1200
Height = Some 900 }.ToProperties transform
|> Array.ofSeq
Expect.hasLength props 4 "There should be five properties"
Expect.equal props[0] ("og:video", "http://test.this") "The URL was not written correctly"
Expect.equal props[1] ("og:video:type", "video/mpeg") "The MIME type was not written correctly"
Expect.equal props[2] ("og:video:width", "1200") "The width was not written correctly"
Expect.equal props[3] ("og:video:height", "900") "The height was not written correctly"
}
test "succeeds when deriving AVI and transforming URL" {
let props = Array.ofSeq ({ OpenGraphVideo.Empty with Url = "my.video.avi" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal
props[0] ("og:video", "https://unit.test/taco/my.video.avi") "The URL not transformed correctly"
Expect.equal
props[1]
("og:video:secure_url", "https://unit.test/taco/my.video.avi")
"The URL not transformed correctly"
Expect.equal props[2] ("og:video:type", "video/x-msvideo") "The MIME type for AVI was not derived correctly"
}
test "succeeds when deriving MP4" {
let props = Array.ofSeq ({ OpenGraphVideo.Empty with Url = "chapters/1/01.mp4" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[2] ("og:video:type", "video/mp4") "The MIME type for MP4 was not derived correctly"
}
test "succeeds when deriving MPEG" {
let props = Array.ofSeq ({ OpenGraphVideo.Empty with Url = "viral/video.mpeg" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[2] ("og:video:type", "video/mpeg") "The MIME type for MPEG was not derived correctly"
}
test "succeeds when deriving OGV" {
let props =
Array.ofSeq ({ OpenGraphVideo.Empty with Url = "open/video/example.ogv" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[2] ("og:video:type", "video/ogg") "The MIME type for OGV was not derived correctly"
}
test "succeeds when deriving WEBM" {
let props = Array.ofSeq ({ OpenGraphVideo.Empty with Url = "images/hero.webm" }.ToProperties transform)
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[2] ("og:video:type", "video/webm") "The MIME type for WEBM was not derived correctly"
}
test "succeeds when type cannot be derived" {
let props = Array.ofSeq ({ OpenGraphVideo.Empty with Url = "favicon.ico" }.ToProperties transform)
Expect.hasLength props 2 "There should be two properties (only URLs; no type derived)"
}
]
]
/// Unit tests for the OpenGraphType type
let openGraphTypeTests = testList "OpenGraphType" [
testList "Parse" [
test "succeeds for \"article\"" {
Expect.equal (OpenGraphType.Parse "article") Article "\"article\" not parsed correctly"
}
test "succeeds for \"book\"" {
Expect.equal (OpenGraphType.Parse "book") Book "\"book\" not parsed correctly"
}
test "succeeds for \"music.album\"" {
Expect.equal (OpenGraphType.Parse "music.album") MusicAlbum "\"music.album\" not parsed correctly"
}
test "succeeds for \"music.playlist\"" {
Expect.equal (OpenGraphType.Parse "music.playlist") MusicPlaylist "\"music.playlist\" not parsed correctly"
}
test "succeeds for \"music.radio_station\"" {
Expect.equal
(OpenGraphType.Parse "music.radio_station")
MusicRadioStation
"\"music.radio_station\" not parsed correctly"
}
test "succeeds for \"music.song\"" {
Expect.equal (OpenGraphType.Parse "music.song") MusicSong "\"music.song\" not parsed correctly"
}
test "succeeds for \"payment.link\"" {
Expect.equal (OpenGraphType.Parse "payment.link") PaymentLink "\"payment.link\" not parsed correctly"
}
test "succeeds for \"profile\"" {
Expect.equal (OpenGraphType.Parse "profile") Profile "\"profile\" not parsed correctly"
}
test "succeeds for \"video.episode\"" {
Expect.equal (OpenGraphType.Parse "video.episode") VideoEpisode "\"video.episode\" not parsed correctly"
}
test "succeeds for \"video.movie\"" {
Expect.equal (OpenGraphType.Parse "video.movie") VideoMovie "\"video.movie\" not parsed correctly"
}
test "succeeds for \"video.other\"" {
Expect.equal (OpenGraphType.Parse "video.other") VideoOther "\"video.other\" not parsed correctly"
}
test "succeeds for \"video.tv_show\"" {
Expect.equal (OpenGraphType.Parse "video.tv_show") VideoTvShow "\"video.tv_show\" not parsed correctly"
}
test "succeeds for \"website\"" {
Expect.equal (OpenGraphType.Parse "website") Website "\"website\" not parsed correctly"
}
test "fails for invalid type" {
Expect.throwsT<ArgumentException>
(fun () -> ignore (OpenGraphType.Parse "anthology")) "Invalid value should have raised an exception"
}
]
test "Selections succeeds" {
let it = OpenGraphType.Selections
Expect.hasLength it 13 "There should be 13 selections"
Expect.equal (List.head it) ("article", "Article") "Article not found where expected"
Expect.equal (it |> List.item 1) ("book", "Book") "Book not found where expected"
Expect.equal (it |> List.item 2) ("music.album", "Music: Album") "MusicAlbum not found where expected"
Expect.equal (it |> List.item 3) ("music.playlist", "Music: Playlist") "MusicPlaylist not found where expected"
Expect.equal
(it |> List.item 4)
("music.radio_station", "Music: Radio Station")
"MusicRadioStation not found where expected"
Expect.equal (it |> List.item 5) ("music.song", "Music: Song") "MusicSong not found where expected"
Expect.equal (it |> List.item 6) ("payment.link", "Payment Link") "PaymentLink not found where expected"
Expect.equal (it |> List.item 7) ("profile", "Profile") "Profile not found where expected"
Expect.equal (it |> List.item 8) ("video.episode", "Video: Episode") "VideoEpisode not found where expected"
Expect.equal (it |> List.item 9) ("video.movie", "Video: Movie") "VideoMovie not found where expected"
Expect.equal (it |> List.item 10) ("video.other", "Video: Other") "VideoOther not found where expected"
Expect.equal (it |> List.item 11) ("video.tv_show", "Video: TV Show") "VideoTvShow not found where expected"
Expect.equal (it |> List.item 12) ("website", "Website") "Website not found where expected"
}
testList "ToString" [
test "succeeds for Article" {
Expect.equal (string Article) "article" "Article string incorrect"
}
test "succeeds for Book" {
Expect.equal (string Book) "book" "Book string incorrect"
}
test "succeeds for MusicAlbum" {
Expect.equal (string MusicAlbum) "music.album" "MusicAlbum string incorrect"
}
test "succeeds for MusicPlaylist" {
Expect.equal (string MusicPlaylist) "music.playlist" "MusicPlaylist string incorrect"
}
test "succeeds for MusicRadioStation" {
Expect.equal (string MusicRadioStation) "music.radio_station" "MusicRadioStation string incorrect"
}
test "succeeds for MusicSong" {
Expect.equal (string MusicSong) "music.song" "MusicSong string incorrect"
}
test "succeeds for PaymentLink" {
Expect.equal (string PaymentLink) "payment.link" "PaymentLink string incorrect"
}
test "succeeds for Profile" {
Expect.equal (string Profile) "profile" "Profile string incorrect"
}
test "succeeds for VideoEpisode" {
Expect.equal (string VideoEpisode) "video.episode" "VideoEpisode string incorrect"
}
test "succeeds for VideoMovie" {
Expect.equal (string VideoMovie) "video.movie" "VideoMovie string incorrect"
}
test "succeeds for VideoOther" {
Expect.equal (string VideoOther) "video.other" "VideoOther string incorrect"
}
test "succeeds for VideoTvShow" {
Expect.equal (string VideoTvShow) "video.tv_show" "VideoTvShow string incorrect"
}
test "succeeds for Website" {
Expect.equal (string Website) "website" "Website string incorrect"
}
]
]
/// Unit tests for the OpenGraphProperties type
let openGraphPropertiesTests = testList "OpenGraphProperties" [
testList "Properties" [
test "succeeds with minimal values" {
let props =
{ OpenGraphProperties.Empty with
Image = { OpenGraphImage.Empty with Url = "http://this.aint.nothing" } }
.ToProperties WebLog.Empty.UrlToAbsolute
|> Array.ofSeq
Expect.hasLength props 2 "There should have been two properties"
Expect.equal props[0] ("og:type", "article") "Type not written correctly"
Expect.equal props[1] ("og:image", "http://this.aint.nothing") "Image URL not written correctly"
}
test "succeeds with all values" {
let props =
{ Type = Book
Image = { OpenGraphImage.Empty with Url = "http://this.image.file" }
Audio = Some { OpenGraphAudio.Empty with Url = "http://this.audio.file" }
Description = Some "This is a unit test"
Determiner = Some "a"
Locale = Some "en_US"
LocaleAlternate = Some [ "en_UK"; "es_MX" ]
Video = Some { OpenGraphVideo.Empty with Url = "http://this.video.file" }
Other = Some [ { Name = "book.publisher"; Value = "Yep" } ] }
.ToProperties WebLog.Empty.UrlToAbsolute
|> Array.ofSeq
Expect.hasLength props 10 "There should have been ten properties"
Expect.equal props[0] ("og:type", "book") "Type not written correctly"
Expect.equal props[1] ("og:image", "http://this.image.file") "Image URL not written correctly"
Expect.equal props[2] ("og:description", "This is a unit test") "Description not written correctly"
Expect.equal props[3] ("og:determiner", "a") "Determiner not written correctly"
Expect.equal props[4] ("og:locale", "en_US") "Locale not written correctly"
Expect.equal props[5] ("og:locale:alternate", "en_UK") "1st Alternate Locale not written correctly"
Expect.equal props[6] ("og:locale:alternate", "es_MX") "2nd Alternate Locale not written correctly"
Expect.equal props[7] ("og:audio", "http://this.audio.file") "Audio URL not written correctly"
Expect.equal props[8] ("og:video", "http://this.video.file") "Video URL not written correctly"
Expect.equal props[9] ("book.publisher", "Yep") "Other property not written correctly"
}
]
]
/// Unit tests for the PodcastMedium type /// Unit tests for the PodcastMedium type
let podcastMediumTests = testList "PodcastMedium" [ let podcastMediumTests = testList "PodcastMedium" [
testList "Parse" [ testList "Parse" [
@ -407,6 +784,11 @@ let all = testList "SupportTypes" [
explicitRatingTests explicitRatingTests
episodeTests episodeTests
markupTextTests markupTextTests
openGraphAudioTests
openGraphImageTests
openGraphVideoTests
openGraphTypeTests
openGraphPropertiesTests
podcastMediumTests podcastMediumTests
postStatusTests postStatusTests
customFeedSourceTests customFeedSourceTests

294
src/MyWebLog.Tests/Domain/ViewModelsTests.fs

@ -206,6 +206,25 @@ let private testFullPage =
Revisions = Revisions =
[ { AsOf = Noda.epoch + Duration.FromHours 1; Text = Markdown "# Howdy!" } [ { AsOf = Noda.epoch + Duration.FromHours 1; Text = Markdown "# Howdy!" }
{ AsOf = Noda.epoch; Text = Html "<h1>howdy</h1>" } ] { AsOf = Noda.epoch; Text = Html "<h1>howdy</h1>" } ]
OpenGraph =
Some { Type = Book
Image =
{ Url = "https://unit.test/it.png"
Type = Some "test/png"
Width = Some 1
Height = Some 2
Alt = Some "huh" }
Audio = Some { Url = "https://unit.test/it.mp3"; Type = Some "test/mpeg-3" }
Description = Some "This is cool"
Determiner = Some "the"
Locale = Some "en-US"
LocaleAlternate = Some [ "es-MX"; "es-ES" ]
Video =
Some { Url = "https://unit.test/it.mp4"
Type = Some "test/mpeg-4"
Width = Some 5
Height = Some 6 }
Other = Some [ { Name = "the-other"; Value = "the-value" } ] }
Metadata = [ { Name = "Test"; Value = "me" }; { Name = "Two"; Value = "2" } ] } Metadata = [ { Name = "Test"; Value = "me" }; { Name = "Two"; Value = "2" } ] }
/// A full post used to test various models /// A full post used to test various models
@ -221,6 +240,25 @@ let testFullPost =
Text = "<p>A post!</p>" Text = "<p>A post!</p>"
CategoryIds = [ CategoryId "cat-a"; CategoryId "cat-b"; CategoryId "cat-n" ] CategoryIds = [ CategoryId "cat-a"; CategoryId "cat-b"; CategoryId "cat-n" ]
Tags = [ "demo"; "post" ] Tags = [ "demo"; "post" ]
OpenGraph =
Some { Type = MusicAlbum
Image =
{ Url = "https://unit.test/it.jpg"
Type = Some "test/jpg"
Width = Some 100
Height = Some 200
Alt = Some "it is a jpeg" }
Audio = Some { Url = "https://unit.test/that.mp3"; Type = Some "test/mp3" }
Description = Some "Just a post"
Determiner = Some "a"
Locale = Some "es-MX"
LocaleAlternate = Some [ "es-ES"; "en-EN" ]
Video =
Some { Url = "https://unit.test/that.mp4"
Type = Some "test/mp4"
Width = Some 50
Height = Some 60 }
Other = Some [ { Name = "an-other"; Value = "a-value" } ] }
Metadata = [ { Name = "A Meta"; Value = "A Value" } ] Metadata = [ { Name = "A Meta"; Value = "A Value" } ]
Revisions = Revisions =
[ { AsOf = Noda.epoch + Duration.FromDays 365; Text = Html "<p>A post!</p>" } [ { AsOf = Noda.epoch + Duration.FromDays 365; Text = Html "<p>A post!</p>" }
@ -266,9 +304,28 @@ let editCommonModelTests = testList "EditCommonModel" [
Expect.equal model.Template "" "Template not filled properly" Expect.equal model.Template "" "Template not filled properly"
Expect.equal model.Source "HTML" "Source not filled properly" Expect.equal model.Source "HTML" "Source not filled properly"
Expect.equal model.Text "" "Text not set properly" Expect.equal model.Text "" "Text not set properly"
Expect.equal model.MetaNames.Length 1 "MetaNames should have one entry" Expect.isFalse model.AssignOpenGraph "OpenGraph properties should not have been assigned"
Expect.equal model.OpenGraphType "" "OpenGraph type not filled properly"
Expect.equal model.OpenGraphImageUrl "" "OpenGraph image URL not filled properly"
Expect.equal model.OpenGraphImageType "" "OpenGraph image type not filled properly"
Expect.equal model.OpenGraphImageWidth "" "OpenGraph image width not filled properly"
Expect.equal model.OpenGraphImageHeight "" "OpenGraph image height not filled properly"
Expect.equal model.OpenGraphImageAlt "" "OpenGraph image alt text not filled properly"
Expect.equal model.OpenGraphAudioUrl "" "OpenGraph audio URL not filled properly"
Expect.equal model.OpenGraphAudioType "" "OpenGraph audio type not filled properly"
Expect.equal model.OpenGraphDescription "" "OpenGraph description not filled properly"
Expect.equal model.OpenGraphDeterminer "" "OpenGraph determiner not filled properly"
Expect.equal model.OpenGraphLocale "" "OpenGraph locale not filled properly"
Expect.equal model.OpenGraphAlternateLocales "" "OpenGraph alt locales not filled properly"
Expect.equal model.OpenGraphVideoUrl "" "OpenGraph video URL not filled properly"
Expect.equal model.OpenGraphVideoType "" "OpenGraph video type not filled properly"
Expect.equal model.OpenGraphVideoWidth "" "OpenGraph video width not filled properly"
Expect.equal model.OpenGraphVideoHeight "" "OpenGraph video height not filled properly"
Expect.isEmpty model.OpenGraphExtraNames "OpenGraph extra names not filled properly"
Expect.isEmpty model.OpenGraphExtraValues "OpenGraph extra values not filled properly"
Expect.hasLength model.MetaNames 1 "MetaNames should have one entry"
Expect.equal model.MetaNames[0] "" "Meta name not set properly" Expect.equal model.MetaNames[0] "" "Meta name not set properly"
Expect.equal model.MetaValues.Length 1 "MetaValues should have one entry" Expect.hasLength model.MetaValues 1 "MetaValues should have one entry"
Expect.equal model.MetaValues[0] "" "Meta value not set properly" Expect.equal model.MetaValues[0] "" "Meta value not set properly"
} }
test "succeeds for filled page" { test "succeeds for filled page" {
@ -280,10 +337,31 @@ let editCommonModelTests = testList "EditCommonModel" [
Expect.equal model.Template "bork" "Template not filled properly" Expect.equal model.Template "bork" "Template not filled properly"
Expect.equal model.Source "Markdown" "Source not filled properly" Expect.equal model.Source "Markdown" "Source not filled properly"
Expect.equal model.Text "# Howdy!" "Text not filled properly" Expect.equal model.Text "# Howdy!" "Text not filled properly"
Expect.equal model.MetaNames.Length 2 "MetaNames should have two entries" Expect.isTrue model.AssignOpenGraph "OpenGraph properties should have been assigned"
Expect.equal model.OpenGraphType "book" "OpenGraph type not filled properly"
Expect.equal model.OpenGraphImageUrl "https://unit.test/it.png" "OpenGraph image URL not filled properly"
Expect.equal model.OpenGraphImageType "test/png" "OpenGraph image type not filled properly"
Expect.equal model.OpenGraphImageWidth "1" "OpenGraph image width not filled properly"
Expect.equal model.OpenGraphImageHeight "2" "OpenGraph image height not filled properly"
Expect.equal model.OpenGraphImageAlt "huh" "OpenGraph image alt text not filled properly"
Expect.equal model.OpenGraphAudioUrl "https://unit.test/it.mp3" "OpenGraph audio URL not filled properly"
Expect.equal model.OpenGraphAudioType "test/mpeg-3" "OpenGraph audio type not filled properly"
Expect.equal model.OpenGraphDescription "This is cool" "OpenGraph description not filled properly"
Expect.equal model.OpenGraphDeterminer "the" "OpenGraph determiner not filled properly"
Expect.equal model.OpenGraphLocale "en-US" "OpenGraph locale not filled properly"
Expect.equal model.OpenGraphAlternateLocales "es-MX, es-ES" "OpenGraph alt locales not filled properly"
Expect.equal model.OpenGraphVideoUrl "https://unit.test/it.mp4" "OpenGraph video URL not filled properly"
Expect.equal model.OpenGraphVideoType "test/mpeg-4" "OpenGraph video type not filled properly"
Expect.equal model.OpenGraphVideoWidth "5" "OpenGraph video width not filled properly"
Expect.equal model.OpenGraphVideoHeight "6" "OpenGraph video height not filled properly"
Expect.hasLength model.OpenGraphExtraNames 1 "OpenGraph extra names should have had 1 entry"
Expect.equal model.OpenGraphExtraNames[0] "the-other" "OpenGraph extra names not filled properly"
Expect.hasLength model.OpenGraphExtraValues 1 "OpenGraph extra values should have had 1 entry"
Expect.equal model.OpenGraphExtraValues[0] "the-value" "OpenGraph extra values not filled properly"
Expect.hasLength model.MetaNames 2 "MetaNames should have two entries"
Expect.equal model.MetaNames[0] "Test" "Meta name 0 not set properly" Expect.equal model.MetaNames[0] "Test" "Meta name 0 not set properly"
Expect.equal model.MetaNames[1] "Two" "Meta name 1 not set properly" Expect.equal model.MetaNames[1] "Two" "Meta name 1 not set properly"
Expect.equal model.MetaValues.Length 2 "MetaValues should have two entries" Expect.hasLength model.MetaValues 2 "MetaValues should have two entries"
Expect.equal model.MetaValues[0] "me" "Meta value 0 not set properly" Expect.equal model.MetaValues[0] "me" "Meta value 0 not set properly"
Expect.equal model.MetaValues[1] "2" "Meta value 1 not set properly" Expect.equal model.MetaValues[1] "2" "Meta value 1 not set properly"
} }
@ -298,9 +376,28 @@ let editCommonModelTests = testList "EditCommonModel" [
Expect.equal model.Source "HTML" "Source not filled properly" Expect.equal model.Source "HTML" "Source not filled properly"
Expect.equal model.Text "" "Text not filled properly" Expect.equal model.Text "" "Text not filled properly"
Expect.equal model.Template "" "Template not filled properly" Expect.equal model.Template "" "Template not filled properly"
Expect.equal model.MetaNames.Length 1 "MetaNames not filled properly" Expect.isFalse model.AssignOpenGraph "OpenGraph properties should not have been assigned"
Expect.equal model.OpenGraphType "" "OpenGraph type not filled properly"
Expect.equal model.OpenGraphImageUrl "" "OpenGraph image URL not filled properly"
Expect.equal model.OpenGraphImageType "" "OpenGraph image type not filled properly"
Expect.equal model.OpenGraphImageWidth "" "OpenGraph image width not filled properly"
Expect.equal model.OpenGraphImageHeight "" "OpenGraph image height not filled properly"
Expect.equal model.OpenGraphImageAlt "" "OpenGraph image alt text not filled properly"
Expect.equal model.OpenGraphAudioUrl "" "OpenGraph audio URL not filled properly"
Expect.equal model.OpenGraphAudioType "" "OpenGraph audio type not filled properly"
Expect.equal model.OpenGraphDescription "" "OpenGraph description not filled properly"
Expect.equal model.OpenGraphDeterminer "" "OpenGraph determiner not filled properly"
Expect.equal model.OpenGraphLocale "" "OpenGraph locale not filled properly"
Expect.equal model.OpenGraphAlternateLocales "" "OpenGraph alt locales not filled properly"
Expect.equal model.OpenGraphVideoUrl "" "OpenGraph video URL not filled properly"
Expect.equal model.OpenGraphVideoType "" "OpenGraph video type not filled properly"
Expect.equal model.OpenGraphVideoWidth "" "OpenGraph video width not filled properly"
Expect.equal model.OpenGraphVideoHeight "" "OpenGraph video height not filled properly"
Expect.isEmpty model.OpenGraphExtraNames "OpenGraph extra names not filled properly"
Expect.isEmpty model.OpenGraphExtraValues "OpenGraph extra values not filled properly"
Expect.hasLength model.MetaNames 1 "MetaNames not filled properly"
Expect.equal model.MetaNames[0] "" "Meta name 0 not filled properly" Expect.equal model.MetaNames[0] "" "Meta name 0 not filled properly"
Expect.equal model.MetaValues.Length 1 "MetaValues not filled properly" Expect.hasLength model.MetaValues 1 "MetaValues not filled properly"
Expect.equal model.MetaValues[0] "" "Meta value 0 not filled properly" Expect.equal model.MetaValues[0] "" "Meta value 0 not filled properly"
} }
test "succeeds for full post with external chapters" { test "succeeds for full post with external chapters" {
@ -312,12 +409,111 @@ let editCommonModelTests = testList "EditCommonModel" [
Expect.equal model.Source "HTML" "Source not filled properly" Expect.equal model.Source "HTML" "Source not filled properly"
Expect.equal model.Text "<p>A post!</p>" "Text not filled properly" Expect.equal model.Text "<p>A post!</p>" "Text not filled properly"
Expect.equal model.Template "demo" "Template not filled properly" Expect.equal model.Template "demo" "Template not filled properly"
Expect.equal model.MetaNames.Length 1 "MetaNames not filled properly" Expect.isTrue model.AssignOpenGraph "OpenGraph properties should have been assigned"
Expect.equal model.OpenGraphType "music.album" "OpenGraph type not filled properly"
Expect.equal model.OpenGraphImageUrl "https://unit.test/it.jpg" "OpenGraph image URL not filled properly"
Expect.equal model.OpenGraphImageType "test/jpg" "OpenGraph image type not filled properly"
Expect.equal model.OpenGraphImageWidth "100" "OpenGraph image width not filled properly"
Expect.equal model.OpenGraphImageHeight "200" "OpenGraph image height not filled properly"
Expect.equal model.OpenGraphImageAlt "it is a jpeg" "OpenGraph image alt text not filled properly"
Expect.equal model.OpenGraphAudioUrl "https://unit.test/that.mp3" "OpenGraph audio URL not filled properly"
Expect.equal model.OpenGraphAudioType "test/mp3" "OpenGraph audio type not filled properly"
Expect.equal model.OpenGraphDescription "Just a post" "OpenGraph description not filled properly"
Expect.equal model.OpenGraphDeterminer "a" "OpenGraph determiner not filled properly"
Expect.equal model.OpenGraphLocale "es-MX" "OpenGraph locale not filled properly"
Expect.equal model.OpenGraphAlternateLocales "es-ES, en-EN" "OpenGraph alt locales not filled properly"
Expect.equal model.OpenGraphVideoUrl "https://unit.test/that.mp4" "OpenGraph video URL not filled properly"
Expect.equal model.OpenGraphVideoType "test/mp4" "OpenGraph video type not filled properly"
Expect.equal model.OpenGraphVideoWidth "50" "OpenGraph video width not filled properly"
Expect.equal model.OpenGraphVideoHeight "60" "OpenGraph video height not filled properly"
Expect.hasLength model.OpenGraphExtraNames 1 "OpenGraph extra names should have had 1 entry"
Expect.equal model.OpenGraphExtraNames[0] "an-other" "OpenGraph extra names not filled properly"
Expect.hasLength model.OpenGraphExtraValues 1 "OpenGraph extra values should have had 1 entry"
Expect.equal model.OpenGraphExtraValues[0] "a-value" "OpenGraph extra values not filled properly"
Expect.hasLength model.MetaNames 1 "MetaNames not filled properly"
Expect.equal model.MetaNames[0] "A Meta" "Meta name 0 not filled properly" Expect.equal model.MetaNames[0] "A Meta" "Meta name 0 not filled properly"
Expect.equal model.MetaValues.Length 1 "MetaValues not filled properly" Expect.hasLength model.MetaValues 1 "MetaValues not filled properly"
Expect.equal model.MetaValues[0] "A Value" "Meta value 0 not filled properly" Expect.equal model.MetaValues[0] "A Value" "Meta value 0 not filled properly"
} }
] ]
testList "ToOpenGraph" [
test "succeeds when OpenGraph properties are not assigned" {
Expect.isNone (EditCommonModel().ToOpenGraph()) "No OpenGraph properties should have returned None"
}
test "succeeds when minimal OpenGraph properties are assigned" {
let model = EditCommonModel()
model.AssignOpenGraph <- true
model.OpenGraphType <- string Article
model.OpenGraphImageUrl <- "https://unit.test/img.tiff"
let tryOg = model.ToOpenGraph()
Expect.isSome tryOg "There should have been a set of OpenGraph properties returned"
let og = tryOg.Value
Expect.equal og.Type Article "OpenGraph type not filled correctly"
Expect.equal og.Image.Url "https://unit.test/img.tiff" "OpenGraph image URL not filled properly"
Expect.isNone og.Image.Type "OpenGraph image type should have been None"
Expect.isNone og.Image.Width "OpenGraph image width should have been None"
Expect.isNone og.Image.Height "OpenGraph image height should have been None"
Expect.isNone og.Image.Alt "OpenGraph image alt text should have been None"
Expect.isNone og.Audio "OpenGraph audio should have been None"
Expect.isNone og.Description "OpenGraph description should have been None"
Expect.isNone og.Determiner "OpenGraph determiner should have been None"
Expect.isNone og.Locale "OpenGraph locale should have been None"
Expect.isNone og.LocaleAlternate "OpenGraph alt locales should have been None"
Expect.isNone og.Video "OpenGraph video should have been None"
Expect.isNone og.Other "OpenGraph other properties should have been None"
}
test "succeeds when all OpenGraph properties are assigned" {
let model = EditCommonModel()
model.AssignOpenGraph <- true
model.OpenGraphType <- string VideoMovie
model.OpenGraphImageUrl <- "https://unit.test/still.jpg"
model.OpenGraphImageType <- "still/jpg"
model.OpenGraphImageWidth <- "17"
model.OpenGraphImageHeight <- "24"
model.OpenGraphImageAlt <- "a still from the film"
model.OpenGraphAudioUrl <- "https://unit.test/movie.mp3"
model.OpenGraphAudioType <- "audio/mp-three"
model.OpenGraphDescription <- "Powerful. Stunning."
model.OpenGraphDeterminer <- "the"
model.OpenGraphLocale <- "en-EN"
model.OpenGraphAlternateLocales <- "es-ES, pt-PT"
model.OpenGraphVideoUrl <- "https://unit.test/movie.avi"
model.OpenGraphVideoType <- "video/outdated"
model.OpenGraphVideoWidth <- "1024"
model.OpenGraphVideoHeight <- "768"
model.OpenGraphExtraNames <- [| "og:duration"; "og:rating" |]
model.OpenGraphExtraValues <- [| "1:30:27"; "G" |]
let tryOg = model.ToOpenGraph()
Expect.isSome tryOg "There should have been a set of OpenGraph properties returned"
let og = tryOg.Value
Expect.equal og.Type VideoMovie "OpenGraph type not filled correctly"
Expect.equal og.Image.Url "https://unit.test/still.jpg" "OpenGraph image URL not filled properly"
Expect.equal og.Image.Type (Some "still/jpg") "OpenGraph image type not filled properly"
Expect.equal og.Image.Width (Some 17) "OpenGraph image width not filled properly"
Expect.equal og.Image.Height (Some 24) "OpenGraph image height not filled properly"
Expect.equal og.Image.Alt (Some "a still from the film") "OpenGraph image alt text not filled properly"
Expect.isSome og.Audio "OpenGraph audio should have been filled"
Expect.equal og.Audio.Value.Url "https://unit.test/movie.mp3" "OpenGraph audio URL not filled properly"
Expect.equal og.Audio.Value.Type (Some "audio/mp-three") "OpenGraph audio type not filled properly"
Expect.equal og.Description (Some "Powerful. Stunning.") "OpenGraph description not filled properly"
Expect.equal og.Determiner (Some "the") "OpenGraph determiner not filled properly"
Expect.equal og.Locale (Some "en-EN") "OpenGraph locale not filled properly"
Expect.isSome og.LocaleAlternate "OpenGraph alt locales not filled properly"
Expect.hasLength og.LocaleAlternate.Value 2 "There should have been 2 alternate locales"
Expect.equal og.LocaleAlternate.Value [ "es-ES"; "pt-PT" ] "OpenGraph alt locales are incorrect"
Expect.isSome og.Video "OpenGraph video should have been filled"
Expect.equal og.Video.Value.Url "https://unit.test/movie.avi" "OpenGraph video URL not filled properly"
Expect.equal og.Video.Value.Type (Some "video/outdated") "OpenGraph video type not filled properly"
Expect.equal og.Video.Value.Width (Some 1024) "OpenGraph video width not filled properly"
Expect.equal og.Video.Value.Height (Some 768) "OpenGraph video height not filled properly"
Expect.isSome og.Other "OpenGraph other properties should have been filled"
Expect.hasLength og.Other.Value 2 "There should have been 2 extra properties"
Expect.equal
og.Other.Value
[ { Name = "og:duration"; Value = "1:30:27" }; { Name = "og:rating"; Value = "G" } ]
"OpenGraph extra properties not filled properly"
}
]
] ]
/// Unit tests for the EditCustomFeedModel type /// Unit tests for the EditCustomFeedModel type
@ -514,11 +710,13 @@ let editPageModelTests = testList "EditPageModel" [
let model = EditPageModel.FromPage { Page.Empty with Id = PageId "abc" } let model = EditPageModel.FromPage { Page.Empty with Id = PageId "abc" }
Expect.equal model.Id "abc" "Parent fields not filled properly" Expect.equal model.Id "abc" "Parent fields not filled properly"
Expect.isFalse model.IsShownInPageList "IsShownInPageList should not have been set" Expect.isFalse model.IsShownInPageList "IsShownInPageList should not have been set"
Expect.isFalse model.AssignOpenGraph "OpenGraph properties should not be assigned"
} }
test "succeeds for filled page" { test "succeeds for filled page" {
let model = EditPageModel.FromPage testFullPage let model = EditPageModel.FromPage testFullPage
Expect.equal model.Id "the-page" "Parent fields not filled properly" Expect.equal model.Id "the-page" "Parent fields not filled properly"
Expect.isTrue model.IsShownInPageList "IsShownInPageList should have been set" Expect.isTrue model.IsShownInPageList "IsShownInPageList should have been set"
Expect.isTrue model.AssignOpenGraph "OpenGraph properties should have been assigned"
} }
] ]
testList "UpdatePage" [ testList "UpdatePage" [
@ -534,13 +732,12 @@ let editPageModelTests = testList "EditPageModel" [
Expect.isFalse page.IsInPageList "IsInPageList should have been unset" Expect.isFalse page.IsInPageList "IsInPageList should have been unset"
Expect.equal page.Template (Some "bork") "Template not filled properly" Expect.equal page.Template (Some "bork") "Template not filled properly"
Expect.equal page.Text "<h1 id=\"howdy\">Howdy!</h1>\n" "Text not filled properly" Expect.equal page.Text "<h1 id=\"howdy\">Howdy!</h1>\n" "Text not filled properly"
Expect.equal page.Metadata.Length 2 "There should be 2 metadata items" Expect.equal page.OpenGraph testFullPage.OpenGraph "OpenGraph properties should be unchanged"
let item1 = List.item 0 page.Metadata Expect.hasLength page.Metadata 2 "There should be 2 metadata items"
Expect.equal item1.Name "Test" "Meta item 0 name not filled properly" Expect.equal
Expect.equal item1.Value "me" "Meta item 0 value not filled properly" page.Metadata
let item2 = List.item 1 page.Metadata [ { Name = "Test"; Value = "me" }; { Name = "Two"; Value = "2" } ]
Expect.equal item2.Name "Two" "Meta item 1 name not filled properly" "Metadata not filled properly"
Expect.equal item2.Value "2" "Meta item 1 value not filled properly"
Expect.equal page.Revisions.Length 2 "There should be 2 revisions" Expect.equal page.Revisions.Length 2 "There should be 2 revisions"
let rev1 = List.item 0 page.Revisions let rev1 = List.item 0 page.Revisions
Expect.equal rev1.AsOf (Noda.epoch + Duration.FromHours 1) "Revision 0 as-of not filled properly" Expect.equal rev1.AsOf (Noda.epoch + Duration.FromHours 1) "Revision 0 as-of not filled properly"
@ -558,6 +755,7 @@ let editPageModelTests = testList "EditPageModel" [
model.IsShownInPageList <- false model.IsShownInPageList <- false
model.Source <- "HTML" model.Source <- "HTML"
model.Text <- "<h1>Howdy, partners!</h1>" model.Text <- "<h1>Howdy, partners!</h1>"
model.AssignOpenGraph <- false
model.MetaNames <- [| "banana"; "apple"; "grape" |] model.MetaNames <- [| "banana"; "apple"; "grape" |]
model.MetaValues <- [| "monkey"; "zebra"; "ape" |] model.MetaValues <- [| "monkey"; "zebra"; "ape" |]
let now = Noda.epoch + Duration.FromDays 7 let now = Noda.epoch + Duration.FromDays 7
@ -569,16 +767,14 @@ let editPageModelTests = testList "EditPageModel" [
Expect.isFalse page.IsInPageList "IsInPageList should not have been set" Expect.isFalse page.IsInPageList "IsInPageList should not have been set"
Expect.isNone page.Template "Template not filled properly" Expect.isNone page.Template "Template not filled properly"
Expect.equal page.Text "<h1>Howdy, partners!</h1>" "Text not filled properly" Expect.equal page.Text "<h1>Howdy, partners!</h1>" "Text not filled properly"
Expect.isNone page.OpenGraph "OpenGraph properties not cleared properly"
Expect.equal page.Metadata.Length 3 "There should be 3 metadata items" Expect.equal page.Metadata.Length 3 "There should be 3 metadata items"
let item1 = List.item 0 page.Metadata Expect.equal
Expect.equal item1.Name "apple" "Meta item 0 name not filled properly" page.Metadata
Expect.equal item1.Value "zebra" "Meta item 0 value not filled properly" [ { Name = "apple"; Value = "zebra" }
let item2 = List.item 1 page.Metadata { Name = "banana"; Value = "monkey" }
Expect.equal item2.Name "banana" "Meta item 1 name not filled properly" { Name = "grape"; Value = "ape" } ]
Expect.equal item2.Value "monkey" "Meta item 1 value not filled properly" "Metadata not filled properly"
let item3 = List.item 2 page.Metadata
Expect.equal item3.Name "grape" "Meta item 2 name not filled properly"
Expect.equal item3.Value "ape" "Meta item 2 value not filled properly"
Expect.equal page.Revisions.Length 3 "There should be 3 revisions" Expect.equal page.Revisions.Length 3 "There should be 3 revisions"
Expect.equal page.Revisions.Head.AsOf now "Head revision as-of not filled properly" Expect.equal page.Revisions.Head.AsOf now "Head revision as-of not filled properly"
Expect.equal Expect.equal
@ -593,6 +789,7 @@ let editPostModelTests = testList "EditPostModel" [
test "succeeds for empty post" { test "succeeds for empty post" {
let model = EditPostModel.FromPost WebLog.Empty { Post.Empty with Id = PostId "la-la-la" } let model = EditPostModel.FromPost WebLog.Empty { Post.Empty with Id = PostId "la-la-la" }
Expect.equal model.Id "la-la-la" "Parent fields not filled properly" Expect.equal model.Id "la-la-la" "Parent fields not filled properly"
Expect.isFalse model.AssignOpenGraph "OpenGraph properties should not be assigned"
Expect.equal model.Tags "" "Tags not filled properly" Expect.equal model.Tags "" "Tags not filled properly"
Expect.isEmpty model.CategoryIds "CategoryIds not filled properly" Expect.isEmpty model.CategoryIds "CategoryIds not filled properly"
Expect.equal model.Status (string Draft) "Status not filled properly" Expect.equal model.Status (string Draft) "Status not filled properly"
@ -624,6 +821,7 @@ let editPostModelTests = testList "EditPostModel" [
test "succeeds for full post with external chapters" { test "succeeds for full post with external chapters" {
let model = EditPostModel.FromPost { WebLog.Empty with TimeZone = "Etc/GMT+1" } testFullPost let model = EditPostModel.FromPost { WebLog.Empty with TimeZone = "Etc/GMT+1" } testFullPost
Expect.equal model.Id "a-post" "Parent fields not filled properly" Expect.equal model.Id "a-post" "Parent fields not filled properly"
Expect.isTrue model.AssignOpenGraph "OpenGraph properties should have been assigned"
Expect.equal model.Tags "demo, post" "Tags not filled properly" Expect.equal model.Tags "demo, post" "Tags not filled properly"
Expect.equal model.CategoryIds [| "cat-a"; "cat-b"; "cat-n" |] "CategoryIds not filled properly" Expect.equal model.CategoryIds [| "cat-a"; "cat-b"; "cat-n" |] "CategoryIds not filled properly"
Expect.equal model.Status (string Published) "Status not filled properly" Expect.equal model.Status (string Published) "Status not filled properly"
@ -679,6 +877,7 @@ let editPostModelTests = testList "EditPostModel" [
model.Tags <- "Zebras, Aardvarks, , Turkeys" model.Tags <- "Zebras, Aardvarks, , Turkeys"
model.Template <- "updated" model.Template <- "updated"
model.CategoryIds <- [| "cat-x"; "cat-y" |] model.CategoryIds <- [| "cat-x"; "cat-y" |]
model.AssignOpenGraph <- false
model.MetaNames <- [| "Zed Meta"; "A Meta" |] model.MetaNames <- [| "Zed Meta"; "A Meta" |]
model.MetaValues <- [| "A Value"; "Zed Value" |] model.MetaValues <- [| "A Value"; "Zed Value" |]
model.Media <- "an-updated-ep.mp3" model.Media <- "an-updated-ep.mp3"
@ -711,11 +910,12 @@ let editPostModelTests = testList "EditPostModel" [
Expect.equal post.Tags [ "aardvarks"; "turkeys"; "zebras" ] "Tags not filled properly" Expect.equal post.Tags [ "aardvarks"; "turkeys"; "zebras" ] "Tags not filled properly"
Expect.equal post.Template (Some "updated") "Template not filled properly" Expect.equal post.Template (Some "updated") "Template not filled properly"
Expect.equal post.CategoryIds [ CategoryId "cat-x"; CategoryId "cat-y" ] "Categories not filled properly" Expect.equal post.CategoryIds [ CategoryId "cat-x"; CategoryId "cat-y" ] "Categories not filled properly"
Expect.equal post.Metadata.Length 2 "There should have been 2 meta items" Expect.isNone post.OpenGraph "OpenGraph properties should have been cleared"
Expect.equal post.Metadata[0].Name "A Meta" "Meta item 0 name not filled properly" Expect.hasLength post.Metadata 2 "There should have been 2 meta items"
Expect.equal post.Metadata[0].Value "Zed Value" "Meta item 0 value not filled properly" Expect.equal
Expect.equal post.Metadata[1].Name "Zed Meta" "Meta item 1 name not filled properly" post.Metadata
Expect.equal post.Metadata[1].Value "A Value" "Meta item 1 value not filled properly" [ { Name = "A Meta"; Value = "Zed Value" }; { Name = "Zed Meta"; Value = "A Value" } ]
"Metadata not filled properly"
Expect.equal post.Revisions.Length 3 "There should have been 3 revisions" Expect.equal post.Revisions.Length 3 "There should have been 3 revisions"
Expect.equal Expect.equal
post.Revisions[0].AsOf (Noda.epoch + Duration.FromDays 400) "Revision 0 AsOf not filled properly" post.Revisions[0].AsOf (Noda.epoch + Duration.FromDays 400) "Revision 0 AsOf not filled properly"
@ -1157,13 +1357,14 @@ let settingsModelTests = testList "SettingsModel" [
let model = let model =
SettingsModel.FromWebLog SettingsModel.FromWebLog
{ WebLog.Empty with { WebLog.Empty with
Name = "The Web Log" Name = "The Web Log"
Slug = "the-web-log" Slug = "the-web-log"
DefaultPage = "this-one" DefaultPage = "this-one"
PostsPerPage = 18 PostsPerPage = 18
TimeZone = "America/Denver" TimeZone = "America/Denver"
ThemeId = ThemeId "my-theme" ThemeId = ThemeId "my-theme"
AutoHtmx = true } AutoHtmx = true
AutoOpenGraph = false }
Expect.equal model.Name "The Web Log" "Name not filled properly" Expect.equal model.Name "The Web Log" "Name not filled properly"
Expect.equal model.Slug "the-web-log" "Slug not filled properly" Expect.equal model.Slug "the-web-log" "Slug not filled properly"
Expect.equal model.Subtitle "" "Subtitle not filled properly" Expect.equal model.Subtitle "" "Subtitle not filled properly"
@ -1173,6 +1374,7 @@ let settingsModelTests = testList "SettingsModel" [
Expect.equal model.ThemeId "my-theme" "ThemeId not filled properly" Expect.equal model.ThemeId "my-theme" "ThemeId not filled properly"
Expect.isTrue model.AutoHtmx "AutoHtmx should have been set" Expect.isTrue model.AutoHtmx "AutoHtmx should have been set"
Expect.equal model.Uploads "Database" "Uploads not filled properly" Expect.equal model.Uploads "Database" "Uploads not filled properly"
Expect.isFalse model.AutoOpenGraph "AutoOpenGraph should have been unset"
} }
test "succeeds with a subtitle" { test "succeeds with a subtitle" {
let model = SettingsModel.FromWebLog { WebLog.Empty with Subtitle = Some "sub here!" } let model = SettingsModel.FromWebLog { WebLog.Empty with Subtitle = Some "sub here!" }
@ -1182,15 +1384,16 @@ let settingsModelTests = testList "SettingsModel" [
testList "Update" [ testList "Update" [
test "succeeds with no subtitle" { test "succeeds with no subtitle" {
let webLog = let webLog =
{ Name = "Interesting" { Name = "Interesting"
Slug = "some-stuff" Slug = "some-stuff"
Subtitle = "" Subtitle = ""
DefaultPage = "that-one" DefaultPage = "that-one"
PostsPerPage = 8 PostsPerPage = 8
TimeZone = "America/Chicago" TimeZone = "America/Chicago"
ThemeId = "test-theme" ThemeId = "test-theme"
AutoHtmx = true AutoHtmx = true
Uploads = "Disk" }.Update WebLog.Empty Uploads = "Disk"
AutoOpenGraph = false }.Update WebLog.Empty
Expect.equal webLog.Name "Interesting" "Name not filled properly" Expect.equal webLog.Name "Interesting" "Name not filled properly"
Expect.equal webLog.Slug "some-stuff" "Slug not filled properly" Expect.equal webLog.Slug "some-stuff" "Slug not filled properly"
Expect.isNone webLog.Subtitle "Subtitle should not have had a value" Expect.isNone webLog.Subtitle "Subtitle should not have had a value"
@ -1200,6 +1403,7 @@ let settingsModelTests = testList "SettingsModel" [
Expect.equal webLog.ThemeId (ThemeId "test-theme") "ThemeId not filled properly" Expect.equal webLog.ThemeId (ThemeId "test-theme") "ThemeId not filled properly"
Expect.isTrue webLog.AutoHtmx "AutoHtmx should have been set" Expect.isTrue webLog.AutoHtmx "AutoHtmx should have been set"
Expect.equal webLog.Uploads Disk "Uploads not filled properly" Expect.equal webLog.Uploads Disk "Uploads not filled properly"
Expect.isFalse webLog.AutoOpenGraph "AutoOpenGraph should have been unset"
} }
test "succeeds with a subtitle" { test "succeeds with a subtitle" {
let webLog = { SettingsModel.FromWebLog WebLog.Empty with Subtitle = "Sub" }.Update WebLog.Empty let webLog = { SettingsModel.FromWebLog WebLog.Empty with Subtitle = "Sub" }.Update WebLog.Empty

4
src/MyWebLog.Tests/MyWebLog.Tests.fsproj

@ -26,9 +26,9 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Expecto" Version="10.2.1" /> <PackageReference Include="Expecto" Version="10.2.3" />
<PackageReference Include="ThrowawayDb.Postgres" Version="1.4.0" /> <PackageReference Include="ThrowawayDb.Postgres" Version="1.4.0" />
<PackageReference Update="FSharp.Core" Version="8.0.300" /> <PackageReference Update="FSharp.Core" Version="9.0.300" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

23
src/MyWebLog.Tests/Program.fs

@ -10,20 +10,19 @@ let sqliteOnly = (RethinkDbDataTests.env "SQLITE_ONLY" "0") = "1"
let postgresOnly = (RethinkDbDataTests.env "PG_ONLY" "0") = "1" let postgresOnly = (RethinkDbDataTests.env "PG_ONLY" "0") = "1"
/// Whether any of the data tests are being isolated /// Whether any of the data tests are being isolated
let dbOnly = rethinkOnly || sqliteOnly || postgresOnly let allDatabases = not (rethinkOnly || sqliteOnly || postgresOnly)
/// Whether to only run the unit tests (skip database/integration tests)
let unitOnly = (RethinkDbDataTests.env "UNIT_ONLY" "0") = "1"
let allTests = testList "MyWebLog" [ let allTests = testList "MyWebLog" [
if not dbOnly then testList "Domain" [ SupportTypesTests.all; DataTypesTests.all; ViewModelsTests.all ] // Skip unit tests if running an isolated database test
if not unitOnly then if allDatabases then
testList "Data" [ testList "Domain" [ SupportTypesTests.all; DataTypesTests.all; ViewModelsTests.all ]
if not dbOnly then ConvertersTests.all testList "Data (Unit)" [ ConvertersTests.all; UtilsTests.all ]
if not dbOnly then UtilsTests.all // Whether to skip integration tests
if not dbOnly || (dbOnly && rethinkOnly) then RethinkDbDataTests.all if RethinkDbDataTests.env "UNIT_ONLY" "0" <> "1" then
if not dbOnly || (dbOnly && sqliteOnly) then SQLiteDataTests.all testList "Data (Integration)" [
if not dbOnly || (dbOnly && postgresOnly) then PostgresDataTests.all if allDatabases || rethinkOnly then RethinkDbDataTests.all
if allDatabases || sqliteOnly then SQLiteDataTests.all
if allDatabases || postgresOnly then PostgresDataTests.all
] ]
] ]

189
src/MyWebLog/Caches.fs

@ -3,7 +3,7 @@
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open MyWebLog.Data open MyWebLog.Data
/// Extension properties on HTTP context for web log /// <summary>Extension properties on HTTP context for web log</summary>
[<AutoOpen>] [<AutoOpen>]
module Extensions = module Extensions =
@ -17,16 +17,16 @@ module Extensions =
type HttpContext with type HttpContext with
/// The anti-CSRF service /// <summary>The anti-CSRF service</summary>
member this.AntiForgery = this.RequestServices.GetRequiredService<IAntiforgery>() member this.AntiForgery = this.RequestServices.GetRequiredService<IAntiforgery>()
/// The cross-site request forgery token set for this request /// <summary>The cross-site request forgery token set for this request</summary>
member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this
/// The data implementation /// <summary>The data implementation</summary>
member this.Data = this.RequestServices.GetRequiredService<IData>() member this.Data = this.RequestServices.GetRequiredService<IData>()
/// The generator string /// <summary>The generator string</summary>
member this.Generator = member this.Generator =
match generatorString with match generatorString with
| Some gen -> gen | Some gen -> gen
@ -38,20 +38,22 @@ module Extensions =
| None -> Some "generator not configured" | None -> Some "generator not configured"
generatorString.Value generatorString.Value
/// The access level for the current user /// <summary>The access level for the current user</summary>
member this.UserAccessLevel = member this.UserAccessLevel =
this.User.Claims this.User.Claims
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.Role) |> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.Role)
|> Option.map (fun claim -> AccessLevel.Parse claim.Value) |> Option.map (fun claim -> AccessLevel.Parse claim.Value)
/// The user ID for the current request /// <summary>The user ID for the current request</summary>
member this.UserId = member this.UserId =
WebLogUserId (this.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value WebLogUserId (this.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value
/// The web log for the current request /// <summary>The web log for the current request</summary>
member this.WebLog = this.Items["webLog"] :?> WebLog member this.WebLog = this.Items["webLog"] :?> WebLog
/// Does the current user have the requested level of access? /// <summary>Does the current user have the required level of access?</summary>
/// <param name="level">The required level of access</param>
/// <returns>True if the user has the required access, false if not</returns>
member this.HasAccessLevel level = member this.HasAccessLevel level =
defaultArg (this.UserAccessLevel |> Option.map _.HasAccess(level)) false defaultArg (this.UserAccessLevel |> Option.map _.HasAccess(level)) false
@ -67,27 +69,30 @@ module WebLogCache =
open System.Text.RegularExpressions open System.Text.RegularExpressions
/// A redirect rule that caches compiled regular expression rules /// <summary>A redirect rule that caches compiled regular expression rules</summary>
type CachedRedirectRule = type CachedRedirectRule =
/// A straight text match rule /// <summary>A straight text match rule</summary>
| Text of string * string | Text of string * string
/// A regular expression match rule /// <summary>A regular expression match rule</summary>
| RegEx of Regex * string | RegEx of Regex * string
/// The cache of web log details /// The cache of web log details
let mutable private _cache : WebLog list = [] let mutable private _cache: WebLog list = []
/// Redirect rules with compiled regular expressions /// Redirect rules with compiled regular expressions
let mutable private _redirectCache = ConcurrentDictionary<WebLogId, CachedRedirectRule list> () let mutable private _redirectCache = ConcurrentDictionary<WebLogId, CachedRedirectRule list>()
/// Try to get the web log for the current request (longest matching URL base wins) /// <summary>Try to get the web log for the current request (longest matching URL base wins)</summary>
let tryGet (path : string) = /// <param name="path">The path for the current request</param>
/// <returns>Some with the web log matching the URL, or None if none is found</returns>
let tryGet (path: string) =
_cache _cache
|> List.filter (fun wl -> path.StartsWith wl.UrlBase) |> List.filter (fun wl -> path.StartsWith wl.UrlBase)
|> List.sortByDescending _.UrlBase.Length |> List.sortByDescending _.UrlBase.Length
|> List.tryHead |> List.tryHead
/// Cache the web log for a particular host /// <summary>Cache the web log for a particular host</summary>
/// <param name="webLog">The web log to be cached</param>
let set webLog = let set webLog =
_cache <- webLog :: (_cache |> List.filter (fun wl -> wl.Id <> webLog.Id)) _cache <- webLog :: (_cache |> List.filter (fun wl -> wl.Id <> webLog.Id))
_redirectCache[webLog.Id] <- _redirectCache[webLog.Id] <-
@ -101,165 +106,123 @@ module WebLogCache =
else else
Text(relUrl it.From, urlTo)) Text(relUrl it.From, urlTo))
/// Get all cached web logs /// <summary>Get all cached web logs</summary>
/// <returns>All cached web logs</returns>
let all () = let all () =
_cache _cache
/// Fill the web log cache from the database /// <summary>Fill the web log cache from the database</summary>
/// <param name="data">The data implementation from which web logs will be retrieved</param>
let fill (data: IData) = backgroundTask { let fill (data: IData) = backgroundTask {
let! webLogs = data.WebLog.All() let! webLogs = data.WebLog.All()
webLogs |> List.iter set webLogs |> List.iter set
} }
/// Get the cached redirect rules for the given web log /// <summary>Get the cached redirect rules for the given web log</summary>
/// <param name="webLogId">The ID of the web log for which rules should be retrieved</param>
/// <returns>The redirect rules for the given web log ID</returns>
let redirectRules webLogId = let redirectRules webLogId =
_redirectCache[webLogId] _redirectCache[webLogId]
/// Is the given theme in use by any web logs? /// <summary>Is the given theme in use by any web logs?</summary>
/// <param name="themeId">The ID of the theme whose use should be checked</param>
/// <returns>True if any web logs are using the given theme, false if not</returns>
let isThemeInUse themeId = let isThemeInUse themeId =
_cache |> List.exists (fun wl -> wl.ThemeId = themeId) _cache |> List.exists (fun wl -> wl.ThemeId = themeId)
/// A cache of page information needed to display the page list in templates /// <summary>A cache of page information needed to display the page list in templates</summary>
module PageListCache = module PageListCache =
open MyWebLog.ViewModels open MyWebLog.ViewModels
/// Cache of displayed pages /// Cache of displayed pages
let private _cache = ConcurrentDictionary<WebLogId, DisplayPage array> () let private _cache = ConcurrentDictionary<WebLogId, DisplayPage array>()
/// Fill the page list for the given web log
let private fillPages (webLog: WebLog) pages = let private fillPages (webLog: WebLog) pages =
_cache[webLog.Id] <- _cache[webLog.Id] <-
pages pages
|> List.map (fun pg -> DisplayPage.FromPage webLog { pg with Text = "" }) |> List.map (fun pg -> DisplayPage.FromPage webLog { pg with Text = "" })
|> Array.ofList |> Array.ofList
/// Are there pages cached for this web log? /// <summary>Are there pages cached for this web log?</summary>
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
/// <returns>True if the current web log has any pages cached, false if not</returns>
let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id
/// Get the pages for the web log for this request /// <summary>Get the pages for the web log for this request</summary>
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
/// <returns>The page list for the current web log</returns>
let get (ctx: HttpContext) = _cache[ctx.WebLog.Id] let get (ctx: HttpContext) = _cache[ctx.WebLog.Id]
/// Update the pages for the current web log /// <summary>Refresh the pages for the given web log</summary>
let update (ctx: HttpContext) = backgroundTask { /// <param name="webLog">The web log for which pages should be refreshed</param>
let! pages = ctx.Data.Page.FindListed ctx.WebLog.Id /// <param name="data">The data implementation from which pages should be retrieved</param>
fillPages ctx.WebLog pages
}
/// Refresh the pages for the given web log
let refresh (webLog: WebLog) (data: IData) = backgroundTask { let refresh (webLog: WebLog) (data: IData) = backgroundTask {
let! pages = data.Page.FindListed webLog.Id let! pages = data.Page.FindListed webLog.Id
fillPages webLog pages fillPages webLog pages
} }
/// <summary>Update the pages for the current web log</summary>
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
let update (ctx: HttpContext) =
refresh ctx.WebLog ctx.Data
/// Cache of all categories, indexed by web log
/// <summary>Cache of all categories, indexed by web log</summary>
module CategoryCache = module CategoryCache =
open MyWebLog.ViewModels open MyWebLog.ViewModels
/// The cache itself /// The cache itself
let private _cache = ConcurrentDictionary<WebLogId, DisplayCategory array> () let private _cache = ConcurrentDictionary<WebLogId, DisplayCategory array>()
/// Are there categories cached for this web log? /// <summary>Are there categories cached for this web log?</summary>
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
/// <returns>True if the current web logs has any categories cached, false if not</returns>
let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id
/// Get the categories for the web log for this request /// <summary>Get the categories for the web log for this request</summary>
/// <param name="ctx">The <c>HttpContext</c> for the current request</param>
/// <returns>The categories for the current web log</returns>
let get (ctx: HttpContext) = _cache[ctx.WebLog.Id] let get (ctx: HttpContext) = _cache[ctx.WebLog.Id]
/// Update the cache with fresh data /// <summary>Refresh the category cache for the given web log</summary>
let update (ctx: HttpContext) = backgroundTask { /// <param name="webLogId">The ID of the web log for which the cache should be refreshed</param>
let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.Id /// <param name="data">The data implementation from which categories should be retrieved</param>
_cache[ctx.WebLog.Id] <- cats
}
/// Refresh the category cache for the given web log
let refresh webLogId (data: IData) = backgroundTask { let refresh webLogId (data: IData) = backgroundTask {
let! cats = data.Category.FindAllForView webLogId let! cats = data.Category.FindAllForView webLogId
_cache[webLogId] <- cats _cache[webLogId] <- cats
} }
/// <summary>Update the cache with fresh data for the current web log</summary>
/// Cache for parsed templates /// <param name="ctx">The <c>HttpContext</c> for the current request</param>
module TemplateCache = let update (ctx: HttpContext) =
refresh ctx.WebLog.Id ctx.Data
open System
open System.Text.RegularExpressions
open DotLiquid
/// Cache of parsed templates
let private _cache = ConcurrentDictionary<string, Template> ()
/// Custom include parameter pattern
let private hasInclude = Regex("""{% include_template \"(.*)\" %}""", RegexOptions.None, TimeSpan.FromSeconds 2)
/// Get a template for the given theme and template name
let get (themeId: ThemeId) (templateName: string) (data: IData) = backgroundTask {
let templatePath = $"{themeId}/{templateName}"
match _cache.ContainsKey templatePath with
| true -> return Ok _cache[templatePath]
| false ->
match! data.Theme.FindById themeId with
| Some theme ->
match theme.Templates |> List.tryFind (fun t -> t.Name = templateName) with
| Some template ->
let mutable text = template.Text
let mutable childNotFound = ""
while hasInclude.IsMatch text do
let child = hasInclude.Match text
let childText =
match theme.Templates |> List.tryFind (fun t -> t.Name = child.Groups[1].Value) with
| Some childTemplate -> childTemplate.Text
| None ->
childNotFound <-
if childNotFound = "" then child.Groups[1].Value
else $"{childNotFound}; {child.Groups[1].Value}"
""
text <- text.Replace(child.Value, childText)
if childNotFound <> "" then
let s = if childNotFound.IndexOf ";" >= 0 then "s" else ""
return Error $"Could not find the child template{s} {childNotFound} required by {templateName}"
else
_cache[templatePath] <- Template.Parse(text, SyntaxCompatibility.DotLiquid22)
return Ok _cache[templatePath]
| None ->
return Error $"Theme ID {themeId} does not have a template named {templateName}"
| None -> return Error $"Theme ID {themeId} does not exist"
}
/// Get all theme/template names currently cached
let allNames () =
_cache.Keys |> Seq.sort |> Seq.toList
/// Invalidate all template cache entries for the given theme ID
let invalidateTheme (themeId: ThemeId) =
let keyPrefix = string themeId
_cache.Keys
|> Seq.filter _.StartsWith(keyPrefix)
|> List.ofSeq
|> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ())
/// Remove all entries from the template cache
let empty () =
_cache.Clear()
/// A cache of asset names by themes /// <summary>A cache of asset names by themes</summary>
module ThemeAssetCache = module ThemeAssetCache =
/// A list of asset names for each theme /// A list of asset names for each theme
let private _cache = ConcurrentDictionary<ThemeId, string list> () let private _cache = ConcurrentDictionary<ThemeId, string list>()
/// Retrieve the assets for the given theme ID /// <summary>Retrieve the assets for the given theme ID</summary>
/// <param name="themeId">The ID of the theme whose assets should be returned</param>
/// <returns>The assets for the given theme</returns>
let get themeId = _cache[themeId] let get themeId = _cache[themeId]
/// Refresh the list of assets for the given theme /// <summary>Refresh the list of assets for the given theme</summary>
/// <param name="themeId">The ID of the theme whose assets should be refreshed</param>
/// <param name="data">The data implementation from which assets should be retrieved</param>
let refreshTheme themeId (data: IData) = backgroundTask { let refreshTheme themeId (data: IData) = backgroundTask {
let! assets = data.ThemeAsset.FindByTheme themeId let! assets = data.ThemeAsset.FindByTheme themeId
_cache[themeId] <- assets |> List.map (fun a -> match a.Id with ThemeAssetId (_, path) -> path) _cache[themeId] <- assets |> List.map (fun a -> match a.Id with ThemeAssetId (_, path) -> path)
} }
/// Fill the theme asset cache /// <summary>Fill the theme asset cache</summary>
/// <param name="data">The data implementation from which assets should be retrieved</param>
let fill (data: IData) = backgroundTask { let fill (data: IData) = backgroundTask {
let! assets = data.ThemeAsset.All() let! assets = data.ThemeAsset.All()
for asset in assets do for asset in assets do

28
src/MyWebLog/Handlers/Admin.fs

@ -28,13 +28,13 @@ module Dashboard =
ListedPages = listed ListedPages = listed
Categories = cats Categories = cats
TopLevelCategories = topCats } TopLevelCategories = topCats }
return! adminPage "Dashboard" false next ctx (Views.WebLog.dashboard model) return! adminPage "Dashboard" next ctx (Views.WebLog.dashboard model)
} }
// GET /admin/administration // GET /admin/administration
let admin : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { let admin : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let! themes = ctx.Data.Theme.All() let! themes = ctx.Data.Theme.All()
return! adminPage "myWebLog Administration" true next ctx (Views.Admin.dashboard themes) return! adminPage "myWebLog Administration" next ctx (Views.Admin.dashboard themes)
} }
/// Redirect the user to the admin dashboard /// Redirect the user to the admin dashboard
@ -71,7 +71,7 @@ module Cache =
let refreshTheme themeId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { let refreshTheme themeId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
if themeId = "all" then if themeId = "all" then
TemplateCache.empty () Template.Cache.empty ()
do! ThemeAssetCache.fill data do! ThemeAssetCache.fill data
do! addMessage ctx do! addMessage ctx
{ UserMessage.Success with { UserMessage.Success with
@ -79,7 +79,7 @@ module Cache =
else else
match! data.Theme.FindById(ThemeId themeId) with match! data.Theme.FindById(ThemeId themeId) with
| Some theme -> | Some theme ->
TemplateCache.invalidateTheme theme.Id Template.Cache.invalidateTheme theme.Id
do! ThemeAssetCache.refreshTheme theme.Id data do! ThemeAssetCache.refreshTheme theme.Id data
do! addMessage ctx do! addMessage ctx
{ UserMessage.Success with { UserMessage.Success with
@ -98,7 +98,7 @@ module Category =
// GET /admin/categories // GET /admin/categories
let all : HttpHandler = fun next ctx -> let all : HttpHandler = fun next ctx ->
let response = fun next ctx -> let response = fun next ctx ->
adminPage "Categories" true next ctx (Views.WebLog.categoryList (ctx.Request.Query.ContainsKey "new")) adminPage "Categories" next ctx (Views.WebLog.categoryList (ctx.Request.Query.ContainsKey "new"))
(withHxPushUrl (ctx.WebLog.RelativeUrl (Permalink "admin/categories")) >=> response) next ctx (withHxPushUrl (ctx.WebLog.RelativeUrl (Permalink "admin/categories")) >=> response) next ctx
// GET /admin/category/{id}/edit // GET /admin/category/{id}/edit
@ -115,7 +115,7 @@ module Category =
| Some (title, cat) -> | Some (title, cat) ->
return! return!
Views.WebLog.categoryEdit (EditCategoryModel.FromCategory cat) Views.WebLog.categoryEdit (EditCategoryModel.FromCategory cat)
|> adminBarePage title true next ctx |> adminBarePage title next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -167,7 +167,7 @@ module RedirectRules =
// GET /admin/settings/redirect-rules // GET /admin/settings/redirect-rules
let all : HttpHandler = fun next ctx -> let all : HttpHandler = fun next ctx ->
adminPage "Redirect Rules" true next ctx (Views.WebLog.redirectList ctx.WebLog.RedirectRules) adminPage "Redirect Rules" next ctx (Views.WebLog.redirectList ctx.WebLog.RedirectRules)
// GET /admin/settings/redirect-rules/[index] // GET /admin/settings/redirect-rules/[index]
let edit idx : HttpHandler = fun next ctx -> let edit idx : HttpHandler = fun next ctx ->
@ -182,7 +182,7 @@ module RedirectRules =
Some Some
("Edit", (Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule idx (List.item idx rules)))) ("Edit", (Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule idx (List.item idx rules))))
match titleAndView with match titleAndView with
| Some (title, view) -> adminBarePage $"{title} Redirect Rule" true next ctx view | Some (title, view) -> adminBarePage $"{title} Redirect Rule" next ctx view
| None -> Error.notFound next ctx | None -> Error.notFound next ctx
/// Update the web log's redirect rules in the database, the request web log, and the web log cache /// Update the web log's redirect rules in the database, the request web log, and the web log cache
@ -247,7 +247,7 @@ module TagMapping =
// GET /admin/settings/tag-mappings // GET /admin/settings/tag-mappings
let all : HttpHandler = fun next ctx -> task { let all : HttpHandler = fun next ctx -> task {
let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
return! adminBarePage "Tag Mapping List" true next ctx (Views.WebLog.tagMapList mappings) return! adminBarePage "Tag Mapping List" next ctx (Views.WebLog.tagMapList mappings)
} }
// GET /admin/settings/tag-mapping/{id}/edit // GET /admin/settings/tag-mapping/{id}/edit
@ -260,7 +260,7 @@ module TagMapping =
| Some tm -> | Some tm ->
return! return!
Views.WebLog.tagMapEdit (EditTagMapModel.FromMapping tm) Views.WebLog.tagMapEdit (EditTagMapModel.FromMapping tm)
|> adminBarePage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag") true next ctx |> adminBarePage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag") next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -302,12 +302,12 @@ module Theme =
let! themes = ctx.Data.Theme.All () let! themes = ctx.Data.Theme.All ()
return! return!
Views.Admin.themeList (List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) themes) Views.Admin.themeList (List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) themes)
|> adminBarePage "Themes" true next ctx |> adminBarePage "Themes" next ctx
} }
// GET /admin/theme/new // GET /admin/theme/new
let add : HttpHandler = requireAccess Administrator >=> fun next ctx -> let add : HttpHandler = requireAccess Administrator >=> fun next ctx ->
adminBarePage "Upload a Theme File" true next ctx Views.Admin.themeUpload adminBarePage "Upload a Theme File" next ctx Views.Admin.themeUpload
/// Update the name and version for a theme based on the version.txt file, if present /// Update the name and version for a theme based on the version.txt file, if present
let private updateNameAndVersion (theme: Theme) (zip: ZipArchive) = backgroundTask { let private updateNameAndVersion (theme: Theme) (zip: ZipArchive) = backgroundTask {
@ -398,7 +398,7 @@ module Theme =
do! themeFile.CopyToAsync stream do! themeFile.CopyToAsync stream
let! _ = loadFromZip themeId stream data let! _ = loadFromZip themeId stream data
do! ThemeAssetCache.refreshTheme themeId data do! ThemeAssetCache.refreshTheme themeId data
TemplateCache.invalidateTheme themeId Template.Cache.invalidateTheme themeId
// Ensure the themes directory exists // Ensure the themes directory exists
let themeDir = Path.Combine(".", "themes") let themeDir = Path.Combine(".", "themes")
if not (Directory.Exists themeDir) then Directory.CreateDirectory themeDir |> ignore if not (Directory.Exists themeDir) then Directory.CreateDirectory themeDir |> ignore
@ -464,7 +464,7 @@ module WebLog =
return! return!
Views.WebLog.webLogSettings Views.WebLog.webLogSettings
(SettingsModel.FromWebLog ctx.WebLog) themes pages uploads (EditRssModel.FromRssOptions ctx.WebLog.Rss) (SettingsModel.FromWebLog ctx.WebLog) themes pages uploads (EditRssModel.FromRssOptions ctx.WebLog.Rss)
|> adminPage "Web Log Settings" true next ctx |> adminPage "Web Log Settings" next ctx
} }
// POST /admin/settings // POST /admin/settings

2
src/MyWebLog/Handlers/Feed.fs

@ -453,7 +453,7 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
{ Name = string Blog; Value = "Blog" } { Name = string Blog; Value = "Blog" }
] ]
Views.WebLog.feedEdit (EditCustomFeedModel.FromFeed f) ratings mediums Views.WebLog.feedEdit (EditCustomFeedModel.FromFeed f) ratings mediums
|> adminPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed""" true next ctx |> adminPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed""" next ctx
| None -> Error.notFound next ctx | None -> Error.notFound next ctx
// POST /admin/settings/rss/save // POST /admin/settings/rss/save

260
src/MyWebLog/Handlers/Helpers.fs

@ -19,113 +19,9 @@ type ISession with
| item -> Some (JsonSerializer.Deserialize<'T> item) | item -> Some (JsonSerializer.Deserialize<'T> item)
/// Keys used in the myWebLog-standard DotLiquid hash /// Messages to be displayed to the user
module ViewContext = [<Literal>]
let MESSAGES = "messages"
/// The anti cross-site request forgery (CSRF) token set to use for form submissions
[<Literal>]
let AntiCsrfTokens = "csrf"
/// The unified application view context
[<Literal>]
let AppViewContext = "app"
/// The categories for this web log
[<Literal>]
let Categories = "categories"
/// The main content of the view
[<Literal>]
let Content = "content"
/// The current page URL
[<Literal>]
let CurrentPage = "current_page"
/// The generator string for the current version of myWebLog
[<Literal>]
let Generator = "generator"
/// The HTML to load htmx from the unpkg CDN
[<Literal>]
let HtmxScript = "htmx_script"
/// Whether the current user has Administrator privileges
[<Literal>]
let IsAdministrator = "is_administrator"
/// Whether the current user has Author (or above) privileges
[<Literal>]
let IsAuthor = "is_author"
/// Whether the current view is displaying a category archive page
[<Literal>]
let IsCategory = "is_category"
/// Whether the current view is displaying the first page of a category archive
[<Literal>]
let IsCategoryHome = "is_category_home"
/// Whether the current user has Editor (or above) privileges
[<Literal>]
let IsEditor = "is_editor"
/// Whether the current view is the home page for the web log
[<Literal>]
let IsHome = "is_home"
/// Whether there is a user logged on
[<Literal>]
let IsLoggedOn = "is_logged_on"
/// Whether the current view is displaying a page
[<Literal>]
let IsPage = "is_page"
/// Whether the current view is displaying a post
[<Literal>]
let IsPost = "is_post"
/// Whether the current view is a tag archive page
[<Literal>]
let IsTag = "is_tag"
/// Whether the current view is the first page of a tag archive
[<Literal>]
let IsTagHome = "is_tag_home"
/// Whether the current user has Web Log Admin (or above) privileges
[<Literal>]
let IsWebLogAdmin = "is_web_log_admin"
/// Messages to be displayed to the user
[<Literal>]
let Messages = "messages"
/// The view model / form for the page
[<Literal>]
let Model = "model"
/// The listed pages for the web log
[<Literal>]
let PageList = "page_list"
/// The title of the page being displayed
[<Literal>]
let PageTitle = "page_title"
/// The slug for category or tag archive pages
[<Literal>]
let Slug = "slug"
/// The ID of the current user
[<Literal>]
let UserId = "user_id"
/// The current web log
[<Literal>]
let WebLog = "web_log"
/// The HTTP item key for loading the session /// The HTTP item key for loading the session
let private sessionLoadedKey = "session-loaded" let private sessionLoadedKey = "session-loaded"
@ -147,36 +43,25 @@ open MyWebLog.ViewModels
/// Add a message to the user's session /// Add a message to the user's session
let addMessage (ctx: HttpContext) message = task { let addMessage (ctx: HttpContext) message = task {
do! loadSession ctx do! loadSession ctx
let msg = match ctx.Session.TryGet<UserMessage list> ViewContext.Messages with Some it -> it | None -> [] let msg = match ctx.Session.TryGet<UserMessage list> MESSAGES with Some it -> it | None -> []
ctx.Session.Set(ViewContext.Messages, message :: msg) ctx.Session.Set(MESSAGES, message :: msg)
} }
/// Get any messages from the user's session, removing them in the process /// Get any messages from the user's session, removing them in the process
let messages (ctx: HttpContext) = task { let messages (ctx: HttpContext) = task {
do! loadSession ctx do! loadSession ctx
match ctx.Session.TryGet<UserMessage list> ViewContext.Messages with match ctx.Session.TryGet<UserMessage list> MESSAGES with
| Some msg -> | Some msg ->
ctx.Session.Remove ViewContext.Messages ctx.Session.Remove MESSAGES
return msg |> (List.rev >> Array.ofList) return msg |> (List.rev >> Array.ofList)
| None -> return [||] | None -> return [||]
} }
open MyWebLog open MyWebLog
open DotLiquid
/// Shorthand for creating a DotLiquid hash from an anonymous object /// Create a view context with the page title filled
let makeHash (values: obj) = let viewCtxForPage title =
Hash.FromAnonymousObject values { AppViewContext.Empty with PageTitle = title }
/// Create a hash with the page title filled
let hashForPage (title: string) =
makeHash {| page_title = title |}
/// Add a key to the hash, returning the modified hash
// (note that the hash itself is mutated; this is only used to make it pipeable)
let addToHash key (value: obj) (hash: Hash) =
if hash.ContainsKey key then hash[key] <- value else hash.Add(key, value)
hash
open System.Security.Claims open System.Security.Claims
open Giraffe open Giraffe
@ -184,7 +69,8 @@ open Giraffe.Htmx
open Giraffe.ViewEngine open Giraffe.ViewEngine
/// htmx script tag /// htmx script tag
let private htmxScript = RenderView.AsString.htmlNode Htmx.Script.minified let private htmxScript (webLog: WebLog) =
$"""<script src="{webLog.RelativeUrl(Permalink "htmx.min.js")}"></script>"""
/// Get the current user messages, and commit the session so that they are preserved /// Get the current user messages, and commit the session so that they are preserved
let private getCurrentMessages ctx = task { let private getCurrentMessages ctx = task {
@ -194,54 +80,31 @@ let private getCurrentMessages ctx = task {
} }
/// Generate the view context for a response /// Generate the view context for a response
let private generateViewContext pageTitle messages includeCsrf (ctx: HttpContext) = let private generateViewContext messages viewCtx (ctx: HttpContext) =
{ WebLog = ctx.WebLog { viewCtx with
UserId = ctx.User.Claims WebLog = ctx.WebLog
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.NameIdentifier) UserId = ctx.User.Claims
|> Option.map (fun claim -> WebLogUserId claim.Value) |> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.NameIdentifier)
PageTitle = pageTitle |> Option.map (fun claim -> WebLogUserId claim.Value)
Csrf = if includeCsrf then Some ctx.CsrfTokenSet else None Csrf = Some ctx.CsrfTokenSet
PageList = PageListCache.get ctx PageList = PageListCache.get ctx
Categories = CategoryCache.get ctx Categories = CategoryCache.get ctx
CurrentPage = ctx.Request.Path.Value[1..] CurrentPage = ctx.Request.Path.Value[1..]
Messages = messages Messages = messages
Generator = ctx.Generator Generator = ctx.Generator
HtmxScript = htmxScript HtmxScript = htmxScript ctx.WebLog
IsAuthor = ctx.HasAccessLevel Author IsAuthor = ctx.HasAccessLevel Author
IsEditor = ctx.HasAccessLevel Editor IsEditor = ctx.HasAccessLevel Editor
IsWebLogAdmin = ctx.HasAccessLevel WebLogAdmin IsWebLogAdmin = ctx.HasAccessLevel WebLogAdmin
IsAdministrator = ctx.HasAccessLevel Administrator } IsAdministrator = ctx.HasAccessLevel Administrator }
/// Update the view context with standard information (if it has not been done yet) or updated messages
/// Populate the DotLiquid hash with standard information let updateViewContext ctx viewCtx = task {
let addViewContext ctx (hash: Hash) = task {
let! messages = getCurrentMessages ctx let! messages = getCurrentMessages ctx
if hash.ContainsKey ViewContext.AppViewContext then if viewCtx.Generator = "" then
let oldApp = hash[ViewContext.AppViewContext] :?> AppViewContext return generateViewContext messages viewCtx ctx
let newApp = { oldApp with Messages = Array.concat [ oldApp.Messages; messages ] }
return
hash
|> addToHash ViewContext.AppViewContext newApp
|> addToHash ViewContext.Messages newApp.Messages
else else
let app = return { viewCtx with Messages = Array.concat [ viewCtx.Messages; messages ] }
generateViewContext (string hash[ViewContext.PageTitle]) messages
(hash.ContainsKey ViewContext.AntiCsrfTokens) ctx
return
hash
|> addToHash ViewContext.UserId (app.UserId |> Option.map string |> Option.defaultValue "")
|> addToHash ViewContext.WebLog app.WebLog
|> addToHash ViewContext.PageList app.PageList
|> addToHash ViewContext.Categories app.Categories
|> addToHash ViewContext.CurrentPage app.CurrentPage
|> addToHash ViewContext.Messages app.Messages
|> addToHash ViewContext.Generator app.Generator
|> addToHash ViewContext.HtmxScript app.HtmxScript
|> addToHash ViewContext.IsLoggedOn app.IsLoggedOn
|> addToHash ViewContext.IsAuthor app.IsAuthor
|> addToHash ViewContext.IsEditor app.IsEditor
|> addToHash ViewContext.IsWebLogAdmin app.IsWebLogAdmin
|> addToHash ViewContext.IsAdministrator app.IsAdministrator
} }
/// Is the request from htmx? /// Is the request from htmx?
@ -269,6 +132,7 @@ let redirectToGet url : HttpHandler = fun _ ctx -> task {
} }
/// The MIME type for podcast episode JSON chapters /// The MIME type for podcast episode JSON chapters
[<Literal>]
let JSON_CHAPTERS = "application/json+chapters" let JSON_CHAPTERS = "application/json+chapters"
@ -311,65 +175,65 @@ module Error =
else ServerErrors.INTERNAL_ERROR message earlyReturn ctx) else ServerErrors.INTERNAL_ERROR message earlyReturn ctx)
/// Render a view for the specified theme, using the specified template, layout, and hash /// Render a view for the specified theme, using the specified template, layout, and context
let viewForTheme themeId template next ctx (hash: Hash) = task { let viewForTheme themeId template next ctx (viewCtx: AppViewContext) = task {
let! hash = addViewContext ctx hash let! updated = updateViewContext ctx viewCtx
// NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render; // NOTE: Although Fluid's view engine support implements layouts and sections, it also relies on the filesystem.
// the net effect is a "layout" capability similar to Razor or Pug // As we are loading templates from memory or a database, we do a 2-pass render; the first for the content,
// the second for the overall page.
// Render view content... // Render view content...
match! TemplateCache.get themeId template ctx.Data with match! Template.Cache.get themeId template ctx.Data with
| Ok contentTemplate -> | Ok contentTemplate ->
let _ = addToHash ViewContext.Content (contentTemplate.Render hash) hash let forLayout = { updated with Content = Template.render contentTemplate updated ctx.Data }
// ...then render that content with its layout // ...then render that content with its layout
match! TemplateCache.get themeId (if isHtmx ctx then "layout-partial" else "layout") ctx.Data with match! Template.Cache.get themeId (if isHtmx ctx then "layout-partial" else "layout") ctx.Data with
| Ok layoutTemplate -> return! htmlString (layoutTemplate.Render hash) next ctx | Ok layoutTemplate -> return! htmlString (Template.render layoutTemplate forLayout ctx.Data) next ctx
| Error message -> return! Error.server message next ctx | Error message -> return! Error.server message next ctx
| Error message -> return! Error.server message next ctx | Error message -> return! Error.server message next ctx
} }
/// Render a bare view for the specified theme, using the specified template and hash /// Render a bare view for the specified theme, using the specified template and context
let bareForTheme themeId template next ctx (hash: Hash) = task { let bareForTheme themeId template next ctx viewCtx = task {
let! hash = addViewContext ctx hash let! updated = updateViewContext ctx viewCtx
let withContent = task { let withContent = task {
if hash.ContainsKey ViewContext.Content then return Ok hash if updated.Content = "" then
else match! Template.Cache.get themeId template ctx.Data with
match! TemplateCache.get themeId template ctx.Data with | Ok contentTemplate -> return Ok { updated with Content = Template.render contentTemplate updated ctx.Data }
| Ok contentTemplate -> return Ok(addToHash ViewContext.Content (contentTemplate.Render hash) hash)
| Error message -> return Error message | Error message -> return Error message
else
return Ok viewCtx
} }
match! withContent with match! withContent with
| Ok completeHash -> | Ok completeCtx ->
// Bare templates are rendered with layout-bare // Bare templates are rendered with layout-bare
match! TemplateCache.get themeId "layout-bare" ctx.Data with match! Template.Cache.get themeId "layout-bare" ctx.Data with
| Ok layoutTemplate -> | Ok layoutTemplate ->
return! return!
(messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage array) (messagesToHeaders completeCtx.Messages >=> htmlString (Template.render layoutTemplate completeCtx ctx.Data))
>=> htmlString (layoutTemplate.Render completeHash))
next ctx next ctx
| Error message -> return! Error.server message next ctx | Error message -> return! Error.server message next ctx
| Error message -> return! Error.server message next ctx | Error message -> return! Error.server message next ctx
} }
/// Return a view for the web log's default theme /// Return a view for the web log's default theme
let themedView template next ctx hash = task { let themedView template next (ctx: HttpContext) viewCtx = task {
let! hash = addViewContext ctx hash return! viewForTheme ctx.WebLog.ThemeId template next ctx viewCtx
return! viewForTheme (hash[ViewContext.WebLog] :?> WebLog).ThemeId template next ctx hash
} }
/// Display a page for an admin endpoint /// Display a page for an admin endpoint
let adminPage pageTitle includeCsrf next ctx (content: AppViewContext -> XmlNode list) = task { let adminPage pageTitle next ctx (content: AppViewContext -> XmlNode list) = task {
let! messages = getCurrentMessages ctx let! messages = getCurrentMessages ctx
let appCtx = generateViewContext pageTitle messages includeCsrf ctx let appCtx = generateViewContext messages (viewCtxForPage pageTitle) ctx
let layout = if isHtmx ctx then Layout.partial else Layout.full let layout = if isHtmx ctx then Layout.partial else Layout.full
return! htmlString (layout content appCtx |> RenderView.AsString.htmlDocument) next ctx return! htmlString (layout content appCtx |> RenderView.AsString.htmlDocument) next ctx
} }
/// Display a bare page for an admin endpoint /// Display a bare page for an admin endpoint
let adminBarePage pageTitle includeCsrf next ctx (content: AppViewContext -> XmlNode list) = task { let adminBarePage pageTitle next ctx (content: AppViewContext -> XmlNode list) = task {
let! messages = getCurrentMessages ctx let! messages = getCurrentMessages ctx
let appCtx = generateViewContext pageTitle messages includeCsrf ctx let appCtx = generateViewContext messages (viewCtxForPage pageTitle) ctx
return! return!
( messagesToHeaders appCtx.Messages ( messagesToHeaders appCtx.Messages
>=> htmlString (Layout.bare content appCtx |> RenderView.AsString.htmlDocument)) next ctx >=> htmlString (Layout.bare content appCtx |> RenderView.AsString.htmlDocument)) next ctx

12
src/MyWebLog/Handlers/Page.fs

@ -17,7 +17,7 @@ let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> List.ofSeq |> List.ofSeq
return! return!
Views.Page.pageList displayPages pageNbr (pages.Length > 25) Views.Page.pageList displayPages pageNbr (pages.Length > 25)
|> adminPage "Pages" true next ctx |> adminPage "Pages" next ctx
} }
// GET /admin/page/{id}/edit // GET /admin/page/{id}/edit
@ -34,7 +34,7 @@ let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
| Some (title, page) when canEdit page.AuthorId ctx -> | Some (title, page) when canEdit page.AuthorId ctx ->
let model = EditPageModel.FromPage page let model = EditPageModel.FromPage page
let! templates = templatesForTheme ctx "page" let! templates = templatesForTheme ctx "page"
return! adminPage title true next ctx (Views.Page.pageEdit model templates) return! adminPage title next ctx (Views.Page.pageEdit model templates)
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -56,7 +56,7 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
return! return!
ManagePermalinksModel.FromPage pg ManagePermalinksModel.FromPage pg
|> Views.Helpers.managePermalinks |> Views.Helpers.managePermalinks
|> adminPage "Manage Prior Permalinks" true next ctx |> adminPage "Manage Prior Permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -84,7 +84,7 @@ let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
return! return!
ManageRevisionsModel.FromPage pg ManageRevisionsModel.FromPage pg
|> Views.Helpers.manageRevisions |> Views.Helpers.manageRevisions
|> adminPage "Manage Page Revisions" true next ctx |> adminPage "Manage Page Revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -115,7 +115,7 @@ let private findPageRevision pgId revDate (ctx: HttpContext) = task {
let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx -> | Some pg, Some rev when canEdit pg.AuthorId ctx ->
return! adminBarePage "" false next ctx (Views.Helpers.commonPreview rev) return! adminBarePage "" next ctx (Views.Helpers.commonPreview rev)
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | _, None -> return! Error.notFound next ctx | None, _ | _, None -> return! Error.notFound next ctx
} }
@ -141,7 +141,7 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
| Some pg, Some rev when canEdit pg.AuthorId ctx -> | Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update { pg with Revisions = pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) } do! ctx.Data.Page.Update { pg with Revisions = pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" } do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
return! adminBarePage "" false next ctx (fun _ -> []) return! adminBarePage "" next ctx (fun _ -> [])
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | None, _
| _, None -> return! Error.notFound next ctx | _, None -> return! Error.notFound next ctx

96
src/MyWebLog/Handlers/Post.fs

@ -4,6 +4,7 @@ module MyWebLog.Handlers.Post
open System open System
open System.Collections.Generic open System.Collections.Generic
open MyWebLog open MyWebLog
open MyWebLog.Views
/// Parse a slug and page number from an "everything else" URL /// Parse a slug and page number from an "everything else" URL
let private parseSlugAndPage webLog (slugAndPage: string seq) = let private parseSlugAndPage webLog (slugAndPage: string seq) =
@ -87,30 +88,29 @@ let preparePostList webLog posts listType (url: string) pageNbr perPage (data: I
OlderName = olderPost |> Option.map _.Title OlderName = olderPost |> Option.map _.Title
} }
return return
makeHash {||} { AppViewContext.Empty with
|> addToHash ViewContext.Model model Payload = model
|> addToHash "tag_mappings" tagMappings TagMappings = Array.ofList tagMappings
|> addToHash ViewContext.IsPost (match listType with SinglePost -> true | _ -> false) IsPost = (match listType with SinglePost -> true | _ -> false) }
} }
open Giraffe open Giraffe
// GET /page/{pageNbr} // GET /page/{pageNbr}
let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task { let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
let count = ctx.WebLog.PostsPerPage let count = ctx.WebLog.PostsPerPage
let data = ctx.Data let data = ctx.Data
let! posts = data.Post.FindPageOfPublishedPosts ctx.WebLog.Id pageNbr count let! posts = data.Post.FindPageOfPublishedPosts ctx.WebLog.Id pageNbr count
let! hash = preparePostList ctx.WebLog posts PostList "" pageNbr count data let! viewCtx = preparePostList ctx.WebLog posts PostList "" pageNbr count data
let title = let title =
match pageNbr, ctx.WebLog.DefaultPage with match pageNbr, ctx.WebLog.DefaultPage with
| 1, "posts" -> None | 1, "posts" -> None
| _, "posts" -> Some $"Page {pageNbr}" | _, "posts" -> Some $"Page {pageNbr}"
| _, _ -> Some $"Page {pageNbr} &laquo; Posts" | _, _ -> Some $"Page {pageNbr} &laquo; Posts"
return! return!
match title with Some ttl -> addToHash ViewContext.PageTitle ttl hash | None -> hash { viewCtx with
|> function PageTitle = defaultArg title viewCtx.PageTitle
| hash -> IsHome = pageNbr = 1 && ctx.WebLog.DefaultPage = "posts" }
if pageNbr = 1 && ctx.WebLog.DefaultPage = "posts" then addToHash ViewContext.IsHome true hash else hash
|> themedView "index" next ctx |> themedView "index" next ctx
} }
@ -134,14 +134,15 @@ let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task {
match! data.Post.FindPageOfCategorizedPosts webLog.Id (getCategoryIds slug ctx) pageNbr webLog.PostsPerPage match! data.Post.FindPageOfCategorizedPosts webLog.Id (getCategoryIds slug ctx) pageNbr webLog.PostsPerPage
with with
| posts when List.length posts > 0 -> | posts when List.length posts > 0 ->
let! hash = preparePostList webLog posts CategoryList cat.Slug pageNbr webLog.PostsPerPage data let! viewCtx = preparePostList webLog posts CategoryList cat.Slug pageNbr webLog.PostsPerPage data
let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>""" let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
return! return!
addToHash ViewContext.PageTitle $"{cat.Name}: Category Archive{pgTitle}" hash { viewCtx with
|> addToHash "subtitle" (defaultArg cat.Description "") PageTitle = $"{cat.Name}: Category Archive{pgTitle}"
|> addToHash ViewContext.IsCategory true Subtitle = cat.Description
|> addToHash ViewContext.IsCategoryHome (pageNbr = 1) IsCategory = true
|> addToHash ViewContext.Slug slug IsCategoryHome = (pageNbr = 1)
Slug = Some slug }
|> themedView "index" next ctx |> themedView "index" next ctx
| _ -> return! Error.notFound next ctx | _ -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@ -169,13 +170,14 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
else else
match! data.Post.FindPageOfTaggedPosts webLog.Id tag pageNbr webLog.PostsPerPage with match! data.Post.FindPageOfTaggedPosts webLog.Id tag pageNbr webLog.PostsPerPage with
| posts when List.length posts > 0 -> | posts when List.length posts > 0 ->
let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.PostsPerPage data let! viewCtx = preparePostList webLog posts TagList rawTag pageNbr webLog.PostsPerPage data
let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>""" let pgTitle = if pageNbr = 1 then "" else $" <small class=\"archive-pg-nbr\">(Page {pageNbr})</small>"
return! return!
addToHash ViewContext.PageTitle $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}" hash { viewCtx with
|> addToHash ViewContext.IsTag true PageTitle = $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}"
|> addToHash ViewContext.IsTagHome (pageNbr = 1) IsTag = true
|> addToHash ViewContext.Slug rawTag IsTagHome = (pageNbr = 1)
Slug = Some rawTag }
|> themedView "index" next ctx |> themedView "index" next ctx
// Other systems use hyphens for spaces; redirect if this is an old tag link // Other systems use hyphens for spaces; redirect if this is an old tag link
| _ -> | _ ->
@ -200,9 +202,9 @@ let home : HttpHandler = fun next ctx -> task {
match! ctx.Data.Page.FindById (PageId pageId) webLog.Id with match! ctx.Data.Page.FindById (PageId pageId) webLog.Id with
| Some page -> | Some page ->
return! return!
hashForPage page.Title { viewCtxForPage page.Title with
|> addToHash "page" (DisplayPage.FromPage webLog page) Payload = DisplayPage.FromPage webLog page
|> addToHash ViewContext.IsHome true IsHome = true }
|> themedView (defaultArg page.Template "single-page") next ctx |> themedView (defaultArg page.Template "single-page") next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -251,10 +253,10 @@ let chapters (post: Post) : HttpHandler = fun next ctx ->
// GET /admin/posts // GET /admin/posts
// GET /admin/posts/page/{pageNbr} // GET /admin/posts/page/{pageNbr}
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task { let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25 let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25
let! hash = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data let! viewCtx = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data
return! adminPage "Posts" true next ctx (Views.Post.list (hash[ViewContext.Model] :?> PostDisplay)) return! adminPage "Posts" next ctx (Post.list viewCtx.Posts)
} }
// GET /admin/post/{id}/edit // GET /admin/post/{id}/edit
@ -278,7 +280,7 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
{ Name = string No; Value = "No" } { Name = string No; Value = "No" }
{ Name = string Clean; Value = "Clean" } { Name = string Clean; Value = "Clean" }
] ]
return! adminPage title true next ctx (Views.Post.postEdit model templates ratings) return! adminPage title next ctx (Post.postEdit model templates ratings)
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -298,8 +300,8 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx
| Some post when canEdit post.AuthorId ctx -> | Some post when canEdit post.AuthorId ctx ->
return! return!
ManagePermalinksModel.FromPost post ManagePermalinksModel.FromPost post
|> Views.Helpers.managePermalinks |> managePermalinks
|> adminPage "Manage Prior Permalinks" true next ctx |> adminPage "Manage Prior Permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -326,8 +328,8 @@ let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -
| Some post when canEdit post.AuthorId ctx -> | Some post when canEdit post.AuthorId ctx ->
return! return!
ManageRevisionsModel.FromPost post ManageRevisionsModel.FromPost post
|> Views.Helpers.manageRevisions |> manageRevisions
|> adminPage "Manage Post Revisions" true next ctx |> adminPage "Manage Post Revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -359,7 +361,7 @@ let private findPostRevision postId revDate (ctx: HttpContext) = task {
let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx -> | Some post, Some rev when canEdit post.AuthorId ctx ->
return! adminBarePage "" false next ctx (Views.Helpers.commonPreview rev) return! adminBarePage "" next ctx (commonPreview rev)
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | _, None -> return! Error.notFound next ctx | None, _ | _, None -> return! Error.notFound next ctx
} }
@ -385,7 +387,7 @@ let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fu
| Some post, Some rev when canEdit post.AuthorId ctx -> | Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) } do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" } do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
return! adminBarePage "" false next ctx (fun _ -> []) return! adminBarePage "" next ctx (fun _ -> [])
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | None, _
| _, None -> return! Error.notFound next ctx | _, None -> return! Error.notFound next ctx
@ -399,8 +401,8 @@ let manageChapters postId : HttpHandler = requireAccess Author >=> fun next ctx
&& Option.isSome post.Episode.Value.Chapters && Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx -> && canEdit post.AuthorId ctx ->
return! return!
Views.Post.chapters false (ManageChaptersModel.Create post) Post.chapters false (ManageChaptersModel.Create post)
|> adminPage "Manage Chapters" true next ctx |> adminPage "Manage Chapters" next ctx
| Some _ | None -> return! Error.notFound next ctx | Some _ | None -> return! Error.notFound next ctx
} }
@ -419,8 +421,8 @@ let editChapter (postId, index) : HttpHandler = requireAccess Author >=> fun nex
match chapter with match chapter with
| Some chap -> | Some chap ->
return! return!
Views.Post.chapterEdit (EditChapterModel.FromChapter post.Id index chap) Post.chapterEdit (EditChapterModel.FromChapter post.Id index chap)
|> adminBarePage (if index = -1 then "Add a Chapter" else "Edit Chapter") true next ctx |> adminBarePage (if index = -1 then "Add a Chapter" else "Edit Chapter") next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx | Some _ | None -> return! Error.notFound next ctx
} }
@ -447,8 +449,8 @@ let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> fun nex
do! data.Post.Update updatedPost do! data.Post.Update updatedPost
do! addMessage ctx { UserMessage.Success with Message = "Chapter saved successfully" } do! addMessage ctx { UserMessage.Success with Message = "Chapter saved successfully" }
return! return!
Views.Post.chapterList form.AddAnother (ManageChaptersModel.Create updatedPost) Post.chapterList form.AddAnother (ManageChaptersModel.Create updatedPost)
|> adminBarePage "Manage Chapters" true next ctx |> adminBarePage "Manage Chapters" next ctx
with with
| ex -> return! Error.server ex.Message next ctx | ex -> return! Error.server ex.Message next ctx
else return! Error.notFound next ctx else return! Error.notFound next ctx
@ -471,8 +473,8 @@ let deleteChapter (postId, index) : HttpHandler = requireAccess Author >=> fun n
do! data.Post.Update updatedPost do! data.Post.Update updatedPost
do! addMessage ctx { UserMessage.Success with Message = "Chapter deleted successfully" } do! addMessage ctx { UserMessage.Success with Message = "Chapter deleted successfully" }
return! return!
Views.Post.chapterList false (ManageChaptersModel.Create updatedPost) Post.chapterList false (ManageChaptersModel.Create updatedPost)
|> adminPage "Manage Chapters" true next ctx |> adminPage "Manage Chapters" next ctx
else return! Error.notFound next ctx else return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx | Some _ | None -> return! Error.notFound next ctx
} }

29
src/MyWebLog/Handlers/Routes.fs

@ -8,6 +8,7 @@ open MyWebLog
/// Module to resolve routes that do not match any other known route (web blog content) /// Module to resolve routes that do not match any other known route (web blog content)
module CatchAll = module CatchAll =
open System.IO
open MyWebLog.ViewModels open MyWebLog.ViewModels
/// Sequence where the first returned value is the proper handler for the link /// Sequence where the first returned value is the proper handler for the link
@ -22,6 +23,18 @@ module CatchAll =
let await it = (Async.AwaitTask >> Async.RunSynchronously) it let await it = (Async.AwaitTask >> Async.RunSynchronously) it
seq { seq {
debug (fun () -> $"Considering URL {textLink}") debug (fun () -> $"Considering URL {textLink}")
let staticFileName =
[ ctx.GetWebHostEnvironment().ContentRootPath
"wwwroot"
if textLink.Length > 1 then textLink[1..] else textLink ]
|> String.concat (string Path.DirectorySeparatorChar)
if File.Exists staticFileName then
debug (fun () -> $"File {textLink} is a static file")
yield
File.GetLastWriteTimeUtc staticFileName
|> System.DateTimeOffset
|> Some
|> streamFile true staticFileName None
// Home page directory without the directory slash // Home page directory without the directory slash
if textLink = "" then yield redirectTo true (webLog.RelativeUrl Permalink.Empty) if textLink = "" then yield redirectTo true (webLog.RelativeUrl Permalink.Empty)
let permalink = Permalink textLink[1..] let permalink = Permalink textLink[1..]
@ -34,9 +47,8 @@ module CatchAll =
yield Post.chapters post yield Post.chapters post
else else
yield fun next ctx -> yield fun next ctx ->
Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 data { await (Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 data) with
|> await PageTitle = post.Title }
|> addToHash ViewContext.PageTitle post.Title
|> themedView (defaultArg post.Template "single-post") next ctx |> themedView (defaultArg post.Template "single-post") next ctx
| None -> () | None -> ()
// Current page // Current page
@ -44,9 +56,9 @@ module CatchAll =
| Some page -> | Some page ->
debug (fun () -> "Found page by permalink") debug (fun () -> "Found page by permalink")
yield fun next ctx -> yield fun next ctx ->
hashForPage page.Title { viewCtxForPage page.Title with
|> addToHash "page" (DisplayPage.FromPage webLog page) Payload = DisplayPage.FromPage webLog page
|> addToHash ViewContext.IsPage true IsPage = true }
|> themedView (defaultArg page.Template "single-page") next ctx |> themedView (defaultArg page.Template "single-page") next ctx
| None -> () | None -> ()
// RSS feed // RSS feed
@ -88,7 +100,6 @@ module CatchAll =
let route : HttpHandler = fun next ctx -> let route : HttpHandler = fun next ctx ->
match deriveAction ctx |> Seq.tryHead with Some handler -> handler next ctx | None -> Error.notFound next ctx match deriveAction ctx |> Seq.tryHead with Some handler -> handler next ctx | None -> Error.notFound next ctx
/// Serve theme assets /// Serve theme assets
module Asset = module Asset =
@ -202,7 +213,7 @@ let router : HttpHandler = choose [
]) ])
route "/upload/save" >=> Upload.save route "/upload/save" >=> Upload.save
] ]
DELETE >=> validateCsrf >=> choose [ DELETE >=> choose [
routef "/category/%s" Admin.Category.delete routef "/category/%s" Admin.Category.delete
subRoute "/page" (choose [ subRoute "/page" (choose [
routef "/%s" Page.delete routef "/%s" Page.delete
@ -243,7 +254,7 @@ let router : HttpHandler = choose [
] ]
]) ])
GET_HEAD >=> CatchAll.route GET_HEAD >=> CatchAll.route
Error.notFound //Error.notFound
] ]
/// Wrap a router in a sub-route /// Wrap a router in a sub-route

4
src/MyWebLog/Handlers/Upload.fs

@ -120,12 +120,12 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> Seq.append diskUploads |> Seq.append diskUploads
|> Seq.sortByDescending (fun file -> file.UpdatedOn, file.Path) |> Seq.sortByDescending (fun file -> file.UpdatedOn, file.Path)
|> Views.WebLog.uploadList |> Views.WebLog.uploadList
|> adminPage "Uploaded Files" true next ctx |> adminPage "Uploaded Files" next ctx
} }
// GET /admin/upload/new // GET /admin/upload/new
let showNew : HttpHandler = requireAccess Author >=> fun next ctx -> let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
adminPage "Upload a File" true next ctx Views.WebLog.uploadNew adminPage "Upload a File" next ctx Views.WebLog.uploadNew
// POST /admin/upload/save // POST /admin/upload/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {

10
src/MyWebLog/Handlers/User.fs

@ -35,7 +35,7 @@ let logOn returnUrl : HttpHandler = fun next ctx ->
match returnUrl with match returnUrl with
| Some _ -> returnUrl | Some _ -> returnUrl
| None -> if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None | None -> if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None
adminPage "Log On" true next ctx (Views.User.logOn { LogOnModel.Empty with ReturnTo = returnTo }) adminPage "Log On" next ctx (Views.User.logOn { LogOnModel.Empty with ReturnTo = returnTo })
open System.Security.Claims open System.Security.Claims
@ -91,12 +91,12 @@ let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?"
// GET /admin/settings/users // GET /admin/settings/users
let all : HttpHandler = fun next ctx -> task { let all : HttpHandler = fun next ctx -> task {
let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id
return! adminBarePage "User Administration" true next ctx (Views.User.userList users) return! adminBarePage "User Administration" next ctx (Views.User.userList users)
} }
/// Show the edit user page /// Show the edit user page
let private showEdit (model: EditUserModel) : HttpHandler = fun next ctx -> let private showEdit (model: EditUserModel) : HttpHandler = fun next ctx ->
adminBarePage (if model.IsNew then "Add a New User" else "Edit User") true next ctx (Views.User.edit model) adminBarePage (if model.IsNew then "Add a New User" else "Edit User") next ctx (Views.User.edit model)
// GET /admin/settings/user/{id}/edit // GET /admin/settings/user/{id}/edit
let edit usrId : HttpHandler = fun next ctx -> task { let edit usrId : HttpHandler = fun next ctx -> task {
@ -139,7 +139,7 @@ let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
| Some user -> | Some user ->
return! return!
Views.User.myInfo (EditMyInfoModel.FromUser user) user Views.User.myInfo (EditMyInfoModel.FromUser user) user
|> adminPage "Edit Your Information" true next ctx |> adminPage "Edit Your Information" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -164,7 +164,7 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
do! addMessage ctx { UserMessage.Error with Message = "Passwords did not match; no updates made" } do! addMessage ctx { UserMessage.Error with Message = "Passwords did not match; no updates made" }
return! return!
Views.User.myInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user Views.User.myInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user
|> adminPage "Edit Your Information" true next ctx |> adminPage "Edit Your Information" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }

18
src/MyWebLog/MyWebLog.fsproj

@ -9,6 +9,8 @@
<ItemGroup> <ItemGroup>
<Content Include="appsettings*.json" CopyToOutputDirectory="Always" /> <Content Include="appsettings*.json" CopyToOutputDirectory="Always" />
<Compile Include="Caches.fs" /> <Compile Include="Caches.fs" />
<Compile Include="ViewContext.fs" />
<Compile Include="Template.fs" />
<Compile Include="Views\Helpers.fs" /> <Compile Include="Views\Helpers.fs" />
<Compile Include="Views\Admin.fs" /> <Compile Include="Views\Admin.fs" />
<Compile Include="Views\Page.fs" /> <Compile Include="Views\Page.fs" />
@ -26,18 +28,20 @@
<Compile Include="DotLiquidBespoke.fs" /> <Compile Include="DotLiquidBespoke.fs" />
<Compile Include="Maintenance.fs" /> <Compile Include="Maintenance.fs" />
<Compile Include="Program.fs" /> <Compile Include="Program.fs" />
<Content Include="wwwroot\htmx.min.js" CopyToOutputDirectory="Always" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.0.0" /> <PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.1.0" />
<PackageReference Include="DotLiquid" Version="2.2.692" /> <PackageReference Include="DotLiquid" Version="2.2.692" />
<PackageReference Include="Giraffe" Version="6.4.0" /> <PackageReference Include="Fluid.Core" Version="2.24.0" />
<PackageReference Include="Giraffe.Htmx" Version="2.0.0" /> <PackageReference Include="Giraffe" Version="7.0.2" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.0" /> <PackageReference Include="Giraffe.Htmx" Version="2.0.6" />
<PackageReference Include="NeoSmart.Caching.Sqlite.AspNetCore" Version="8.0.0" /> <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.6" />
<PackageReference Include="NeoSmart.Caching.Sqlite.AspNetCore" Version="9.0.1" />
<PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" /> <PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" />
<PackageReference Include="System.ServiceModel.Syndication" Version="8.0.0" /> <PackageReference Include="System.ServiceModel.Syndication" Version="9.0.6" />
<PackageReference Update="FSharp.Core" Version="8.0.300" /> <PackageReference Update="FSharp.Core" Version="9.0.300" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

10
src/MyWebLog/Program.fs

@ -26,8 +26,10 @@ type WebLogMiddleware(next: RequestDelegate, log: ILogger<WebLogMiddleware>) =
} }
open Giraffe.Htmx
/// Middleware to check redirects for the current web log /// Middleware to check redirects for the current web log
type RedirectRuleMiddleware(next: RequestDelegate, log: ILogger<RedirectRuleMiddleware>) = type RedirectRuleMiddleware(next: RequestDelegate, _log: ILogger<RedirectRuleMiddleware>) =
/// Shorthand for case-insensitive string equality /// Shorthand for case-insensitive string equality
let ciEquals str1 str2 = let ciEquals str1 str2 =
@ -44,6 +46,8 @@ type RedirectRuleMiddleware(next: RequestDelegate, log: ILogger<RedirectRuleMidd
| WebLogCache.CachedRedirectRule.RegEx (regExFrom, patternTo) -> | WebLogCache.CachedRedirectRule.RegEx (regExFrom, patternTo) ->
if regExFrom.IsMatch path then Some (regExFrom.Replace(path, patternTo)) else None) if regExFrom.IsMatch path then Some (regExFrom.Replace(path, patternTo)) else None)
match matched with match matched with
| Some url when url.StartsWith "http" && ctx.Request.IsHtmx ->
do! ctx.Response.WriteAsync $"""<script>window.location.href = "{url}"</script>"""
| Some url -> ctx.Response.Redirect(url, permanent = true) | Some url -> ctx.Response.Redirect(url, permanent = true)
| None -> return! next.Invoke ctx | None -> return! next.Invoke ctx
} }
@ -131,7 +135,7 @@ open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Builder open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.HttpOverrides open Microsoft.AspNetCore.HttpOverrides
open Microsoft.Extensions.Caching.Distributed open Microsoft.Extensions.Caching.Distributed
open NeoSmart.Caching.Sqlite.AspNetCore open NeoSmart.Caching.Sqlite
open RethinkDB.DistributedCache open RethinkDB.DistributedCache
[<EntryPoint>] [<EntryPoint>]
@ -191,7 +195,7 @@ let main args =
| _ -> () | _ -> ()
let _ = builder.Services.AddSession(fun opts -> let _ = builder.Services.AddSession(fun opts ->
opts.IdleTimeout <- TimeSpan.FromMinutes 60 opts.IdleTimeout <- TimeSpan.FromMinutes 60.
opts.Cookie.HttpOnly <- true opts.Cookie.HttpOnly <- true
opts.Cookie.IsEssential <- true) opts.Cookie.IsEssential <- true)
let _ = builder.Services.AddGiraffe() let _ = builder.Services.AddGiraffe()

377
src/MyWebLog/Template.fs Normal file

@ -0,0 +1,377 @@
/// <summary>Logic to work with Fluid templates</summary>
module MyWebLog.Template
open System
open System.Collections.Generic
open System.IO
open System.Text
open Fluid
open Fluid.Values
open Microsoft.AspNetCore.Antiforgery
open Microsoft.Extensions.FileProviders
open MyWebLog
open MyWebLog.ViewModels
/// Alias for ValueTask
type VTask<'T> = System.Threading.Tasks.ValueTask<'T>
/// <summary>Extensions on Fluid's TemplateContext object</summary>
type TemplateContext with
/// <summary>Get the model of the context as an <tt>AppViewContext</tt> instance</summary>
member this.App =
this.Model.ToObjectValue() :?> AppViewContext
/// <summary>Helper functions for filters and tags</summary>
[<AutoOpen>]
module private Helpers =
/// <summary>Does an asset exist for the current theme?</summary>
/// <param name="fileName">The name of the asset</param>
/// <param name="webLog">The current web log</param>
/// <returns>True if the theme has the requested asset name, false if not</returns>
let assetExists fileName (webLog: WebLog) =
ThemeAssetCache.get webLog.ThemeId |> List.exists (fun it -> it = fileName)
/// <summary>Obtain the link from known types</summary>
/// <param name="item">The <tt>FluidValue</tt> for the given parameter</param>
/// <param name="linkFunc">The function to extract the value of the link into a string</param>
/// <returns>The link as a string, or JavaScript to show an alert if a link cannot be determined</returns>
let permalink (item: FluidValue) (linkFunc: Permalink -> string) =
match item.Type with
| FluidValues.String -> Some (item.ToStringValue())
| FluidValues.Object ->
match item.ToObjectValue() with
| :? DisplayPage as page -> Some page.Permalink
| :? PostListItem as post -> Some post.Permalink
| :? Permalink as link -> Some (string link)
| _ -> None
| _ -> None
|> function
| Some link -> linkFunc (Permalink link)
| None -> $"alert('unknown item type {item.Type}')"
/// <summary>Generate a link for theme asset (image, stylesheet, script, etc.)</summary>
/// <param name="input">The name of the theme asset</param>
/// <param name="ctx">The template context for the current template rendering</param>
/// <returns>A relative URL for the given theme asset</returns>
let themeAsset (input: FluidValue) (ctx: TemplateContext) =
let app = ctx.App
app.WebLog.RelativeUrl(Permalink $"themes/{app.WebLog.ThemeId}/{input.ToStringValue()}")
/// <summary>Fluid template options customized with myWebLog filters</summary>
/// <returns>A <tt>TemplateOptions</tt> instance with all myWebLog filters and types registered</returns>
let options () =
let sValue = StringValue >> VTask<FluidValue>
let it = TemplateOptions.Default
it.MemberAccessStrategy.MemberNameStrategy <- MemberNameStrategies.SnakeCase
[ // Domain types
typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>; typeof<MetaItem>; typeof<Page>; typeof<RssOptions>
typeof<TagMap>; typeof<WebLog>
// View models
typeof<AppViewContext>; typeof<DisplayCategory>; typeof<DisplayPage>; typeof<EditPageModel>; typeof<PostDisplay>
typeof<PostListItem>; typeof<UserMessage>
// Framework types
typeof<AntiforgeryTokenSet>; typeof<DateTime option>; typeof<int option>; typeof<KeyValuePair>
typeof<MetaItem list>; typeof<string list>; typeof<string option>; typeof<TagMap list> ]
|> List.iter it.MemberAccessStrategy.Register
// A filter to generate an absolute link
it.Filters.AddFilter("absolute_link", fun input _ ctx -> sValue (permalink input ctx.App.WebLog.AbsoluteUrl))
// A filter to generate a link with posts categorized under the given category
it.Filters.AddFilter("category_link",
fun input _ ctx ->
match input.ToObjectValue() with
| :? DisplayCategory as cat -> Some cat.Slug
| :? string as slug -> Some slug
| _ -> None
|> function
| Some slug -> ctx.App.WebLog.RelativeUrl(Permalink $"category/{slug}/")
| None -> $"alert('unknown category object type {input.Type}')"
|> sValue)
// A filter to generate a link that will edit a page
it.Filters.AddFilter("edit_page_link",
fun input _ ctx ->
match input.ToObjectValue() with
| :? DisplayPage as page -> Some page.Id
| :? string as theId -> Some theId
| _ -> None
|> function
| Some pageId -> ctx.App.WebLog.RelativeUrl(Permalink $"admin/page/{pageId}/edit")
| None -> $"alert('unknown page object type {input.Type}')"
|> sValue)
// A filter to generate a link that will edit a post
it.Filters.AddFilter("edit_post_link",
fun input _ ctx ->
match input.ToObjectValue() with
| :? PostListItem as post -> Some post.Id
| :? string as theId -> Some theId
| _ -> None
|> function
| Some postId -> ctx.App.WebLog.RelativeUrl(Permalink $"admin/post/{postId}/edit")
| None -> $"alert('unknown post object type {input.Type}')"
|> sValue)
// A filter to generate nav links, highlighting the active link (starts-with match)
it.Filters.AddFilter("nav_link",
fun input args ctx ->
let app = ctx.App
let extraPath = app.WebLog.ExtraPath
let path = if extraPath = "" then "" else $"{extraPath[1..]}/"
let url = input.ToStringValue()
seq {
"<li class=nav-item><a class=\"nav-link"
if app.CurrentPage.StartsWith $"{path}{url}" then " active"
"\" href=\""
app.WebLog.RelativeUrl(Permalink url)
"\">"
args.At(0).ToStringValue()
"</a>"
}
|> String.concat ""
|> sValue)
// A filter to generate a relative link
it.Filters.AddFilter("relative_link", fun input _ ctx -> sValue (permalink input ctx.App.WebLog.RelativeUrl))
// A filter to generate a link with posts tagged with the given tag
it.Filters.AddFilter("tag_link",
fun input _ ctx ->
let tag = input.ToStringValue()
ctx.App.TagMappings
|> Array.tryFind (fun it -> it.Tag = tag)
|> function
| Some tagMap -> tagMap.UrlValue
| None -> tag.Replace(" ", "+")
|> function tagUrl -> ctx.App.WebLog.RelativeUrl(Permalink $"tag/{tagUrl}/")
|> sValue)
// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
it.Filters.AddFilter("theme_asset", fun input _ ctx -> sValue (themeAsset input ctx))
// A filter to retrieve the value of a meta item from a list
// (shorter than `{% assign item = list | where: "Name", [name] | first %}{{ item.value }}`)
it.Filters.AddFilter("value",
fun input args ctx ->
let name = args.At(0).ToStringValue()
let picker (value: FluidValue) =
let item = value.ToObjectValue() :?> MetaItem
if item.Name = name then Some item.Value else None
match input with
| :? NilValue -> $"-- {name} not found --"
| it ->
(it :?> ArrayValue).Values
|> Seq.tryPick picker
|> Option.defaultValue $"-- {name} not found --"
|> sValue)
it
/// <summary>Fluid parser customized with myWebLog filters and tags</summary>
let parser =
// spacer
let s = " "
// Required return for tag delegates
let ok () =
VTask<Fluid.Ast.Completion> Fluid.Ast.Completion.Normal
let it = FluidParser()
// Create various items in the page header based on the state of the page being generated
it.RegisterEmptyTag("page_head",
fun writer encoder context ->
let app = context.App
let attrEnc = System.Web.HttpUtility.HtmlAttributeEncode
// OpenGraph tags
let doOpenGraph =
(app.WebLog.AutoOpenGraph && (app.IsPage || app.IsPost))
|| (app.IsPage && Option.isSome app.Page.OpenGraph)
|| (app.IsPost && Option.isSome app.Posts.Posts[0].OpenGraph)
if doOpenGraph then
let writeOgProp (name, value) =
writer.WriteLine $"""{s}<meta property=%s{name} content="{attrEnc value}">"""
writeOgProp ("og:title", if app.IsPage then app.Page.Title else app.Posts.Posts[0].Title)
writeOgProp ("og:site_name", app.WebLog.Name)
if app.IsPage then app.Page.Permalink else app.Posts.Posts[0].Permalink
|> Permalink
|> app.WebLog.AbsoluteUrl
|> function url -> writeOgProp ("og:url", url)
match if app.IsPage then app.Page.OpenGraph else app.Posts.Posts[0].OpenGraph with
| Some props -> props.ToProperties app.WebLog.UrlToAbsolute |> Seq.iter writeOgProp
| None -> ()
writer.WriteLine $"""{s}<meta name=generator content="{app.Generator}">"""
// Theme assets
if assetExists "style.css" app.WebLog then
themeAsset (StringValue "style.css") context
|> sprintf "%s<link rel=stylesheet href=\"%s\">" s
|> writer.WriteLine
if assetExists "favicon.ico" app.WebLog then
themeAsset (StringValue "favicon.ico") context
|> sprintf "%s<link rel=icon href=\"%s\">" s
|> writer.WriteLine
// RSS feeds and canonical URLs
let feedLink title url =
let escTitle = System.Web.HttpUtility.HtmlAttributeEncode title
let relUrl = app.WebLog.RelativeUrl(Permalink url)
$"""{s}<link rel=alternate type="application/rss+xml" title="{escTitle}" href="{relUrl}">"""
if app.WebLog.Rss.IsFeedEnabled && app.IsHome then
writer.WriteLine(feedLink app.WebLog.Name app.WebLog.Rss.FeedName)
writer.WriteLine $"""{s}<link rel=canonical href="{app.WebLog.AbsoluteUrl Permalink.Empty}">"""
if app.WebLog.Rss.IsCategoryEnabled && app.IsCategoryHome then
let slug = context.AmbientValues["slug"] :?> string
writer.WriteLine(feedLink app.WebLog.Name $"category/{slug}/{app.WebLog.Rss.FeedName}")
if app.WebLog.Rss.IsTagEnabled && app.IsTagHome then
let slug = context.AmbientValues["slug"] :?> string
writer.WriteLine(feedLink app.WebLog.Name $"tag/{slug}/{app.WebLog.Rss.FeedName}")
if app.IsPost then
let url = app.WebLog.AbsoluteUrl(Permalink app.Posts.Posts[0].Permalink)
writer.WriteLine $"""{s}<link rel=canonical href="{url}">"""
if app.IsPage then
let url = app.WebLog.AbsoluteUrl(Permalink app.Page.Permalink)
writer.WriteLine $"""{s}<link rel=canonical href="{url}">"""
ok ())
// Create various items in the page footer based on the state of the page being generated
it.RegisterEmptyTag("page_foot",
fun writer encoder context ->
let webLog = context.App.WebLog
if webLog.AutoHtmx then
context.App.WebLog.RelativeUrl(Permalink "htmx.min.js")
|> sprintf "%s<script src=\"%s\"></script>" s
|> writer.WriteLine
if assetExists "script.js" webLog then
themeAsset (StringValue "script.js") context
|> sprintf "%s<script src=\"%s\"></script>" s
|> writer.WriteLine
ok ())
// Create links for a user to log on or off, and a dashboard link if they are logged off
it.RegisterEmptyTag("user_links",
fun writer encoder ctx ->
let app = ctx.App
let link it = app.WebLog.RelativeUrl(Permalink it)
seq {
"""<ul class="navbar-nav flex-grow-1 justify-content-end">"""
match app.IsLoggedOn with
| true ->
$"""<li class=nav-item><a class=nav-link href="{link "admin/dashboard"}">Dashboard</a>"""
$"""<li class=nav-item><a class=nav-link href="{link "user/log-off"}">Log Off</a>"""
| false ->
$"""<li class=nav-item><a class=nav-link href="{link "user/log-on"}">Log On</a>"""
"</ul>"
}
|> Seq.iter writer.WriteLine
ok())
it
open MyWebLog.Data
/// <summary>Cache for parsed templates</summary>
module Cache =
open System.Collections.Concurrent
/// Cache of parsed templates
let private _cache = ConcurrentDictionary<string, IFluidTemplate> ()
/// <summary>Get a template for the given theme and template name</summary>
/// <param name="themeId">The ID of the theme for which a template should be retrieved</param>
/// <param name="templateName">The name of the template to retrieve</param>
/// <param name="data">The data implementation from which the template should be retrieved (if not cached)</param>
/// <returns>
/// An <tt>Ok</tt> result with the template if it is found and valid, an <tt>Error</tt> result if not
/// </returns>
let get (themeId: ThemeId) (templateName: string) (data: IData) = backgroundTask {
let templatePath = $"{themeId}/{templateName}"
match _cache.ContainsKey templatePath with
| true -> return Ok _cache[templatePath]
| false ->
match! data.Theme.FindById themeId with
| Some theme ->
match theme.Templates |> List.tryFind (fun t -> t.Name = templateName) with
| Some template ->
_cache[templatePath] <- parser.Parse(template.Text)
return Ok _cache[templatePath]
| None ->
return Error $"Theme ID {themeId} does not have a template named {templateName}"
| None -> return Error $"Theme ID {themeId} does not exist"
}
/// <summary>Get all theme/template names currently cached</summary>
/// <returns>All theme/template names current cached</returns>
let allNames () =
_cache.Keys |> Seq.sort |> Seq.toList
/// <summary>Invalidate all template cache entries for the given theme ID</summary>
/// <param name="themeId">The ID of the theme whose cache should be invalidated</param>
let invalidateTheme (themeId: ThemeId) =
let keyPrefix = string themeId
_cache.Keys
|> Seq.filter _.StartsWith(keyPrefix)
|> List.ofSeq
|> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ())
/// <summary>Remove all entries from the template cache</summary>
let empty () =
_cache.Clear()
/// <summary>A file provider to retrieve files by theme</summary>
type ThemeFileProvider(themeId: ThemeId, data: IData) =
interface IFileProvider with
member _.GetDirectoryContents _ =
raise <| NotImplementedException "The theme file provider does not support directory listings"
member _.GetFileInfo path =
match data.Theme.FindById themeId |> Async.AwaitTask |> Async.RunSynchronously with
| Some theme ->
match theme.Templates |> List.tryFind (fun t -> t.Name = path) with
| Some template ->
{ new IFileInfo with
member _.Exists = true
member _.IsDirectory = false
member _.LastModified = DateTimeOffset.Now
member _.Length = int64 template.Text.Length
member _.Name = template.Name.Split '/' |> Array.last
member _.PhysicalPath = null
member _.CreateReadStream() =
new MemoryStream(Encoding.UTF8.GetBytes template.Text) }
| None -> NotFoundFileInfo path
| None -> NotFoundFileInfo path
member _.Watch _ =
raise <| NotImplementedException "The theme file provider does not support watching for changes"
/// <summary>Render a template to a string</summary>
/// <param name="template">The template to be rendered</param>
/// <param name="viewCtx">The app context for rendering this template</param>
/// <param name="data">The data implementation to use if required</param>
/// <returns>The rendered template as a string</returns>
let render (template: IFluidTemplate) (viewCtx: AppViewContext) data =
let opts = options ()
opts.FileProvider <- ThemeFileProvider(viewCtx.WebLog.ThemeId, data)
template.Render(TemplateContext(viewCtx, opts, true))

132
src/MyWebLog/ViewContext.fs Normal file

@ -0,0 +1,132 @@
/// <summary>View rendering context for myWebLog</summary>
[<AutoOpen>]
module MyWebLog.ViewContext
open Microsoft.AspNetCore.Antiforgery
open MyWebLog.ViewModels
/// <summary>The rendering context for this application</summary>
[<NoComparison; NoEquality>]
type AppViewContext = {
/// <summary>The web log for this request</summary>
WebLog: WebLog
/// <summary>The ID of the current user</summary>
UserId: WebLogUserId option
/// <summary>The title of the page being rendered</summary>
PageTitle: string
/// <summary>The subtitle for the page</summary>
Subtitle: string option
/// <summary>The anti-Cross Site Request Forgery (CSRF) token set to use when rendering a form</summary>
Csrf: AntiforgeryTokenSet option
/// <summary>The page list for the web log</summary>
PageList: DisplayPage array
/// <summary>Categories and post counts for the web log</summary>
Categories: DisplayCategory array
/// <summary>Tag mappings</summary>
TagMappings: TagMap array
/// <summary>The URL of the page being rendered</summary>
CurrentPage: string
/// <summary>User messages</summary>
Messages: UserMessage array
/// <summary>The generator string for the rendered page</summary>
Generator: string
/// <summary>The payload for this page (see other properties that wrap this one)</summary>
Payload: obj
/// <summary>The content of a page (wrapped when rendering the layout)</summary>
Content: string
/// <summary>A string to load the minified htmx script</summary>
HtmxScript: string
/// <summary>Whether the current user is an author</summary>
IsAuthor: bool
/// <summary>Whether the current user is an editor (implies author)</summary>
IsEditor: bool
/// <summary>Whether the current user is a web log administrator (implies author and editor)</summary>
IsWebLogAdmin: bool
/// <summary>Whether the current user is an installation administrator (implies all web log rights)</summary>
IsAdministrator: bool
/// <summary>Whether the current page is the home page of the web log</summary>
IsHome: bool
/// <summary>Whether the current page is a category archive page</summary>
IsCategory: bool
/// <summary>Whether the current page is a category archive home page</summary>
IsCategoryHome: bool
/// <summary>Whether the current page is a tag archive page</summary>
IsTag: bool
/// <summary>Whether the current page is a tag archive home page</summary>
IsTagHome: bool
/// <summary>Whether the current page is a single post</summary>
IsPost: bool
/// <summary>Whether the current page is a static page</summary>
IsPage: bool
/// <summary>The slug for a category or tag</summary>
Slug: string option
} with
/// <summary>Whether there is a user logged on</summary>
member this.IsLoggedOn = Option.isSome this.UserId
/// <summary>The payload for this page as a <c>DisplayPage</c></summary>
member this.Page =
this.Payload :?> DisplayPage
/// <summary>The payload for this page as a <c>PostDisplay</c></summary>
member this.Posts =
this.Payload :?> PostDisplay
/// <summary>The model for this view (prior versions used <c>model</c> for the v3 <c>payload</c>)</summary>
member this.Model =
this.Payload
/// <summary>An empty view context</summary>
static member Empty =
{ WebLog = WebLog.Empty
UserId = None
PageTitle = ""
Subtitle = None
Csrf = None
PageList = [||]
Categories = [||]
TagMappings = [||]
CurrentPage = ""
Messages = [||]
Generator = ""
Payload = obj ()
Content = ""
HtmxScript = ""
IsAuthor = false
IsEditor = false
IsWebLogAdmin = false
IsAdministrator = false
IsHome = false
IsCategory = false
IsCategoryHome = false
IsTag = false
IsTagHome = false
IsPost = false
IsPage = false
Slug = None }

7
src/MyWebLog/Views/Admin.fs

@ -6,9 +6,12 @@ open Giraffe.ViewEngine.Htmx
open MyWebLog open MyWebLog
open MyWebLog.ViewModels open MyWebLog.ViewModels
/// The administrator dashboard /// <summary>The administrator dashboard</summary>
/// <param name="themes">The themes to display</param>
/// <param name="app">The view context</param>
/// <returns>The admin dashboard view</returns>
let dashboard (themes: Theme list) app = [ let dashboard (themes: Theme list) app = [
let templates = TemplateCache.allNames () let templates = Template.Cache.allNames ()
let cacheBaseUrl = relUrl app "admin/cache/" let cacheBaseUrl = relUrl app "admin/cache/"
let webLogCacheUrl = $"{cacheBaseUrl}web-log/" let webLogCacheUrl = $"{cacheBaseUrl}web-log/"
let themeCacheUrl = $"{cacheBaseUrl}theme/" let themeCacheUrl = $"{cacheBaseUrl}theme/"

386
src/MyWebLog/Views/Helpers.fs

@ -1,7 +1,7 @@
/// <summary>Helpers available for all myWebLog views</summary>
[<AutoOpen>] [<AutoOpen>]
module MyWebLog.Views.Helpers module MyWebLog.Views.Helpers
open Microsoft.AspNetCore.Antiforgery
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Giraffe.ViewEngine.Accessibility open Giraffe.ViewEngine.Accessibility
open Giraffe.ViewEngine.Htmx open Giraffe.ViewEngine.Htmx
@ -10,78 +10,35 @@ open MyWebLog.ViewModels
open NodaTime open NodaTime
open NodaTime.Text open NodaTime.Text
/// The rendering context for this application /// <summary>Create a relative URL for the current web log</summary>
[<NoComparison; NoEquality>] /// <param name="app">The app view context for the current view</param>
type AppViewContext = { /// <returns>A function that, given a string, will construct a relative URL</returns>
/// The web log for this request
WebLog: WebLog
/// The ID of the current user
UserId: WebLogUserId option
/// The title of the page being rendered
PageTitle: string
/// The anti-Cross Site Request Forgery (CSRF) token set to use when rendering a form
Csrf: AntiforgeryTokenSet option
/// The page list for the web log
PageList: DisplayPage array
/// Categories and post counts for the web log
Categories: DisplayCategory array
/// The URL of the page being rendered
CurrentPage: string
/// User messages
Messages: UserMessage array
/// The generator string for the rendered page
Generator: string
/// A string to load the minified htmx script
HtmxScript: string
/// Whether the current user is an author
IsAuthor: bool
/// Whether the current user is an editor (implies author)
IsEditor: bool
/// Whether the current user is a web log administrator (implies author and editor)
IsWebLogAdmin: bool
/// Whether the current user is an installation administrator (implies all web log rights)
IsAdministrator: bool
} with
/// Whether there is a user logged on
member this.IsLoggedOn = Option.isSome this.UserId
/// Create a relative URL for the current web log
let relUrl app = let relUrl app =
Permalink >> app.WebLog.RelativeUrl Permalink >> app.WebLog.RelativeUrl
/// Add a hidden input with the anti-Cross Site Request Forgery (CSRF) token /// <summary>Create a hidden input with the anti-Cross Site Request Forgery (CSRF) token</summary>
/// <param name="app">The app view context for the current view</param>
/// <returns>A hidden input with the CSRF token value</returns>
let antiCsrf app = let antiCsrf app =
input [ _type "hidden"; _name app.Csrf.Value.FormFieldName; _value app.Csrf.Value.RequestToken ] input [ _type "hidden"; _name app.Csrf.Value.FormFieldName; _value app.Csrf.Value.RequestToken ]
/// Shorthand for encoded text in a template /// <summary>Shorthand for encoded text in a template</summary>
let txt = encodedText let txt = encodedText
/// Shorthand for raw text in a template /// <summary>Shorthand for raw text in a template</summary>
let raw = rawText let raw = rawText
/// Rel attribute to prevent opener information from being provided to the new window /// <summary><c>rel</c> attribute to prevent opener information from being provided to the new window</summary>
let _relNoOpener = _rel "noopener" let _relNoOpener = _rel "noopener"
/// The pattern for a long date /// <summary>The pattern for a long date</summary>
let longDatePattern = let longDatePattern =
ZonedDateTimePattern.CreateWithInvariantCulture("MMMM d, yyyy", DateTimeZoneProviders.Tzdb) ZonedDateTimePattern.CreateWithInvariantCulture("MMMM d, yyyy", DateTimeZoneProviders.Tzdb)
/// Create a long date /// <summary>Create a long date</summary>
/// <param name="app">The app view context for the current view</param>
/// <param name="instant">The instant from which a localized long date should be produced</param>
/// <returns>A text node with the long date</returns>
let longDate app (instant: Instant) = let longDate app (instant: Instant) =
DateTimeZoneProviders.Tzdb[app.WebLog.TimeZone] DateTimeZoneProviders.Tzdb[app.WebLog.TimeZone]
|> Option.ofObj |> Option.ofObj
@ -89,11 +46,14 @@ let longDate app (instant: Instant) =
|> Option.defaultValue "--" |> Option.defaultValue "--"
|> txt |> txt
/// The pattern for a short time /// <summary>The pattern for a short time</summary>
let shortTimePattern = let shortTimePattern =
ZonedDateTimePattern.CreateWithInvariantCulture("h:mmtt", DateTimeZoneProviders.Tzdb) ZonedDateTimePattern.CreateWithInvariantCulture("h:mmtt", DateTimeZoneProviders.Tzdb)
/// Create a short time /// <summary>Create a short time</summary>
/// <param name="app">The app view context for the current view</param>
/// <param name="instant">The instant from which a localized short date should be produced</param>
/// <returns>A text node with the short date</returns>
let shortTime app (instant: Instant) = let shortTime app (instant: Instant) =
DateTimeZoneProviders.Tzdb[app.WebLog.TimeZone] DateTimeZoneProviders.Tzdb[app.WebLog.TimeZone]
|> Option.ofObj |> Option.ofObj
@ -101,11 +61,19 @@ let shortTime app (instant: Instant) =
|> Option.defaultValue "--" |> Option.defaultValue "--"
|> txt |> txt
/// Display "Yes" or "No" based on the state of a boolean value /// <summary>Display "Yes" or "No" based on the state of a boolean value</summary>
/// <param name="value">The true/false value</param>
/// <returns>A text node with <c>Yes</c> if true, <c>No</c> if false</returns>
let yesOrNo value = let yesOrNo value =
raw (if value then "Yes" else "No") raw (if value then "Yes" else "No")
/// Extract an attribute value from a list of attributes, remove that attribute if it is found /// <summary>Extract an attribute value from a list of attributes, remove that attribute if it is found</summary>
/// <param name="name">The name of the attribute to be extracted and removed</param>
/// <param name="attrs">The list of attributes to be searched</param>
/// <returns>
/// A tuple with <c>fst</c> being <c>Some</c> with the attribute if found, <c>None</c> if not; and <c>snd</c>
/// being the list of attributes with the extracted one removed
/// </returns>
let extractAttrValue name attrs = let extractAttrValue name attrs =
let valueAttr = attrs |> List.tryFind (fun x -> match x with KeyValue (key, _) when key = name -> true | _ -> false) let valueAttr = attrs |> List.tryFind (fun x -> match x with KeyValue (key, _) when key = name -> true | _ -> false)
match valueAttr with match valueAttr with
@ -114,7 +82,14 @@ let extractAttrValue name attrs =
attrs |> List.filter (fun x -> match x with KeyValue (key, _) when key = name -> false | _ -> true) attrs |> List.filter (fun x -> match x with KeyValue (key, _) when key = name -> false | _ -> true)
| Some _ | None -> None, attrs | Some _ | None -> None, attrs
/// Create a text input field /// <summary>Create a text input field</summary>
/// <param name="fieldType">The <c>input</c> field type</param>
/// <param name="attrs">Attributes for the field</param>
/// <param name="name">The name of the input field</param>
/// <param name="labelText">The text of the <c>label</c> element associated with this <c>input</c></param>
/// <param name="value">The value of the <c>input</c> field</param>
/// <param name="extra">Any extra elements to include after the <c>input</c> and <c>label</c></param>
/// <returns>A <c>div</c> element with the <c>input</c> field constructed</returns>
let inputField fieldType attrs name labelText value extra = let inputField fieldType attrs name labelText value extra =
let fieldId, attrs = extractAttrValue "id" attrs let fieldId, attrs = extractAttrValue "id" attrs
let cssClass, attrs = extractAttrValue "class" attrs let cssClass, attrs = extractAttrValue "class" attrs
@ -127,23 +102,58 @@ let inputField fieldType attrs name labelText value extra =
yield! extra yield! extra
] ]
/// Create a text input field /// <summary>Create a text input field</summary>
/// <param name="attrs">Attributes for the field</param>
/// <param name="name">The name of the input field</param>
/// <param name="labelText">The text of the <c>label</c> element associated with this <c>input</c></param>
/// <param name="value">The value of the <c>input</c> field</param>
/// <param name="extra">Any extra elements to include after the <c>input</c> and <c>label</c></param>
/// <returns>A <c>div</c> element with the &lt;input type=text&gt; field constructed</returns>
let textField attrs name labelText value extra = let textField attrs name labelText value extra =
inputField "text" attrs name labelText value extra inputField "text" attrs name labelText value extra
/// Create a number input field /// <summary>Create a number input field</summary>
/// <param name="attrs">Attributes for the field</param>
/// <param name="name">The name of the input field</param>
/// <param name="labelText">The text of the <c>label</c> element associated with this <c>input</c></param>
/// <param name="value">The value of the <c>input</c> field</param>
/// <param name="extra">Any extra elements to include after the <c>input</c> and <c>label</c></param>
/// <returns>A <c>div</c> element with the &lt;input type=number&gt; field constructed</returns>
let numberField attrs name labelText value extra = let numberField attrs name labelText value extra =
inputField "number" attrs name labelText value extra inputField "number" attrs name labelText value extra
/// Create an e-mail input field /// <summary>Create an e-mail input field</summary>
/// <param name="attrs">Attributes for the field</param>
/// <param name="name">The name of the input field</param>
/// <param name="labelText">The text of the <c>label</c> element associated with this <c>input</c></param>
/// <param name="value">The value of the <c>input</c> field</param>
/// <param name="extra">Any extra elements to include after the <c>input</c> and <c>label</c></param>
/// <returns>A <c>div</c> element with the &lt;input type=email&gt; field constructed</returns>
let emailField attrs name labelText value extra = let emailField attrs name labelText value extra =
inputField "email" attrs name labelText value extra inputField "email" attrs name labelText value extra
/// Create a password input field /// <summary>Create a password input field</summary>
/// <param name="attrs">Attributes for the field</param>
/// <param name="name">The name of the input field</param>
/// <param name="labelText">The text of the <c>label</c> element associated with this <c>input</c></param>
/// <param name="value">The value of the <c>input</c> field</param>
/// <param name="extra">Any extra elements to include after the <c>input</c> and <c>label</c></param>
/// <returns>A <c>div</c> element with the &lt;input type=password&gt; field constructed</returns>
let passwordField attrs name labelText value extra = let passwordField attrs name labelText value extra =
inputField "password" attrs name labelText value extra inputField "password" attrs name labelText value extra
/// Create a select (dropdown) field /// <summary>Create a select (dropdown) field</summary>
/// <typeparam name="T">The type of value in the backing list</typeparam>
/// <typeparam name="a">The type of the <c>value</c> attribute</typeparam>
/// <param name="attrs">Attributes for the field</param>
/// <param name="name">The name of the input field</param>
/// <param name="labelText">The text of the <c>label</c> element associated with this <c>input</c></param>
/// <param name="value">The value of the <c>input</c> field</param>
/// <param name="values">The backing list for this dropdown</param>
/// <param name="idFunc">The function to extract the ID (<c>value</c> attribute)</param>
/// <param name="displayFunc">The function to extract the displayed version of the item</param>
/// <param name="extra">Any extra elements to include after the <c>input</c> and <c>label</c></param>
/// <returns>A <c>div</c> element with the &lt;select&gt; field constructed</returns>
let selectField<'T, 'a> let selectField<'T, 'a>
attrs name labelText value (values: 'T seq) (idFunc: 'T -> 'a) (displayFunc: 'T -> string) extra = attrs name labelText value (values: 'T seq) (idFunc: 'T -> 'a) (displayFunc: 'T -> string) extra =
let cssClass, attrs = extractAttrValue "class" attrs let cssClass, attrs = extractAttrValue "class" attrs
@ -157,7 +167,13 @@ let selectField<'T, 'a>
yield! extra yield! extra
] ]
/// Create a checkbox input styled as a switch /// <summary>Create a checkbox input styled as a switch</summary>
/// <param name="attrs">Attributes for the field</param>
/// <param name="name">The name of the input field</param>
/// <param name="labelText">The text of the <c>label</c> element associated with this <c>input</c></param>
/// <param name="value">Whether the checkbox should be checked or not</param>
/// <param name="extra">Any extra elements to include after the <c>input</c> and <c>label</c></param>
/// <returns>A <c>div</c> element with the switch-style &lt;input type=checkbox&gt; field constructed</returns>
let checkboxSwitch attrs name labelText (value: bool) extra = let checkboxSwitch attrs name labelText (value: bool) extra =
let cssClass, attrs = extractAttrValue "class" attrs let cssClass, attrs = extractAttrValue "class" attrs
div [ _class $"""form-check form-switch {defaultArg cssClass ""}""" ] [ div [ _class $"""form-check form-switch {defaultArg cssClass ""}""" ] [
@ -168,15 +184,15 @@ let checkboxSwitch attrs name labelText (value: bool) extra =
yield! extra yield! extra
] ]
/// A standard save button /// <summary>A standard save button</summary>
let saveButton = let saveButton =
button [ _type "submit"; _class "btn btn-sm btn-primary" ] [ raw "Save Changes" ] button [ _type "submit"; _class "btn btn-sm btn-primary" ] [ raw "Save Changes" ]
/// A spacer bullet to use between action links /// <summary>A spacer bullet to use between action links</summary>
let actionSpacer = let actionSpacer =
span [ _class "text-muted" ] [ raw " &bull; " ] span [ _class "text-muted" ] [ raw " &bull; " ]
/// Functions for generating content in varying layouts /// <summary>Functions for generating content in varying layouts</summary>
module Layout = module Layout =
/// Generate the title tag for a page /// Generate the title tag for a page
@ -273,14 +289,20 @@ module Layout =
] ]
] ]
/// Render a page with a partial layout (htmx request) /// <summary>Render a page with a partial layout (htmx request)</summary>
/// <param name="content">A function that, when given a view context, will return a view</param>
/// <param name="app">The app view context to use when rendering the view</param>
/// <returns>A constructed Giraffe View Engine view</returns>
let partial content app = let partial content app =
html [ _lang "en" ] [ html [ _lang "en" ] [
titleTag app titleTag app
yield! pageView content app yield! pageView content app
] ]
/// Render a page with a full layout /// <summary>Render a page with a full layout</summary>
/// <param name="content">A function that, when given a view context, will return a view</param>
/// <param name="app">The app view context to use when rendering the view</param>
/// <returns>A constructed Giraffe View Engine view</returns>
let full content app = let full content app =
html [ _lang "en" ] [ html [ _lang "en" ] [
meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ] meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
@ -295,12 +317,15 @@ module Layout =
script [ _src "https://cdn.jsdelivr.net/npm/bootstrap@5.1.3/dist/js/bootstrap.bundle.min.js" script [ _src "https://cdn.jsdelivr.net/npm/bootstrap@5.1.3/dist/js/bootstrap.bundle.min.js"
_integrity "sha384-ka7Sk0Gln4gmtz2MlQnikT1wXgYsOg+OMhuP+IlRH9sENBO0LRn5q+8nbTov4+1p" _integrity "sha384-ka7Sk0Gln4gmtz2MlQnikT1wXgYsOg+OMhuP+IlRH9sENBO0LRn5q+8nbTov4+1p"
_crossorigin "anonymous" ] [] _crossorigin "anonymous" ] []
Script.minified script [ _src (relUrl app "htmx.min.js") ] []
script [ _src (relUrl app "themes/admin/admin.js") ] [] script [ _src (relUrl app "themes/admin/admin.js") ] []
] ]
] ]
/// Render a bare layout /// <summary>Render a bare layout</summary>
/// <param name="content">A function that, when given a view context, will return a view</param>
/// <param name="app">The app view context to use when rendering the view</param>
/// <returns>A constructed Giraffe View Engine view</returns>
let bare (content: AppViewContext -> XmlNode list) app = let bare (content: AppViewContext -> XmlNode list) app =
html [ _lang "en" ] [ html [ _lang "en" ] [
title [] [] title [] []
@ -311,14 +336,17 @@ module Layout =
// ~~ SHARED TEMPLATES BETWEEN POSTS AND PAGES // ~~ SHARED TEMPLATES BETWEEN POSTS AND PAGES
open Giraffe.Htmx.Common open Giraffe.Htmx.Common
/// The round-trip instant pattern /// <summary>The round-trip instant pattern</summary>
let roundTrip = InstantPattern.CreateWithInvariantCulture "uuuu'-'MM'-'dd'T'HH':'mm':'ss'.'fffffff" let roundTrip = InstantPattern.CreateWithInvariantCulture "uuuu'-'MM'-'dd'T'HH':'mm':'ss'.'fffffff"
/// Capitalize the first letter in the given string /// Capitalize the first letter in the given string
let private capitalize (it: string) = let private capitalize (it: string) =
$"{(string it[0]).ToUpper()}{it[1..]}" $"{(string it[0]).ToUpper()}{it[1..]}"
/// The common edit form shared by pages and posts /// <summary>The common edit form shared by pages and posts</summary>
/// <param name="model">The model to use to render this view</param>
/// <param name="app">The app view context to use to render this view</param>
/// <returns>A common edit view</returns>
let commonEdit (model: EditCommonModel) app = [ let commonEdit (model: EditCommonModel) app = [
textField [ _class "mb-3"; _required; _autofocus ] (nameof model.Title) "Title" model.Title [] textField [ _class "mb-3"; _required; _autofocus ] (nameof model.Title) "Title" model.Title []
textField [ _class "mb-3"; _required ] (nameof model.Permalink) "Permalink" model.Permalink [ textField [ _class "mb-3"; _required ] (nameof model.Permalink) "Permalink" model.Permalink [
@ -352,19 +380,194 @@ let commonEdit (model: EditCommonModel) app = [
] ]
/// Display a common template list /// <summary>Display a common template list</summary>
/// <param name="model">The edit model</param>
/// <param name="templates">A list of available templates for this page or post</param>
/// <returns>A &lt;select&gt; element to allow a template to be selected</returns>
let commonTemplates (model: EditCommonModel) (templates: MetaItem seq) = let commonTemplates (model: EditCommonModel) (templates: MetaItem seq) =
selectField [ _class "mb-3" ] (nameof model.Template) $"{capitalize model.Entity} Template" model.Template templates selectField [ _class "mb-3" ] (nameof model.Template) $"{capitalize model.Entity} Template" model.Template templates
(_.Name) (_.Value) [] _.Name _.Value []
/// Display the metadata item edit form /// <summary>Display the OpenGraph data edit form</summary>
/// <param name="model">The edit model</param>
/// <returns>Fields for editing OpenGraph data for a page or post</returns>
let commonOpenGraph (model: EditCommonModel) =
fieldset [ _class "mb-3" ] [
legend [] [
span [ _class "form-check form-switch" ] [
small [] [
input [ _type "checkbox"; _name (nameof model.AssignOpenGraph)
_id (nameof model.AssignOpenGraph); _class "form-check-input"; _value "true"
_data "bs-toggle" "collapse"; _data "bs-target" "#og_props"
_onclick "Admin.toggleOpenGraphFields()"; if model.AssignOpenGraph then _checked ]
]
label [ _for (nameof model.AssignOpenGraph) ] [ raw "OpenGraph Properties" ]
]
]
div [ _id "og_props"; _class $"""container p-0 collapse{if model.AssignOpenGraph then " show" else ""}""" ] [
fieldset [ _id "og_item" ] [
legend [] [ raw "Item Details" ]
div [ _class "row p-0" ] [
div [ _class "mb-3 col-xs-6 col-md-3" ] [
selectField [ _required ] (nameof model.OpenGraphType) "Type" model.OpenGraphType
OpenGraphType.Selections fst snd []
]
div [ _class "mb-3 col-xs-6 col-md-3" ] [
textField [] (nameof model.OpenGraphLocale) "Locale" model.OpenGraphLocale
[ span [ _class "form-text" ] [ raw "ex. en-US" ] ]
]
div [ _class "mb-3 col-xs-6 col-md-4" ] [
textField [] (nameof model.OpenGraphAlternateLocales) "Alternate Locales"
model.OpenGraphAlternateLocales
[ span [ _class "form-text" ] [ raw "comma separated" ] ]
]
div [ _class "mb-3 col-xs-6 col-md-2" ] [
textField [] (nameof model.OpenGraphDeterminer) "Determiner" model.OpenGraphDeterminer
[ span [ _class "form-text" ] [ raw "a/an/the"; br []; raw "(blank = auto)" ] ]
]
div [ _class "mb-3 col-12" ] [
textField [] (nameof model.OpenGraphDescription) "Short Description" model.OpenGraphDescription
[]
]
]
]
fieldset [ _id "og_image" ] [
legend [] [ raw "Image" ]
div [ _class "row p-0" ] [
let syncJS = $"Admin.pathOrFile('{nameof model.OpenGraphImageUrl}', 'OpenGraphImageFile')"
div [ _class "mb-3 col-12" ] [
textField [ _onkeyup syncJS ] (nameof model.OpenGraphImageUrl) "Existing Image URL"
model.OpenGraphImageUrl []
]
div [ _class "mb-3 col-12" ] [
if model.OpenGraphImageUrl = "" then
div [ _class "form-floating" ] [
input [ _type "file"; _id "OpenGraphImageFile"; _name "OpenGraphImageFile"
_class "form-control"; _accept "image/*"; _oninput syncJS ]
label [ _for "OpenGraphImageFile" ] [ raw "Upload Image File" ]
]
else
input [ _type "hidden"; _id "OpenGraphImageFile"; _name "OpenGraphImageFile" ]
]
div [ _class "mb-3 col-12" ] [
textField [] (nameof model.OpenGraphImageAlt) "Alternate Text" model.OpenGraphImageAlt []
]
div [ _class "mb-3 col-6" ] [
textField [] (nameof model.OpenGraphImageType) "MIME Type" model.OpenGraphImageType
[ span [ _class "form-text" ] [ raw "Leave blank to derive type from extension" ] ]
]
div [ _class "mb-3 col-3" ] [
numberField [] (nameof model.OpenGraphImageWidth) "Width" model.OpenGraphImageWidth
[ span [ _class "form-text" ] [ raw "px" ] ]
]
div [ _class "mb-3 col-3" ] [
numberField [] (nameof model.OpenGraphImageHeight) "Height" model.OpenGraphImageHeight
[ span [ _class "form-text" ] [ raw "px" ] ]
]
]
]
fieldset [ _id "og_audio" ] [
legend [] [ raw "Audio" ]
div [ _class "row p-0" ] [
let syncJS = $"Admin.pathOrFile('{nameof model.OpenGraphAudioUrl}', 'OpenGraphAudioFile')"
div [ _class "mb-3 col-12" ] [
textField [ _onkeyup syncJS ] (nameof model.OpenGraphAudioUrl) "Existing Audio URL"
model.OpenGraphAudioUrl []
]
div [ _class "mb-3 col-12" ] [
if model.OpenGraphAudioUrl = "" then
div [ _class "form-floating" ] [
input [ _type "file"; _id "OpenGraphAudioFile"; _name "OpenGraphAudioFile"
_class "form-control"; _accept "image/*"; _oninput syncJS ]
label [ _for "OpenGraphAudioFile" ] [ raw "Upload Audio File" ]
]
else
input [ _type "hidden"; _id "OpenGraphAudioFile"; _name "OpenGraphAudioFile" ]
]
div [ _class "mb-3 col-6" ] [
textField [] (nameof model.OpenGraphAudioType) "MIME Type" model.OpenGraphAudioType
[ span [ _class "form-text" ] [ raw "Leave blank to derive type from extension" ] ]
]
]
]
fieldset [ _id "og_video" ] [
legend [] [ raw "Video" ]
div [ _class "row p-0" ] [
let syncJS = $"Admin.pathOrFile('{nameof model.OpenGraphVideoUrl}', 'OpenGraphVideoFile')"
div [ _class "mb-3 col-12" ] [
textField [ _onkeyup syncJS ] (nameof model.OpenGraphVideoUrl) "Existing Video URL"
model.OpenGraphVideoUrl []
]
div [ _class "mb-3 col-12" ] [
if model.OpenGraphVideoUrl = "" then
div [ _class "form-floating" ] [
input [ _type "file"; _id "OpenGraphVideoFile"; _name "OpenGraphVideoFile"
_class "form-control"; _accept "image/*"; _oninput syncJS ]
label [ _for "OpenGraphVideoFile" ] [ raw "Upload Video File" ]
]
else
input [ _type "hidden"; _id "OpenGraphVideoFile"; _name "OpenGraphVideoFile" ]
]
div [ _class "mb-3 col-6" ] [
textField [] (nameof model.OpenGraphVideoType) "MIME Type" model.OpenGraphVideoType
[ span [ _class "form-text" ] [ raw "Leave blank to derive type from extension" ] ]
]
div [ _class "mb-3 col-3" ] [
numberField [] (nameof model.OpenGraphVideoWidth) "Width" model.OpenGraphVideoWidth
[ span [ _class "form-text" ] [ raw "px" ] ]
]
div [ _class "mb-3 col-3" ] [
numberField [] (nameof model.OpenGraphVideoHeight) "Height" model.OpenGraphVideoHeight
[ span [ _class "form-text" ] [ raw "px" ] ]
]
]
]
fieldset [] [
legend [] [ raw "Extra Properties" ]
let items = Array.zip model.OpenGraphExtraNames model.OpenGraphExtraValues
let extraDetail idx (name, value) =
div [ _id $"og_extra_%i{idx}"; _class "row mb-3" ] [
div [ _class "col-1 text-center align-self-center" ] [
button [ _type "button"; _class "btn btn-sm btn-danger"
_onclick $"Admin.removeMetaItem('og_extra', {idx})" ] [
raw "&minus;"
]
]
div [ _class "col-3" ] [
textField [ _id $"{nameof model.OpenGraphExtraNames}_{idx}" ]
(nameof model.OpenGraphExtraNames) "Name" name []
]
div [ _class "col-8" ] [
textField [ _id $"{nameof model.OpenGraphExtraValues}_{idx}" ]
(nameof model.OpenGraphExtraValues) "Value" value []
]
]
div [] [
div [ _id "og_extra_items"; _class "container p-0" ] (items |> Array.mapi extraDetail |> List.ofArray)
button [ _type "button"; _class "btn btn-sm btn-secondary"
_onclick "Admin.addMetaItem('og_extra')" ] [
raw "Add an Extra Property"
]
script [] [
raw """document.addEventListener("DOMContentLoaded", """
raw $"() => Admin.setNextExtraIndex({items.Length}))"
]
]
]
]
]
/// <summary>Display the metadata item edit form</summary>
/// <param name="model">The edit model</param>
/// <returns>A form for editing metadata</returns>
let commonMetaItems (model: EditCommonModel) = let commonMetaItems (model: EditCommonModel) =
let items = Array.zip model.MetaNames model.MetaValues let items = Array.zip model.MetaNames model.MetaValues
let metaDetail idx (name, value) = let metaDetail idx (name, value) =
div [ _id $"meta_%i{idx}"; _class "row mb-3" ] [ div [ _id $"meta_%i{idx}"; _class "row mb-3" ] [
div [ _class "col-1 text-center align-self-center" ] [ div [ _class "col-1 text-center align-self-center" ] [
button [ _type "button"; _class "btn btn-sm btn-danger"; _onclick $"Admin.removeMetaItem({idx})" ] [ button [ _type "button"; _class "btn btn-sm btn-danger"
_onclick $"Admin.removeMetaItem('meta', {idx})" ] [
raw "&minus;" raw "&minus;"
] ]
] ]
@ -382,7 +585,7 @@ let commonMetaItems (model: EditCommonModel) =
] ]
div [ _id "meta_item_container"; _class "collapse" ] [ div [ _id "meta_item_container"; _class "collapse" ] [
div [ _id "meta_items"; _class "container" ] (items |> Array.mapi metaDetail |> List.ofArray) div [ _id "meta_items"; _class "container" ] (items |> Array.mapi metaDetail |> List.ofArray)
button [ _type "button"; _class "btn btn-sm btn-secondary"; _onclick "Admin.addMetaItem()" ] [ button [ _type "button"; _class "btn btn-sm btn-secondary"; _onclick "Admin.addMetaItem('meta')" ] [
raw "Add an Item" raw "Add an Item"
] ]
script [] [ script [] [
@ -393,7 +596,10 @@ let commonMetaItems (model: EditCommonModel) =
] ]
/// Revision preview template /// <summary>Revision preview template</summary>
/// <param name="rev">The revision to preview</param>
/// <param name="app">The app view context to use when rendering the preview</param>
/// <returns>A view with a revision preview</returns>
let commonPreview (rev: Revision) app = let commonPreview (rev: Revision) app =
div [ _class "mwl-revision-preview mb-3" ] [ div [ _class "mwl-revision-preview mb-3" ] [
rev.Text.AsHtml() |> addBaseToRelativeUrls app.WebLog.ExtraPath |> raw rev.Text.AsHtml() |> addBaseToRelativeUrls app.WebLog.ExtraPath |> raw
@ -401,7 +607,10 @@ let commonPreview (rev: Revision) app =
|> List.singleton |> List.singleton
/// Form to manage permalinks for pages or posts /// <summary>Form to manage permalinks for pages or posts</summary>
/// <param name="model">The manage permalinks model to be rendered</param>
/// <param name="app">The app view context to use when rendering this view</param>
/// <returns>A view for managing permalinks for a page or post</returns>
let managePermalinks (model: ManagePermalinksModel) app = [ let managePermalinks (model: ManagePermalinksModel) app = [
let baseUrl = relUrl app $"admin/{model.Entity}/" let baseUrl = relUrl app $"admin/{model.Entity}/"
let linkDetail idx link = let linkDetail idx link =
@ -465,7 +674,10 @@ let managePermalinks (model: ManagePermalinksModel) app = [
] ]
] ]
/// Form to manage revisions for pages or posts /// <summary>Form to manage revisions for pages or posts</summary>
/// <param name="model">The manage revisions model to be rendered</param>
/// <param name="app">The app view context to use when rendering this view</param>
/// <returns>A view for managing revisions for a page or post</returns>
let manageRevisions (model: ManageRevisionsModel) app = [ let manageRevisions (model: ManageRevisionsModel) app = [
let revUrlBase = relUrl app $"admin/{model.Entity}/{model.Id}/revision" let revUrlBase = relUrl app $"admin/{model.Entity}/{model.Id}/revision"
let revDetail idx (rev: Revision) = let revDetail idx (rev: Revision) =
@ -485,7 +697,7 @@ let manageRevisions (model: ManageRevisionsModel) app = [
span [ _class "text-muted" ] [ raw " &bull; " ] span [ _class "text-muted" ] [ raw " &bull; " ]
a [ _href revRestore; _hxPost revRestore ] [ raw "Restore as Current" ] a [ _href revRestore; _hxPost revRestore ] [ raw "Restore as Current" ]
span [ _class "text-muted" ] [ raw " &bull; " ] span [ _class "text-muted" ] [ raw " &bull; " ]
a [ _href revUrlPrefix; _hxDelete revUrlPrefix; _hxTarget $"#{asOfId}" a [ _href revUrlPrefix; _hxDelete revUrlPrefix; _hxTarget $"#{asOfId}"; _hxPushUrl "false"
_hxSwap HxSwap.OuterHtml; _class "text-danger" ] [ _hxSwap HxSwap.OuterHtml; _class "text-danger" ] [
raw "Delete" raw "Delete"
] ]

81
src/MyWebLog/Views/Page.fs

@ -29,7 +29,7 @@ let pageEdit (model: EditPageModel) templates app = [
/// Display a list of pages for this web log /// Display a list of pages for this web log
let pageList (pages: DisplayPage list) pageNbr hasNext app = [ let pageList (pages: DisplayPage list) pageNbr hasNext app = [
h2 [ _class "my-3" ] [ raw app.PageTitle ] h2 [ _class "my-3" ] [ raw app.PageTitle ]
article [] [ article [ _class "container mb-3" ] [
a [ _href (relUrl app "admin/page/new/edit"); _class "btn btn-primary btn-sm mb-3" ] [ raw "Create a New Page" ] a [ _href (relUrl app "admin/page/new/edit"); _class "btn btn-primary btn-sm mb-3" ] [ raw "Create a New Page" ]
if pages.Length = 0 then if pages.Length = 0 then
p [ _class "text-muted fst-italic text-center" ] [ raw "This web log has no pages" ] p [ _class "text-muted fst-italic text-center" ] [ raw "This web log has no pages" ]
@ -37,50 +37,47 @@ let pageList (pages: DisplayPage list) pageNbr hasNext app = [
let titleCol = "col-12 col-md-5" let titleCol = "col-12 col-md-5"
let linkCol = "col-12 col-md-5" let linkCol = "col-12 col-md-5"
let upd8Col = "col-12 col-md-2" let upd8Col = "col-12 col-md-2"
form [ _method "post"; _class "container mb-3"; _hxTarget "body" ] [ div [ _class "row mwl-table-heading" ] [
antiCsrf app div [ _class titleCol ] [
div [ _class "row mwl-table-heading" ] [ span [ _class "d-none d-md-inline" ] [ raw "Title" ]; span [ _class "d-md-none" ] [ raw "Page" ]
div [ _class titleCol ] [
span [ _class "d-none d-md-inline" ] [ raw "Title" ]; span [ _class "d-md-none" ] [ raw "Page" ]
]
div [ _class $"{linkCol} d-none d-md-inline-block" ] [ raw "Permalink" ]
div [ _class $"{upd8Col} d-none d-md-inline-block" ] [ raw "Updated" ]
] ]
for pg in pages do div [ _class $"{linkCol} d-none d-md-inline-block" ] [ raw "Permalink" ]
let pageLink = if pg.IsDefault then "" else pg.Permalink div [ _class $"{upd8Col} d-none d-md-inline-block" ] [ raw "Updated" ]
div [ _class "row mwl-table-detail" ] [ ]
div [ _class titleCol ] [ for pg in pages do
txt pg.Title let pageLink = if pg.IsDefault then "" else pg.Permalink
if pg.IsDefault then div [ _class "row mwl-table-detail" ] [
raw " &nbsp; "; span [ _class "badge bg-success" ] [ raw "HOME PAGE" ] div [ _class titleCol ] [
if pg.IsInPageList then txt pg.Title
raw " &nbsp; "; span [ _class "badge bg-primary" ] [ raw "IN PAGE LIST" ] if pg.IsDefault then
br [] ; small [] [ raw " &nbsp; "; span [ _class "badge bg-success" ] [ raw "HOME PAGE" ]
let adminUrl = relUrl app $"admin/page/{pg.Id}" if pg.IsInPageList then
a [ _href (relUrl app pageLink); _target "_blank" ] [ raw "View Page" ] raw " &nbsp; "; span [ _class "badge bg-primary" ] [ raw "IN PAGE LIST" ]
if app.IsEditor || (app.IsAuthor && app.UserId.Value = WebLogUserId pg.AuthorId) then br [] ; small [] [
span [ _class "text-muted" ] [ raw " &bull; " ] let adminUrl = relUrl app $"admin/page/{pg.Id}"
a [ _href $"{adminUrl}/edit" ] [ raw "Edit" ] a [ _href (relUrl app pageLink); _target "_blank" ] [ raw "View Page" ]
if app.IsWebLogAdmin then if app.IsEditor || (app.IsAuthor && app.UserId.Value = WebLogUserId pg.AuthorId) then
span [ _class "text-muted" ] [ raw " &bull; " ] span [ _class "text-muted" ] [ raw " &bull; " ]
a [ _href adminUrl; _hxDelete adminUrl; _class "text-danger" a [ _href $"{adminUrl}/edit" ] [ raw "Edit" ]
_hxConfirm $"Are you sure you want to delete the page &ldquo;{pg.Title}&rdquo;? This action cannot be undone." ] [ if app.IsWebLogAdmin then
raw "Delete" span [ _class "text-muted" ] [ raw " &bull; " ]
] a [ _href adminUrl; _hxDelete adminUrl; _hxTarget "body"; _class "text-danger"
] _hxConfirm $"Are you sure you want to delete the page &ldquo;{pg.Title}&rdquo;? This action cannot be undone." ] [
] raw "Delete"
div [ _class linkCol ] [ ]
small [ _class "d-md-none" ] [ txt pageLink ]
span [ _class "d-none d-md-inline" ] [ txt pageLink ]
]
div [ _class upd8Col ] [
small [ _class "d-md-none text-muted" ] [
raw "Updated "; txt (pg.UpdatedOn.ToString "MMMM d, yyyy")
]
span [ _class "d-none d-md-inline" ] [ txt (pg.UpdatedOn.ToString "MMMM d, yyyy") ]
] ]
] ]
] div [ _class linkCol ] [
small [ _class "d-md-none" ] [ txt pageLink ]
span [ _class "d-none d-md-inline" ] [ txt pageLink ]
]
div [ _class upd8Col ] [
small [ _class "d-md-none text-muted" ] [
raw "Updated "; txt (pg.UpdatedOn.ToString "MMMM d, yyyy")
]
span [ _class "d-none d-md-inline" ] [ txt (pg.UpdatedOn.ToString "MMMM d, yyyy") ]
]
]
if pageNbr > 1 || hasNext then if pageNbr > 1 || hasNext then
div [ _class "d-flex justify-content-evenly mb-3" ] [ div [ _class "d-flex justify-content-evenly mb-3" ] [
div [] [ div [] [

7
src/MyWebLog/Views/Post.fs

@ -102,9 +102,7 @@ let chapterEdit (model: EditChapterModel) app = [
/// Display a list of chapters /// Display a list of chapters
let chapterList withNew (model: ManageChaptersModel) app = let chapterList withNew (model: ManageChaptersModel) app =
form [ _method "post"; _id "chapter_list"; _class "container mb-3"; _hxTarget "this"; _hxSwap HxSwap.OuterHtml ] [ div [ _id "chapter_list"; _class "container mb-3"; _hxTarget "this"; _hxSwap HxSwap.OuterHtml ] [
antiCsrf app
input [ _type "hidden"; _name "Id"; _value model.Id ]
div [ _class "row mwl-table-heading" ] [ div [ _class "row mwl-table-heading" ] [
div [ _class "col-3 col-md-2" ] [ raw "Start" ] div [ _class "col-3 col-md-2" ] [ raw "Start" ]
div [ _class "col-3 col-md-6 col-lg-8" ] [ raw "Title" ] div [ _class "col-3 col-md-6 col-lg-8" ] [ raw "Title" ]
@ -293,6 +291,7 @@ let postEdit (model: EditPostModel) templates (ratings: MetaItem list) app = [
checkboxSwitch [ _class "mb-2" ] (nameof model.DoPublish) "Publish This Post" model.DoPublish [] checkboxSwitch [ _class "mb-2" ] (nameof model.DoPublish) "Publish This Post" model.DoPublish []
saveButton saveButton
hr [ _class "mb-3" ] hr [ _class "mb-3" ]
commonOpenGraph model
fieldset [ _class "mb-3" ] [ fieldset [ _class "mb-3" ] [
legend [] [ legend [] [
span [ _class "form-check form-switch" ] [ span [ _class "form-check form-switch" ] [
@ -355,7 +354,7 @@ let postEdit (model: EditPostModel) templates (ratings: MetaItem list) app = [
] ]
div [ _class "col-12 col-md-4 pb-3" ] [ div [ _class "col-12 col-md-4 pb-3" ] [
selectField [] (nameof model.Explicit) "Explicit Rating" model.Explicit ratings selectField [] (nameof model.Explicit) "Explicit Rating" model.Explicit ratings
(_.Name) (_.Value) [ _.Name _.Value [
div [ _class "form-text" ] [ raw "Optional; overrides podcast default" ] div [ _class "form-text" ] [ raw "Optional; overrides podcast default" ]
] ]
] ]

9
src/MyWebLog/Views/User.fs

@ -144,7 +144,7 @@ let userList (model: WebLogUser list) app =
] ]
if app.UserId.Value <> user.Id then if app.UserId.Value <> user.Id then
span [ _class "text-muted" ] [ raw " &bull; " ] span [ _class "text-muted" ] [ raw " &bull; " ]
a [ _href userUrl; _hxDelete userUrl; _class "text-danger" a [ _href userUrl; _hxDelete userUrl; _hxPushUrl "false"; _class "text-danger"
_hxConfirm $"Are you sure you want to delete the user “{user.PreferredName}”? This action cannot be undone. (This action will not succeed if the user has authored any posts or pages.)" ] [ _hxConfirm $"Are you sure you want to delete the user “{user.PreferredName}”? This action cannot be undone. (This action will not succeed if the user has authored any posts or pages.)" ] [
raw "Delete" raw "Delete"
] ]
@ -186,11 +186,8 @@ let userList (model: WebLogUser list) app =
div [ _class "container g-0" ] [ div [ _class "container g-0" ] [
div [ _class "row mwl-table-detail"; _id "user_new" ] [] div [ _class "row mwl-table-detail"; _id "user_new" ] []
] ]
form [ _method "post"; _class "container g-0"; _hxTarget "#user_panel" List.map userDetail model
_hxSwap $"{HxSwap.OuterHtml} show:window:top" ] [ |> div [ _class "container g-0"; _hxTarget "#user_panel"; _hxSwap $"{HxSwap.OuterHtml} show:window:top" ]
antiCsrf app
yield! List.map userDetail model
]
] ]
] ]
|> List.singleton |> List.singleton

42
src/MyWebLog/Views/WebLog.fs

@ -33,7 +33,7 @@ let categoryEdit (model: EditCategoryModel) app =
|> String.concat "" |> String.concat ""
{ Name = c.Id; Value = $"{parents}{c.Name}" }) { Name = c.Id; Value = $"{parents}{c.Name}" })
|> Seq.append [ { Name = ""; Value = "&ndash; None &ndash;" } ] |> Seq.append [ { Name = ""; Value = "&ndash; None &ndash;" } ]
selectField [] (nameof model.ParentId) "Parent Category" model.ParentId cats (_.Name) (_.Value) [] selectField [] (nameof model.ParentId) "Parent Category" model.ParentId cats _.Name _.Value []
] ]
div [ _class "col-12 col-xl-10 offset-xl-1 mb-3" ] [ div [ _class "col-12 col-xl-10 offset-xl-1 mb-3" ] [
textField [] (nameof model.Description) "Description" model.Description [] textField [] (nameof model.Description) "Description" model.Description []
@ -107,9 +107,6 @@ let categoryList includeNew app = [
div [ _class catCol ] [ raw "Category"; span [ _class "d-md-none" ] [ raw "; Description" ] ] div [ _class catCol ] [ raw "Category"; span [ _class "d-md-none" ] [ raw "; Description" ] ]
div [ _class $"{descCol} d-none d-md-inline-block" ] [ raw "Description" ] div [ _class $"{descCol} d-none d-md-inline-block" ] [ raw "Description" ]
] ]
]
form [ _method "post"; _class "container" ] [
antiCsrf app
div [ _class "row mwl-table-detail"; _id "cat_new" ] [ if includeNew then loadNew ] div [ _class "row mwl-table-detail"; _id "cat_new" ] [ if includeNew then loadNew ]
yield! app.Categories |> Seq.ofArray |> Seq.map categoryDetail |> List.ofSeq yield! app.Categories |> Seq.ofArray |> Seq.map categoryDetail |> List.ofSeq
] ]
@ -249,8 +246,8 @@ let feedEdit (model: EditCustomFeedModel) (ratings: MetaItem list) (mediums: Met
|> Seq.append [ { Name = ""; Value = "&ndash; Select Category &ndash;" } ] |> Seq.append [ { Name = ""; Value = "&ndash; Select Category &ndash;" } ]
selectField [ _id "SourceValueCat"; _required selectField [ _id "SourceValueCat"; _required
if model.SourceType = "tag" then _disabled ] if model.SourceType = "tag" then _disabled ]
(nameof model.SourceValue) "Category" model.SourceValue cats (_.Name) (nameof model.SourceValue) "Category" model.SourceValue cats _.Name _.Value
(_.Value) [] []
] ]
div [ _class "col-1 d-flex justify-content-end pb-3" ] [ div [ _class "col-1 d-flex justify-content-end pb-3" ] [
div [ _class "form-check form-check-inline me-0" ] [ div [ _class "form-check form-check-inline me-0" ] [
@ -305,7 +302,7 @@ let feedEdit (model: EditCustomFeedModel) (ratings: MetaItem list) (mediums: Met
] ]
div [ _class "col-12 col-md-3 col-lg-2 pb-3" ] [ div [ _class "col-12 col-md-3 col-lg-2 pb-3" ] [
selectField [ _required ] (nameof model.Explicit) "Explicit Rating" model.Explicit selectField [ _required ] (nameof model.Explicit) "Explicit Rating" model.Explicit
ratings (_.Name) (_.Value) [] ratings _.Name _.Value []
] ]
] ]
div [ _class "row" ] [ div [ _class "row" ] [
@ -380,7 +377,7 @@ let feedEdit (model: EditCustomFeedModel) (ratings: MetaItem list) (mediums: Met
] ]
] ]
div [ _class "col-4 col-lg-3 offset-lg-2 pb-3" ] [ div [ _class "col-4 col-lg-3 offset-lg-2 pb-3" ] [
selectField [] (nameof model.Medium) "Medium" model.Medium mediums (_.Name) (_.Value) [ selectField [] (nameof model.Medium) "Medium" model.Medium mediums _.Name _.Value [
span [ _class "form-text fst-italic" ] [ span [ _class "form-text fst-italic" ] [
raw "Optional; medium of the podcast content (" raw "Optional; medium of the podcast content ("
a [ _href "https://github.com/Podcastindex-org/podcast-namespace/blob/main/docs/1.0.md#medium" a [ _href "https://github.com/Podcastindex-org/podcast-namespace/blob/main/docs/1.0.md#medium"
@ -465,7 +462,7 @@ let redirectList (model: RedirectRule list) app = [
if idx <> model.Length - 1 then if idx <> model.Length - 1 then
actionSpacer; a [ _href $"{ruleUrl}/down"; _hxPost $"{ruleUrl}/down" ] [ raw "Move Down" ] actionSpacer; a [ _href $"{ruleUrl}/down"; _hxPost $"{ruleUrl}/down" ] [ raw "Move Down" ]
actionSpacer actionSpacer
a [ _class "text-danger"; _href ruleUrl; _hxDelete ruleUrl a [ _class "text-danger"; _href ruleUrl; _hxDelete ruleUrl; _hxPushUrl "false"
_hxConfirm "Are you sure you want to delete this redirect rule?" ] [ _hxConfirm "Are you sure you want to delete this redirect rule?" ] [
raw "Delete" raw "Delete"
] ]
@ -502,7 +499,8 @@ let redirectList (model: RedirectRule list) app = [
] ]
div [ _class "row mwl-table-detail"; _id "rule_new" ] [] div [ _class "row mwl-table-detail"; _id "rule_new" ] []
form [ _method "post"; _class "container g-0"; _hxTarget "body" ] [ form [ _method "post"; _class "container g-0"; _hxTarget "body" ] [
antiCsrf app; yield! List.mapi ruleDetail model antiCsrf app
yield! List.mapi ruleDetail model
] ]
] ]
p [ _class "mt-3 text-muted fst-italic text-center" ] [ p [ _class "mt-3 text-muted fst-italic text-center" ] [
@ -556,7 +554,8 @@ let tagMapList (model: TagMap list) app =
_hxSwap $"{HxSwap.InnerHtml} show:#tag_{map.Id}:top" ] [ _hxSwap $"{HxSwap.InnerHtml} show:#tag_{map.Id}:top" ] [
raw "Edit" raw "Edit"
]; actionSpacer ]; actionSpacer
a [ _href url; _hxDelete url; _class "text-danger" a [ _href url; _hxDelete url; _hxTarget "#tagList"; _hxPushUrl "false"; _hxSwap HxSwap.OuterHtml
_class "text-danger"
_hxConfirm $"Are you sure you want to delete the mapping for “{map.Tag}”? This action cannot be undone." ] [ _hxConfirm $"Are you sure you want to delete the mapping for “{map.Tag}”? This action cannot be undone." ] [
raw "Delete" raw "Delete"
] ]
@ -576,11 +575,8 @@ let tagMapList (model: TagMap list) app =
div [ _class "col" ] [ raw "URL Value" ] div [ _class "col" ] [ raw "URL Value" ]
] ]
] ]
form [ _method "post"; _class "container g-0"; _hxTarget "#tagList"; _hxSwap HxSwap.OuterHtml ] [ div [ _class "row mwl-table-detail"; _id "tag_new" ] []
antiCsrf app yield! List.map tagMapDetail model
div [ _class "row mwl-table-detail"; _id "tag_new" ] []
yield! List.map tagMapDetail model
]
] ]
|> List.singleton |> List.singleton
@ -640,8 +636,7 @@ let uploadList (model: DisplayUpload seq) app = [
h2 [ _class "my-3" ] [ raw app.PageTitle ] h2 [ _class "my-3" ] [ raw app.PageTitle ]
article [] [ article [] [
a [ _href (relUrl app "admin/upload/new"); _class "btn btn-primary btn-sm mb-3" ] [ raw "Upload a New File" ] a [ _href (relUrl app "admin/upload/new"); _class "btn btn-primary btn-sm mb-3" ] [ raw "Upload a New File" ]
form [ _method "post"; _class "container"; _hxTarget "body" ] [ div [ _class "container"; _hxTarget "body" ] [
antiCsrf app
div [ _class "row" ] [ div [ _class "row" ] [
div [ _class "col text-center" ] [ div [ _class "col text-center" ] [
em [ _class "text-muted" ] [ raw "Uploaded files served from" ]; br []; raw relativeBase em [ _class "text-muted" ] [ raw "Uploaded files served from" ]; br []; raw relativeBase
@ -729,7 +724,7 @@ let webLogSettings
a [ _href (relUrl app (string feed.Path)); _target "_blank" ] [ raw "View Feed" ] a [ _href (relUrl app (string feed.Path)); _target "_blank" ] [ raw "View Feed" ]
actionSpacer actionSpacer
a [ _href $"{feedUrl}/edit" ] [ raw "Edit" ]; actionSpacer a [ _href $"{feedUrl}/edit" ] [ raw "Edit" ]; actionSpacer
a [ _href feedUrl; _hxDelete feedUrl; _class "text-danger" a [ _href feedUrl; _hxDelete feedUrl; _hxPushUrl "false"; _class "text-danger"
_hxConfirm $"Are you sure you want to delete the custom RSS feed based on {feed.Source}? This action cannot be undone." ] [ _hxConfirm $"Are you sure you want to delete the custom RSS feed based on {feed.Source}? This action cannot be undone." ] [
raw "Delete" raw "Delete"
] ]
@ -779,7 +774,7 @@ let webLogSettings
] ]
div [ _class "col-12 col-md-6 offset-md-1 col-xl-4 offset-xl-0 pb-3" ] [ div [ _class "col-12 col-md-6 offset-md-1 col-xl-4 offset-xl-0 pb-3" ] [
selectField [ _required ] (nameof model.DefaultPage) "Default Page" model.DefaultPage pages selectField [ _required ] (nameof model.DefaultPage) "Default Page" model.DefaultPage pages
(fun p -> string p.Id) (_.Title) [] (fun p -> string p.Id) _.Title []
] ]
div [ _class "col-12 col-md-4 col-xl-2 pb-3" ] [ div [ _class "col-12 col-md-4 col-xl-2 pb-3" ] [
numberField [ _required; _min "0"; _max "50" ] (nameof model.PostsPerPage) "Posts per Page" numberField [ _required; _min "0"; _max "50" ] (nameof model.PostsPerPage) "Posts per Page"
@ -800,6 +795,13 @@ let webLogSettings
selectField [] (nameof model.Uploads) "Default Upload Destination" model.Uploads uploads selectField [] (nameof model.Uploads) "Default Upload Destination" model.Uploads uploads
string string [] string string []
] ]
div [ _class "col-12 col-md-6 offset-md-3 col-xl-4 offset-xl-4" ] [
checkboxSwitch [] (nameof model.AutoOpenGraph) "Auto-Add OpenGraph Properties"
model.AutoOpenGraph []
span [ _class "form-text fst-italic" ] [
raw "Adds title, site name, and permalink to all pages and posts"
]
]
] ]
div [ _class "row pb-3" ] [ div [ _class "row pb-3" ] [
div [ _class "col text-center" ] [ div [ _class "col text-center" ] [

6
src/MyWebLog/appsettings.json

@ -1,5 +1,5 @@
{ {
"Generator": "myWebLog 2.2", "Generator": "myWebLog 3",
"Logging": { "Logging": {
"LogLevel": { "LogLevel": {
"MyWebLog.Handlers": "Information" "MyWebLog.Handlers": "Information"
@ -8,7 +8,7 @@
"Kestrel": { "Kestrel": {
"Endpoints": { "Endpoints": {
"Http": { "Http": {
"Url": "http://0.0.0.0:80" "Url": "http://0.0.0.0:5000"
} }
} }
} }

1
src/MyWebLog/wwwroot/htmx.min.js vendored Normal file

File diff suppressed because one or more lines are too long

2
src/admin-theme/version.txt

@ -1,2 +1,2 @@
myWebLog Admin myWebLog Admin
2.2 3

94
src/admin-theme/wwwroot/admin.js

@ -2,6 +2,12 @@
* Support functions for the administrative UI * Support functions for the administrative UI
*/ */
this.Admin = { this.Admin = {
/**
* The next index for an OpenGraph extra property item
* @type {number}
*/
nextExtraIndex : 0,
/** /**
* The next index for a metadata item * The next index for a metadata item
* @type {number} * @type {number}
@ -14,6 +20,14 @@ this.Admin = {
*/ */
nextPermalink : 0, nextPermalink : 0,
/**
* Set the next OpenGraph extra propery index
* @param {number} idx The index to set
*/
setNextExtraIndex(idx) {
this.nextExtraIndex = idx
},
/** /**
* Set the next meta item index * Set the next meta item index
* @param {number} idx The index to set * @param {number} idx The index to set
@ -32,14 +46,16 @@ this.Admin = {
/** /**
* Create a metadata remove button * Create a metadata remove button
* @param {string} prefix The prefix of the row to be removed
* @returns {HTMLDivElement} The column with the remove button * @returns {HTMLDivElement} The column with the remove button
*/ */
createMetaRemoveColumn() { createMetaRemoveColumn(prefix) {
const removeBtn = document.createElement("button") const removeBtn = document.createElement("button")
removeBtn.type = "button" removeBtn.type = "button"
removeBtn.className = "btn btn-sm btn-danger" removeBtn.className = "btn btn-sm btn-danger"
removeBtn.innerHTML = "&minus;" removeBtn.innerHTML = "&minus;"
removeBtn.setAttribute("onclick", `Admin.removeMetaItem(${this.nextMetaIndex})`) removeBtn.setAttribute("onclick",
`Admin.removeMetaItem('${prefix}', ${prefix === "og_extra" ? this.nextExtraIndex : this.nextMetaIndex})`)
const removeCol = document.createElement("div") const removeCol = document.createElement("div")
removeCol.className = "col-1 text-center align-self-center" removeCol.className = "col-1 text-center align-self-center"
@ -50,14 +66,16 @@ this.Admin = {
/** /**
* Create a metadata name field * Create a metadata name field
* @param {string} prefix The prefix for the element
* @returns {HTMLInputElement} The name input element * @returns {HTMLInputElement} The name input element
*/ */
createMetaNameField() { createMetaNameField(prefix) {
const namePfx = prefix === "og_extra" ? "OpenGraphExtra" : "Meta"
const nameField = document.createElement("input") const nameField = document.createElement("input")
nameField.type = "text" nameField.type = "text"
nameField.name = "MetaNames" nameField.name = `${namePfx}Names`
nameField.id = `metaNames_${this.nextMetaIndex}` nameField.id = `${namePfx}Names_${prefix === "og_extra" ? this.nextExtraIndex : this.nextMetaIndex}`
nameField.className = "form-control" nameField.className = "form-control"
nameField.placeholder = "Name" nameField.placeholder = "Name"
@ -88,14 +106,16 @@ this.Admin = {
/** /**
* Create a metadata value field * Create a metadata value field
* @param {string} prefix The prefix for the field being created
* @returns {HTMLInputElement} The metadata value field * @returns {HTMLInputElement} The metadata value field
*/ */
createMetaValueField() { createMetaValueField(prefix) {
const namePfx = prefix === "og_extra" ? "OpenGraphExtra" : "Meta"
const valueField = document.createElement("input") const valueField = document.createElement("input")
valueField.type = "text" valueField.type = "text"
valueField.name = "MetaValues" valueField.name = `${namePfx}Values`
valueField.id = `metaValues_${this.nextMetaIndex}` valueField.id = `${namePfx}Values_${prefix === "og_extra" ? this.nextExtraIndex : this.nextMetaIndex}`
valueField.className = "form-control" valueField.className = "form-control"
valueField.placeholder = "Value" valueField.placeholder = "Value"
@ -134,32 +154,39 @@ this.Admin = {
/** /**
* Construct and add a metadata item row * Construct and add a metadata item row
* @param {string} prefix The prefix of the row being added
* @param {HTMLDivElement} removeCol The column with the remove button * @param {HTMLDivElement} removeCol The column with the remove button
* @param {HTMLDivElement} nameCol The column with the name field * @param {HTMLDivElement} nameCol The column with the name field
* @param {HTMLDivElement} valueCol The column with the value field * @param {HTMLDivElement} valueCol The column with the value field
*/ */
createMetaRow(removeCol, nameCol, valueCol) { createMetaRow(prefix, removeCol, nameCol, valueCol) {
const newRow = document.createElement("div") const newRow = document.createElement("div")
newRow.className = "row mb-3" newRow.className = "row mb-3"
newRow.id = `meta_${this.nextMetaIndex}` newRow.id = `${prefix}_${prefix === "og_extra" ? this.nextExtraIndex : this.nextMetaIndex}`
newRow.appendChild(removeCol) newRow.appendChild(removeCol)
newRow.appendChild(nameCol) newRow.appendChild(nameCol)
newRow.appendChild(valueCol) newRow.appendChild(valueCol)
document.getElementById("meta_items").appendChild(newRow) document.getElementById(`${prefix}_items`).appendChild(newRow)
this.nextMetaIndex++ if (prefix === "og_extra") {
this.nextExtraIndex++
} else {
this.nextMetaIndex++
}
}, },
/** /**
* Add a new row for metadata entry * Add a new row for metadata entry
* @param {string} prefix The prefix for the field being created
*/ */
addMetaItem() { addMetaItem(prefix) {
const nameField = this.createMetaNameField() const nameField = this.createMetaNameField(prefix)
this.createMetaRow( this.createMetaRow(
this.createMetaRemoveColumn(), prefix,
this.createMetaRemoveColumn(prefix),
this.createMetaNameColumn(nameField), this.createMetaNameColumn(nameField),
this.createMetaValueColumn(this.createMetaValueField(), undefined)) this.createMetaValueColumn(this.createMetaValueField(prefix), undefined))
document.getElementById(nameField.id).focus() document.getElementById(nameField.id).focus()
}, },
@ -227,6 +254,34 @@ this.Admin = {
if (link) link.style.display = src === "none" || src === "external" ? "none" : "" if (link) link.style.display = src === "none" || src === "external" ? "none" : ""
}, },
/**
* Enable or disable OpenGraph fields
*/
toggleOpenGraphFields() {
const disabled = !document.getElementById("AssignOpenGraph").checked
let fieldsets = ["og_item", "og_image", "og_audio", "og_video"]
fieldsets.forEach(it => document.getElementById(it).disabled = disabled)
},
/**
* Disable the file upload or path field if the other is entered
* @param {string} pathElt The path element to check
* @param {string} fileElt The file element to check
*/
pathOrFile(pathElt, fileElt) {
/** @type {HTMLInputElement} */
const path = document.getElementById(pathElt)
/** @type {HTMLInputElement} */
const file = document.getElementById(fileElt)
if (path.value.length > 0) {
file.disabled = true
} else if (file.value.length > 0) {
path.disabled = true
} else {
file.disabled = path.disabled = false
}
},
/** /**
* Enable or disable podcast fields * Enable or disable podcast fields
*/ */
@ -284,10 +339,11 @@ this.Admin = {
/** /**
* Remove a metadata item * Remove a metadata item
* @param {number} idx The index of the metadata item to remove * @param {string} id The ID prefix of the item to remove
* @param {number} idx The index of the item to remove
*/ */
removeMetaItem(idx) { removeMetaItem(id, idx) {
document.getElementById(`meta_${idx}`).remove() document.getElementById(`${id}_${idx}`).remove()
}, },
/** /**