28 Commits

Author SHA1 Message Date
5f3daa1de9 v2 RC2 (#33)
* Add PostgreSQL back end (#30)
* Upgrade password storage (#32)
* Change podcast/episode storage for SQLite (#29)
* Move date/time handling to NodaTime (#31)
2022-08-21 18:56:18 -04:00
1ec664ad24 Fix casing on CLI usage examples 2022-08-01 07:46:53 -04:00
33698bd182 Reassign child cats when deleting parent cat (#27)
- Create common page/post edit field template (#25)
- Fix relative URL adjustment throughout
- Fix upload name sanitization regex
- Create modules within Admin handler module
- Enable/disable podcast episode fields on page load
- Fix upload destination casing in templates
- Tweak default theme to show no posts found on index template
- Update Bootstrap to 5.1.3 in default theme
2022-07-28 20:36:02 -04:00
6b49793fbb Change alerts to toasts (#25)
- Upgrade to Bootstrap 5.1.3
- Move RSS settings and tag mappings to web log settings (#25)
- Fix parameters in 2 SQLite queries
2022-07-27 21:38:46 -04:00
a8386d6c97 Add loading indicator for admin theme (#25) 2022-07-26 22:34:19 -04:00
b1ca48c2c5 Add docs link to admin header (#25)
- Change executable name in release packages
2022-07-26 20:37:18 -04:00
3189681021 Tweak admin UI templates (#25)
- Move user management under web log settings
- Move user self-update to my-info
- Return meaningful error if a template does not exist
- Tweak margins/paddings throughout
- Do not show headings on list pages if lists are empty
- Fix pagination styles for page/post list pages
2022-07-26 16:28:14 -04:00
ff9c08842b First cut at cache management (#23) 2022-07-24 23:55:00 -04:00
e103738d39 Prevent deletion if theme is in use (#20) 2022-07-24 19:26:36 -04:00
d854178255 Upload / delete themes (#20)
- Moved themes to section of installation admin page (will also implement #23 there)
2022-07-24 19:18:20 -04:00
0a32181e65 WIP on theme upload (#20) 2022-07-24 16:32:37 -04:00
81fe03b8f3 WIP on theme admin page (#20) 2022-07-22 21:19:19 -04:00
4514c4864d Load themes at startup (#20)
- Adjust release packaging (#20)
- Fix default theme for beta-5 changes (#24)
- Remove RethinkDB case fix (cleanup from #21)
- Bump versions for next release
2022-07-22 10:33:11 -04:00
99ccdebcc7 Delete user / admin clean-up (#19)
- Add CLI help (#22)
- Add constants for common view items
- Construct hashes with piped functions
2022-07-21 21:42:38 -04:00
59f385122b Add user add/edit (#19)
- Add makeHash function to simplify code around DotLiquid hashes
- Add context extension to determine if a user has an access level
- Add someTask function to simply Task.FromResult (Some x)
2022-07-20 23:13:16 -04:00
41ae1d8dad First cut of user admin page (#19) 2022-07-19 22:51:51 -04:00
1e987fdf72 Eliminate compiler warnings
- Change RethinkDB to use connection-string style settings
2022-07-19 20:59:53 -04:00
7eaad4a076 Clean up database names (#21)
- Moved user edit to "my info" (#19)
2022-07-18 20:05:10 -04:00
5fb3a73dcf Add user created and last seen on (#19)
- Updated view models / interfaces per F# naming guidelines
2022-07-17 23:10:30 -04:00
e0a03bfca9 Add upgrade-user CLI option (#19) 2022-07-17 15:50:33 -04:00
d30312c23f Add access restrictions to UI (#19)
- Vary default user access for new web logs (#19)
- Add htmx detection to not auth/404 handlers
- Bump version
2022-07-16 22:17:57 -04:00
eae1509d81 Add access restrictions to server routes (#19) 2022-07-16 17:32:18 -04:00
425223a3a8 Add access levels (#19)
- Remove authorization level
2022-07-16 15:51:58 -04:00
07aff16c3a Version bump 2022-07-16 13:38:44 -04:00
d290e6e8a6 Complete page / post revision maint (#13)
- Fix log on redirection
- Move page handlers to its own file
- Add version to admin area footer
- Move generator to HttpContext extension property
2022-07-16 12:33:34 -04:00
039d09aed5 WIP on page revisions (#13)
- Simplify redirectToGet usage
- Move a few functions to HttpContext extension properties
- Modify bare response to allow content not from a template
- Fix uploaded date/time handling
2022-07-15 22:51:51 -04:00
d667d09372 WIP on revision mgt template (#13) 2022-07-14 23:25:29 -04:00
2906c20efa Upgrade htmx to v1.8.0 (#18) 2022-07-14 18:55:52 -04:00
86 changed files with 9048 additions and 4757 deletions

View File

@@ -34,9 +34,9 @@ let version =
let zipTheme (name : string) (_ : TargetParameter) = let zipTheme (name : string) (_ : TargetParameter) =
let path = $"src/{name}-theme" let path = $"src/{name}-theme"
!! $"{path}/**/*" !! $"{path}/**/*"
|> Zip.filesAsSpecs path //$"src/{name}-theme" |> Zip.filesAsSpecs path
|> Seq.filter (fun (_, name) -> not (name.EndsWith ".zip")) |> Seq.filter (fun (_, name) -> not (name.EndsWith ".zip"))
|> Zip.zipSpec $"{releasePath}/{name}.zip" |> Zip.zipSpec $"{releasePath}/{name}-theme.zip"
/// Publish the project for the given runtime ID /// Publish the project for the given runtime ID
let publishFor rid (_ : TargetParameter) = let publishFor rid (_ : TargetParameter) =
@@ -45,11 +45,14 @@ let publishFor rid (_ : TargetParameter) =
/// Package published output for the given runtime ID /// Package published output for the given runtime ID
let packageFor (rid : string) (_ : TargetParameter) = let packageFor (rid : string) (_ : TargetParameter) =
let path = $"{projectPath}/bin/Release/net6.0/{rid}/publish" let path = $"{projectPath}/bin/Release/net6.0/{rid}/publish"
let prodSettings = $"{path}/appsettings.Production.json"
if File.exists prodSettings then File.delete prodSettings
[ !! $"{path}/**/*" [ !! $"{path}/**/*"
|> Zip.filesAsSpecs path |> Zip.filesAsSpecs path
|> Zip.moveToFolder "app" |> Seq.map (fun (orig, dest) ->
Seq.singleton ($"{releasePath}/admin.zip", "admin.zip") orig, if dest.StartsWith "MyWebLog" then dest.Replace ("MyWebLog", "myWebLog") else dest)
Seq.singleton ($"{releasePath}/default.zip", "default.zip") Seq.singleton ($"{releasePath}/admin-theme.zip", "admin-theme.zip")
Seq.singleton ($"{releasePath}/default-theme.zip", "default-theme.zip")
] ]
|> Seq.concat |> Seq.concat
|> Zip.zipSpec $"{releasePath}/myWebLog-{version}.{rid}.zip" |> Zip.zipSpec $"{releasePath}/myWebLog-{version}.{rid}.zip"
@@ -86,7 +89,7 @@ Target.create "RepackageLinux" (fun _ ->
Shell.mkdir workDir Shell.mkdir workDir
Zip.unzip workDir zipArchive Zip.unzip workDir zipArchive
Shell.cd workDir Shell.cd workDir
sh "chmod" [ "+x"; "app/MyWebLog" ] sh "chmod" [ "+x"; "./myWebLog" ]
sh "tar" [ "cfj"; $"../myWebLog-{version}.linux-x64.tar.bz2"; "." ] sh "tar" [ "cfj"; $"../myWebLog-{version}.linux-x64.tar.bz2"; "." ]
Shell.cd "../.." Shell.cd "../.."
Shell.rm zipArchive Shell.rm zipArchive
@@ -96,8 +99,8 @@ Target.create "RepackageLinux" (fun _ ->
Target.create "All" ignore Target.create "All" ignore
Target.create "RemoveThemeArchives" (fun _ -> Target.create "RemoveThemeArchives" (fun _ ->
Shell.rm $"{releasePath}/admin.zip" Shell.rm $"{releasePath}/admin-theme.zip"
Shell.rm $"{releasePath}/default.zip" Shell.rm $"{releasePath}/default-theme.zip"
) )
Target.create "CI" ignore Target.create "CI" ignore

10
src/Directory.Build.props Normal file
View File

@@ -0,0 +1,10 @@
<Project>
<PropertyGroup>
<TargetFramework>net6.0</TargetFramework>
<DebugType>embedded</DebugType>
<AssemblyVersion>2.0.0.0</AssemblyVersion>
<FileVersion>2.0.0.0</FileVersion>
<Version>2.0.0</Version>
<VersionSuffix>rc2</VersionSuffix>
</PropertyGroup>
</Project>

View File

@@ -100,13 +100,6 @@ 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
type UploadDestinationConverter () =
inherit JsonConverter<UploadDestination> ()
override _.WriteJson (writer : JsonWriter, value : UploadDestination, _ : JsonSerializer) =
writer.WriteValue (UploadDestination.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadDestination, _ : bool, _ : JsonSerializer) =
(string >> UploadDestination.parse) reader.Value
type UploadIdConverter () = type UploadIdConverter () =
inherit JsonConverter<UploadId> () inherit JsonConverter<UploadId> ()
override _.WriteJson (writer : JsonWriter, value : UploadId, _ : JsonSerializer) = override _.WriteJson (writer : JsonWriter, value : UploadId, _ : JsonSerializer) =
@@ -129,28 +122,57 @@ module Json =
(string >> WebLogUserId) reader.Value (string >> WebLogUserId) reader.Value
open Microsoft.FSharpLu.Json open Microsoft.FSharpLu.Json
open NodaTime
open NodaTime.Serialization.JsonNet
/// All converters to use for data conversion /// Configure a serializer to use these converters
let all () : JsonConverter seq = let configure (ser : JsonSerializer) =
seq { // Our converters
// Our converters [ CategoryIdConverter () :> JsonConverter
CategoryIdConverter () CommentIdConverter ()
CommentIdConverter () CustomFeedIdConverter ()
CustomFeedIdConverter () CustomFeedSourceConverter ()
CustomFeedSourceConverter () ExplicitRatingConverter ()
ExplicitRatingConverter () MarkupTextConverter ()
MarkupTextConverter () PermalinkConverter ()
PermalinkConverter () PageIdConverter ()
PageIdConverter () PodcastMediumConverter ()
PodcastMediumConverter () PostIdConverter ()
PostIdConverter () TagMapIdConverter ()
TagMapIdConverter () ThemeAssetIdConverter ()
ThemeAssetIdConverter () ThemeIdConverter ()
ThemeIdConverter () UploadIdConverter ()
UploadDestinationConverter () WebLogIdConverter ()
UploadIdConverter () WebLogUserIdConverter ()
WebLogIdConverter () ] |> List.iter ser.Converters.Add
WebLogUserIdConverter () // NodaTime
// Handles DUs with no associated data, as well as option fields let _ = ser.ConfigureForNodaTime DateTimeZoneProviders.Tzdb
CompactUnionJsonConverter () // Handles DUs with no associated data, as well as option fields
} ser.Converters.Add (CompactUnionJsonConverter ())
ser.NullValueHandling <- NullValueHandling.Ignore
ser.MissingMemberHandling <- MissingMemberHandling.Ignore
ser
/// Serializer settings extracted from a JsonSerializer (a property sure would be nice...)
let mutable private serializerSettings : JsonSerializerSettings option = None
/// Extract settings from the serializer to be used in JsonConvert calls
let settings (ser : JsonSerializer) =
if Option.isNone serializerSettings then
serializerSettings <- JsonSerializerSettings (
ConstructorHandling = ser.ConstructorHandling,
ContractResolver = ser.ContractResolver,
Converters = ser.Converters,
DefaultValueHandling = ser.DefaultValueHandling,
DateFormatHandling = ser.DateFormatHandling,
MetadataPropertyHandling = ser.MetadataPropertyHandling,
MissingMemberHandling = ser.MissingMemberHandling,
NullValueHandling = ser.NullValueHandling,
ObjectCreationHandling = ser.ObjectCreationHandling,
ReferenceLoopHandling = ser.ReferenceLoopHandling,
SerializationBinder = ser.SerializationBinder,
TraceWriter = ser.TraceWriter,
TypeNameAssemblyFormatHandling = ser.TypeNameAssemblyFormatHandling,
TypeNameHandling = ser.TypeNameHandling)
|> Some
serializerSettings.Value

View File

@@ -1,274 +1,300 @@
namespace MyWebLog.Data namespace MyWebLog.Data
open System
open System.Threading.Tasks open System.Threading.Tasks
open MyWebLog open MyWebLog
open MyWebLog.ViewModels open MyWebLog.ViewModels
open Newtonsoft.Json
open NodaTime
/// The result of a category deletion attempt
type CategoryDeleteResult =
/// The category was deleted successfully
| CategoryDeleted
/// The category was deleted successfully, and its children were reassigned to its parent
| ReassignedChildCategories
/// The category was not found, so no effort was made to delete it
| CategoryNotFound
/// Data functions to support manipulating categories /// Data functions to support manipulating categories
type ICategoryData = type ICategoryData =
/// Add a category /// Add a category
abstract member add : Category -> Task<unit> abstract member Add : Category -> Task<unit>
/// Count all categories for the given web log /// Count all categories for the given web log
abstract member countAll : WebLogId -> Task<int> abstract member CountAll : WebLogId -> Task<int>
/// Count all top-level categories for the given web log /// Count all top-level categories for the given web log
abstract member countTopLevel : WebLogId -> Task<int> abstract member CountTopLevel : WebLogId -> Task<int>
/// Delete a category (also removes it from posts) /// Delete a category (also removes it from posts)
abstract member delete : CategoryId -> WebLogId -> Task<bool> abstract member Delete : CategoryId -> WebLogId -> Task<CategoryDeleteResult>
/// Find all categories for a web log, sorted alphabetically and grouped by hierarchy /// Find all categories for a web log, sorted alphabetically and grouped by hierarchy
abstract member findAllForView : WebLogId -> Task<DisplayCategory[]> abstract member FindAllForView : WebLogId -> Task<DisplayCategory[]>
/// Find a category by its ID /// Find a category by its ID
abstract member findById : CategoryId -> WebLogId -> Task<Category option> abstract member FindById : CategoryId -> WebLogId -> Task<Category option>
/// Find all categories for the given web log /// Find all categories for the given web log
abstract member findByWebLog : WebLogId -> Task<Category list> abstract member FindByWebLog : WebLogId -> Task<Category list>
/// Restore categories from a backup /// Restore categories from a backup
abstract member restore : Category list -> Task<unit> abstract member Restore : Category list -> Task<unit>
/// Update a category (slug, name, description, and parent ID) /// Update a category (slug, name, description, and parent ID)
abstract member update : Category -> Task<unit> abstract member Update : Category -> Task<unit>
/// Data functions to support manipulating pages /// Data functions to support manipulating pages
type IPageData = type IPageData =
/// Add a page /// Add a page
abstract member add : Page -> Task<unit> abstract member Add : Page -> Task<unit>
/// Get all pages for the web log (excluding meta items, text, revisions, and prior permalinks) /// Get all pages for the web log (excluding meta items, text, revisions, and prior permalinks)
abstract member all : WebLogId -> Task<Page list> abstract member All : WebLogId -> Task<Page list>
/// Count all pages for the given web log /// Count all pages for the given web log
abstract member countAll : WebLogId -> Task<int> abstract member CountAll : WebLogId -> Task<int>
/// Count pages marked as "show in page list" for the given web log /// Count pages marked as "show in page list" for the given web log
abstract member countListed : WebLogId -> Task<int> abstract member CountListed : WebLogId -> Task<int>
/// Delete a page /// Delete a page
abstract member delete : PageId -> WebLogId -> Task<bool> abstract member Delete : PageId -> WebLogId -> Task<bool>
/// Find a page by its ID (excluding revisions and prior permalinks) /// Find a page by its ID (excluding revisions and prior permalinks)
abstract member findById : PageId -> WebLogId -> Task<Page option> abstract member FindById : PageId -> WebLogId -> Task<Page option>
/// Find a page by its permalink (excluding revisions and prior permalinks) /// Find a page by its permalink (excluding revisions and prior permalinks)
abstract member findByPermalink : Permalink -> WebLogId -> Task<Page option> abstract member FindByPermalink : Permalink -> WebLogId -> Task<Page option>
/// Find the current permalink for a page from a list of prior permalinks /// Find the current permalink for a page from a list of prior permalinks
abstract member findCurrentPermalink : Permalink list -> WebLogId -> Task<Permalink option> abstract member FindCurrentPermalink : Permalink list -> WebLogId -> Task<Permalink option>
/// Find a page by its ID (including revisions and prior permalinks) /// Find a page by its ID (including revisions and prior permalinks)
abstract member findFullById : PageId -> WebLogId -> Task<Page option> abstract member FindFullById : PageId -> WebLogId -> Task<Page option>
/// Find all pages for the given web log (including revisions and prior permalinks) /// Find all pages for the given web log (including revisions and prior permalinks)
abstract member findFullByWebLog : WebLogId -> Task<Page list> abstract member FindFullByWebLog : WebLogId -> Task<Page list>
/// Find pages marked as "show in page list" for the given web log (excluding text, revisions, and prior permalinks) /// Find pages marked as "show in page list" for the given web log (excluding text, revisions, and prior permalinks)
abstract member findListed : WebLogId -> Task<Page list> abstract member FindListed : WebLogId -> Task<Page list>
/// Find a page of pages (displayed in admin section) (excluding meta items, revisions and prior permalinks) /// Find a page of pages (displayed in admin section) (excluding meta items, revisions and prior permalinks)
abstract member findPageOfPages : WebLogId -> pageNbr : int -> Task<Page list> abstract member FindPageOfPages : WebLogId -> pageNbr : int -> Task<Page list>
/// Restore pages from a backup /// Restore pages from a backup
abstract member restore : Page list -> Task<unit> abstract member Restore : Page list -> Task<unit>
/// Update a page /// Update a page
abstract member update : Page -> Task<unit> abstract member Update : Page -> Task<unit>
/// Update the prior permalinks for the given page /// Update the prior permalinks for the given page
abstract member updatePriorPermalinks : PageId -> WebLogId -> Permalink list -> Task<bool> abstract member UpdatePriorPermalinks : PageId -> WebLogId -> Permalink list -> Task<bool>
/// Data functions to support manipulating posts /// Data functions to support manipulating posts
type IPostData = type IPostData =
/// Add a post /// Add a post
abstract member add : Post -> Task<unit> abstract member Add : Post -> Task<unit>
/// Count posts by their status /// Count posts by their status
abstract member countByStatus : PostStatus -> WebLogId -> Task<int> abstract member CountByStatus : PostStatus -> WebLogId -> Task<int>
/// Delete a post /// Delete a post
abstract member delete : PostId -> WebLogId -> Task<bool> abstract member Delete : PostId -> WebLogId -> Task<bool>
/// Find a post by its ID (excluding revisions and prior permalinks)
abstract member FindById : PostId -> WebLogId -> Task<Post option>
/// Find a post by its permalink (excluding revisions and prior permalinks) /// Find a post by its permalink (excluding revisions and prior permalinks)
abstract member findByPermalink : Permalink -> WebLogId -> Task<Post option> abstract member FindByPermalink : Permalink -> WebLogId -> Task<Post option>
/// Find the current permalink for a post from a list of prior permalinks /// Find the current permalink for a post from a list of prior permalinks
abstract member findCurrentPermalink : Permalink list -> WebLogId -> Task<Permalink option> abstract member FindCurrentPermalink : Permalink list -> WebLogId -> Task<Permalink option>
/// Find a post by its ID (including revisions and prior permalinks) /// Find a post by its ID (including revisions and prior permalinks)
abstract member findFullById : PostId -> WebLogId -> Task<Post option> abstract member FindFullById : PostId -> WebLogId -> Task<Post option>
/// Find all posts for the given web log (including revisions and prior permalinks) /// Find all posts for the given web log (including revisions and prior permalinks)
abstract member findFullByWebLog : WebLogId -> Task<Post list> abstract member FindFullByWebLog : WebLogId -> Task<Post list>
/// Find posts to be displayed on a category list page (excluding revisions and prior permalinks) /// Find posts to be displayed on a category list page (excluding revisions and prior permalinks)
abstract member findPageOfCategorizedPosts : abstract member FindPageOfCategorizedPosts :
WebLogId -> CategoryId list -> pageNbr : int -> postsPerPage : int -> Task<Post list> WebLogId -> CategoryId list -> pageNbr : int -> postsPerPage : int -> Task<Post list>
/// Find posts to be displayed on an admin page (excluding revisions and prior permalinks) /// Find posts to be displayed on an admin page (excluding revisions and prior permalinks)
abstract member findPageOfPosts : WebLogId -> pageNbr : int -> postsPerPage : int -> Task<Post list> abstract member FindPageOfPosts : WebLogId -> pageNbr : int -> postsPerPage : int -> Task<Post list>
/// Find posts to be displayed on a page (excluding revisions and prior permalinks) /// Find posts to be displayed on a page (excluding revisions and prior permalinks)
abstract member findPageOfPublishedPosts : WebLogId -> pageNbr : int -> postsPerPage : int -> Task<Post list> abstract member FindPageOfPublishedPosts : WebLogId -> pageNbr : int -> postsPerPage : int -> Task<Post list>
/// Find posts to be displayed on a tag list page (excluding revisions and prior permalinks) /// Find posts to be displayed on a tag list page (excluding revisions and prior permalinks)
abstract member findPageOfTaggedPosts : abstract member FindPageOfTaggedPosts :
WebLogId -> tag : string -> pageNbr : int -> postsPerPage : int -> Task<Post list> WebLogId -> tag : string -> pageNbr : int -> postsPerPage : int -> Task<Post list>
/// Find the next older and newer post for the given published date/time (excluding revisions and prior permalinks) /// Find the next older and newer post for the given published date/time (excluding revisions and prior permalinks)
abstract member findSurroundingPosts : WebLogId -> publishedOn : DateTime -> Task<Post option * Post option> abstract member FindSurroundingPosts : WebLogId -> publishedOn : Instant -> Task<Post option * Post option>
/// Restore posts from a backup /// Restore posts from a backup
abstract member restore : Post list -> Task<unit> abstract member Restore : Post list -> Task<unit>
/// Update a post /// Update a post
abstract member update : Post -> Task<unit> abstract member Update : Post -> Task<unit>
/// Update the prior permalinks for a post /// Update the prior permalinks for a post
abstract member updatePriorPermalinks : PostId -> WebLogId -> Permalink list -> Task<bool> abstract member UpdatePriorPermalinks : PostId -> WebLogId -> Permalink list -> Task<bool>
/// Functions to manipulate tag mappings /// Functions to manipulate tag mappings
type ITagMapData = type ITagMapData =
/// Delete a tag mapping /// Delete a tag mapping
abstract member delete : TagMapId -> WebLogId -> Task<bool> abstract member Delete : TagMapId -> WebLogId -> Task<bool>
/// Find a tag mapping by its ID /// Find a tag mapping by its ID
abstract member findById : TagMapId -> WebLogId -> Task<TagMap option> abstract member FindById : TagMapId -> WebLogId -> Task<TagMap option>
/// Find a tag mapping by its URL value /// Find a tag mapping by its URL value
abstract member findByUrlValue : string -> WebLogId -> Task<TagMap option> abstract member FindByUrlValue : string -> WebLogId -> Task<TagMap option>
/// Retrieve all tag mappings for the given web log /// Retrieve all tag mappings for the given web log
abstract member findByWebLog : WebLogId -> Task<TagMap list> abstract member FindByWebLog : WebLogId -> Task<TagMap list>
/// Find tag mappings for the given tags /// Find tag mappings for the given tags
abstract member findMappingForTags : tags : string list -> WebLogId -> Task<TagMap list> abstract member FindMappingForTags : tags : string list -> WebLogId -> Task<TagMap list>
/// Restore tag mappings from a backup /// Restore tag mappings from a backup
abstract member restore : TagMap list -> Task<unit> abstract member Restore : TagMap list -> Task<unit>
/// Save a tag mapping (insert or update) /// Save a tag mapping (insert or update)
abstract member save : TagMap -> Task<unit> abstract member Save : TagMap -> Task<unit>
/// Functions to manipulate themes /// Functions to manipulate themes
type IThemeData = type IThemeData =
/// Retrieve all themes (except "admin") /// Retrieve all themes (except "admin") (excluding the text of templates)
abstract member all : unit -> Task<Theme list> abstract member All : unit -> Task<Theme list>
/// Delete a theme
abstract member Delete : ThemeId -> Task<bool>
/// Determine if a theme exists
abstract member Exists : ThemeId -> Task<bool>
/// Find a theme by its ID /// Find a theme by its ID
abstract member findById : ThemeId -> Task<Theme option> abstract member FindById : ThemeId -> Task<Theme option>
/// Find a theme by its ID (excluding the text of its templates) /// Find a theme by its ID (excluding the text of its templates)
abstract member findByIdWithoutText : ThemeId -> Task<Theme option> abstract member FindByIdWithoutText : ThemeId -> Task<Theme option>
/// Save a theme (insert or update) /// Save a theme (insert or update)
abstract member save : Theme -> Task<unit> abstract member Save : Theme -> Task<unit>
/// Functions to manipulate theme assets /// Functions to manipulate theme assets
type IThemeAssetData = type IThemeAssetData =
/// Retrieve all theme assets (excluding data) /// Retrieve all theme assets (excluding data)
abstract member all : unit -> Task<ThemeAsset list> abstract member All : unit -> Task<ThemeAsset list>
/// Delete all theme assets for the given theme /// Delete all theme assets for the given theme
abstract member deleteByTheme : ThemeId -> Task<unit> abstract member DeleteByTheme : ThemeId -> Task<unit>
/// Find a theme asset by its ID /// Find a theme asset by its ID
abstract member findById : ThemeAssetId -> Task<ThemeAsset option> abstract member FindById : ThemeAssetId -> Task<ThemeAsset option>
/// Find all assets for the given theme (excludes data) /// Find all assets for the given theme (excludes data)
abstract member findByTheme : ThemeId -> Task<ThemeAsset list> abstract member FindByTheme : ThemeId -> Task<ThemeAsset list>
/// Find all assets for the given theme (includes data) /// Find all assets for the given theme (includes data)
abstract member findByThemeWithData : ThemeId -> Task<ThemeAsset list> abstract member FindByThemeWithData : ThemeId -> Task<ThemeAsset list>
/// Save a theme asset (insert or update) /// Save a theme asset (insert or update)
abstract member save : ThemeAsset -> Task<unit> abstract member Save : ThemeAsset -> Task<unit>
/// Functions to manipulate uploaded files /// Functions to manipulate uploaded files
type IUploadData = type IUploadData =
/// Add an uploaded file /// Add an uploaded file
abstract member add : Upload -> Task<unit> abstract member Add : Upload -> Task<unit>
/// Delete an uploaded file /// Delete an uploaded file
abstract member delete : UploadId -> WebLogId -> Task<Result<string, string>> abstract member Delete : UploadId -> WebLogId -> Task<Result<string, string>>
/// Find an uploaded file by its path for the given web log /// Find an uploaded file by its path for the given web log
abstract member findByPath : string -> WebLogId -> Task<Upload option> abstract member FindByPath : string -> WebLogId -> Task<Upload option>
/// Find all uploaded files for a web log (excludes data) /// Find all uploaded files for a web log (excludes data)
abstract member findByWebLog : WebLogId -> Task<Upload list> abstract member FindByWebLog : WebLogId -> Task<Upload list>
/// Find all uploaded files for a web log /// Find all uploaded files for a web log
abstract member findByWebLogWithData : WebLogId -> Task<Upload list> abstract member FindByWebLogWithData : WebLogId -> Task<Upload list>
/// Restore uploaded files from a backup /// Restore uploaded files from a backup
abstract member restore : Upload list -> Task<unit> abstract member Restore : Upload list -> Task<unit>
/// Functions to manipulate web logs /// Functions to manipulate web logs
type IWebLogData = type IWebLogData =
/// Add a web log /// Add a web log
abstract member add : WebLog -> Task<unit> abstract member Add : WebLog -> Task<unit>
/// Retrieve all web logs /// Retrieve all web logs
abstract member all : unit -> Task<WebLog list> abstract member All : unit -> Task<WebLog list>
/// Delete a web log, including categories, tag mappings, posts/comments, and pages /// Delete a web log, including categories, tag mappings, posts/comments, and pages
abstract member delete : WebLogId -> Task<unit> abstract member Delete : WebLogId -> Task<unit>
/// Find a web log by its host (URL base) /// Find a web log by its host (URL base)
abstract member findByHost : string -> Task<WebLog option> abstract member FindByHost : string -> Task<WebLog option>
/// Find a web log by its ID /// Find a web log by its ID
abstract member findById : WebLogId -> Task<WebLog option> abstract member FindById : WebLogId -> Task<WebLog option>
/// Update RSS options for a web log /// Update RSS options for a web log
abstract member updateRssOptions : WebLog -> Task<unit> abstract member UpdateRssOptions : WebLog -> Task<unit>
/// Update web log settings (from the settings page) /// Update web log settings (from the settings page)
abstract member updateSettings : WebLog -> Task<unit> abstract member UpdateSettings : WebLog -> Task<unit>
/// Functions to manipulate web log users /// Functions to manipulate web log users
type IWebLogUserData = type IWebLogUserData =
/// Add a web log user /// Add a web log user
abstract member add : WebLogUser -> Task<unit> abstract member Add : WebLogUser -> Task<unit>
/// Delete a web log user
abstract member Delete : WebLogUserId -> WebLogId -> Task<Result<bool, string>>
/// Find a web log user by their e-mail address /// Find a web log user by their e-mail address
abstract member findByEmail : email : string -> WebLogId -> Task<WebLogUser option> abstract member FindByEmail : email : string -> WebLogId -> Task<WebLogUser option>
/// Find a web log user by their ID /// Find a web log user by their ID
abstract member findById : WebLogUserId -> WebLogId -> Task<WebLogUser option> abstract member FindById : WebLogUserId -> WebLogId -> Task<WebLogUser option>
/// Find all web log users for the given web log /// Find all web log users for the given web log
abstract member findByWebLog : WebLogId -> Task<WebLogUser list> abstract member FindByWebLog : WebLogId -> Task<WebLogUser list>
/// Get a user ID -> name dictionary for the given user IDs /// Get a user ID -> name dictionary for the given user IDs
abstract member findNames : WebLogId -> WebLogUserId list -> Task<MetaItem list> abstract member FindNames : WebLogId -> WebLogUserId list -> Task<MetaItem list>
/// Restore users from a backup /// Restore users from a backup
abstract member restore : WebLogUser list -> Task<unit> abstract member Restore : WebLogUser list -> Task<unit>
/// Set a user's last seen date/time to now
abstract member SetLastSeen : WebLogUserId -> WebLogId -> Task<unit>
/// Update a web log user /// Update a web log user
abstract member update : WebLogUser -> Task<unit> abstract member Update : WebLogUser -> Task<unit>
/// Data interface required for a myWebLog data implementation /// Data interface required for a myWebLog data implementation
@@ -301,6 +327,9 @@ type IData =
/// Web log user data functions /// Web log user data functions
abstract member WebLogUser : IWebLogUserData abstract member WebLogUser : IWebLogUserData
/// Do any required start up data checks /// A JSON serializer for use in persistence
abstract member startUp : unit -> Task<unit> abstract member Serializer : JsonSerializer
/// Do any required start up data checks
abstract member StartUp : unit -> Task<unit>

View File

@@ -1,22 +1,22 @@
<Project Sdk="Microsoft.NET.Sdk"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net6.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<DebugType>embedded</DebugType>
</PropertyGroup>
<ItemGroup> <ItemGroup>
<ProjectReference Include="..\MyWebLog.Domain\MyWebLog.Domain.fsproj" /> <ProjectReference Include="..\MyWebLog.Domain\MyWebLog.Domain.fsproj" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.6" /> <PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.8" />
<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="6.0.0" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" /> <PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" />
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" /> <PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" /> <PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
<PackageReference Include="NodaTime" Version="3.1.2" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" />
<PackageReference Include="Npgsql" Version="6.0.6" />
<PackageReference Include="Npgsql.FSharp" Version="5.3.0" />
<PackageReference Include="Npgsql.NodaTime" Version="6.0.6" />
<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-05" /> <PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
<PackageReference Update="FSharp.Core" Version="6.0.5" /> <PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup> </ItemGroup>
@@ -35,6 +35,17 @@
<Compile Include="SQLite\SQLiteWebLogData.fs" /> <Compile Include="SQLite\SQLiteWebLogData.fs" />
<Compile Include="SQLite\SQLiteWebLogUserData.fs" /> <Compile Include="SQLite\SQLiteWebLogUserData.fs" />
<Compile Include="SQLiteData.fs" /> <Compile Include="SQLiteData.fs" />
<Compile Include="Postgres\PostgresHelpers.fs" />
<Compile Include="Postgres\PostgresCache.fs" />
<Compile Include="Postgres\PostgresCategoryData.fs" />
<Compile Include="Postgres\PostgresPageData.fs" />
<Compile Include="Postgres\PostgresPostData.fs" />
<Compile Include="Postgres\PostgresTagMapData.fs" />
<Compile Include="Postgres\PostgresThemeData.fs" />
<Compile Include="Postgres\PostgresUploadData.fs" />
<Compile Include="Postgres\PostgresWebLogData.fs" />
<Compile Include="Postgres\PostgresWebLogUserData.fs" />
<Compile Include="PostgresData.fs" />
</ItemGroup> </ItemGroup>
</Project> </Project>

View File

@@ -0,0 +1,210 @@
namespace MyWebLog.Data.Postgres
open System.Threading
open System.Threading.Tasks
open Microsoft.Extensions.Caching.Distributed
open NodaTime
open Npgsql.FSharp
/// Helper types and functions for the cache
[<AutoOpen>]
module private Helpers =
/// The cache entry
type Entry =
{ /// The ID of the cache entry
Id : string
/// The value to be cached
Payload : byte[]
/// When this entry will expire
ExpireAt : Instant
/// The duration by which the expiration should be pushed out when being refreshed
SlidingExpiration : Duration option
/// The must-expire-by date/time for the cache entry
AbsoluteExpiration : Instant option
}
/// Run a task synchronously
let sync<'T> (it : Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously)
/// Get the current instant
let getNow () = SystemClock.Instance.GetCurrentInstant ()
/// Create a parameter for the expire-at time
let expireParam =
typedParam "expireAt"
/// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog
type DistributedCache (connStr : string) =
// ~~~ INITIALIZATION ~~~
do
task {
let! exists =
Sql.connect connStr
|> Sql.query $"
SELECT EXISTS
(SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session')
AS {existsName}"
|> Sql.executeRowAsync Map.toExists
if not exists then
let! _ =
Sql.connect connStr
|> Sql.query
"CREATE TABLE session (
id TEXT NOT NULL PRIMARY KEY,
payload BYTEA NOT NULL,
expire_at TIMESTAMPTZ NOT NULL,
sliding_expiration INTERVAL,
absolute_expiration TIMESTAMPTZ);
CREATE INDEX idx_session_expiration ON session (expire_at)"
|> Sql.executeNonQueryAsync
()
} |> sync
// ~~~ SUPPORT FUNCTIONS ~~~
/// Get an entry, updating it for sliding expiration
let getEntry key = backgroundTask {
let idParam = "@id", Sql.string key
let! tryEntry =
Sql.connect connStr
|> Sql.query "SELECT * FROM session WHERE id = @id"
|> Sql.parameters [ idParam ]
|> Sql.executeAsync (fun row ->
{ Id = row.string "id"
Payload = row.bytea "payload"
ExpireAt = row.fieldValue<Instant> "expire_at"
SlidingExpiration = row.fieldValueOrNone<Duration> "sliding_expiration"
AbsoluteExpiration = row.fieldValueOrNone<Instant> "absolute_expiration" })
|> tryHead
match tryEntry with
| Some entry ->
let now = getNow ()
let slideExp = defaultArg entry.SlidingExpiration Duration.MinValue
let absExp = defaultArg entry.AbsoluteExpiration Instant.MinValue
let needsRefresh, item =
if entry.ExpireAt = absExp then false, entry
elif slideExp = Duration.MinValue && absExp = Instant.MinValue then false, entry
elif absExp > Instant.MinValue && entry.ExpireAt.Plus slideExp > absExp then
true, { entry with ExpireAt = absExp }
else true, { entry with ExpireAt = now.Plus slideExp }
if needsRefresh then
let! _ =
Sql.connect connStr
|> Sql.query "UPDATE session SET expire_at = @expireAt WHERE id = @id"
|> Sql.parameters [ expireParam item.ExpireAt; idParam ]
|> Sql.executeNonQueryAsync
()
return if item.ExpireAt > now then Some entry else None
| None -> return None
}
/// The last time expired entries were purged (runs every 30 minutes)
let mutable lastPurge = Instant.MinValue
/// Purge expired entries every 30 minutes
let purge () = backgroundTask {
let now = getNow ()
if lastPurge.Plus (Duration.FromMinutes 30L) < now then
let! _ =
Sql.connect connStr
|> Sql.query "DELETE FROM session WHERE expire_at < @expireAt"
|> Sql.parameters [ expireParam now ]
|> Sql.executeNonQueryAsync
lastPurge <- now
}
/// Remove a cache entry
let removeEntry key = backgroundTask {
let! _ =
Sql.connect connStr
|> Sql.query "DELETE FROM session WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string key ]
|> Sql.executeNonQueryAsync
()
}
/// Save an entry
let saveEntry (opts : DistributedCacheEntryOptions) key payload = backgroundTask {
let now = getNow ()
let expireAt, slideExp, absExp =
if opts.SlidingExpiration.HasValue then
let slide = Duration.FromTimeSpan opts.SlidingExpiration.Value
now.Plus slide, Some slide, None
elif opts.AbsoluteExpiration.HasValue then
let exp = Instant.FromDateTimeOffset opts.AbsoluteExpiration.Value
exp, None, Some exp
elif opts.AbsoluteExpirationRelativeToNow.HasValue then
let exp = now.Plus (Duration.FromTimeSpan opts.AbsoluteExpirationRelativeToNow.Value)
exp, None, Some exp
else
// Default to 1 hour sliding expiration
let slide = Duration.FromHours 1
now.Plus slide, Some slide, None
let! _ =
Sql.connect connStr
|> Sql.query
"INSERT INTO session (
id, payload, expire_at, sliding_expiration, absolute_expiration
) VALUES (
@id, @payload, @expireAt, @slideExp, @absExp
) ON CONFLICT (id) DO UPDATE
SET payload = EXCLUDED.payload,
expire_at = EXCLUDED.expire_at,
sliding_expiration = EXCLUDED.sliding_expiration,
absolute_expiration = EXCLUDED.absolute_expiration"
|> Sql.parameters
[ "@id", Sql.string key
"@payload", Sql.bytea payload
expireParam expireAt
optParam "slideExp" slideExp
optParam "absExp" absExp ]
|> Sql.executeNonQueryAsync
()
}
// ~~~ IMPLEMENTATION FUNCTIONS ~~~
/// Retrieve the data for a cache entry
let get key (_ : CancellationToken) = backgroundTask {
match! getEntry key with
| Some entry ->
do! purge ()
return entry.Payload
| None -> return null
}
/// Refresh an entry
let refresh key (cancelToken : CancellationToken) = backgroundTask {
let! _ = get key cancelToken
()
}
/// Remove an entry
let remove key (_ : CancellationToken) = backgroundTask {
do! removeEntry key
do! purge ()
}
/// Set an entry
let set key value options (_ : CancellationToken) = backgroundTask {
do! saveEntry options key value
do! purge ()
}
interface IDistributedCache with
member this.Get key = get key CancellationToken.None |> sync
member this.GetAsync (key, token) = get key token
member this.Refresh key = refresh key CancellationToken.None |> sync
member this.RefreshAsync (key, token) = refresh key token
member this.Remove key = remove key CancellationToken.None |> sync
member this.RemoveAsync (key, token) = remove key token
member this.Set (key, value, options) = set key value options CancellationToken.None |> sync
member this.SetAsync (key, value, options, token) = set key value options token

View File

@@ -0,0 +1,172 @@
namespace MyWebLog.Data.Postgres
open MyWebLog
open MyWebLog.Data
open Npgsql
open Npgsql.FSharp
/// PostgreSQL myWebLog category data implementation
type PostgresCategoryData (conn : NpgsqlConnection) =
/// Count all categories for the given web log
let countAll webLogId =
Sql.existingConnection conn
|> Sql.query $"SELECT COUNT(id) AS {countName} FROM category WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toCount
/// Count all top-level categories for the given web log
let countTopLevel webLogId =
Sql.existingConnection conn
|> Sql.query $"SELECT COUNT(id) AS {countName} FROM category WHERE web_log_id = @webLogId AND parent_id IS NULL"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toCount
/// Retrieve all categories for the given web log in a DotLiquid-friendly format
let findAllForView webLogId = backgroundTask {
let! cats =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM category WHERE web_log_id = @webLogId ORDER BY LOWER(name)"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toCategory
let ordered = Utils.orderByHierarchy cats None None []
let counts =
ordered
|> Seq.map (fun it ->
// Parent category post counts include posts in subcategories
let catIdSql, catIdParams =
ordered
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|> Seq.map (fun cat -> cat.Id)
|> Seq.append (Seq.singleton it.Id)
|> List.ofSeq
|> inClause "AND pc.category_id" "id" id
let postCount =
Sql.existingConnection conn
|> Sql.query $"
SELECT COUNT(DISTINCT p.id) AS {countName}
FROM post p
INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = 'Published'
{catIdSql}"
|> Sql.parameters (webLogIdParam webLogId :: catIdParams)
|> Sql.executeRowAsync Map.toCount
|> Async.AwaitTask
|> Async.RunSynchronously
it.Id, postCount)
|> List.ofSeq
return
ordered
|> Seq.map (fun cat ->
{ cat with
PostCount = counts
|> List.tryFind (fun c -> fst c = cat.Id)
|> Option.map snd
|> Option.defaultValue 0
})
|> Array.ofSeq
}
/// Find a category by its ID for the given web log
let findById catId webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM category WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ]
|> Sql.executeAsync Map.toCategory
|> tryHead
/// Find all categories for the given web log
let findByWebLog webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM category WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toCategory
/// Delete a category
let delete catId webLogId = backgroundTask {
match! findById catId webLogId with
| Some cat ->
// Reassign any children to the category's parent category
let parentParam = "@parentId", Sql.string (CategoryId.toString catId)
let! hasChildren =
Sql.existingConnection conn
|> Sql.query $"SELECT EXISTS (SELECT 1 FROM category WHERE parent_id = @parentId) AS {existsName}"
|> Sql.parameters [ parentParam ]
|> Sql.executeRowAsync Map.toExists
if hasChildren then
let! _ =
Sql.existingConnection conn
|> Sql.query "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId"
|> Sql.parameters
[ parentParam
"@newParentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) ]
|> Sql.executeNonQueryAsync
()
// Delete the category off all posts where it is assigned, and the category itself
let! _ =
Sql.existingConnection conn
|> Sql.query
"DELETE FROM post_category
WHERE category_id = @id
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId);
DELETE FROM category WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ]
|> Sql.executeNonQueryAsync
return if hasChildren then ReassignedChildCategories else CategoryDeleted
| None -> return CategoryNotFound
}
/// The INSERT statement for a category
let catInsert =
"INSERT INTO category (
id, web_log_id, name, slug, description, parent_id
) VALUES (
@id, @webLogId, @name, @slug, @description, @parentId
)"
/// Create parameters for a category insert / update
let catParameters (cat : Category) = [
webLogIdParam cat.WebLogId
"@id", Sql.string (CategoryId.toString cat.Id)
"@name", Sql.string cat.Name
"@slug", Sql.string cat.Slug
"@description", Sql.stringOrNone cat.Description
"@parentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString)
]
/// Save a category
let save cat = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query $"
{catInsert} ON CONFLICT (id) DO UPDATE
SET name = EXCLUDED.name,
slug = EXCLUDED.slug,
description = EXCLUDED.description,
parent_id = EXCLUDED.parent_id"
|> Sql.parameters (catParameters cat)
|> Sql.executeNonQueryAsync
()
}
/// Restore categories from a backup
let restore cats = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
catInsert, cats |> List.map catParameters
]
()
}
interface ICategoryData with
member _.Add cat = save cat
member _.CountAll webLogId = countAll webLogId
member _.CountTopLevel webLogId = countTopLevel webLogId
member _.FindAllForView webLogId = findAllForView webLogId
member _.FindById catId webLogId = findById catId webLogId
member _.FindByWebLog webLogId = findByWebLog webLogId
member _.Delete catId webLogId = delete catId webLogId
member _.Restore cats = restore cats
member _.Update cat = save cat

View File

@@ -0,0 +1,240 @@
/// Helper functions for the PostgreSQL data implementation
[<AutoOpen>]
module MyWebLog.Data.Postgres.PostgresHelpers
open System
open System.Threading.Tasks
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
open NodaTime
open Npgsql
open Npgsql.FSharp
/// Create a SQL parameter for the web log ID
let webLogIdParam webLogId =
"@webLogId", Sql.string (WebLogId.toString webLogId)
/// The name of the field to select to be able to use Map.toCount
let countName = "the_count"
/// The name of the field to select to be able to use Map.toExists
let existsName = "does_exist"
/// 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}", ($"@%s{paramName}{idx}", Sql.string (valueFunc it)) :: itemP)
(Seq.ofList items
|> Seq.map (fun it ->
$"%s{colNameAndPrefix} IN (@%s{paramName}0", [ $"@%s{paramName}0", Sql.string (valueFunc it) ])
|> Seq.head)
|> function sql, ps -> $"{sql})", ps
/// Create the SQL and parameters for the array equivalent of an IN clause
let arrayInClause<'T> name (valueFunc : 'T -> string) (items : 'T list) =
if List.isEmpty items then "TRUE = FALSE", []
else
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS} OR %s{name} && ARRAY[@{name}{idx}]",
($"@{name}{idx}", Sql.string (valueFunc it)) :: itemP)
(Seq.ofList items
|> Seq.map (fun it ->
$"{name} && ARRAY[@{name}0]", [ $"@{name}0", Sql.string (valueFunc it) ])
|> Seq.head)
/// Get the first result of the given query
let tryHead<'T> (query : Task<'T list>) = backgroundTask {
let! results = query
return List.tryHead results
}
/// Create a parameter for a non-standard type
let typedParam<'T> name (it : 'T) =
$"@%s{name}", Sql.parameter (NpgsqlParameter ($"@{name}", it))
/// Create a parameter for a possibly-missing non-standard type
let optParam<'T> name (it : 'T option) =
let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value)
p.ParameterName, Sql.parameter p
/// Mapping functions for SQL queries
module Map =
/// Map an id field to a category ID
let toCategoryId (row : RowReader) =
CategoryId (row.string "id")
/// Create a category from the current row
let toCategory (row : RowReader) : Category =
{ Id = toCategoryId row
WebLogId = row.string "web_log_id" |> WebLogId
Name = row.string "name"
Slug = row.string "slug"
Description = row.stringOrNone "description"
ParentId = row.stringOrNone "parent_id" |> Option.map CategoryId
}
/// Get a count from a row
let toCount (row : RowReader) =
row.int countName
/// Create a custom feed from the current row
let toCustomFeed (ser : JsonSerializer) (row : RowReader) : CustomFeed =
{ Id = row.string "id" |> CustomFeedId
Source = row.string "source" |> CustomFeedSource.parse
Path = row.string "path" |> Permalink
Podcast = row.stringOrNone "podcast" |> Option.map (Utils.deserialize ser)
}
/// Get a true/false value as to whether an item exists
let toExists (row : RowReader) =
row.bool existsName
/// Create a meta item from the current row
let toMetaItem (row : RowReader) : MetaItem =
{ Name = row.string "name"
Value = row.string "value"
}
/// Create a permalink from the current row
let toPermalink (row : RowReader) =
Permalink (row.string "permalink")
/// Create a page from the current row
let toPage (ser : JsonSerializer) (row : RowReader) : Page =
{ Page.empty with
Id = row.string "id" |> PageId
WebLogId = row.string "web_log_id" |> WebLogId
AuthorId = row.string "author_id" |> WebLogUserId
Title = row.string "title"
Permalink = toPermalink row
PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray
PublishedOn = row.fieldValue<Instant> "published_on"
UpdatedOn = row.fieldValue<Instant> "updated_on"
IsInPageList = row.bool "is_in_page_list"
Template = row.stringOrNone "template"
Text = row.string "page_text"
Metadata = row.stringOrNone "meta_items"
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
}
/// Create a post from the current row
let toPost (ser : JsonSerializer) (row : RowReader) : Post =
{ Post.empty with
Id = row.string "id" |> PostId
WebLogId = row.string "web_log_id" |> WebLogId
AuthorId = row.string "author_id" |> WebLogUserId
Status = row.string "status" |> PostStatus.parse
Title = row.string "title"
Permalink = toPermalink row
PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray
PublishedOn = row.fieldValueOrNone<Instant> "published_on"
UpdatedOn = row.fieldValue<Instant> "updated_on"
Template = row.stringOrNone "template"
Text = row.string "post_text"
Episode = row.stringOrNone "episode" |> Option.map (Utils.deserialize ser)
CategoryIds = row.stringArrayOrNone "category_ids"
|> Option.map (Array.map CategoryId >> List.ofArray)
|> Option.defaultValue []
Tags = row.stringArrayOrNone "tags"
|> Option.map List.ofArray
|> Option.defaultValue []
Metadata = row.stringOrNone "meta_items"
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
}
/// Create a revision from the current row
let toRevision (row : RowReader) : Revision =
{ AsOf = row.fieldValue<Instant> "as_of"
Text = row.string "revision_text" |> MarkupText.parse
}
/// Create a tag mapping from the current row
let toTagMap (row : RowReader) : TagMap =
{ Id = row.string "id" |> TagMapId
WebLogId = row.string "web_log_id" |> WebLogId
Tag = row.string "tag"
UrlValue = row.string "url_value"
}
/// Create a theme from the current row (excludes templates)
let toTheme (row : RowReader) : Theme =
{ Theme.empty with
Id = row.string "id" |> ThemeId
Name = row.string "name"
Version = row.string "version"
}
/// Create a theme asset from the current row
let toThemeAsset includeData (row : RowReader) : ThemeAsset =
{ Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||]
}
/// Create a theme template from the current row
let toThemeTemplate includeText (row : RowReader) : ThemeTemplate =
{ Name = row.string "name"
Text = if includeText then row.string "template" else ""
}
/// Create an uploaded file from the current row
let toUpload includeData (row : RowReader) : Upload =
{ Id = row.string "id" |> UploadId
WebLogId = row.string "web_log_id" |> WebLogId
Path = row.string "path" |> Permalink
UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||]
}
/// Create a web log from the current row
let toWebLog (row : RowReader) : WebLog =
{ Id = row.string "id" |> WebLogId
Name = row.string "name"
Slug = row.string "slug"
Subtitle = row.stringOrNone "subtitle"
DefaultPage = row.string "default_page"
PostsPerPage = row.int "posts_per_page"
ThemeId = row.string "theme_id" |> ThemeId
UrlBase = row.string "url_base"
TimeZone = row.string "time_zone"
AutoHtmx = row.bool "auto_htmx"
Uploads = row.string "uploads" |> UploadDestination.parse
Rss = {
IsFeedEnabled = row.bool "is_feed_enabled"
FeedName = row.string "feed_name"
ItemsInFeed = row.intOrNone "items_in_feed"
IsCategoryEnabled = row.bool "is_category_enabled"
IsTagEnabled = row.bool "is_tag_enabled"
Copyright = row.stringOrNone "copyright"
CustomFeeds = []
}
}
/// Create a web log user from the current row
let toWebLogUser (row : RowReader) : WebLogUser =
{ Id = row.string "id" |> WebLogUserId
WebLogId = row.string "web_log_id" |> WebLogId
Email = row.string "email"
FirstName = row.string "first_name"
LastName = row.string "last_name"
PreferredName = row.string "preferred_name"
PasswordHash = row.string "password_hash"
Url = row.stringOrNone "url"
AccessLevel = row.string "access_level" |> AccessLevel.parse
CreatedOn = row.fieldValue<Instant> "created_on"
LastSeenOn = row.fieldValueOrNone<Instant> "last_seen_on"
}

View File

@@ -0,0 +1,281 @@
namespace MyWebLog.Data.Postgres
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
open Npgsql
open Npgsql.FSharp
/// PostgreSQL myWebLog page data implementation
type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS
/// Append revisions and permalinks to a page
let appendPageRevisions (page : Page) = backgroundTask {
let! revisions =
Sql.existingConnection conn
|> Sql.query "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC"
|> Sql.parameters [ "@pageId", Sql.string (PageId.toString page.Id) ]
|> Sql.executeAsync Map.toRevision
return { page with Revisions = revisions }
}
/// Shorthand to map to a page
let toPage = Map.toPage ser
/// Return a page with no text or revisions
let pageWithoutText row =
{ toPage row with Text = "" }
/// The INSERT statement for a page revision
let revInsert = "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)"
/// Parameters for a revision INSERT statement
let revParams pageId rev = [
typedParam "asOf" rev.AsOf
"@pageId", Sql.string (PageId.toString pageId)
"@text", Sql.string (MarkupText.toString rev.Text)
]
/// Update a page's revisions
let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
"DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf",
toDelete
|> List.map (fun it -> [
"@pageId", Sql.string (PageId.toString pageId)
typedParam "asOf" it.AsOf
])
if not (List.isEmpty toAdd) then
revInsert, toAdd |> List.map (revParams pageId)
]
()
}
/// Does the given page exist?
let pageExists pageId webLogId =
Sql.existingConnection conn
|> Sql.query $"SELECT EXISTS (SELECT 1 FROM page WHERE id = @id AND web_log_id = @webLogId) AS {existsName}"
|> Sql.parameters [ "@id", Sql.string (PageId.toString pageId); webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toExists
// IMPLEMENTATION FUNCTIONS
/// Get all pages for a web log (without text, revisions, prior permalinks, or metadata)
let all webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync pageWithoutText
/// Count all pages for the given web log
let countAll webLogId =
Sql.existingConnection conn
|> Sql.query $"SELECT COUNT(id) AS {countName} FROM page WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toCount
/// Count all pages shown in the page list for the given web log
let countListed webLogId =
Sql.existingConnection conn
|> Sql.query $"
SELECT COUNT(id) AS {countName}
FROM page
WHERE web_log_id = @webLogId
AND is_in_page_list = TRUE"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toCount
/// Find a page by its ID (without revisions)
let findById pageId webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM page WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters [ "@id", Sql.string (PageId.toString pageId); webLogIdParam webLogId ]
|> Sql.executeAsync toPage
|> tryHead
/// Find a complete page by its ID
let findFullById pageId webLogId = backgroundTask {
match! findById pageId webLogId with
| Some page ->
let! withMore = appendPageRevisions page
return Some withMore
| None -> return None
}
/// Delete a page by its ID
let delete pageId webLogId = backgroundTask {
match! pageExists pageId webLogId with
| true ->
let! _ =
Sql.existingConnection conn
|> Sql.query
"DELETE FROM page_revision WHERE page_id = @id;
DELETE FROM page WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string (PageId.toString pageId) ]
|> Sql.executeNonQueryAsync
return true
| false -> return false
}
/// Find a page by its permalink for the given web log
let findByPermalink permalink webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link"
|> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ]
|> Sql.executeAsync toPage
|> tryHead
/// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
if List.isEmpty permalinks then return None
else
let linkSql, linkParams = arrayInClause "prior_permalinks" Permalink.toString permalinks
return!
Sql.existingConnection conn
|> Sql.query $"SELECT permalink FROM page WHERE web_log_id = @webLogId AND ({linkSql})"
|> Sql.parameters (webLogIdParam webLogId :: linkParams)
|> Sql.executeAsync Map.toPermalink
|> tryHead
}
/// Get all complete pages for the given web log
let findFullByWebLog webLogId = backgroundTask {
let! pages =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync toPage
let! revisions =
Sql.existingConnection conn
|> Sql.query
"SELECT *
FROM page_revision pr
INNER JOIN page p ON p.id = pr.page_id
WHERE p.web_log_id = @webLogId
ORDER BY pr.as_of DESC"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (fun row -> PageId (row.string "page_id"), Map.toRevision row)
return
pages
|> List.map (fun it ->
{ it with Revisions = revisions |> List.filter (fun r -> fst r = it.Id) |> List.map snd })
}
/// Get all listed pages for the given web log (without revisions or text)
let findListed webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND is_in_page_list = TRUE ORDER BY LOWER(title)"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync pageWithoutText
/// Get a page of pages for the given web log (without revisions)
let findPageOfPages webLogId pageNbr =
Sql.existingConnection conn
|> Sql.query
"SELECT *
FROM page
WHERE web_log_id = @webLogId
ORDER BY LOWER(title)
LIMIT @pageSize OFFSET @toSkip"
|> Sql.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
|> Sql.executeAsync toPage
/// The INSERT statement for a page
let pageInsert =
"INSERT INTO page (
id, web_log_id, author_id, title, permalink, prior_permalinks, published_on, updated_on, is_in_page_list,
template, page_text, meta_items
) VALUES (
@id, @webLogId, @authorId, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn, @isInPageList,
@template, @text, @metaItems
)"
/// The parameters for saving a page
let pageParams (page : Page) = [
webLogIdParam page.WebLogId
"@id", Sql.string (PageId.toString page.Id)
"@authorId", Sql.string (WebLogUserId.toString page.AuthorId)
"@title", Sql.string page.Title
"@permalink", Sql.string (Permalink.toString page.Permalink)
"@isInPageList", Sql.bool page.IsInPageList
"@template", Sql.stringOrNone page.Template
"@text", Sql.string page.Text
"@metaItems", Sql.jsonb (Utils.serialize ser page.Metadata)
"@priorPermalinks", Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
typedParam "publishedOn" page.PublishedOn
typedParam "updatedOn" page.UpdatedOn
]
/// Restore pages from a backup
let restore (pages : Page list) = backgroundTask {
let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
pageInsert, pages |> List.map pageParams
revInsert, revisions |> List.map (fun (pageId, rev) -> revParams pageId rev)
]
()
}
/// Save a page
let save (page : Page) = backgroundTask {
let! oldPage = findFullById page.Id page.WebLogId
let! _ =
Sql.existingConnection conn
|> Sql.query $"
{pageInsert} ON CONFLICT (id) DO UPDATE
SET author_id = EXCLUDED.author_id,
title = EXCLUDED.title,
permalink = EXCLUDED.permalink,
prior_permalinks = EXCLUDED.prior_permalinks,
published_on = EXCLUDED.published_on,
updated_on = EXCLUDED.updated_on,
is_in_page_list = EXCLUDED.is_in_page_list,
template = EXCLUDED.template,
page_text = EXCLUDED.page_text,
meta_items = EXCLUDED.meta_items"
|> Sql.parameters (pageParams page)
|> Sql.executeNonQueryAsync
do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions
()
}
/// Update a page's prior permalinks
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
match! pageExists pageId webLogId with
| true ->
let! _ =
Sql.existingConnection conn
|> Sql.query "UPDATE page SET prior_permalinks = @prior WHERE id = @id"
|> Sql.parameters
[ "@id", Sql.string (PageId.toString pageId)
"@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ]
|> Sql.executeNonQueryAsync
return true
| false -> return false
}
interface IPageData with
member _.Add page = save page
member _.All webLogId = all webLogId
member _.CountAll webLogId = countAll webLogId
member _.CountListed webLogId = countListed webLogId
member _.Delete pageId webLogId = delete pageId webLogId
member _.FindById pageId webLogId = findById pageId webLogId
member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId
member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
member _.FindFullById pageId webLogId = findFullById pageId webLogId
member _.FindFullByWebLog webLogId = findFullByWebLog webLogId
member _.FindListed webLogId = findListed webLogId
member _.FindPageOfPages webLogId pageNbr = findPageOfPages webLogId pageNbr
member _.Restore pages = restore pages
member _.Update page = save page
member _.UpdatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks

View File

@@ -0,0 +1,378 @@
namespace MyWebLog.Data.Postgres
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
open NodaTime
open Npgsql
open Npgsql.FSharp
/// PostgreSQL myWebLog post data implementation
type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS
/// Append revisions to a post
let appendPostRevisions (post : Post) = backgroundTask {
let! revisions =
Sql.existingConnection conn
|> Sql.query "SELECT as_of, revision_text FROM post_revision WHERE post_id = @id ORDER BY as_of DESC"
|> Sql.parameters [ "@id", Sql.string (PostId.toString post.Id) ]
|> Sql.executeAsync Map.toRevision
return { post with Revisions = revisions }
}
/// The SELECT statement for a post that will include category IDs
let selectPost =
"SELECT *, ARRAY(SELECT cat.category_id FROM post_category cat WHERE cat.post_id = p.id) AS category_ids
FROM post p"
/// Shorthand for mapping to a post
let toPost = Map.toPost ser
/// Return a post with no revisions, prior permalinks, or text
let postWithoutText row =
{ toPost row with Text = "" }
/// The INSERT statement for a post/category cross-reference
let catInsert = "INSERT INTO post_category VALUES (@postId, @categoryId)"
/// Parameters for adding or updating a post/category cross-reference
let catParams postId cat = [
"@postId", Sql.string (PostId.toString postId)
"categoryId", Sql.string (CategoryId.toString cat)
]
/// Update a post's assigned categories
let updatePostCategories postId oldCats newCats = backgroundTask {
let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
"DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId",
toDelete |> List.map (catParams postId)
if not (List.isEmpty toAdd) then
catInsert, toAdd |> List.map (catParams postId)
]
()
}
/// The INSERT statement for a post revision
let revInsert = "INSERT INTO post_revision VALUES (@postId, @asOf, @text)"
/// The parameters for adding a post revision
let revParams postId rev = [
typedParam "asOf" rev.AsOf
"@postId", Sql.string (PostId.toString postId)
"@text", Sql.string (MarkupText.toString rev.Text)
]
/// Update a post's revisions
let updatePostRevisions postId oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
"DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf",
toDelete
|> List.map (fun it -> [
"@postId", Sql.string (PostId.toString postId)
typedParam "asOf" it.AsOf
])
if not (List.isEmpty toAdd) then
revInsert, toAdd |> List.map (revParams postId)
]
()
}
/// Does the given post exist?
let postExists postId webLogId =
Sql.existingConnection conn
|> Sql.query $"SELECT EXISTS (SELECT 1 FROM post WHERE id = @id AND web_log_id = @webLogId) AS {existsName}"
|> Sql.parameters [ "@id", Sql.string (PostId.toString postId); webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toExists
// IMPLEMENTATION FUNCTIONS
/// Count posts in a status for the given web log
let countByStatus status webLogId =
Sql.existingConnection conn
|> Sql.query $"SELECT COUNT(id) AS {countName} FROM post WHERE web_log_id = @webLogId AND status = @status"
|> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString status) ]
|> Sql.executeRowAsync Map.toCount
/// Find a post by its ID for the given web log (excluding revisions)
let findById postId webLogId =
Sql.existingConnection conn
|> Sql.query $"{selectPost} WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters [ "@id", Sql.string (PostId.toString postId); webLogIdParam webLogId ]
|> Sql.executeAsync toPost
|> tryHead
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink permalink webLogId =
Sql.existingConnection conn
|> Sql.query $"{selectPost} WHERE web_log_id = @webLogId AND permalink = @link"
|> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ]
|> Sql.executeAsync toPost
|> tryHead
/// Find a complete post by its ID for the given web log
let findFullById postId webLogId = backgroundTask {
match! findById postId webLogId with
| Some post ->
let! withRevisions = appendPostRevisions post
return Some withRevisions
| None -> return None
}
/// Delete a post by its ID for the given web log
let delete postId webLogId = backgroundTask {
match! postExists postId webLogId with
| true ->
let! _ =
Sql.existingConnection conn
|> Sql.query
"DELETE FROM post_revision WHERE post_id = @id;
DELETE FROM post_category WHERE post_id = @id;
DELETE FROM post WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string (PostId.toString postId) ]
|> Sql.executeNonQueryAsync
return true
| false -> return false
}
/// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
if List.isEmpty permalinks then return None
else
let linkSql, linkParams = arrayInClause "prior_permalinks" Permalink.toString permalinks
return!
Sql.existingConnection conn
|> Sql.query $"SELECT permalink FROM post WHERE web_log_id = @webLogId AND ({linkSql})"
|> Sql.parameters (webLogIdParam webLogId :: linkParams)
|> Sql.executeAsync Map.toPermalink
|> tryHead
}
/// Get all complete posts for the given web log
let findFullByWebLog webLogId = backgroundTask {
let! posts =
Sql.existingConnection conn
|> Sql.query $"{selectPost} WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync toPost
let! revisions =
Sql.existingConnection conn
|> Sql.query
"SELECT *
FROM post_revision pr
INNER JOIN post p ON p.id = pr.post_id
WHERE p.web_log_id = @webLogId
ORDER BY as_of DESC"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (fun row -> PostId (row.string "post_id"), Map.toRevision row)
return
posts
|> List.map (fun it ->
{ it with Revisions = revisions |> List.filter (fun r -> fst r = it.Id) |> List.map snd })
}
/// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
let catSql, catParams = inClause "AND pc.category_id" "catId" CategoryId.toString categoryIds
Sql.existingConnection conn
|> Sql.query $"
{selectPost}
INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = @status
{catSql}
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters
[ webLogIdParam webLogId
"@status", Sql.string (PostStatus.toString Published)
yield! catParams ]
|> Sql.executeAsync toPost
/// Get a page of posts for the given web log (excludes text and revisions)
let findPageOfPosts webLogId pageNbr postsPerPage =
Sql.existingConnection conn
|> Sql.query $"
{selectPost}
WHERE web_log_id = @webLogId
ORDER BY published_on DESC NULLS FIRST, updated_on
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync postWithoutText
/// Get a page of published posts for the given web log (excludes revisions)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
Sql.existingConnection conn
|> Sql.query $"
{selectPost}
WHERE web_log_id = @webLogId
AND status = @status
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString Published) ]
|> Sql.executeAsync toPost
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage =
Sql.existingConnection conn
|> Sql.query $"
{selectPost}
WHERE web_log_id = @webLogId
AND status = @status
AND tags && ARRAY[@tag]
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters
[ webLogIdParam webLogId
"@status", Sql.string (PostStatus.toString Published)
"@tag", Sql.string tag
]
|> Sql.executeAsync toPost
/// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask {
let queryParams () = Sql.parameters [
webLogIdParam webLogId
typedParam "publishedOn" publishedOn
"@status", Sql.string (PostStatus.toString Published)
]
let! older =
Sql.existingConnection conn
|> Sql.query $"
{selectPost}
WHERE web_log_id = @webLogId
AND status = @status
AND published_on < @publishedOn
ORDER BY published_on DESC
LIMIT 1"
|> queryParams ()
|> Sql.executeAsync toPost
let! newer =
Sql.existingConnection conn
|> Sql.query $"
{selectPost}
WHERE web_log_id = @webLogId
AND status = @status
AND published_on > @publishedOn
ORDER BY published_on
LIMIT 1"
|> queryParams ()
|> Sql.executeAsync toPost
return List.tryHead older, List.tryHead newer
}
/// The INSERT statement for a post
let postInsert =
"INSERT INTO post (
id, web_log_id, author_id, status, title, permalink, prior_permalinks, published_on, updated_on,
template, post_text, tags, meta_items, episode
) VALUES (
@id, @webLogId, @authorId, @status, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn,
@template, @text, @tags, @metaItems, @episode
)"
/// The parameters for saving a post
let postParams (post : Post) = [
webLogIdParam post.WebLogId
"@id", Sql.string (PostId.toString post.Id)
"@authorId", Sql.string (WebLogUserId.toString post.AuthorId)
"@status", Sql.string (PostStatus.toString post.Status)
"@title", Sql.string post.Title
"@permalink", Sql.string (Permalink.toString post.Permalink)
"@template", Sql.stringOrNone post.Template
"@text", Sql.string post.Text
"@priorPermalinks", Sql.stringArray (post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
"@episode", Sql.jsonbOrNone (post.Episode |> Option.map (Utils.serialize ser))
"@tags", Sql.stringArrayOrNone (if List.isEmpty post.Tags then None else Some (Array.ofList post.Tags))
"@metaItems",
if List.isEmpty post.Metadata then None else Some (Utils.serialize ser post.Metadata)
|> Sql.jsonbOrNone
optParam "publishedOn" post.PublishedOn
typedParam "updatedOn" post.UpdatedOn
]
/// Save a post
let save (post : Post) = backgroundTask {
let! oldPost = findFullById post.Id post.WebLogId
let! _ =
Sql.existingConnection conn
|> Sql.query $"
{postInsert} ON CONFLICT (id) DO UPDATE
SET author_id = EXCLUDED.author_id,
status = EXCLUDED.status,
title = EXCLUDED.title,
permalink = EXCLUDED.permalink,
prior_permalinks = EXCLUDED.prior_permalinks,
published_on = EXCLUDED.published_on,
updated_on = EXCLUDED.updated_on,
template = EXCLUDED.template,
post_text = EXCLUDED.post_text,
tags = EXCLUDED.tags,
meta_items = EXCLUDED.meta_items,
episode = EXCLUDED.episode"
|> Sql.parameters (postParams post)
|> Sql.executeNonQueryAsync
do! updatePostCategories post.Id (match oldPost with Some p -> p.CategoryIds | None -> []) post.CategoryIds
do! updatePostRevisions post.Id (match oldPost with Some p -> p.Revisions | None -> []) post.Revisions
}
/// Restore posts from a backup
let restore posts = backgroundTask {
let cats = posts |> List.collect (fun p -> p.CategoryIds |> List.map (fun c -> p.Id, c))
let revisions = posts |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
postInsert, posts |> List.map postParams
catInsert, cats |> List.map (fun (postId, catId) -> catParams postId catId)
revInsert, revisions |> List.map (fun (postId, rev) -> revParams postId rev)
]
()
}
/// Update prior permalinks for a post
let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
match! postExists postId webLogId with
| true ->
let! _ =
Sql.existingConnection conn
|> Sql.query "UPDATE post SET prior_permalinks = @prior WHERE id = @id"
|> Sql.parameters
[ "@id", Sql.string (PostId.toString postId)
"@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ]
|> Sql.executeNonQueryAsync
return true
| false -> return false
}
interface IPostData with
member _.Add post = save post
member _.CountByStatus status webLogId = countByStatus status webLogId
member _.Delete postId webLogId = delete postId webLogId
member _.FindById postId webLogId = findById postId webLogId
member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId
member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
member _.FindFullById postId webLogId = findFullById postId webLogId
member _.FindFullByWebLog webLogId = findFullByWebLog webLogId
member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage
member _.FindPageOfPosts webLogId pageNbr postsPerPage = findPageOfPosts webLogId pageNbr postsPerPage
member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage =
findPageOfPublishedPosts webLogId pageNbr postsPerPage
member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage =
findPageOfTaggedPosts webLogId tag pageNbr postsPerPage
member _.FindSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn
member _.Restore posts = restore posts
member _.Update post = save post
member _.UpdatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks

View File

@@ -0,0 +1,109 @@
namespace MyWebLog.Data.Postgres
open MyWebLog
open MyWebLog.Data
open Npgsql
open Npgsql.FSharp
/// PostgreSQL myWebLog tag mapping data implementation
type PostgresTagMapData (conn : NpgsqlConnection) =
/// Find a tag mapping by its ID for the given web log
let findById tagMapId webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM tag_map WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters [ "@id", Sql.string (TagMapId.toString tagMapId); webLogIdParam webLogId ]
|> Sql.executeAsync Map.toTagMap
|> tryHead
/// Delete a tag mapping for the given web log
let delete tagMapId webLogId = backgroundTask {
let idParams = [ "@id", Sql.string (TagMapId.toString tagMapId) ]
let! exists =
Sql.existingConnection conn
|> Sql.query $"
SELECT EXISTS
(SELECT 1 FROM tag_map WHERE id = @id AND web_log_id = @webLogId)
AS {existsName}"
|> Sql.parameters (webLogIdParam webLogId :: idParams)
|> Sql.executeRowAsync Map.toExists
if exists then
let! _ =
Sql.existingConnection conn
|> Sql.query "DELETE FROM tag_map WHERE id = @id"
|> Sql.parameters idParams
|> Sql.executeNonQueryAsync
return true
else return false
}
/// Find a tag mapping by its URL value for the given web log
let findByUrlValue urlValue webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue"
|> Sql.parameters [ webLogIdParam webLogId; "@urlValue", Sql.string urlValue ]
|> Sql.executeAsync Map.toTagMap
|> tryHead
/// Get all tag mappings for the given web log
let findByWebLog webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM tag_map WHERE web_log_id = @webLogId ORDER BY tag"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toTagMap
/// Find any tag mappings in a list of tags for the given web log
let findMappingForTags tags webLogId =
let tagSql, tagParams = inClause "AND tag" "tag" id tags
Sql.existingConnection conn
|> Sql.query $"SELECT * FROM tag_map WHERE web_log_id = @webLogId {tagSql}"
|> Sql.parameters (webLogIdParam webLogId :: tagParams)
|> Sql.executeAsync Map.toTagMap
/// The INSERT statement for a tag mapping
let tagMapInsert =
"INSERT INTO tag_map (
id, web_log_id, tag, url_value
) VALUES (
@id, @webLogId, @tag, @urlValue
)"
/// The parameters for saving a tag mapping
let tagMapParams (tagMap : TagMap) = [
webLogIdParam tagMap.WebLogId
"@id", Sql.string (TagMapId.toString tagMap.Id)
"@tag", Sql.string tagMap.Tag
"@urlValue", Sql.string tagMap.UrlValue
]
/// Save a tag mapping
let save tagMap = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query $"
{tagMapInsert} ON CONFLICT (id) DO UPDATE
SET tag = EXCLUDED.tag,
url_value = EXCLUDED.url_value"
|> Sql.parameters (tagMapParams tagMap)
|> Sql.executeNonQueryAsync
()
}
/// Restore tag mappings from a backup
let restore tagMaps = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
tagMapInsert, tagMaps |> List.map tagMapParams
]
()
}
interface ITagMapData with
member _.Delete tagMapId webLogId = delete tagMapId webLogId
member _.FindById tagMapId webLogId = findById tagMapId webLogId
member _.FindByUrlValue urlValue webLogId = findByUrlValue urlValue webLogId
member _.FindByWebLog webLogId = findByWebLog webLogId
member _.FindMappingForTags tags webLogId = findMappingForTags tags webLogId
member _.Save tagMap = save tagMap
member _.Restore tagMaps = restore tagMaps

View File

@@ -0,0 +1,207 @@
namespace MyWebLog.Data.Postgres
open MyWebLog
open MyWebLog.Data
open Npgsql
open Npgsql.FSharp
/// PostreSQL myWebLog theme data implementation
type PostgresThemeData (conn : NpgsqlConnection) =
/// Retrieve all themes (except 'admin'; excludes template text)
let all () = backgroundTask {
let! themes =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id"
|> Sql.executeAsync Map.toTheme
let! templates =
Sql.existingConnection conn
|> Sql.query "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name"
|> Sql.executeAsync (fun row -> ThemeId (row.string "theme_id"), Map.toThemeTemplate false row)
return
themes
|> List.map (fun t ->
{ t with Templates = templates |> List.filter (fun tt -> fst tt = t.Id) |> List.map snd })
}
/// Does a given theme exist?
let exists themeId =
Sql.existingConnection conn
|> Sql.query "SELECT EXISTS (SELECT 1 FROM theme WHERE id = @id) AS does_exist"
|> Sql.parameters [ "@id", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeRowAsync Map.toExists
/// Find a theme by its ID
let findById themeId = backgroundTask {
let themeIdParam = [ "@id", Sql.string (ThemeId.toString themeId) ]
let! theme =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme WHERE id = @id"
|> Sql.parameters themeIdParam
|> Sql.executeAsync Map.toTheme
|> tryHead
if Option.isSome theme then
let! templates =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme_template WHERE theme_id = @id"
|> Sql.parameters themeIdParam
|> Sql.executeAsync (Map.toThemeTemplate true)
return Some { theme.Value with Templates = templates }
else return None
}
/// Find a theme by its ID (excludes the text of templates)
let findByIdWithoutText themeId = backgroundTask {
match! findById themeId with
| Some theme ->
return Some {
theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" })
}
| None -> return None
}
/// Delete a theme by its ID
let delete themeId = backgroundTask {
let idParams = [ "@id", Sql.string (ThemeId.toString themeId) ]
let! exists =
Sql.existingConnection conn
|> Sql.query $"SELECT EXISTS (SELECT 1 FROM theme WHERE id = @id) AS {existsName}"
|> Sql.parameters idParams
|> Sql.executeRowAsync Map.toExists
if exists then
let! _ =
Sql.existingConnection conn
|> Sql.query
"DELETE FROM theme_asset WHERE theme_id = @id;
DELETE FROM theme_template WHERE theme_id = @id;
DELETE FROM theme WHERE id = @id"
|> Sql.parameters idParams
|> Sql.executeNonQueryAsync
return true
else return false
}
/// Save a theme
let save (theme : Theme) = backgroundTask {
let! oldTheme = findById theme.Id
let themeIdParam = Sql.string (ThemeId.toString theme.Id)
let! _ =
Sql.existingConnection conn
|> Sql.query
"INSERT INTO theme VALUES (@id, @name, @version)
ON CONFLICT (id) DO UPDATE
SET name = EXCLUDED.name,
version = EXCLUDED.version"
|> Sql.parameters
[ "@id", themeIdParam
"@name", Sql.string theme.Name
"@version", Sql.string theme.Version ]
|> Sql.executeNonQueryAsync
let toDelete, _ =
Utils.diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue [])
theme.Templates (fun t -> t.Name)
let toAddOrUpdate =
theme.Templates
|> List.filter (fun t -> not (toDelete |> List.exists (fun d -> d.Name = t.Name)))
if not (List.isEmpty toDelete) || not (List.isEmpty toAddOrUpdate) then
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
"DELETE FROM theme_template WHERE theme_id = @themeId AND name = @name",
toDelete |> List.map (fun tmpl -> [ "@themeId", themeIdParam; "@name", Sql.string tmpl.Name ])
if not (List.isEmpty toAddOrUpdate) then
"INSERT INTO theme_template VALUES (@themeId, @name, @template)
ON CONFLICT (theme_id, name) DO UPDATE
SET template = EXCLUDED.template",
toAddOrUpdate |> List.map (fun tmpl -> [
"@themeId", themeIdParam
"@name", Sql.string tmpl.Name
"@template", Sql.string tmpl.Text
])
]
()
}
interface IThemeData with
member _.All () = all ()
member _.Delete themeId = delete themeId
member _.Exists themeId = exists themeId
member _.FindById themeId = findById themeId
member _.FindByIdWithoutText themeId = findByIdWithoutText themeId
member _.Save theme = save theme
/// PostreSQL myWebLog theme data implementation
type PostgresThemeAssetData (conn : NpgsqlConnection) =
/// Get all theme assets (excludes data)
let all () =
Sql.existingConnection conn
|> Sql.query "SELECT theme_id, path, updated_on FROM theme_asset"
|> Sql.executeAsync (Map.toThemeAsset false)
/// Delete all assets for the given theme
let deleteByTheme themeId = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query "DELETE FROM theme_asset WHERE theme_id = @themeId"
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeNonQueryAsync
()
}
/// Find a theme asset by its ID
let findById assetId =
let (ThemeAssetId (ThemeId themeId, path)) = assetId
Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId AND path = @path"
|> Sql.parameters [ "@themeId", Sql.string themeId; "@path", Sql.string path ]
|> Sql.executeAsync (Map.toThemeAsset true)
|> tryHead
/// Get theme assets for the given theme (excludes data)
let findByTheme themeId =
Sql.existingConnection conn
|> Sql.query "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId"
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeAsync (Map.toThemeAsset false)
/// Get theme assets for the given theme
let findByThemeWithData themeId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId"
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeAsync (Map.toThemeAsset true)
/// Save a theme asset
let save (asset : ThemeAsset) = backgroundTask {
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
let! _ =
Sql.existingConnection conn
|> Sql.query
"INSERT INTO theme_asset (
theme_id, path, updated_on, data
) VALUES (
@themeId, @path, @updatedOn, @data
) ON CONFLICT (theme_id, path) DO UPDATE
SET updated_on = EXCLUDED.updated_on,
data = EXCLUDED.data"
|> Sql.parameters
[ "@themeId", Sql.string themeId
"@path", Sql.string path
"@data", Sql.bytea asset.Data
typedParam "updatedOn" asset.UpdatedOn ]
|> Sql.executeNonQueryAsync
()
}
interface IThemeAssetData with
member _.All () = all ()
member _.DeleteByTheme themeId = deleteByTheme themeId
member _.FindById assetId = findById assetId
member _.FindByTheme themeId = findByTheme themeId
member _.FindByThemeWithData themeId = findByThemeWithData themeId
member _.Save asset = save asset

View File

@@ -0,0 +1,97 @@
namespace MyWebLog.Data.Postgres
open MyWebLog
open MyWebLog.Data
open Npgsql
open Npgsql.FSharp
/// PostgreSQL myWebLog uploaded file data implementation
type PostgresUploadData (conn : NpgsqlConnection) =
/// The INSERT statement for an uploaded file
let upInsert =
"INSERT INTO upload (
id, web_log_id, path, updated_on, data
) VALUES (
@id, @webLogId, @path, @updatedOn, @data
)"
/// Parameters for adding an uploaded file
let upParams (upload : Upload) = [
webLogIdParam upload.WebLogId
typedParam "updatedOn" upload.UpdatedOn
"@id", Sql.string (UploadId.toString upload.Id)
"@path", Sql.string (Permalink.toString upload.Path)
"@data", Sql.bytea upload.Data
]
/// Save an uploaded file
let add upload = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query upInsert
|> Sql.parameters (upParams upload)
|> Sql.executeNonQueryAsync
()
}
/// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask {
let theParams = [ "@id", Sql.string (UploadId.toString uploadId); webLogIdParam webLogId ]
let! path =
Sql.existingConnection conn
|> Sql.query "SELECT path FROM upload WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters theParams
|> Sql.executeAsync (fun row -> row.string "path")
|> tryHead
if Option.isSome path then
let! _ =
Sql.existingConnection conn
|> Sql.query "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters theParams
|> Sql.executeNonQueryAsync
return Ok path.Value
else return Error $"""Upload ID {UploadId.toString uploadId} not found"""
}
/// Find an uploaded file by its path for the given web log
let findByPath path webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId AND path = @path"
|> Sql.parameters [ webLogIdParam webLogId; "@path", Sql.string path ]
|> Sql.executeAsync (Map.toUpload true)
|> tryHead
/// Find all uploaded files for the given web log (excludes data)
let findByWebLog webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT id, web_log_id, path, updated_on FROM upload WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (Map.toUpload false)
/// Find all uploaded files for the given web log
let findByWebLogWithData webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (Map.toUpload true)
/// Restore uploads from a backup
let restore uploads = backgroundTask {
for batch in uploads |> List.chunkBySize 5 do
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
upInsert, batch |> List.map upParams
]
()
}
interface IUploadData with
member _.Add upload = add upload
member _.Delete uploadId webLogId = delete uploadId webLogId
member _.FindByPath path webLogId = findByPath path webLogId
member _.FindByWebLog webLogId = findByWebLog webLogId
member _.FindByWebLogWithData webLogId = findByWebLogWithData webLogId
member _.Restore uploads = restore uploads

View File

@@ -0,0 +1,238 @@
namespace MyWebLog.Data.Postgres
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
open Npgsql
open Npgsql.FSharp
/// PostgreSQL myWebLog web log data implementation
type PostgresWebLogData (conn : NpgsqlConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS
/// The parameters for web log INSERT or web log/RSS options UPDATE statements
let rssParams (webLog : WebLog) = [
"@isFeedEnabled", Sql.bool webLog.Rss.IsFeedEnabled
"@feedName", Sql.string webLog.Rss.FeedName
"@itemsInFeed", Sql.intOrNone webLog.Rss.ItemsInFeed
"@isCategoryEnabled", Sql.bool webLog.Rss.IsCategoryEnabled
"@isTagEnabled", Sql.bool webLog.Rss.IsTagEnabled
"@copyright", Sql.stringOrNone webLog.Rss.Copyright
]
/// The parameters for web log INSERT or UPDATE statements
let webLogParams (webLog : WebLog) = [
"@id", Sql.string (WebLogId.toString webLog.Id)
"@name", Sql.string webLog.Name
"@slug", Sql.string webLog.Slug
"@subtitle", Sql.stringOrNone webLog.Subtitle
"@defaultPage", Sql.string webLog.DefaultPage
"@postsPerPage", Sql.int webLog.PostsPerPage
"@themeId", Sql.string (ThemeId.toString webLog.ThemeId)
"@urlBase", Sql.string webLog.UrlBase
"@timeZone", Sql.string webLog.TimeZone
"@autoHtmx", Sql.bool webLog.AutoHtmx
"@uploads", Sql.string (UploadDestination.toString webLog.Uploads)
yield! rssParams webLog
]
/// Shorthand to map a result to a custom feed
let toCustomFeed =
Map.toCustomFeed ser
/// Get the current custom feeds for a web log
let getCustomFeeds (webLog : WebLog) =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log_feed WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLog.Id ]
|> Sql.executeAsync toCustomFeed
/// Append custom feeds to a web log
let appendCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog
return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
}
/// The parameters to save a custom feed
let feedParams webLogId (feed : CustomFeed) = [
webLogIdParam webLogId
"@id", Sql.string (CustomFeedId.toString feed.Id)
"@source", Sql.string (CustomFeedSource.toString feed.Source)
"@path", Sql.string (Permalink.toString feed.Path)
"@podcast", Sql.jsonbOrNone (feed.Podcast |> Option.map (Utils.serialize ser))
]
/// Update the custom feeds for a web log
let updateCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog
let toDelete, _ = Utils.diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
let toId (feed : CustomFeed) = feed.Id
let toAddOrUpdate =
webLog.Rss.CustomFeeds |> List.filter (fun f -> not (toDelete |> List.map toId |> List.contains f.Id))
if not (List.isEmpty toDelete) || not (List.isEmpty toAddOrUpdate) then
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
"DELETE FROM web_log_feed WHERE id = @id",
toDelete |> List.map (fun it -> [ "@id", Sql.string (CustomFeedId.toString it.Id) ])
if not (List.isEmpty toAddOrUpdate) then
"INSERT INTO web_log_feed (
id, web_log_id, source, path, podcast
) VALUES (
@id, @webLogId, @source, @path, @podcast
) ON CONFLICT (id) DO UPDATE
SET source = EXCLUDED.source,
path = EXCLUDED.path,
podcast = EXCLUDED.podcast",
toAddOrUpdate |> List.map (feedParams webLog.Id)
]
()
}
// IMPLEMENTATION FUNCTIONS
/// Add a web log
let add webLog = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query
"INSERT INTO web_log (
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright
) VALUES (
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
@uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
)"
|> Sql.parameters (webLogParams webLog)
|> Sql.executeNonQueryAsync
do! updateCustomFeeds webLog
}
/// Retrieve all web logs
let all () = backgroundTask {
let! webLogs =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log"
|> Sql.executeAsync Map.toWebLog
let! feeds =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log_feed"
|> Sql.executeAsync (fun row -> WebLogId (row.string "web_log_id"), toCustomFeed row)
return
webLogs
|> List.map (fun it ->
{ it with
Rss =
{ it.Rss with
CustomFeeds = feeds |> List.filter (fun (wlId, _) -> wlId = it.Id) |> List.map snd } })
}
/// Delete a web log by its ID
let delete webLogId = backgroundTask {
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
let postSubQuery = subQuery "post"
let pageSubQuery = subQuery "page"
let! _ =
Sql.existingConnection conn
|> Sql.query $"
DELETE FROM post_comment WHERE post_id IN {postSubQuery};
DELETE FROM post_revision WHERE post_id IN {postSubQuery};
DELETE FROM post_category WHERE post_id IN {postSubQuery};
DELETE FROM post WHERE web_log_id = @webLogId;
DELETE FROM page_revision WHERE page_id IN {pageSubQuery};
DELETE FROM page WHERE web_log_id = @webLogId;
DELETE FROM category WHERE web_log_id = @webLogId;
DELETE FROM tag_map WHERE web_log_id = @webLogId;
DELETE FROM upload WHERE web_log_id = @webLogId;
DELETE FROM web_log_user WHERE web_log_id = @webLogId;
DELETE FROM web_log_feed WHERE web_log_id = @webLogId;
DELETE FROM web_log WHERE id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeNonQueryAsync
()
}
/// Find a web log by its host (URL base)
let findByHost url = backgroundTask {
let! webLog =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log WHERE url_base = @urlBase"
|> Sql.parameters [ "@urlBase", Sql.string url ]
|> Sql.executeAsync Map.toWebLog
|> tryHead
if Option.isSome webLog then
let! withFeeds = appendCustomFeeds webLog.Value
return Some withFeeds
else return None
}
/// Find a web log by its ID
let findById webLogId = backgroundTask {
let! webLog =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log WHERE id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toWebLog
|> tryHead
if Option.isSome webLog then
let! withFeeds = appendCustomFeeds webLog.Value
return Some withFeeds
else return None
}
/// Update settings for a web log
let updateSettings webLog = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query
"UPDATE web_log
SET name = @name,
slug = @slug,
subtitle = @subtitle,
default_page = @defaultPage,
posts_per_page = @postsPerPage,
theme_id = @themeId,
url_base = @urlBase,
time_zone = @timeZone,
auto_htmx = @autoHtmx,
uploads = @uploads,
is_feed_enabled = @isFeedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright
WHERE id = @id"
|> Sql.parameters (webLogParams webLog)
|> Sql.executeNonQueryAsync
()
}
/// Update RSS options for a web log
let updateRssOptions (webLog : WebLog) = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query
"UPDATE web_log
SET is_feed_enabled = @isFeedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright
WHERE id = @webLogId"
|> Sql.parameters (webLogIdParam webLog.Id :: rssParams webLog)
|> Sql.executeNonQueryAsync
do! updateCustomFeeds webLog
}
interface IWebLogData with
member _.Add webLog = add webLog
member _.All () = all ()
member _.Delete webLogId = delete webLogId
member _.FindByHost url = findByHost url
member _.FindById webLogId = findById webLogId
member _.UpdateSettings webLog = updateSettings webLog
member _.UpdateRssOptions webLog = updateRssOptions webLog

View File

@@ -0,0 +1,149 @@
namespace MyWebLog.Data.Postgres
open MyWebLog
open MyWebLog.Data
open Npgsql
open Npgsql.FSharp
/// PostgreSQL myWebLog user data implementation
type PostgresWebLogUserData (conn : NpgsqlConnection) =
/// The INSERT statement for a user
let userInsert =
"INSERT INTO web_log_user (
id, web_log_id, email, first_name, last_name, preferred_name, password_hash, url, access_level,
created_on, last_seen_on
) VALUES (
@id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @url, @accessLevel,
@createdOn, @lastSeenOn
)"
/// Parameters for saving web log users
let userParams (user : WebLogUser) = [
"@id", Sql.string (WebLogUserId.toString user.Id)
"@webLogId", Sql.string (WebLogId.toString user.WebLogId)
"@email", Sql.string user.Email
"@firstName", Sql.string user.FirstName
"@lastName", Sql.string user.LastName
"@preferredName", Sql.string user.PreferredName
"@passwordHash", Sql.string user.PasswordHash
"@url", Sql.stringOrNone user.Url
"@accessLevel", Sql.string (AccessLevel.toString user.AccessLevel)
typedParam "createdOn" user.CreatedOn
optParam "lastSeenOn" user.LastSeenOn
]
/// Find a user by their ID for the given web log
let findById userId webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log_user WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters [ "@id", Sql.string (WebLogUserId.toString userId); webLogIdParam webLogId ]
|> Sql.executeAsync Map.toWebLogUser
|> tryHead
/// Delete a user if they have no posts or pages
let delete userId webLogId = backgroundTask {
match! findById userId webLogId with
| Some _ ->
let userParam = [ "@userId", Sql.string (WebLogUserId.toString userId) ]
let! isAuthor =
Sql.existingConnection conn
|> Sql.query
"SELECT ( EXISTS (SELECT 1 FROM page WHERE author_id = @userId
OR EXISTS (SELECT 1 FROM post WHERE author_id = @userId)) AS does_exist"
|> Sql.parameters userParam
|> Sql.executeRowAsync Map.toExists
if isAuthor then
return Error "User has pages or posts; cannot delete"
else
let! _ =
Sql.existingConnection conn
|> Sql.query "DELETE FROM web_log_user WHERE id = @userId"
|> Sql.parameters userParam
|> Sql.executeNonQueryAsync
return Ok true
| None -> return Error "User does not exist"
}
/// Find a user by their e-mail address for the given web log
let findByEmail email webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND email = @email"
|> Sql.parameters [ webLogIdParam webLogId; "@email", Sql.string email ]
|> Sql.executeAsync Map.toWebLogUser
|> tryHead
/// Get all users for the given web log
let findByWebLog webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log_user WHERE web_log_id = @webLogId ORDER BY LOWER(preferred_name)"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toWebLogUser
/// Find the names of users by their IDs for the given web log
let findNames webLogId userIds = backgroundTask {
let idSql, idParams = inClause "AND id" "id" WebLogUserId.toString userIds
let! users =
Sql.existingConnection conn
|> Sql.query $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {idSql}"
|> Sql.parameters (webLogIdParam webLogId :: idParams)
|> Sql.executeAsync Map.toWebLogUser
return
users
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
}
/// Restore users from a backup
let restore users = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
userInsert, users |> List.map userParams
]
()
}
/// Set a user's last seen date/time to now
let setLastSeen userId webLogId = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query "UPDATE web_log_user SET last_seen_on = @lastSeenOn WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters
[ webLogIdParam webLogId
typedParam "lastSeenOn" (Noda.now ())
"@id", Sql.string (WebLogUserId.toString userId) ]
|> Sql.executeNonQueryAsync
()
}
/// Save a user
let save user = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query $"
{userInsert} ON CONFLICT (id) DO UPDATE
SET email = @email,
first_name = @firstName,
last_name = @lastName,
preferred_name = @preferredName,
password_hash = @passwordHash,
url = @url,
access_level = @accessLevel,
created_on = @createdOn,
last_seen_on = @lastSeenOn"
|> Sql.parameters (userParams user)
|> Sql.executeNonQueryAsync
()
}
interface IWebLogUserData with
member _.Add user = save user
member _.Delete userId webLogId = delete userId webLogId
member _.FindByEmail email webLogId = findByEmail email webLogId
member _.FindById userId webLogId = findById userId webLogId
member _.FindByWebLog webLogId = findByWebLog webLogId
member _.FindNames webLogId userIds = findNames webLogId userIds
member _.Restore users = restore users
member _.SetLastSeen userId webLogId = setLastSeen userId webLogId
member _.Update user = save user

View File

@@ -0,0 +1,260 @@
namespace MyWebLog.Data
open Microsoft.Extensions.Logging
open MyWebLog.Data.Postgres
open Newtonsoft.Json
open Npgsql
open Npgsql.FSharp
/// Data implementation for PostgreSQL
type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, ser : JsonSerializer) =
/// Create any needed tables
let ensureTables () = backgroundTask {
let _ = NpgsqlConnection.GlobalTypeMapper.UseNodaTime ()
let! tables =
Sql.existingConnection conn
|> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'"
|> Sql.executeAsync (fun row -> row.string "tablename")
let needsTable table = not (List.contains table tables)
let mutable isNew = false
let sql = seq {
// Theme tables
if needsTable "theme" then
isNew <- true
"CREATE TABLE theme (
id TEXT NOT NULL PRIMARY KEY,
name TEXT NOT NULL,
version TEXT NOT NULL)"
if needsTable "theme_template" then
"CREATE TABLE theme_template (
theme_id TEXT NOT NULL REFERENCES theme (id),
name TEXT NOT NULL,
template TEXT NOT NULL,
PRIMARY KEY (theme_id, name))"
if needsTable "theme_asset" then
"CREATE TABLE theme_asset (
theme_id TEXT NOT NULL REFERENCES theme (id),
path TEXT NOT NULL,
updated_on TIMESTAMPTZ NOT NULL,
data BYTEA NOT NULL,
PRIMARY KEY (theme_id, path))"
// Web log tables
if needsTable "web_log" then
"CREATE TABLE web_log (
id TEXT NOT NULL PRIMARY KEY,
name TEXT NOT NULL,
slug TEXT NOT NULL,
subtitle TEXT,
default_page TEXT NOT NULL,
posts_per_page INTEGER NOT NULL,
theme_id TEXT NOT NULL REFERENCES theme (id),
url_base TEXT NOT NULL,
time_zone TEXT NOT NULL,
auto_htmx BOOLEAN NOT NULL DEFAULT FALSE,
uploads TEXT NOT NULL,
is_feed_enabled BOOLEAN NOT NULL DEFAULT FALSE,
feed_name TEXT NOT NULL,
items_in_feed INTEGER,
is_category_enabled BOOLEAN NOT NULL DEFAULT FALSE,
is_tag_enabled BOOLEAN NOT NULL DEFAULT FALSE,
copyright TEXT)"
"CREATE INDEX web_log_theme_idx ON web_log (theme_id)"
if needsTable "web_log_feed" then
"CREATE TABLE web_log_feed (
id TEXT NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
source TEXT NOT NULL,
path TEXT NOT NULL,
podcast JSONB)"
"CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"
// Category table
if needsTable "category" then
"CREATE TABLE category (
id TEXT NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
name TEXT NOT NULL,
slug TEXT NOT NULL,
description TEXT,
parent_id TEXT)"
"CREATE INDEX category_web_log_idx ON category (web_log_id)"
// Web log user table
if needsTable "web_log_user" then
"CREATE TABLE web_log_user (
id TEXT NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
email TEXT NOT NULL,
first_name TEXT NOT NULL,
last_name TEXT NOT NULL,
preferred_name TEXT NOT NULL,
password_hash TEXT NOT NULL,
url TEXT,
access_level TEXT NOT NULL,
created_on TIMESTAMPTZ NOT NULL,
last_seen_on TIMESTAMPTZ)"
"CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id)"
"CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)"
// Page tables
if needsTable "page" then
"CREATE TABLE page (
id TEXT NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id),
title TEXT NOT NULL,
permalink TEXT NOT NULL,
prior_permalinks TEXT[] NOT NULL DEFAULT '{}',
published_on TIMESTAMPTZ NOT NULL,
updated_on TIMESTAMPTZ NOT NULL,
is_in_page_list BOOLEAN NOT NULL DEFAULT FALSE,
template TEXT,
page_text TEXT NOT NULL,
meta_items JSONB)"
"CREATE INDEX page_web_log_idx ON page (web_log_id)"
"CREATE INDEX page_author_idx ON page (author_id)"
"CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)"
if needsTable "page_revision" then
"CREATE TABLE page_revision (
page_id TEXT NOT NULL REFERENCES page (id),
as_of TIMESTAMPTZ NOT NULL,
revision_text TEXT NOT NULL,
PRIMARY KEY (page_id, as_of))"
// Post tables
if needsTable "post" then
"CREATE TABLE post (
id TEXT NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id),
status TEXT NOT NULL,
title TEXT NOT NULL,
permalink TEXT NOT NULL,
prior_permalinks TEXT[] NOT NULL DEFAULT '{}',
published_on TIMESTAMPTZ,
updated_on TIMESTAMPTZ NOT NULL,
template TEXT,
post_text TEXT NOT NULL,
tags TEXT[],
meta_items JSONB,
episode JSONB)"
"CREATE INDEX post_web_log_idx ON post (web_log_id)"
"CREATE INDEX post_author_idx ON post (author_id)"
"CREATE INDEX post_status_idx ON post (web_log_id, status, updated_on)"
"CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)"
if needsTable "post_category" then
"CREATE TABLE post_category (
post_id TEXT NOT NULL REFERENCES post (id),
category_id TEXT NOT NULL REFERENCES category (id),
PRIMARY KEY (post_id, category_id))"
"CREATE INDEX post_category_category_idx ON post_category (category_id)"
if needsTable "post_revision" then
"CREATE TABLE post_revision (
post_id TEXT NOT NULL REFERENCES post (id),
as_of TIMESTAMPTZ NOT NULL,
revision_text TEXT NOT NULL,
PRIMARY KEY (post_id, as_of))"
if needsTable "post_comment" then
"CREATE TABLE post_comment (
id TEXT NOT NULL PRIMARY KEY,
post_id TEXT NOT NULL REFERENCES post(id),
in_reply_to_id TEXT,
name TEXT NOT NULL,
email TEXT NOT NULL,
url TEXT,
status TEXT NOT NULL,
posted_on TIMESTAMPTZ NOT NULL,
comment_text TEXT NOT NULL)"
"CREATE INDEX post_comment_post_idx ON post_comment (post_id)"
// Tag map table
if needsTable "tag_map" then
"CREATE TABLE tag_map (
id TEXT NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
tag TEXT NOT NULL,
url_value TEXT NOT NULL)"
"CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)"
// Uploaded file table
if needsTable "upload" then
"CREATE TABLE upload (
id TEXT NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
path TEXT NOT NULL,
updated_on TIMESTAMPTZ NOT NULL,
data BYTEA NOT NULL)"
"CREATE INDEX upload_web_log_idx ON upload (web_log_id)"
"CREATE INDEX upload_path_idx ON upload (web_log_id, path)"
// Database version table
if needsTable "db_version" then
"CREATE TABLE db_version (id TEXT NOT NULL PRIMARY KEY)"
$"INSERT INTO db_version VALUES ('{Utils.currentDbVersion}')"
}
Sql.existingConnection conn
|> Sql.executeTransactionAsync
(sql
|> Seq.map (fun s ->
let parts = s.Split ' '
if parts[1].ToLowerInvariant () = "table" then
log.LogInformation $"Creating {parts[2]} table..."
s, [ [] ])
|> List.ofSeq)
|> Async.AwaitTask
|> Async.RunSynchronously
|> ignore
}
/// Set a specific database version
let setDbVersion version = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')"
|> Sql.executeNonQueryAsync
()
}
/// Do required data migration between versions
let migrate version = backgroundTask {
match version with
| Some "v2-rc2" -> ()
// Future versions will be inserted here
| Some _
| None ->
log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
do! setDbVersion Utils.currentDbVersion
}
interface IData with
member _.Category = PostgresCategoryData conn
member _.Page = PostgresPageData (conn, ser)
member _.Post = PostgresPostData (conn, ser)
member _.TagMap = PostgresTagMapData conn
member _.Theme = PostgresThemeData conn
member _.ThemeAsset = PostgresThemeAssetData conn
member _.Upload = PostgresUploadData conn
member _.WebLog = PostgresWebLogData (conn, ser)
member _.WebLogUser = PostgresWebLogUserData conn
member _.Serializer = ser
member _.StartUp () = backgroundTask {
do! ensureTables ()
let! version =
Sql.existingConnection conn
|> Sql.query "SELECT id FROM db_version"
|> Sql.executeAsync (fun row -> row.string "id")
|> tryHead
match version with
| Some v when v = Utils.currentDbVersion -> ()
| Some _
| None -> do! migrate version
}

File diff suppressed because it is too large Load Diff

View File

@@ -5,6 +5,8 @@ module MyWebLog.Data.SQLite.Helpers
open System open System
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open MyWebLog open MyWebLog
open MyWebLog.Data
open NodaTime.Text
/// Run a command that returns a count /// Run a command that returns a count
let count (cmd : SqliteCommand) = backgroundTask { let count (cmd : SqliteCommand) = backgroundTask {
@@ -12,23 +14,6 @@ let count (cmd : SqliteCommand) = backgroundTask {
return int (it :?> int64) return int (it :?> int64)
} }
/// Get lists of items removed from and added to the given lists
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))
List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems
/// Find meta items added and removed
let diffMetaItems (oldItems : MetaItem list) newItems =
diffLists oldItems newItems (fun item -> $"{item.name}|{item.value}")
/// Find the permalinks added and removed
let diffPermalinks oldLinks newLinks =
diffLists oldLinks newLinks Permalink.toString
/// Find the revisions added and removed
let diffRevisions oldRevs newRevs =
diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.asOf.Ticks}|{MarkupText.toString rev.text}")
/// Create a list of items from the given data reader /// Create a list of items from the given data reader
let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) = let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) =
seq { while rdr.Read () do it rdr } seq { while rdr.Read () do it rdr }
@@ -39,8 +24,7 @@ let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (it : SqliteDataReader ->
if rdr.Read () then if rdr.Read () then
let item = it rdr let item = it rdr
if prop item = webLogId then Some item else None if prop item = webLogId then Some item else None
else else None
None
/// Execute a command that returns no data /// Execute a command that returns no data
let write (cmd : SqliteCommand) = backgroundTask { let write (cmd : SqliteCommand) = backgroundTask {
@@ -48,6 +32,42 @@ let write (cmd : SqliteCommand) = backgroundTask {
() ()
} }
/// Add a possibly-missing parameter, substituting null for None
let maybe<'T> (it : 'T option) : obj = match it with Some x -> x :> obj | None -> DBNull.Value
/// Create a value for a Duration
let durationParam =
DurationPattern.Roundtrip.Format
/// Create a value for an Instant
let instantParam =
InstantPattern.General.Format
/// Create an optional value for a Duration
let maybeDuration =
Option.map durationParam >> maybe
/// Create an optional value for an Instant
let maybeInstant =
Option.map instantParam >> maybe
/// 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 =
@@ -74,6 +94,26 @@ module Map =
/// Get a string value from a data reader /// Get a string value from a data reader
let getString col (rdr : SqliteDataReader) = rdr.GetString (rdr.GetOrdinal col) let getString col (rdr : SqliteDataReader) = rdr.GetString (rdr.GetOrdinal col)
/// Parse a Duration from the given value
let parseDuration value =
match DurationPattern.Roundtrip.Parse value with
| it when it.Success -> it.Value
| it -> raise it.Exception
/// Get a Duration value from a data reader
let getDuration col rdr =
getString col rdr |> parseDuration
/// Parse an Instant from the given value
let parseInstant value =
match InstantPattern.General.Parse value with
| it when it.Success -> it.Value
| it -> raise it.Exception
/// Get an Instant value from a data reader
let getInstant col rdr =
getString col rdr |> parseInstant
/// Get a timespan value from a data reader /// Get a timespan value from a data reader
let getTimeSpan col (rdr : SqliteDataReader) = rdr.GetTimeSpan (rdr.GetOrdinal col) let getTimeSpan col (rdr : SqliteDataReader) = rdr.GetTimeSpan (rdr.GetOrdinal col)
@@ -97,138 +137,103 @@ module Map =
let tryString col (rdr : SqliteDataReader) = let tryString col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr) if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr)
/// Get a possibly null Duration value from a data reader
let tryDuration col rdr =
tryString col rdr |> Option.map parseDuration
/// Get a possibly null Instant value from a data reader
let tryInstant col rdr =
tryString col rdr |> Option.map parseInstant
/// Get a possibly null timespan value from a data reader /// Get a possibly null timespan value from a data reader
let tryTimeSpan col (rdr : SqliteDataReader) = let tryTimeSpan col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr) if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
/// Create a category ID from the current row in the given data reader /// Map an id field to a category ID
let toCategoryId = getString "id" >> CategoryId let toCategoryId rdr = getString "id" rdr |> CategoryId
/// Create a category from the current row in the given data reader /// Create a category from the current row in the given data reader
let toCategory (rdr : SqliteDataReader) : Category = let toCategory rdr : Category =
{ id = toCategoryId rdr { Id = toCategoryId rdr
webLogId = WebLogId (getString "web_log_id" rdr) WebLogId = getString "web_log_id" rdr |> WebLogId
name = getString "name" rdr Name = getString "name" rdr
slug = getString "slug" rdr Slug = getString "slug" rdr
description = tryString "description" rdr Description = tryString "description" rdr
parentId = tryString "parent_id" rdr |> Option.map CategoryId ParentId = tryString "parent_id" rdr |> Option.map CategoryId
} }
/// Create a custom feed from the current row in the given data reader /// Create a custom feed from the current row in the given data reader
let toCustomFeed (rdr : SqliteDataReader) : CustomFeed = let toCustomFeed ser rdr : CustomFeed =
{ id = CustomFeedId (getString "id" rdr) { Id = getString "id" rdr |> CustomFeedId
source = CustomFeedSource.parse (getString "source" rdr) Source = getString "source" rdr |> CustomFeedSource.parse
path = Permalink (getString "path" rdr) Path = getString "path" rdr |> Permalink
podcast = Podcast = tryString "podcast" rdr |> Option.map (Utils.deserialize ser)
if rdr.IsDBNull (rdr.GetOrdinal "title") then
None
else
Some {
title = getString "title" rdr
subtitle = tryString "subtitle" rdr
itemsInFeed = getInt "items_in_feed" rdr
summary = getString "summary" rdr
displayedAuthor = getString "displayed_author" rdr
email = getString "email" rdr
imageUrl = Permalink (getString "image_url" rdr)
iTunesCategory = getString "itunes_category" rdr
iTunesSubcategory = tryString "itunes_subcategory" rdr
explicit = ExplicitRating.parse (getString "explicit" rdr)
defaultMediaType = tryString "default_media_type" rdr
mediaBaseUrl = tryString "media_base_url" rdr
guid = tryGuid "guid" rdr
fundingUrl = tryString "funding_url" rdr
fundingText = tryString "funding_text" rdr
medium = tryString "medium" rdr |> Option.map PodcastMedium.parse
}
}
/// Create a meta item from the current row in the given data reader
let toMetaItem (rdr : SqliteDataReader) : MetaItem =
{ name = getString "name" rdr
value = getString "value" rdr
} }
/// Create a permalink from the current row in the given data reader /// Create a permalink from the current row in the given data reader
let toPermalink = getString "permalink" >> Permalink let toPermalink rdr = getString "permalink" rdr |> Permalink
/// Create a page from the current row in the given data reader /// Create a page from the current row in the given data reader
let toPage (rdr : SqliteDataReader) : Page = let toPage ser rdr : Page =
{ Page.empty with { Page.empty with
id = PageId (getString "id" rdr) Id = getString "id" rdr |> PageId
webLogId = WebLogId (getString "web_log_id" rdr) WebLogId = getString "web_log_id" rdr |> WebLogId
authorId = WebLogUserId (getString "author_id" rdr) AuthorId = getString "author_id" rdr |> WebLogUserId
title = getString "title" rdr Title = getString "title" rdr
permalink = toPermalink rdr Permalink = toPermalink rdr
publishedOn = getDateTime "published_on" rdr PublishedOn = getInstant "published_on" rdr
updatedOn = getDateTime "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
showInPageList = getBoolean "show_in_page_list" rdr IsInPageList = getBoolean "is_in_page_list" rdr
template = tryString "template" rdr Template = tryString "template" rdr
text = getString "page_text" rdr Text = getString "page_text" rdr
Metadata = tryString "meta_items" rdr
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
} }
/// Create a post from the current row in the given data reader /// Create a post from the current row in the given data reader
let toPost (rdr : SqliteDataReader) : Post = let toPost ser rdr : Post =
{ Post.empty with { Post.empty with
id = PostId (getString "id" rdr) Id = getString "id" rdr |> PostId
webLogId = WebLogId (getString "web_log_id" rdr) WebLogId = getString "web_log_id" rdr |> WebLogId
authorId = WebLogUserId (getString "author_id" rdr) AuthorId = getString "author_id" rdr |> WebLogUserId
status = PostStatus.parse (getString "status" rdr) Status = getString "status" rdr |> PostStatus.parse
title = getString "title" rdr Title = getString "title" rdr
permalink = toPermalink rdr Permalink = toPermalink rdr
publishedOn = tryDateTime "published_on" rdr PublishedOn = tryInstant "published_on" rdr
updatedOn = getDateTime "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
template = tryString "template" rdr Template = tryString "template" rdr
text = getString "post_text" rdr Text = getString "post_text" rdr
episode = Episode = tryString "episode" rdr |> Option.map (Utils.deserialize ser)
match tryString "media" rdr with Metadata = tryString "meta_items" rdr
| Some media -> |> Option.map (Utils.deserialize ser)
Some { |> Option.defaultValue []
media = media
length = getLong "length" rdr
duration = tryTimeSpan "duration" rdr
mediaType = tryString "media_type" rdr
imageUrl = tryString "image_url" rdr
subtitle = tryString "subtitle" rdr
explicit = tryString "explicit" rdr |> Option.map ExplicitRating.parse
chapterFile = tryString "chapter_file" rdr
chapterType = tryString "chapter_type" rdr
transcriptUrl = tryString "transcript_url" rdr
transcriptType = tryString "transcript_type" rdr
transcriptLang = tryString "transcript_lang" rdr
transcriptCaptions = tryBoolean "transcript_captions" rdr
seasonNumber = tryInt "season_number" rdr
seasonDescription = tryString "season_description" rdr
episodeNumber = tryString "episode_number" rdr |> Option.map Double.Parse
episodeDescription = tryString "episode_description" rdr
}
| None -> None
} }
/// Create a revision from the current row in the given data reader /// Create a revision from the current row in the given data reader
let toRevision (rdr : SqliteDataReader) : Revision = let toRevision rdr : Revision =
{ asOf = getDateTime "as_of" rdr { AsOf = getInstant "as_of" rdr
text = MarkupText.parse (getString "revision_text" rdr) Text = getString "revision_text" rdr |> MarkupText.parse
} }
/// Create a tag mapping from the current row in the given data reader /// Create a tag mapping from the current row in the given data reader
let toTagMap (rdr : SqliteDataReader) : TagMap = let toTagMap rdr : TagMap =
{ id = TagMapId (getString "id" rdr) { Id = getString "id" rdr |> TagMapId
webLogId = WebLogId (getString "web_log_id" rdr) WebLogId = getString "web_log_id" rdr |> WebLogId
tag = getString "tag" rdr Tag = getString "tag" rdr
urlValue = getString "url_value" rdr UrlValue = getString "url_value" rdr
} }
/// Create a theme from the current row in the given data reader (excludes templates) /// Create a theme from the current row in the given data reader (excludes templates)
let toTheme (rdr : SqliteDataReader) : Theme = let toTheme rdr : Theme =
{ Theme.empty with { Theme.empty with
id = ThemeId (getString "id" rdr) Id = getString "id" rdr |> ThemeId
name = getString "name" rdr Name = getString "name" rdr
version = getString "version" rdr Version = getString "version" rdr
} }
/// Create a theme asset from the current row in the given data reader /// Create a theme asset from the current row in the given data reader
let toThemeAsset includeData (rdr : SqliteDataReader) : ThemeAsset = let toThemeAsset includeData rdr : ThemeAsset =
let assetData = let assetData =
if includeData then if includeData then
use dataStream = new MemoryStream () use dataStream = new MemoryStream ()
@@ -237,19 +242,19 @@ module Map =
dataStream.ToArray () dataStream.ToArray ()
else else
[||] [||]
{ id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr) { Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
updatedOn = getDateTime "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
data = assetData Data = assetData
} }
/// Create a theme template from the current row in the given data reader /// Create a theme template from the current row in the given data reader
let toThemeTemplate (rdr : SqliteDataReader) : ThemeTemplate = let toThemeTemplate includeText rdr : ThemeTemplate =
{ name = getString "name" rdr { Name = getString "name" rdr
text = getString "template" rdr Text = if includeText then getString "template" rdr else ""
} }
/// Create an uploaded file from the current row in the given data reader /// Create an uploaded file from the current row in the given data reader
let toUpload includeData (rdr : SqliteDataReader) : Upload = let toUpload includeData rdr : Upload =
let data = let data =
if includeData then if includeData then
use dataStream = new MemoryStream () use dataStream = new MemoryStream ()
@@ -258,54 +263,52 @@ module Map =
dataStream.ToArray () dataStream.ToArray ()
else else
[||] [||]
{ id = UploadId (getString "id" rdr) { Id = getString "id" rdr |> UploadId
webLogId = WebLogId (getString "web_log_id" rdr) WebLogId = getString "web_log_id" rdr |> WebLogId
path = Permalink (getString "path" rdr) Path = getString "path" rdr |> Permalink
updatedOn = getDateTime "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
data = data Data = data
} }
/// Create a web log from the current row in the given data reader /// Create a web log from the current row in the given data reader
let toWebLog (rdr : SqliteDataReader) : WebLog = let toWebLog rdr : WebLog =
{ id = WebLogId (getString "id" rdr) { Id = getString "id" rdr |> WebLogId
name = getString "name" rdr Name = getString "name" rdr
slug = getString "slug" rdr Slug = getString "slug" rdr
subtitle = tryString "subtitle" rdr Subtitle = tryString "subtitle" rdr
defaultPage = getString "default_page" rdr DefaultPage = getString "default_page" rdr
postsPerPage = getInt "posts_per_page" rdr PostsPerPage = getInt "posts_per_page" rdr
themePath = getString "theme_id" rdr ThemeId = getString "theme_id" rdr |> ThemeId
urlBase = getString "url_base" rdr UrlBase = getString "url_base" rdr
timeZone = getString "time_zone" rdr TimeZone = getString "time_zone" rdr
autoHtmx = getBoolean "auto_htmx" rdr AutoHtmx = getBoolean "auto_htmx" rdr
uploads = UploadDestination.parse (getString "uploads" rdr) Uploads = getString "uploads" rdr |> UploadDestination.parse
rss = { Rss = {
feedEnabled = getBoolean "feed_enabled" rdr IsFeedEnabled = getBoolean "is_feed_enabled" rdr
feedName = getString "feed_name" rdr FeedName = getString "feed_name" rdr
itemsInFeed = tryInt "items_in_feed" rdr ItemsInFeed = tryInt "items_in_feed" rdr
categoryEnabled = getBoolean "category_enabled" rdr IsCategoryEnabled = getBoolean "is_category_enabled" rdr
tagEnabled = getBoolean "tag_enabled" rdr IsTagEnabled = getBoolean "is_tag_enabled" rdr
copyright = tryString "copyright" rdr Copyright = tryString "copyright" rdr
customFeeds = [] CustomFeeds = []
} }
} }
/// Create a web log user from the current row in the given data reader /// Create a web log user from the current row in the given data reader
let toWebLogUser (rdr : SqliteDataReader) : WebLogUser = let toWebLogUser rdr : WebLogUser =
{ id = WebLogUserId (getString "id" rdr) { Id = getString "id" rdr |> WebLogUserId
webLogId = WebLogId (getString "web_log_id" rdr) WebLogId = getString "web_log_id" rdr |> WebLogId
userName = getString "user_name" rdr Email = getString "email" rdr
firstName = getString "first_name" rdr FirstName = getString "first_name" rdr
lastName = getString "last_name" rdr LastName = getString "last_name" rdr
preferredName = getString "preferred_name" rdr PreferredName = getString "preferred_name" rdr
passwordHash = getString "password_hash" rdr PasswordHash = getString "password_hash" rdr
salt = getGuid "salt" rdr Url = tryString "url" rdr
url = tryString "url" rdr AccessLevel = getString "access_level" rdr |> AccessLevel.parse
authorizationLevel = AuthorizationLevel.parse (getString "authorization_level" rdr) CreatedOn = getInstant "created_on" rdr
LastSeenOn = tryInstant "last_seen_on" rdr
} }
/// Add a possibly-missing parameter, substituting null for None
let maybe<'T> (it : 'T option) : obj = match it with Some x -> x :> obj | None -> DBNull.Value
/// Add a web log ID parameter /// Add a web log ID parameter
let addWebLogId (cmd : SqliteCommand) webLogId = let addWebLogId (cmd : SqliteCommand) webLogId =
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore

View File

@@ -10,23 +10,23 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Add parameters for category INSERT or UPDATE statements /// Add parameters for category INSERT or UPDATE statements
let addCategoryParameters (cmd : SqliteCommand) (cat : Category) = let addCategoryParameters (cmd : SqliteCommand) (cat : Category) =
[ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.id) [ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.webLogId) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId)
cmd.Parameters.AddWithValue ("@name", cat.name) cmd.Parameters.AddWithValue ("@name", cat.Name)
cmd.Parameters.AddWithValue ("@slug", cat.slug) cmd.Parameters.AddWithValue ("@slug", cat.Slug)
cmd.Parameters.AddWithValue ("@description", maybe cat.description) cmd.Parameters.AddWithValue ("@description", maybe cat.Description)
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.parentId |> Option.map CategoryId.toString)) cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
] |> ignore ] |> ignore
/// Add a category /// Add a category
let add cat = backgroundTask { let add cat = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO category ( "INSERT INTO category (
id, web_log_id, name, slug, description, parent_id id, web_log_id, name, slug, description, parent_id
) VALUES ( ) VALUES (
@id, @webLogId, @name, @slug, @description, @parentId @id, @webLogId, @name, @slug, @description, @parentId
)""" )"
addCategoryParameters cmd cat addCategoryParameters cmd cat
let! _ = cmd.ExecuteNonQueryAsync () let! _ = cmd.ExecuteNonQueryAsync ()
() ()
@@ -60,7 +60,7 @@ type SQLiteCategoryData (conn : SqliteConnection) =
while rdr.Read () do while rdr.Read () do
Map.toCategory rdr Map.toCategory rdr
} }
|> Seq.sortBy (fun cat -> cat.name.ToLowerInvariant ()) |> Seq.sortBy (fun cat -> cat.Name.ToLowerInvariant ())
|> List.ofSeq |> List.ofSeq
do! rdr.CloseAsync () do! rdr.CloseAsync ()
let ordered = Utils.orderByHierarchy cats None None [] let ordered = Utils.orderByHierarchy cats None None []
@@ -68,34 +68,33 @@ type SQLiteCategoryData (conn : SqliteConnection) =
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 =
ordered
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|> Seq.map (fun cat -> cat.Id)
|> Seq.append (Seq.singleton it.Id)
|> List.ofSeq
|> inClause "AND pc.category_id" "catId" id
cmd.Parameters.Clear () cmd.Parameters.Clear ()
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.CommandText <- """ cmd.Parameters.AddRange catParams
cmd.CommandText <- $"
SELECT COUNT(DISTINCT p.id) SELECT COUNT(DISTINCT p.id)
FROM post p FROM post p
INNER JOIN post_category pc ON pc.post_id = p.id INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = 'Published' AND p.status = 'Published'
AND pc.category_id IN (""" {catSql}"
ordered
|> Seq.filter (fun cat -> cat.parentNames |> Array.contains it.name)
|> Seq.map (fun cat -> cat.id)
|> Seq.append (Seq.singleton it.id)
|> Seq.iteri (fun idx item ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@catId{idx}"
cmd.Parameters.AddWithValue ($"@catId{idx}", item) |> ignore)
cmd.CommandText <- $"{cmd.CommandText})"
let! postCount = count cmd let! postCount = count cmd
return it.id, postCount return it.Id, postCount
}) })
|> Task.WhenAll |> Task.WhenAll
return return
ordered ordered
|> Seq.map (fun cat -> |> Seq.map (fun cat ->
{ cat with { cat with
postCount = counts PostCount = counts
|> Array.tryFind (fun c -> fst c = cat.id) |> Array.tryFind (fun c -> fst c = cat.Id)
|> Option.map snd |> Option.map snd
|> Option.defaultValue 0 |> Option.defaultValue 0
}) })
@@ -107,7 +106,7 @@ type SQLiteCategoryData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT * FROM category WHERE id = @id" cmd.CommandText <- "SELECT * FROM category WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) |> ignore cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<Category> webLogId (fun c -> c.webLogId) Map.toCategory rdr return Helpers.verifyWebLog<Category> webLogId (fun c -> c.WebLogId) Map.toCategory rdr
} }
/// Find all categories for the given web log /// Find all categories for the given web log
@@ -122,23 +121,29 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Delete a category /// Delete a category
let delete catId webLogId = backgroundTask { let delete catId webLogId = backgroundTask {
match! findById catId webLogId with match! findById catId webLogId with
| Some _ -> | Some cat ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
// Delete the category off all posts where it is assigned // Reassign any children to the category's parent category
cmd.CommandText <- """ cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE parent_id = @parentId"
DELETE FROM post_category cmd.Parameters.AddWithValue ("@parentId", CategoryId.toString catId) |> ignore
WHERE category_id = @id let! children = count cmd
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)""" if children > 0 then
let catIdParameter = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) cmd.CommandText <- "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId"
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
do! write cmd |> ignore
// Delete the category itself do! write cmd
cmd.CommandText <- "DELETE FROM category WHERE id = @id" // Delete the category off all posts where it is assigned, and the category itself
cmd.CommandText <-
"DELETE FROM post_category
WHERE category_id = @id
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId);
DELETE FROM category WHERE id = @id"
cmd.Parameters.Clear () cmd.Parameters.Clear ()
cmd.Parameters.Add catIdParameter |> ignore let _ = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
addWebLogId cmd webLogId
do! write cmd do! write cmd
return true return if children = 0 then CategoryDeleted else ReassignedChildCategories
| None -> return false | None -> return CategoryNotFound
} }
/// Restore categories from a backup /// Restore categories from a backup
@@ -150,25 +155,25 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Update a category /// Update a category
let update cat = backgroundTask { let update cat = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
UPDATE category "UPDATE category
SET name = @name, SET name = @name,
slug = @slug, slug = @slug,
description = @description, description = @description,
parent_id = @parentId parent_id = @parentId
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId""" AND web_log_id = @webLogId"
addCategoryParameters cmd cat addCategoryParameters cmd cat
do! write cmd do! write cmd
} }
interface ICategoryData with interface ICategoryData with
member _.add cat = add cat member _.Add cat = add cat
member _.countAll webLogId = countAll webLogId member _.CountAll webLogId = countAll webLogId
member _.countTopLevel webLogId = countTopLevel webLogId member _.CountTopLevel webLogId = countTopLevel webLogId
member _.findAllForView webLogId = findAllForView webLogId member _.FindAllForView webLogId = findAllForView webLogId
member _.findById catId webLogId = findById catId webLogId member _.FindById catId webLogId = findById catId webLogId
member _.findByWebLog webLogId = findByWebLog webLogId member _.FindByWebLog webLogId = findByWebLog webLogId
member _.delete catId webLogId = delete catId webLogId member _.Delete catId webLogId = delete catId webLogId
member _.restore cats = restore cats member _.Restore cats = restore cats
member _.update cat = update cat member _.Update cat = update cat

View File

@@ -4,91 +4,61 @@ open System.Threading.Tasks
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
/// SQLite myWebLog page data implementation /// SQLite myWebLog page data implementation
type SQLitePageData (conn : SqliteConnection) = type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// Add parameters for page INSERT or UPDATE statements /// Add parameters for page INSERT or UPDATE statements
let addPageParameters (cmd : SqliteCommand) (page : Page) = let addPageParameters (cmd : SqliteCommand) (page : Page) =
[ cmd.Parameters.AddWithValue ("@id", PageId.toString page.id) [ cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.webLogId) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.authorId) cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId)
cmd.Parameters.AddWithValue ("@title", page.title) cmd.Parameters.AddWithValue ("@title", page.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.permalink) cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", page.publishedOn) cmd.Parameters.AddWithValue ("@publishedOn", instantParam page.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", page.updatedOn) cmd.Parameters.AddWithValue ("@updatedOn", instantParam page.UpdatedOn)
cmd.Parameters.AddWithValue ("@showInPageList", page.showInPageList) cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
cmd.Parameters.AddWithValue ("@template", maybe page.template) cmd.Parameters.AddWithValue ("@template", maybe page.Template)
cmd.Parameters.AddWithValue ("@text", page.text) cmd.Parameters.AddWithValue ("@text", page.Text)
cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty page.Metadata then None
else Some (Utils.serialize ser page.Metadata)))
] |> ignore ] |> ignore
/// Append meta items to a page
let appendPageMeta (page : Page) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT name, value FROM page_meta WHERE page_id = @id"
cmd.Parameters.AddWithValue ("@id", PageId.toString page.id) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return { page with metadata = toList Map.toMetaItem rdr }
}
/// Append revisions and permalinks to a page /// Append revisions and permalinks to a page
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask { let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.id) |> ignore cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.Id) |> ignore
cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId" cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let page = { page with priorPermalinks = toList Map.toPermalink rdr } let page = { page with PriorPermalinks = toList Map.toPermalink rdr }
do! rdr.CloseAsync () do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC" cmd.CommandText <- "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return { page with revisions = toList Map.toRevision rdr } return { page with Revisions = toList Map.toRevision rdr }
} }
/// Return a page with no text (or meta items, prior permalinks, or revisions) /// Shorthand for mapping a data reader to a page
let pageWithoutTextOrMeta rdr = let toPage =
{ Map.toPage rdr with text = "" } Map.toPage ser
/// Update a page's metadata items /// Return a page with no text (or prior permalinks or revisions)
let updatePageMeta pageId oldItems newItems = backgroundTask { let pageWithoutText rdr =
let toDelete, toAdd = diffMetaItems oldItems newItems { toPage rdr with Text = "" }
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
cmd.Parameters.Add ("@name", SqliteType.Text)
cmd.Parameters.Add ("@value", SqliteType.Text)
] |> ignore
let runCmd (item : MetaItem) = backgroundTask {
cmd.Parameters["@name" ].Value <- item.name
cmd.Parameters["@value"].Value <- item.value
do! write cmd
}
cmd.CommandText <- "DELETE FROM page_meta WHERE page_id = @pageId AND name = @name AND value = @value"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO page_meta VALUES (@pageId, @name, @value)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a page's prior permalinks /// Update a page's prior permalinks
let updatePagePermalinks pageId oldLinks newLinks = backgroundTask { let updatePagePermalinks pageId oldLinks newLinks = backgroundTask {
let toDelete, toAdd = diffPermalinks oldLinks newLinks let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
if List.isEmpty toDelete && List.isEmpty toAdd then if List.isEmpty toDelete && List.isEmpty toAdd then
return () return ()
else else
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId) [ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
cmd.Parameters.Add ("@link", SqliteType.Text) cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore ] |> ignore
let runCmd link = backgroundTask { let runCmd link = backgroundTask {
cmd.Parameters["@link"].Value <- Permalink.toString link cmd.Parameters["@link"].Value <- Permalink.toString link
@@ -108,17 +78,17 @@ type SQLitePageData (conn : SqliteConnection) =
/// Update a page's revisions /// Update a page's revisions
let updatePageRevisions pageId oldRevs newRevs = backgroundTask { let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
let toDelete, toAdd = diffRevisions oldRevs newRevs let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if List.isEmpty toDelete && List.isEmpty toAdd then if List.isEmpty toDelete && List.isEmpty toAdd then
return () return ()
else else
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask { let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear () cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId) [ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
cmd.Parameters.AddWithValue ("@asOf", rev.asOf) cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore ] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.text) |> ignore if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
do! write cmd do! write cmd
} }
cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf" cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf"
@@ -139,19 +109,18 @@ type SQLitePageData (conn : SqliteConnection) =
let add page = backgroundTask { let add page = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
// The page itself // The page itself
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO page ( "INSERT INTO page (
id, web_log_id, author_id, title, permalink, published_on, updated_on, show_in_page_list, template, id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template,
page_text page_text, meta_items
) VALUES ( ) VALUES (
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @showInPageList, @template, @id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template,
@text @text, @metaItems
)""" )"
addPageParameters cmd page addPageParameters cmd page
do! write cmd do! write cmd
do! updatePageMeta page.id [] page.metadata do! updatePagePermalinks page.Id [] page.PriorPermalinks
do! updatePagePermalinks page.id [] page.priorPermalinks do! updatePageRevisions page.Id [] page.Revisions
do! updatePageRevisions page.id [] page.revisions
} }
/// Get all pages for a web log (without text, revisions, prior permalinks, or metadata) /// Get all pages for a web log (without text, revisions, prior permalinks, or metadata)
@@ -160,7 +129,7 @@ type SQLitePageData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)" cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)"
addWebLogId cmd webLogId addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return toList pageWithoutTextOrMeta rdr return toList pageWithoutText rdr
} }
/// Count all pages for the given web log /// Count all pages for the given web log
@@ -174,13 +143,13 @@ type SQLitePageData (conn : SqliteConnection) =
/// 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 = backgroundTask { let countListed webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
SELECT COUNT(id) "SELECT COUNT(id)
FROM page FROM page
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList""" AND is_in_page_list = @isInPageList"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
return! count cmd return! count cmd
} }
@@ -190,11 +159,7 @@ type SQLitePageData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT * FROM page WHERE id = @id" cmd.CommandText <- "SELECT * FROM page WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
match Helpers.verifyWebLog<Page> webLogId (fun it -> it.webLogId) Map.toPage rdr with return Helpers.verifyWebLog<Page> webLogId (fun it -> it.WebLogId) (Map.toPage ser) rdr
| Some page ->
let! page = appendPageMeta page
return Some page
| None -> return None
} }
/// Find a complete page by its ID /// Find a complete page by its ID
@@ -211,11 +176,10 @@ type SQLitePageData (conn : SqliteConnection) =
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
cmd.CommandText <- """ cmd.CommandText <-
DELETE FROM page_revision WHERE page_id = @id; "DELETE FROM page_revision WHERE page_id = @id;
DELETE FROM page_permalink WHERE page_id = @id; DELETE FROM page_permalink WHERE page_id = @id;
DELETE FROM page_meta WHERE page_id = @id; DELETE FROM page WHERE id = @id"
DELETE FROM page WHERE id = @id"""
do! write cmd do! write cmd
return true return true
| None -> return false | None -> return false
@@ -228,29 +192,21 @@ type SQLitePageData (conn : SqliteConnection) =
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then return if rdr.Read () then Some (toPage rdr) else None
let! page = appendPageMeta (Map.toPage rdr)
return Some page
else
return None
} }
/// 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 webLogId = backgroundTask { let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ let linkSql, linkParams = inClause "AND pp.permalink" "link" Permalink.toString permalinks
cmd.CommandText <- $"
SELECT p.permalink SELECT p.permalink
FROM page p FROM page p
INNER JOIN page_permalink pp ON pp.page_id = p.id INNER JOIN page_permalink pp ON pp.page_id = p.id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND pp.permalink IN (""" {linkSql}"
permalinks
|> List.iteri (fun idx link ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@link{idx}"
cmd.Parameters.AddWithValue ($"@link{idx}", Permalink.toString link) |> ignore)
cmd.CommandText <- $"{cmd.CommandText})"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddRange linkParams
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toPermalink rdr) else None return if rdr.Read () then Some (Map.toPermalink rdr) else None
} }
@@ -262,11 +218,8 @@ type SQLitePageData (conn : SqliteConnection) =
addWebLogId cmd webLogId addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! pages = let! pages =
toList Map.toPage rdr toList toPage rdr
|> List.map (fun page -> backgroundTask { |> List.map (fun page -> backgroundTask { return! appendPageRevisionsAndPermalinks page })
let! page = appendPageMeta page
return! appendPageRevisionsAndPermalinks page
})
|> Task.WhenAll |> Task.WhenAll
return List.ofArray pages return List.ofArray pages
} }
@@ -274,37 +227,33 @@ type SQLitePageData (conn : SqliteConnection) =
/// Get all listed pages for the given web log (without revisions, prior permalinks, or text) /// Get all listed pages for the given web log (without revisions, prior permalinks, or text)
let findListed webLogId = backgroundTask { let findListed webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
SELECT * "SELECT *
FROM page FROM page
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList AND is_in_page_list = @isInPageList
ORDER BY LOWER(title)""" ORDER BY LOWER(title)"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! pages = return toList pageWithoutText rdr
toList pageWithoutTextOrMeta rdr
|> List.map (fun page -> backgroundTask { return! appendPageMeta page })
|> Task.WhenAll
return List.ofArray pages
} }
/// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata) /// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata)
let findPageOfPages webLogId pageNbr = backgroundTask { let findPageOfPages webLogId pageNbr = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
SELECT * "SELECT *
FROM page FROM page
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
ORDER BY LOWER(title) ORDER BY LOWER(title)
LIMIT @pageSize OFFSET @toSkip""" LIMIT @pageSize OFFSET @toSkip"
addWebLogId cmd webLogId addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@pageSize", 26) [ cmd.Parameters.AddWithValue ("@pageSize", 26)
cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25) cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25)
] |> ignore ] |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toPage rdr return toList toPage rdr
} }
/// Restore pages from a backup /// Restore pages from a backup
@@ -315,26 +264,26 @@ type SQLitePageData (conn : SqliteConnection) =
/// Update a page /// Update a page
let update (page : Page) = backgroundTask { let update (page : Page) = backgroundTask {
match! findFullById page.id page.webLogId with match! findFullById page.Id page.WebLogId with
| Some oldPage -> | Some oldPage ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
UPDATE page "UPDATE page
SET author_id = @authorId, SET author_id = @authorId,
title = @title, title = @title,
permalink = @permalink, permalink = @permalink,
published_on = @publishedOn, published_on = @publishedOn,
updated_on = @updatedOn, updated_on = @updatedOn,
show_in_page_list = @showInPageList, is_in_page_list = @isInPageList,
template = @template, template = @template,
page_text = @text page_text = @text,
WHERE id = @pageId meta_items = @metaItems
AND web_log_id = @webLogId""" WHERE id = @id
AND web_log_id = @webLogId"
addPageParameters cmd page addPageParameters cmd page
do! write cmd do! write cmd
do! updatePageMeta page.id oldPage.metadata page.metadata do! updatePagePermalinks page.Id oldPage.PriorPermalinks page.PriorPermalinks
do! updatePagePermalinks page.id oldPage.priorPermalinks page.priorPermalinks do! updatePageRevisions page.Id oldPage.Revisions page.Revisions
do! updatePageRevisions page.id oldPage.revisions page.revisions
return () return ()
| None -> return () | None -> return ()
} }
@@ -343,24 +292,24 @@ type SQLitePageData (conn : SqliteConnection) =
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask { let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
match! findFullById pageId webLogId with match! findFullById pageId webLogId with
| Some page -> | Some page ->
do! updatePagePermalinks pageId page.priorPermalinks permalinks do! updatePagePermalinks pageId page.PriorPermalinks permalinks
return true return true
| None -> return false | None -> return false
} }
interface IPageData with interface IPageData with
member _.add page = add page member _.Add page = add page
member _.all webLogId = all webLogId member _.All webLogId = all webLogId
member _.countAll webLogId = countAll webLogId member _.CountAll webLogId = countAll webLogId
member _.countListed webLogId = countListed webLogId member _.CountListed webLogId = countListed webLogId
member _.delete pageId webLogId = delete pageId webLogId member _.Delete pageId webLogId = delete pageId webLogId
member _.findById pageId webLogId = findById pageId webLogId member _.FindById pageId webLogId = findById pageId webLogId
member _.findByPermalink permalink webLogId = findByPermalink permalink webLogId member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId
member _.findCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
member _.findFullById pageId webLogId = findFullById pageId webLogId member _.FindFullById pageId webLogId = findFullById pageId webLogId
member _.findFullByWebLog webLogId = findFullByWebLog webLogId member _.FindFullByWebLog webLogId = findFullByWebLog webLogId
member _.findListed webLogId = findListed webLogId member _.FindListed webLogId = findListed webLogId
member _.findPageOfPages webLogId pageNbr = findPageOfPages webLogId pageNbr member _.FindPageOfPages webLogId pageNbr = findPageOfPages webLogId pageNbr
member _.restore pages = restore pages member _.Restore pages = restore pages
member _.update page = update page member _.Update page = update page
member _.updatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks member _.UpdatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks

View File

@@ -1,99 +1,95 @@
namespace MyWebLog.Data.SQLite namespace MyWebLog.Data.SQLite
open System
open System.Threading.Tasks open System.Threading.Tasks
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open NodaTime
/// SQLite myWebLog post data implementation /// SQLite myWebLog post data implementation
type SQLitePostData (conn : SqliteConnection) = type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// Add parameters for post INSERT or UPDATE statements /// Add parameters for post INSERT or UPDATE statements
let addPostParameters (cmd : SqliteCommand) (post : Post) = let addPostParameters (cmd : SqliteCommand) (post : Post) =
[ cmd.Parameters.AddWithValue ("@id", PostId.toString post.id) [ cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.webLogId) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.authorId) cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId)
cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.status) cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status)
cmd.Parameters.AddWithValue ("@title", post.title) cmd.Parameters.AddWithValue ("@title", post.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.permalink) cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", maybe post.publishedOn) cmd.Parameters.AddWithValue ("@publishedOn", maybeInstant post.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", post.updatedOn) cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn)
cmd.Parameters.AddWithValue ("@template", maybe post.template) cmd.Parameters.AddWithValue ("@template", maybe post.Template)
cmd.Parameters.AddWithValue ("@text", post.text) cmd.Parameters.AddWithValue ("@text", post.Text)
cmd.Parameters.AddWithValue ("@episode", maybe (if Option.isSome post.Episode then
Some (Utils.serialize ser post.Episode)
else None))
cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty post.Metadata then None
else Some (Utils.serialize ser post.Metadata)))
] |> ignore ] |> ignore
/// Add parameters for episode INSERT or UPDATE statements /// Append category IDs and tags to a post
let addEpisodeParameters (cmd : SqliteCommand) (ep : Episode) = let appendPostCategoryAndTag (post : Post) = backgroundTask {
[ cmd.Parameters.AddWithValue ("@media", ep.media)
cmd.Parameters.AddWithValue ("@length", ep.length)
cmd.Parameters.AddWithValue ("@duration", maybe ep.duration)
cmd.Parameters.AddWithValue ("@mediaType", maybe ep.mediaType)
cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.imageUrl)
cmd.Parameters.AddWithValue ("@subtitle", maybe ep.subtitle)
cmd.Parameters.AddWithValue ("@explicit", maybe (ep.explicit |> Option.map ExplicitRating.toString))
cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.chapterFile)
cmd.Parameters.AddWithValue ("@chapterType", maybe ep.chapterType)
cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.transcriptUrl)
cmd.Parameters.AddWithValue ("@transcriptType", maybe ep.transcriptType)
cmd.Parameters.AddWithValue ("@transcriptLang", maybe ep.transcriptLang)
cmd.Parameters.AddWithValue ("@transcriptCaptions", maybe ep.transcriptCaptions)
cmd.Parameters.AddWithValue ("@seasonNumber", maybe ep.seasonNumber)
cmd.Parameters.AddWithValue ("@seasonDescription", maybe ep.seasonDescription)
cmd.Parameters.AddWithValue ("@episodeNumber", maybe (ep.episodeNumber |> Option.map string))
cmd.Parameters.AddWithValue ("@episodeDescription", maybe ep.episodeDescription)
] |> ignore
/// Append category IDs, tags, and meta items to a post
let appendPostCategoryTagAndMeta (post : Post) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PostId.toString post.id) |> ignore cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id) |> ignore
cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id" cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let post = { post with categoryIds = toList Map.toCategoryId rdr } let post = { post with CategoryIds = toList Map.toCategoryId rdr }
do! rdr.CloseAsync () do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id" cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let post = { post with tags = toList (Map.getString "tag") rdr } return { post with Tags = toList (Map.getString "tag") rdr }
do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT name, value FROM post_meta WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync ()
return { post with metadata = toList Map.toMetaItem rdr }
} }
/// Append revisions and permalinks to a post /// Append revisions and permalinks to a post
let appendPostRevisionsAndPermalinks (post : Post) = backgroundTask { let appendPostRevisionsAndPermalinks (post : Post) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@postId", PostId.toString post.id) |> ignore cmd.Parameters.AddWithValue ("@postId", PostId.toString post.Id) |> ignore
cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId" cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let post = { post with priorPermalinks = toList Map.toPermalink rdr } let post = { post with PriorPermalinks = toList Map.toPermalink rdr }
do! rdr.CloseAsync () do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT as_of, revision_text FROM post_revision WHERE post_id = @postId ORDER BY as_of DESC" cmd.CommandText <- "SELECT as_of, revision_text FROM post_revision WHERE post_id = @postId ORDER BY as_of DESC"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return { post with revisions = toList Map.toRevision rdr } return { post with Revisions = toList Map.toRevision rdr }
}
/// The SELECT statement for a post that will include episode data, if it exists
let selectPost = "SELECT p.* FROM post p"
/// Shorthand for mapping a data reader to a post
let toPost =
Map.toPost ser
/// Find just-the-post by its ID for the given web log (excludes category, tag, meta, revisions, and permalinks)
let findPostById postId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<Post> webLogId (fun p -> p.WebLogId) toPost rdr
} }
/// Return a post with no revisions, prior permalinks, or text /// Return a post with no revisions, prior permalinks, or text
let postWithoutText rdr = let postWithoutText rdr =
{ Map.toPost rdr with text = "" } { toPost rdr with Text = "" }
/// Update a post's assigned categories /// Update a post's assigned categories
let updatePostCategories postId oldCats newCats = backgroundTask { let updatePostCategories postId oldCats newCats = backgroundTask {
let toDelete, toAdd = diffLists oldCats newCats CategoryId.toString let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString
if List.isEmpty toDelete && List.isEmpty toAdd then if List.isEmpty toDelete && List.isEmpty toAdd then
return () return ()
else else
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.Add ("@categoryId", SqliteType.Text) cmd.Parameters.Add ("@categoryId", SqliteType.Text)
] |> ignore ] |> ignore
let runCmd catId = backgroundTask { let runCmd catId = backgroundTask {
cmd.Parameters["@categoryId"].Value <- CategoryId.toString catId cmd.Parameters["@categoryId"].Value <- CategoryId.toString catId
@@ -113,13 +109,13 @@ type SQLitePostData (conn : SqliteConnection) =
/// Update a post's assigned categories /// Update a post's assigned categories
let updatePostTags postId (oldTags : string list) newTags = backgroundTask { let updatePostTags postId (oldTags : string list) newTags = backgroundTask {
let toDelete, toAdd = diffLists oldTags newTags id let toDelete, toAdd = Utils.diffLists oldTags newTags id
if List.isEmpty toDelete && List.isEmpty toAdd then if List.isEmpty toDelete && List.isEmpty toAdd then
return () return ()
else else
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.Add ("@tag", SqliteType.Text) cmd.Parameters.Add ("@tag", SqliteType.Text)
] |> ignore ] |> ignore
let runCmd (tag : string) = backgroundTask { let runCmd (tag : string) = backgroundTask {
cmd.Parameters["@tag"].Value <- tag cmd.Parameters["@tag"].Value <- tag
@@ -137,95 +133,15 @@ type SQLitePostData (conn : SqliteConnection) =
|> ignore |> ignore
} }
/// Update an episode
let updatePostEpisode (post : Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(post_id) FROM post_episode WHERE post_id = @postId"
cmd.Parameters.AddWithValue ("@postId", PostId.toString post.id) |> ignore
let! count = count cmd
if count = 1 then
match post.episode with
| Some ep ->
cmd.CommandText <- """
UPDATE post_episode
SET media = @media,
length = @length,
duration = @duration,
media_type = @mediaType,
image_url = @imageUrl,
subtitle = @subtitle,
explicit = @explicit,
chapter_file = @chapterFile,
chapter_type = @chapterType,
transcript_url = @transcriptUrl,
transcript_type = @transcriptType,
transcript_lang = @transcriptLang,
transcript_captions = @transcriptCaptions,
season_number = @seasonNumber,
season_description = @seasonDescription,
episode_number = @episodeNumber,
episode_description = @episodeDescription
WHERE post_id = @postId"""
addEpisodeParameters cmd ep
do! write cmd
| None ->
cmd.CommandText <- "DELETE FROM post_episode WHERE post_id = @postId"
do! write cmd
else
match post.episode with
| Some ep ->
cmd.CommandText <- """
INSERT INTO post_episode (
post_id, media, length, duration, media_type, image_url, subtitle, explicit, chapter_file,
chapter_type, transcript_url, transcript_type, transcript_lang, transcript_captions,
season_number, season_description, episode_number, episode_description
) VALUES (
@postId, @media, @length, @duration, @mediaType, @imageUrl, @subtitle, @explicit, @chapterFile,
@chapterType, @transcriptUrl, @transcriptType, @transcriptLang, @transcriptCaptions,
@seasonNumber, @seasonDescription, @episodeNumber, @episodeDescription
)"""
addEpisodeParameters cmd ep
do! write cmd
| None -> ()
}
/// Update a post's metadata items
let updatePostMeta postId oldItems newItems = backgroundTask {
let toDelete, toAdd = diffMetaItems oldItems newItems
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.Add ("@name", SqliteType.Text)
cmd.Parameters.Add ("@value", SqliteType.Text)
] |> ignore
let runCmd (item : MetaItem) = backgroundTask {
cmd.Parameters["@name" ].Value <- item.name
cmd.Parameters["@value"].Value <- item.value
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_meta WHERE post_id = @postId AND name = @name AND value = @value"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO post_meta VALUES (@postId, @name, @value)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a post's prior permalinks /// Update a post's prior permalinks
let updatePostPermalinks postId oldLinks newLinks = backgroundTask { let updatePostPermalinks postId oldLinks newLinks = backgroundTask {
let toDelete, toAdd = diffPermalinks oldLinks newLinks let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
if List.isEmpty toDelete && List.isEmpty toAdd then if List.isEmpty toDelete && List.isEmpty toAdd then
return () return ()
else else
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.Add ("@link", SqliteType.Text) cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore ] |> ignore
let runCmd link = backgroundTask { let runCmd link = backgroundTask {
cmd.Parameters["@link"].Value <- Permalink.toString link cmd.Parameters["@link"].Value <- Permalink.toString link
@@ -245,17 +161,17 @@ type SQLitePostData (conn : SqliteConnection) =
/// Update a post's revisions /// Update a post's revisions
let updatePostRevisions postId oldRevs newRevs = backgroundTask { let updatePostRevisions postId oldRevs newRevs = backgroundTask {
let toDelete, toAdd = diffRevisions oldRevs newRevs let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if List.isEmpty toDelete && List.isEmpty toAdd then if List.isEmpty toDelete && List.isEmpty toAdd then
return () return ()
else else
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask { let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear () cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.AddWithValue ("@asOf", rev.asOf) cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore ] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.text) |> ignore if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
do! write cmd do! write cmd
} }
cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf" cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf"
@@ -270,28 +186,25 @@ type SQLitePostData (conn : SqliteConnection) =
|> ignore |> ignore
} }
/// The SELECT statement for a post that will include episode data, if it exists
let selectPost = "SELECT p.*, e.* FROM post p LEFT JOIN post_episode e ON e.post_id = p.id"
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Add a post /// Add a post
let add post = backgroundTask { let add post = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO post ( "INSERT INTO post (
id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text,
episode, meta_items
) VALUES ( ) VALUES (
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text @id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text,
)""" @episode, @metaItems
)"
addPostParameters cmd post addPostParameters cmd post
do! write cmd do! write cmd
do! updatePostCategories post.id [] post.categoryIds do! updatePostCategories post.Id [] post.CategoryIds
do! updatePostTags post.id [] post.tags do! updatePostTags post.Id [] post.Tags
do! updatePostEpisode post do! updatePostPermalinks post.Id [] post.PriorPermalinks
do! updatePostMeta post.id [] post.metadata do! updatePostRevisions post.Id [] post.Revisions
do! updatePostPermalinks post.id [] post.priorPermalinks
do! updatePostRevisions post.id [] post.revisions
} }
/// Count posts in a status for the given web log /// Count posts in a status for the given web log
@@ -303,6 +216,15 @@ type SQLitePostData (conn : SqliteConnection) =
return! count cmd return! count cmd
} }
/// Find a post by its ID for the given web log (excluding revisions and prior permalinks
let findById postId webLogId = backgroundTask {
match! findPostById postId webLogId with
| Some post ->
let! post = appendPostCategoryAndTag post
return Some post
| None -> return None
}
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks) /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink permalink webLogId = backgroundTask { let findByPermalink permalink webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
@@ -311,7 +233,7 @@ type SQLitePostData (conn : SqliteConnection) =
cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then if rdr.Read () then
let! post = appendPostCategoryTagAndMeta (Map.toPost rdr) let! post = appendPostCategoryAndTag (toPost rdr)
return Some post return Some post
else else
return None return None
@@ -319,17 +241,11 @@ type SQLitePostData (conn : SqliteConnection) =
/// 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 {
use cmd = conn.CreateCommand () match! findById postId webLogId with
cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
match Helpers.verifyWebLog<Post> webLogId (fun p -> p.webLogId) Map.toPost rdr with
| Some post -> | Some post ->
let! post = appendPostCategoryTagAndMeta post
let! post = appendPostRevisionsAndPermalinks post let! post = appendPostRevisionsAndPermalinks post
return Some post return Some post
| None -> | None -> return None
return None
} }
/// Delete a post by its ID for the given web log /// Delete a post by its ID for the given web log
@@ -338,14 +254,13 @@ type SQLitePostData (conn : SqliteConnection) =
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
cmd.CommandText <- """ cmd.CommandText <-
DELETE FROM post_revision WHERE post_id = @id; "DELETE FROM post_revision WHERE post_id = @id;
DELETE FROM post_permalink WHERE post_id = @id; DELETE FROM post_permalink WHERE post_id = @id;
DELETE FROM post_meta WHERE post_id = @id; DELETE FROM post_tag WHERE post_id = @id;
DELETE FROM post_episode WHERE post_id = @id; DELETE FROM post_category WHERE post_id = @id;
DELETE FROM post_tag WHERE post_id = @id; DELETE FROM post_comment WHERE post_id = @id;
DELETE FROM post_category WHERE post_id = @id; DELETE FROM post WHERE id = @id"
DELETE FROM post WHERE id = @id"""
do! write cmd do! write cmd
return true return true
| None -> return false | None -> return false
@@ -354,19 +269,15 @@ type SQLitePostData (conn : SqliteConnection) =
/// 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 webLogId = backgroundTask { let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ let linkSql, linkParams = inClause "AND pp.permalink" "link" Permalink.toString permalinks
cmd.CommandText <- $"
SELECT p.permalink SELECT p.permalink
FROM post p FROM post p
INNER JOIN post_permalink pp ON pp.post_id = p.id INNER JOIN post_permalink pp ON pp.post_id = p.id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND pp.permalink IN (""" {linkSql}"
permalinks
|> List.iteri (fun idx link ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@link{idx}"
cmd.Parameters.AddWithValue ($"@link{idx}", Permalink.toString link) |> ignore)
cmd.CommandText <- $"{cmd.CommandText})"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddRange linkParams
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toPermalink rdr) else None return if rdr.Read () then Some (Map.toPermalink rdr) else None
} }
@@ -378,9 +289,9 @@ type SQLitePostData (conn : SqliteConnection) =
addWebLogId cmd webLogId addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! posts = let! posts =
toList Map.toPost rdr toList toPost rdr
|> List.map (fun post -> backgroundTask { |> List.map (fun post -> backgroundTask {
let! post = appendPostCategoryTagAndMeta post let! post = appendPostCategoryAndTag post
return! appendPostRevisionsAndPermalinks post return! appendPostRevisionsAndPermalinks post
}) })
|> Task.WhenAll |> Task.WhenAll
@@ -390,27 +301,22 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks) /// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask { let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- $""" let catSql, catParams = inClause "AND pc.category_id" "catId" CategoryId.toString categoryIds
cmd.CommandText <- $"
{selectPost} {selectPost}
INNER JOIN post_category pc ON pc.post_id = p.id INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = @status AND p.status = @status
AND pc.category_id IN (""" {catSql}
categoryIds ORDER BY published_on DESC
|> List.iteri (fun idx catId -> LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@catId{idx}"
cmd.Parameters.AddWithValue ($"@catId{idx}", CategoryId.toString catId) |> ignore)
cmd.CommandText <-
$"""{cmd.CommandText})
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
cmd.Parameters.AddRange catParams
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! posts = let! posts =
toList Map.toPost rdr toList toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post }) |> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll |> Task.WhenAll
return List.ofArray posts return List.ofArray posts
} }
@@ -418,16 +324,16 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks) /// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks)
let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask { let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- $""" cmd.CommandText <- $"
{selectPost} {selectPost}
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
ORDER BY p.published_on DESC NULLS FIRST, p.updated_on ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! posts = let! posts =
toList postWithoutText rdr toList postWithoutText rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post }) |> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll |> Task.WhenAll
return List.ofArray posts return List.ofArray posts
} }
@@ -435,18 +341,18 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of published posts for the given web log (excludes revisions and prior permalinks) /// Get a page of published posts for the given web log (excludes revisions and prior permalinks)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask { let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- $""" cmd.CommandText <- $"
{selectPost} {selectPost}
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = @status AND p.status = @status
ORDER BY p.published_on DESC ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! posts = let! posts =
toList Map.toPost rdr toList toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post }) |> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll |> Task.WhenAll
return List.ofArray posts return List.ofArray posts
} }
@@ -454,60 +360,60 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks) /// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask { let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- $""" cmd.CommandText <- $"
{selectPost} {selectPost}
INNER JOIN post_tag pt ON pt.post_id = p.id INNER JOIN post_tag pt ON pt.post_id = p.id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = @status AND p.status = @status
AND pt.tag = @tag AND pt.tag = @tag
ORDER BY p.published_on DESC ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) [ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
cmd.Parameters.AddWithValue ("@tag", tag) cmd.Parameters.AddWithValue ("@tag", tag)
] |> ignore ] |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! posts = let! posts =
toList Map.toPost rdr toList toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post }) |> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll |> Task.WhenAll
return List.ofArray posts return List.ofArray posts
} }
/// 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 : DateTime) = backgroundTask { let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- $""" cmd.CommandText <- $"
{selectPost} {selectPost}
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = @status AND p.status = @status
AND p.published_on < @publishedOn AND p.published_on < @publishedOn
ORDER BY p.published_on DESC ORDER BY p.published_on DESC
LIMIT 1""" LIMIT 1"
addWebLogId cmd webLogId addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) [ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
cmd.Parameters.AddWithValue ("@publishedOn", publishedOn) cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn)
] |> ignore ] |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! older = backgroundTask { let! older = backgroundTask {
if rdr.Read () then if rdr.Read () then
let! post = appendPostCategoryTagAndMeta (postWithoutText rdr) let! post = appendPostCategoryAndTag (postWithoutText rdr)
return Some post return Some post
else else
return None return None
} }
do! rdr.CloseAsync () do! rdr.CloseAsync ()
cmd.CommandText <- $""" cmd.CommandText <- $"
{selectPost} {selectPost}
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = @status AND p.status = @status
AND p.published_on > @publishedOn AND p.published_on > @publishedOn
ORDER BY p.published_on ORDER BY p.published_on
LIMIT 1""" LIMIT 1"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! newer = backgroundTask { let! newer = backgroundTask {
if rdr.Read () then if rdr.Read () then
let! post = appendPostCategoryTagAndMeta (postWithoutText rdr) let! post = appendPostCategoryAndTag (postWithoutText rdr)
return Some post return Some post
else else
return None return None
@@ -523,29 +429,29 @@ type SQLitePostData (conn : SqliteConnection) =
/// Update a post /// Update a post
let update (post : Post) = backgroundTask { let update (post : Post) = backgroundTask {
match! findFullById post.id post.webLogId with match! findFullById post.Id post.WebLogId with
| Some oldPost -> | Some oldPost ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
UPDATE post "UPDATE post
SET author_id = @authorId, SET author_id = @authorId,
status = @status, status = @status,
title = @title, title = @title,
permalink = @permalink, permalink = @permalink,
published_on = @publishedOn, published_on = @publishedOn,
updated_on = @updatedOn, updated_on = @updatedOn,
template = @template, template = @template,
post_text = @text post_text = @text,
WHERE id = @id episode = @episode,
AND web_log_id = @webLogId""" meta_items = @metaItems
WHERE id = @id
AND web_log_id = @webLogId"
addPostParameters cmd post addPostParameters cmd post
do! write cmd do! write cmd
do! updatePostCategories post.id oldPost.categoryIds post.categoryIds do! updatePostCategories post.Id oldPost.CategoryIds post.CategoryIds
do! updatePostTags post.id oldPost.tags post.tags do! updatePostTags post.Id oldPost.Tags post.Tags
do! updatePostEpisode post do! updatePostPermalinks post.Id oldPost.PriorPermalinks post.PriorPermalinks
do! updatePostMeta post.id oldPost.metadata post.metadata do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
do! updatePostPermalinks post.id oldPost.priorPermalinks post.priorPermalinks
do! updatePostRevisions post.id oldPost.revisions post.revisions
| None -> return () | None -> return ()
} }
@@ -553,27 +459,28 @@ type SQLitePostData (conn : SqliteConnection) =
let updatePriorPermalinks postId webLogId permalinks = backgroundTask { let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
match! findFullById postId webLogId with match! findFullById postId webLogId with
| Some post -> | Some post ->
do! updatePostPermalinks postId post.priorPermalinks permalinks do! updatePostPermalinks postId post.PriorPermalinks permalinks
return true return true
| None -> return false | None -> return false
} }
interface IPostData with interface IPostData with
member _.add post = add post member _.Add post = add post
member _.countByStatus status webLogId = countByStatus status webLogId member _.CountByStatus status webLogId = countByStatus status webLogId
member _.delete postId webLogId = delete postId webLogId member _.Delete postId webLogId = delete postId webLogId
member _.findByPermalink permalink webLogId = findByPermalink permalink webLogId member _.FindById postId webLogId = findById postId webLogId
member _.findCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId
member _.findFullById postId webLogId = findFullById postId webLogId member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
member _.findFullByWebLog webLogId = findFullByWebLog webLogId member _.FindFullById postId webLogId = findFullById postId webLogId
member _.findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = member _.FindFullByWebLog webLogId = findFullByWebLog webLogId
member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage
member _.findPageOfPosts webLogId pageNbr postsPerPage = findPageOfPosts webLogId pageNbr postsPerPage member _.FindPageOfPosts webLogId pageNbr postsPerPage = findPageOfPosts webLogId pageNbr postsPerPage
member _.findPageOfPublishedPosts webLogId pageNbr postsPerPage = member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage =
findPageOfPublishedPosts webLogId pageNbr postsPerPage findPageOfPublishedPosts webLogId pageNbr postsPerPage
member _.findPageOfTaggedPosts webLogId tag pageNbr postsPerPage = member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage =
findPageOfTaggedPosts webLogId tag pageNbr postsPerPage findPageOfTaggedPosts webLogId tag pageNbr postsPerPage
member _.findSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn member _.FindSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn
member _.restore posts = restore posts member _.Restore posts = restore posts
member _.update post = update post member _.Update post = update post
member _.updatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks member _.UpdatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks

View File

@@ -13,7 +13,7 @@ type SQLiteTagMapData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT * FROM tag_map WHERE id = @id" cmd.CommandText <- "SELECT * FROM tag_map WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<TagMap> webLogId (fun tm -> tm.webLogId) Map.toTagMap rdr return Helpers.verifyWebLog<TagMap> webLogId (fun tm -> tm.WebLogId) Map.toTagMap rdr
} }
/// Delete a tag mapping for the given web log /// Delete a tag mapping for the given web log
@@ -50,18 +50,14 @@ type SQLiteTagMapData (conn : SqliteConnection) =
/// 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 = backgroundTask { let findMappingForTags (tags : string list) webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ let mapSql, mapParams = inClause "AND tag" "tag" id tags
cmd.CommandText <- $"
SELECT * SELECT *
FROM tag_map FROM tag_map
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
AND tag IN (""" {mapSql}"
tags
|> List.iteri (fun idx tag ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@tag{idx}"
cmd.Parameters.AddWithValue ($"@tag{idx}", tag) |> ignore)
cmd.CommandText <- $"{cmd.CommandText})"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddRange mapParams
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toTagMap rdr return toList Map.toTagMap rdr
} }
@@ -69,25 +65,25 @@ type SQLiteTagMapData (conn : SqliteConnection) =
/// Save a tag mapping /// Save a tag mapping
let save (tagMap : TagMap) = backgroundTask { let save (tagMap : TagMap) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
match! findById tagMap.id tagMap.webLogId with match! findById tagMap.Id tagMap.WebLogId with
| Some _ -> | Some _ ->
cmd.CommandText <- """ cmd.CommandText <-
UPDATE tag_map "UPDATE tag_map
SET tag = @tag, SET tag = @tag,
url_value = @urlValue url_value = @urlValue
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId""" AND web_log_id = @webLogId"
| None -> | None ->
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO tag_map ( "INSERT INTO tag_map (
id, web_log_id, tag, url_value id, web_log_id, tag, url_value
) VALUES ( ) VALUES (
@id, @webLogId, @tag, @urlValue @id, @webLogId, @tag, @urlValue
)""" )"
addWebLogId cmd tagMap.webLogId addWebLogId cmd tagMap.WebLogId
[ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.id) [ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id)
cmd.Parameters.AddWithValue ("@tag", tagMap.tag) cmd.Parameters.AddWithValue ("@tag", tagMap.Tag)
cmd.Parameters.AddWithValue ("@urlValue", tagMap.urlValue) cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue)
] |> ignore ] |> ignore
do! write cmd do! write cmd
} }
@@ -99,10 +95,10 @@ type SQLiteTagMapData (conn : SqliteConnection) =
} }
interface ITagMapData with interface ITagMapData with
member _.delete tagMapId webLogId = delete tagMapId webLogId member _.Delete tagMapId webLogId = delete tagMapId webLogId
member _.findById tagMapId webLogId = findById tagMapId webLogId member _.FindById tagMapId webLogId = findById tagMapId webLogId
member _.findByUrlValue urlValue webLogId = findByUrlValue urlValue webLogId member _.FindByUrlValue urlValue webLogId = findByUrlValue urlValue webLogId
member _.findByWebLog webLogId = findByWebLog webLogId member _.FindByWebLog webLogId = findByWebLog webLogId
member _.findMappingForTags tags webLogId = findMappingForTags tags webLogId member _.FindMappingForTags tags webLogId = findMappingForTags tags webLogId
member _.save tagMap = save tagMap member _.Save tagMap = save tagMap
member this.restore tagMaps = restore tagMaps member _.Restore tagMaps = restore tagMaps

View File

@@ -8,12 +8,31 @@ open MyWebLog.Data
/// SQLite myWebLog theme data implementation /// SQLite myWebLog theme data implementation
type SQLiteThemeData (conn : SqliteConnection) = type SQLiteThemeData (conn : SqliteConnection) =
/// Retrieve all themes (except 'admin'; excludes templates) /// Retrieve all themes (except 'admin'; excludes template text)
let all () = backgroundTask { let all () = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id" cmd.CommandText <- "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toTheme rdr let themes = toList Map.toTheme rdr
do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name"
use! rdr = cmd.ExecuteReaderAsync ()
let templates =
seq { while rdr.Read () do ThemeId (Map.getString "theme_id" rdr), Map.toThemeTemplate false rdr }
|> List.ofSeq
return
themes
|> List.map (fun t ->
{ t with Templates = templates |> List.filter (fun (themeId, _) -> themeId = t.Id) |> List.map snd })
}
/// Does a given theme exist?
let exists themeId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM theme WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
let! count = count cmd
return count > 0
} }
/// Find a theme by its ID /// Find a theme by its ID
@@ -28,7 +47,7 @@ type SQLiteThemeData (conn : SqliteConnection) =
templateCmd.CommandText <- "SELECT * FROM theme_template WHERE theme_id = @id" templateCmd.CommandText <- "SELECT * FROM theme_template WHERE theme_id = @id"
templateCmd.Parameters.Add cmd.Parameters["@id"] |> ignore templateCmd.Parameters.Add cmd.Parameters["@id"] |> ignore
use! templateRdr = templateCmd.ExecuteReaderAsync () use! templateRdr = templateCmd.ExecuteReaderAsync ()
return Some { theme with templates = toList Map.toThemeTemplate templateRdr } return Some { theme with Templates = toList (Map.toThemeTemplate true) templateRdr }
else else
return None return None
} }
@@ -38,44 +57,59 @@ type SQLiteThemeData (conn : SqliteConnection) =
match! findById themeId with match! findById themeId with
| Some theme -> | Some theme ->
return Some { return Some {
theme with templates = theme.templates |> List.map (fun t -> { t with text = "" }) theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" })
} }
| None -> return None | None -> return None
} }
/// Delete a theme by its ID
let delete themeId = backgroundTask {
match! findByIdWithoutText themeId with
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"DELETE FROM theme_asset WHERE theme_id = @id;
DELETE FROM theme_template WHERE theme_id = @id;
DELETE FROM theme WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
do! write cmd
return true
| None -> return false
}
/// Save a theme /// Save a theme
let save (theme : Theme) = backgroundTask { let save (theme : Theme) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
let! oldTheme = findById theme.id let! oldTheme = findById theme.Id
cmd.CommandText <- cmd.CommandText <-
match oldTheme with match oldTheme with
| Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id" | Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id"
| None -> "INSERT INTO theme VALUES (@id, @name, @version)" | None -> "INSERT INTO theme VALUES (@id, @name, @version)"
[ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.id) [ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.Id)
cmd.Parameters.AddWithValue ("@name", theme.name) cmd.Parameters.AddWithValue ("@name", theme.Name)
cmd.Parameters.AddWithValue ("@version", theme.version) cmd.Parameters.AddWithValue ("@version", theme.Version)
] |> ignore ] |> ignore
do! write cmd do! write cmd
let toDelete, toAdd = let toDelete, toAdd =
diffLists (oldTheme |> Option.map (fun t -> t.templates) |> Option.defaultValue []) Utils.diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue [])
theme.templates (fun t -> t.name) theme.Templates (fun t -> t.Name)
let toUpdate = let toUpdate =
theme.templates theme.Templates
|> List.filter (fun t -> |> List.filter (fun t ->
not (toDelete |> List.exists (fun d -> d.name = t.name)) not (toDelete |> List.exists (fun d -> d.Name = t.Name))
&& not (toAdd |> List.exists (fun a -> a.name = t.name))) && not (toAdd |> List.exists (fun a -> a.Name = t.Name)))
cmd.CommandText <- cmd.CommandText <-
"UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name" "UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name"
cmd.Parameters.Clear () cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.id) [ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.Id)
cmd.Parameters.Add ("@name", SqliteType.Text) cmd.Parameters.Add ("@name", SqliteType.Text)
cmd.Parameters.Add ("@template", SqliteType.Text) cmd.Parameters.Add ("@template", SqliteType.Text)
] |> ignore ] |> ignore
toUpdate toUpdate
|> List.map (fun template -> backgroundTask { |> List.map (fun template -> backgroundTask {
cmd.Parameters["@name" ].Value <- template.name cmd.Parameters["@name" ].Value <- template.Name
cmd.Parameters["@template"].Value <- template.text cmd.Parameters["@template"].Value <- template.Text
do! write cmd do! write cmd
}) })
|> Task.WhenAll |> Task.WhenAll
@@ -83,8 +117,8 @@ type SQLiteThemeData (conn : SqliteConnection) =
cmd.CommandText <- "INSERT INTO theme_template VALUES (@themeId, @name, @template)" cmd.CommandText <- "INSERT INTO theme_template VALUES (@themeId, @name, @template)"
toAdd toAdd
|> List.map (fun template -> backgroundTask { |> List.map (fun template -> backgroundTask {
cmd.Parameters["@name" ].Value <- template.name cmd.Parameters["@name" ].Value <- template.Name
cmd.Parameters["@template"].Value <- template.text cmd.Parameters["@template"].Value <- template.Text
do! write cmd do! write cmd
}) })
|> Task.WhenAll |> Task.WhenAll
@@ -93,7 +127,7 @@ type SQLiteThemeData (conn : SqliteConnection) =
cmd.Parameters.Remove cmd.Parameters["@template"] cmd.Parameters.Remove cmd.Parameters["@template"]
toDelete toDelete
|> List.map (fun template -> backgroundTask { |> List.map (fun template -> backgroundTask {
cmd.Parameters["@name"].Value <- template.name cmd.Parameters["@name"].Value <- template.Name
do! write cmd do! write cmd
}) })
|> Task.WhenAll |> Task.WhenAll
@@ -101,10 +135,12 @@ type SQLiteThemeData (conn : SqliteConnection) =
} }
interface IThemeData with interface IThemeData with
member _.all () = all () member _.All () = all ()
member _.findById themeId = findById themeId member _.Delete themeId = delete themeId
member _.findByIdWithoutText themeId = findByIdWithoutText themeId member _.Exists themeId = exists themeId
member _.save theme = save theme member _.FindById themeId = findById themeId
member _.FindByIdWithoutText themeId = findByIdWithoutText themeId
member _.Save theme = save theme
open System.IO open System.IO
@@ -133,8 +169,8 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path" cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
let (ThemeAssetId (ThemeId themeId, path)) = assetId let (ThemeAssetId (ThemeId themeId, path)) = assetId
[ cmd.Parameters.AddWithValue ("@themeId", themeId) [ cmd.Parameters.AddWithValue ("@themeId", themeId)
cmd.Parameters.AddWithValue ("@path", path) cmd.Parameters.AddWithValue ("@path", path)
] |> ignore ] |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toThemeAsset true rdr) else None return if rdr.Read () then Some (Map.toThemeAsset true rdr) else None
@@ -163,45 +199,45 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
use sideCmd = conn.CreateCommand () use sideCmd = conn.CreateCommand ()
sideCmd.CommandText <- sideCmd.CommandText <-
"SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path" "SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path"
let (ThemeAssetId (ThemeId themeId, path)) = asset.id let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
[ sideCmd.Parameters.AddWithValue ("@themeId", themeId) [ sideCmd.Parameters.AddWithValue ("@themeId", themeId)
sideCmd.Parameters.AddWithValue ("@path", path) sideCmd.Parameters.AddWithValue ("@path", path)
] |> ignore ] |> ignore
let! exists = count sideCmd let! exists = count sideCmd
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <-
if exists = 1 then if exists = 1 then
"""UPDATE theme_asset "UPDATE theme_asset
SET updated_on = @updatedOn, SET updated_on = @updatedOn,
data = ZEROBLOB(@dataLength) data = ZEROBLOB(@dataLength)
WHERE theme_id = @themeId WHERE theme_id = @themeId
AND path = @path""" AND path = @path"
else else
"""INSERT INTO theme_asset ( "INSERT INTO theme_asset (
theme_id, path, updated_on, data theme_id, path, updated_on, data
) VALUES ( ) VALUES (
@themeId, @path, @updatedOn, ZEROBLOB(@dataLength) @themeId, @path, @updatedOn, ZEROBLOB(@dataLength)
)""" )"
[ cmd.Parameters.AddWithValue ("@themeId", themeId) [ cmd.Parameters.AddWithValue ("@themeId", themeId)
cmd.Parameters.AddWithValue ("@path", path) cmd.Parameters.AddWithValue ("@path", path)
cmd.Parameters.AddWithValue ("@updatedOn", asset.updatedOn) cmd.Parameters.AddWithValue ("@updatedOn", instantParam asset.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", asset.data.Length) cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length)
] |> ignore ] |> ignore
do! write cmd do! write cmd
sideCmd.CommandText <- "SELECT ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path" sideCmd.CommandText <- "SELECT ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
let! rowId = sideCmd.ExecuteScalarAsync () let! rowId = sideCmd.ExecuteScalarAsync ()
use dataStream = new MemoryStream (asset.data) use dataStream = new MemoryStream (asset.Data)
use blobStream = new SqliteBlob (conn, "theme_asset", "data", rowId :?> int64) use blobStream = new SqliteBlob (conn, "theme_asset", "data", rowId :?> int64)
do! dataStream.CopyToAsync blobStream do! dataStream.CopyToAsync blobStream
} }
interface IThemeAssetData with interface IThemeAssetData with
member _.all () = all () member _.All () = all ()
member _.deleteByTheme themeId = deleteByTheme themeId member _.DeleteByTheme themeId = deleteByTheme themeId
member _.findById assetId = findById assetId member _.FindById assetId = findById assetId
member _.findByTheme themeId = findByTheme themeId member _.FindByTheme themeId = findByTheme themeId
member _.findByThemeWithData themeId = findByThemeWithData themeId member _.FindByThemeWithData themeId = findByThemeWithData themeId
member _.save asset = save asset member _.Save asset = save asset

View File

@@ -10,29 +10,29 @@ type SQLiteUploadData (conn : SqliteConnection) =
/// Add parameters for uploaded file INSERT and UPDATE statements /// Add parameters for uploaded file INSERT and UPDATE statements
let addUploadParameters (cmd : SqliteCommand) (upload : Upload) = let addUploadParameters (cmd : SqliteCommand) (upload : Upload) =
[ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.id) [ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.webLogId) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId)
cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.path) cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.Path)
cmd.Parameters.AddWithValue ("@updatedOn", upload.updatedOn) cmd.Parameters.AddWithValue ("@updatedOn", instantParam upload.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", upload.data.Length) cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length)
] |> ignore ] |> ignore
/// Save an uploaded file /// Save an uploaded file
let add upload = backgroundTask { let add upload = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO upload ( "INSERT INTO upload (
id, web_log_id, path, updated_on, data id, web_log_id, path, updated_on, data
) VALUES ( ) VALUES (
@id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength) @id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength)
)""" )"
addUploadParameters cmd upload addUploadParameters cmd upload
do! write cmd do! write cmd
cmd.CommandText <- "SELECT ROWID FROM upload WHERE id = @id" cmd.CommandText <- "SELECT ROWID FROM upload WHERE id = @id"
let! rowId = cmd.ExecuteScalarAsync () let! rowId = cmd.ExecuteScalarAsync ()
use dataStream = new MemoryStream (upload.data) use dataStream = new MemoryStream (upload.Data)
use blobStream = new SqliteBlob (conn, "upload", "data", rowId :?> int64) use blobStream = new SqliteBlob (conn, "upload", "data", rowId :?> int64)
do! dataStream.CopyToAsync blobStream do! dataStream.CopyToAsync blobStream
} }
@@ -40,11 +40,11 @@ type SQLiteUploadData (conn : SqliteConnection) =
/// Delete an uploaded file by its ID /// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask { let delete uploadId webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
SELECT id, web_log_id, path, updated_on "SELECT id, web_log_id, path, updated_on
FROM upload FROM upload
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId""" AND web_log_id = @webLogId"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@id", UploadId.toString uploadId) |> ignore cmd.Parameters.AddWithValue ("@id", UploadId.toString uploadId) |> ignore
let! rdr = cmd.ExecuteReaderAsync () let! rdr = cmd.ExecuteReaderAsync ()
@@ -53,7 +53,7 @@ type SQLiteUploadData (conn : SqliteConnection) =
do! rdr.CloseAsync () do! rdr.CloseAsync ()
cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId" cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
do! write cmd do! write cmd
return Ok (Permalink.toString upload.path) return Ok (Permalink.toString upload.Path)
else else
return Error $"""Upload ID {cmd.Parameters["@id"]} not found""" return Error $"""Upload ID {cmd.Parameters["@id"]} not found"""
} }
@@ -92,10 +92,10 @@ type SQLiteUploadData (conn : SqliteConnection) =
} }
interface IUploadData with interface IUploadData with
member _.add upload = add upload member _.Add upload = add upload
member _.delete uploadId webLogId = delete uploadId webLogId member _.Delete uploadId webLogId = delete uploadId webLogId
member _.findByPath path webLogId = findByPath path webLogId member _.FindByPath path webLogId = findByPath path webLogId
member _.findByWebLog webLogId = findByWebLog webLogId member _.FindByWebLog webLogId = findByWebLog webLogId
member _.findByWebLogWithData webLogId = findByWebLogWithData webLogId member _.FindByWebLogWithData webLogId = findByWebLogWithData webLogId
member _.restore uploads = restore uploads member _.Restore uploads = restore uploads

View File

@@ -4,123 +4,87 @@ open System.Threading.Tasks
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
// The web log podcast insert loop is not statically compilable; this is OK // The web log podcast insert loop is not statically compilable; this is OK
#nowarn "3511" #nowarn "3511"
/// SQLite myWebLog web log data implementation /// SQLite myWebLog web log data implementation
type SQLiteWebLogData (conn : SqliteConnection) = type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// Add parameters for web log INSERT or web log/RSS options UPDATE statements /// Add parameters for web log INSERT or web log/RSS options UPDATE statements
let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) = let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@feedEnabled", webLog.rss.feedEnabled) [ cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled)
cmd.Parameters.AddWithValue ("@feedName", webLog.rss.feedName) cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName)
cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.rss.itemsInFeed) cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed)
cmd.Parameters.AddWithValue ("@categoryEnabled", webLog.rss.categoryEnabled) cmd.Parameters.AddWithValue ("@isCategoryEnabled", webLog.Rss.IsCategoryEnabled)
cmd.Parameters.AddWithValue ("@tagEnabled", webLog.rss.tagEnabled) cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled)
cmd.Parameters.AddWithValue ("@copyright", maybe webLog.rss.copyright) cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright)
] |> ignore ] |> ignore
/// Add parameters for web log INSERT or UPDATE statements /// Add parameters for web log INSERT or UPDATE statements
let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) = let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.id) [ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id)
cmd.Parameters.AddWithValue ("@name", webLog.name) cmd.Parameters.AddWithValue ("@name", webLog.Name)
cmd.Parameters.AddWithValue ("@slug", webLog.slug) cmd.Parameters.AddWithValue ("@slug", webLog.Slug)
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.subtitle) cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle)
cmd.Parameters.AddWithValue ("@defaultPage", webLog.defaultPage) cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage)
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.postsPerPage) cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage)
cmd.Parameters.AddWithValue ("@themeId", webLog.themePath) cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId)
cmd.Parameters.AddWithValue ("@urlBase", webLog.urlBase) cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase)
cmd.Parameters.AddWithValue ("@timeZone", webLog.timeZone) cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone)
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.autoHtmx) cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx)
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.uploads) cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads)
] |> ignore ] |> ignore
addWebLogRssParameters cmd webLog addWebLogRssParameters cmd webLog
/// Add parameters for custom feed INSERT or UPDATE statements /// Add parameters for custom feed INSERT or UPDATE statements
let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) = let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) =
[ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.id) [ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId)
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.source) cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source)
cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.path) cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path)
cmd.Parameters.AddWithValue ("@podcast", maybe (if Option.isSome feed.Podcast then
Some (Utils.serialize ser feed.Podcast)
else None))
] |> ignore ] |> ignore
/// Add parameters for podcast INSERT or UPDATE statements /// Shorthand to map a data reader to a custom feed
let addPodcastParameters (cmd : SqliteCommand) feedId (podcast : PodcastOptions) = let toCustomFeed =
[ cmd.Parameters.AddWithValue ("@feedId", CustomFeedId.toString feedId) Map.toCustomFeed ser
cmd.Parameters.AddWithValue ("@title", podcast.title)
cmd.Parameters.AddWithValue ("@subtitle", maybe podcast.subtitle)
cmd.Parameters.AddWithValue ("@itemsInFeed", podcast.itemsInFeed)
cmd.Parameters.AddWithValue ("@summary", podcast.summary)
cmd.Parameters.AddWithValue ("@displayedAuthor", podcast.displayedAuthor)
cmd.Parameters.AddWithValue ("@email", podcast.email)
cmd.Parameters.AddWithValue ("@imageUrl", Permalink.toString podcast.imageUrl)
cmd.Parameters.AddWithValue ("@iTunesCategory", podcast.iTunesCategory)
cmd.Parameters.AddWithValue ("@iTunesSubcategory", maybe podcast.iTunesSubcategory)
cmd.Parameters.AddWithValue ("@explicit", ExplicitRating.toString podcast.explicit)
cmd.Parameters.AddWithValue ("@defaultMediaType", maybe podcast.defaultMediaType)
cmd.Parameters.AddWithValue ("@mediaBaseUrl", maybe podcast.mediaBaseUrl)
cmd.Parameters.AddWithValue ("@guid", maybe podcast.guid)
cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.fundingUrl)
cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.fundingText)
cmd.Parameters.AddWithValue ("@medium", maybe (podcast.medium |> Option.map PodcastMedium.toString))
] |> ignore
/// Get the current custom feeds for a web log /// Get the current custom feeds for a web log
let getCustomFeeds (webLog : WebLog) = backgroundTask { let getCustomFeeds (webLog : WebLog) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <- "SELECT * FROM web_log_feed WHERE web_log_id = @webLogId"
SELECT f.*, p.* addWebLogId cmd webLog.Id
FROM web_log_feed f
LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id
WHERE f.web_log_id = @webLogId"""
addWebLogId cmd webLog.id
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toCustomFeed rdr return toList toCustomFeed rdr
} }
/// Append custom feeds to a web log /// Append custom feeds to a web log
let appendCustomFeeds (webLog : WebLog) = backgroundTask { let appendCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog let! feeds = getCustomFeeds webLog
return { webLog with rss = { webLog.rss with customFeeds = feeds } } return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
}
/// Add a podcast to a custom feed
let addPodcast feedId (podcast : PodcastOptions) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
INSERT INTO web_log_feed_podcast (
feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url,
itunes_category, itunes_subcategory, explicit, default_media_type, media_base_url, guid, funding_url,
funding_text, medium
) VALUES (
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl,
@iTunesCategory, @iTunesSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @guid, @fundingUrl,
@fundingText, @medium
)"""
addPodcastParameters cmd feedId podcast
do! write cmd
} }
/// Update the custom feeds for a web log /// Update the custom feeds for a web log
let updateCustomFeeds (webLog : WebLog) = backgroundTask { let updateCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog let! feeds = getCustomFeeds webLog
let toDelete, toAdd = diffLists feeds webLog.rss.customFeeds (fun it -> $"{CustomFeedId.toString it.id}") let toDelete, toAdd = Utils.diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
let toId (feed : CustomFeed) = feed.id let toId (feed : CustomFeed) = feed.Id
let toUpdate = let toUpdate =
webLog.rss.customFeeds webLog.Rss.CustomFeeds
|> List.filter (fun f -> |> List.filter (fun f ->
not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.id)) not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.Id))
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
toDelete toDelete
|> List.map (fun it -> backgroundTask { |> List.map (fun it -> backgroundTask {
cmd.CommandText <- """ cmd.CommandText <- "DELETE FROM web_log_feed WHERE id = @id"
DELETE FROM web_log_feed_podcast WHERE feed_id = @id; cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id
DELETE FROM web_log_feed WHERE id = @id"""
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.id
do! write cmd do! write cmd
}) })
|> Task.WhenAll |> Task.WhenAll
@@ -128,68 +92,30 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.Parameters.Clear () cmd.Parameters.Clear ()
toAdd toAdd
|> List.map (fun it -> backgroundTask { |> List.map (fun it -> backgroundTask {
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO web_log_feed ( "INSERT INTO web_log_feed (
id, web_log_id, source, path id, web_log_id, source, path, podcast
) VALUES ( ) VALUES (
@id, @webLogId, @source, @path @id, @webLogId, @source, @path, @podcast
)""" )"
cmd.Parameters.Clear () cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.id it addCustomFeedParameters cmd webLog.Id it
do! write cmd do! write cmd
match it.podcast with
| Some podcast -> do! addPodcast it.id podcast
| None -> ()
}) })
|> Task.WhenAll |> Task.WhenAll
|> ignore |> ignore
toUpdate toUpdate
|> List.map (fun it -> backgroundTask { |> List.map (fun it -> backgroundTask {
cmd.CommandText <- """ cmd.CommandText <-
UPDATE web_log_feed "UPDATE web_log_feed
SET source = @source, SET source = @source,
path = @path path = @path,
WHERE id = @id podcast = @podcast
AND web_log_id = @webLogId""" WHERE id = @id
AND web_log_id = @webLogId"
cmd.Parameters.Clear () cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.id it addCustomFeedParameters cmd webLog.Id it
do! write cmd do! write cmd
let hadPodcast = Option.isSome (feeds |> List.find (fun f -> f.id = it.id)).podcast
match it.podcast with
| Some podcast ->
if hadPodcast then
cmd.CommandText <- """
UPDATE web_log_feed_podcast
SET title = @title,
subtitle = @subtitle,
items_in_feed = @itemsInFeed,
summary = @summary,
displayed_author = @displayedAuthor,
email = @email,
image_url = @imageUrl,
itunes_category = @iTunesCategory,
itunes_subcategory = @iTunesSubcategory,
explicit = @explicit,
default_media_type = @defaultMediaType,
media_base_url = @mediaBaseUrl,
guid = @guid,
funding_url = @fundingUrl,
funding_text = @fundingText,
medium = @medium
WHERE feed_id = @feedId"""
cmd.Parameters.Clear ()
addPodcastParameters cmd it.id podcast
do! write cmd
else
do! addPodcast it.id podcast
| None ->
if hadPodcast then
cmd.CommandText <- "DELETE FROM web_log_feed_podcast WHERE feed_id = @id"
cmd.Parameters.Clear ()
cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString it.id) |> ignore
do! write cmd
else
()
}) })
|> Task.WhenAll |> Task.WhenAll
|> ignore |> ignore
@@ -200,14 +126,14 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Add a web log /// Add a web log
let add webLog = backgroundTask { let add webLog = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO web_log ( "INSERT INTO web_log (
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx, id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
uploads, feed_enabled, feed_name, items_in_feed, category_enabled, tag_enabled, copyright uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright
) VALUES ( ) VALUES (
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx, @id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
@uploads, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled, @copyright @uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
)""" )"
addWebLogParameters cmd webLog addWebLogParameters cmd webLog
do! write cmd do! write cmd
do! updateCustomFeeds webLog do! updateCustomFeeds webLog
@@ -232,26 +158,22 @@ type SQLiteWebLogData (conn : SqliteConnection) =
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)" let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
let postSubQuery = subQuery "post" let postSubQuery = subQuery "post"
let pageSubQuery = subQuery "page" let pageSubQuery = subQuery "page"
cmd.CommandText <- $""" cmd.CommandText <- $"
DELETE FROM post_comment WHERE post_id IN {postSubQuery}; DELETE FROM post_comment WHERE post_id IN {postSubQuery};
DELETE FROM post_revision WHERE post_id IN {postSubQuery}; DELETE FROM post_revision WHERE post_id IN {postSubQuery};
DELETE FROM post_permalink WHERE post_id IN {postSubQuery}; DELETE FROM post_permalink WHERE post_id IN {postSubQuery};
DELETE FROM post_episode WHERE post_id IN {postSubQuery}; DELETE FROM post_tag WHERE post_id IN {postSubQuery};
DELETE FROM post_tag WHERE post_id IN {postSubQuery}; DELETE FROM post_category WHERE post_id IN {postSubQuery};
DELETE FROM post_category WHERE post_id IN {postSubQuery}; DELETE FROM post WHERE web_log_id = @webLogId;
DELETE FROM post_meta WHERE post_id IN {postSubQuery}; DELETE FROM page_revision WHERE page_id IN {pageSubQuery};
DELETE FROM post WHERE web_log_id = @webLogId; DELETE FROM page_permalink WHERE page_id IN {pageSubQuery};
DELETE FROM page_revision WHERE page_id IN {pageSubQuery}; DELETE FROM page WHERE web_log_id = @webLogId;
DELETE FROM page_permalink WHERE page_id IN {pageSubQuery}; DELETE FROM category WHERE web_log_id = @webLogId;
DELETE FROM page_meta WHERE page_id IN {pageSubQuery}; DELETE FROM tag_map WHERE web_log_id = @webLogId;
DELETE FROM page WHERE web_log_id = @webLogId; DELETE FROM upload WHERE web_log_id = @webLogId;
DELETE FROM category WHERE web_log_id = @webLogId; DELETE FROM web_log_user WHERE web_log_id = @webLogId;
DELETE FROM tag_map WHERE web_log_id = @webLogId; DELETE FROM web_log_feed WHERE web_log_id = @webLogId;
DELETE FROM upload WHERE web_log_id = @webLogId; DELETE FROM web_log WHERE id = @webLogId"
DELETE FROM web_log_user WHERE web_log_id = @webLogId;
DELETE FROM web_log_feed_podcast WHERE feed_id IN {subQuery "web_log_feed"};
DELETE FROM web_log_feed WHERE web_log_id = @webLogId;
DELETE FROM web_log WHERE id = @webLogId"""
do! write cmd do! write cmd
} }
@@ -284,25 +206,25 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Update settings for a web log /// Update settings for a web log
let updateSettings webLog = backgroundTask { let updateSettings webLog = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
UPDATE web_log "UPDATE web_log
SET name = @name, SET name = @name,
slug = @slug, slug = @slug,
subtitle = @subtitle, subtitle = @subtitle,
default_page = @defaultPage, default_page = @defaultPage,
posts_per_page = @postsPerPage, posts_per_page = @postsPerPage,
theme_id = @themeId, theme_id = @themeId,
url_base = @urlBase, url_base = @urlBase,
time_zone = @timeZone, time_zone = @timeZone,
auto_htmx = @autoHtmx, auto_htmx = @autoHtmx,
uploads = @uploads, uploads = @uploads,
feed_enabled = @feedEnabled, is_feed_enabled = @isFeedEnabled,
feed_name = @feedName, feed_name = @feedName,
items_in_feed = @itemsInFeed, items_in_feed = @itemsInFeed,
category_enabled = @categoryEnabled, is_category_enabled = @isCategoryEnabled,
tag_enabled = @tagEnabled, is_tag_enabled = @isTagEnabled,
copyright = @copyright copyright = @copyright
WHERE id = @id""" WHERE id = @id"
addWebLogParameters cmd webLog addWebLogParameters cmd webLog
do! write cmd do! write cmd
} }
@@ -310,25 +232,26 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Update RSS options for a web log /// Update RSS options for a web log
let updateRssOptions webLog = backgroundTask { let updateRssOptions webLog = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
UPDATE web_log "UPDATE web_log
SET feed_enabled = @feedEnabled, SET is_feed_enabled = @isFeedEnabled,
feed_name = @feedName, feed_name = @feedName,
items_in_feed = @itemsInFeed, items_in_feed = @itemsInFeed,
category_enabled = @categoryEnabled, is_category_enabled = @isCategoryEnabled,
tag_enabled = @tagEnabled, is_tag_enabled = @isTagEnabled,
copyright = @copyright copyright = @copyright
WHERE id = @id""" WHERE id = @id"
addWebLogRssParameters cmd webLog addWebLogRssParameters cmd webLog
cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) |> ignore
do! write cmd do! write cmd
do! updateCustomFeeds webLog do! updateCustomFeeds webLog
} }
interface IWebLogData with interface IWebLogData with
member _.add webLog = add webLog member _.Add webLog = add webLog
member _.all () = all () member _.All () = all ()
member _.delete webLogId = delete webLogId member _.Delete webLogId = delete webLogId
member _.findByHost url = findByHost url member _.FindByHost url = findByHost url
member _.findById webLogId = findById webLogId member _.FindById webLogId = findById webLogId
member _.updateSettings webLog = updateSettings webLog member _.UpdateSettings webLog = updateSettings webLog
member _.updateRssOptions webLog = updateRssOptions webLog member _.UpdateRssOptions webLog = updateRssOptions webLog

View File

@@ -11,16 +11,17 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Add parameters for web log user INSERT or UPDATE statements /// Add parameters for web log user INSERT or UPDATE statements
let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) = let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) =
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.id) [ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.webLogId) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.WebLogId)
cmd.Parameters.AddWithValue ("@userName", user.userName) cmd.Parameters.AddWithValue ("@email", user.Email)
cmd.Parameters.AddWithValue ("@firstName", user.firstName) cmd.Parameters.AddWithValue ("@firstName", user.FirstName)
cmd.Parameters.AddWithValue ("@lastName", user.lastName) cmd.Parameters.AddWithValue ("@lastName", user.LastName)
cmd.Parameters.AddWithValue ("@preferredName", user.preferredName) cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName)
cmd.Parameters.AddWithValue ("@passwordHash", user.passwordHash) cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash)
cmd.Parameters.AddWithValue ("@salt", user.salt) cmd.Parameters.AddWithValue ("@url", maybe user.Url)
cmd.Parameters.AddWithValue ("@url", maybe user.url) cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel)
cmd.Parameters.AddWithValue ("@authorizationLevel", AuthorizationLevel.toString user.authorizationLevel) cmd.Parameters.AddWithValue ("@createdOn", instantParam user.CreatedOn)
cmd.Parameters.AddWithValue ("@lastSeenOn", maybeInstant user.LastSeenOn)
] |> ignore ] |> ignore
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
@@ -28,41 +29,60 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Add a user /// Add a user
let add user = backgroundTask { let add user = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO web_log_user ( "INSERT INTO web_log_user (
id, web_log_id, user_name, first_name, last_name, preferred_name, password_hash, salt, url, id, web_log_id, email, first_name, last_name, preferred_name, password_hash, url, access_level,
authorization_level created_on, last_seen_on
) VALUES ( ) VALUES (
@id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @url, @accessLevel,
@authorizationLevel @createdOn, @lastSeenOn
)""" )"
addWebLogUserParameters cmd user addWebLogUserParameters cmd user
do! write cmd do! write cmd
} }
/// Find a user by their e-mail address for the given web log
let findByEmail (email : string) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND user_name = @userName"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@userName", email) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toWebLogUser rdr) else None
}
/// 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 = backgroundTask { let findById userId webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id" cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<WebLogUser> webLogId (fun u -> u.webLogId) Map.toWebLogUser rdr return Helpers.verifyWebLog<WebLogUser> webLogId (fun u -> u.WebLogId) Map.toWebLogUser rdr
}
/// Delete a user if they have no posts or pages
let delete userId webLogId = backgroundTask {
match! findById userId webLogId with
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE author_id = @userId"
cmd.Parameters.AddWithValue ("@userId", WebLogUserId.toString userId) |> ignore
let! pageCount = count cmd
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE author_id = @userId"
let! postCount = count cmd
if pageCount + postCount > 0 then
return Error "User has pages or posts; cannot delete"
else
cmd.CommandText <- "DELETE FROM web_log_user WHERE id = @userId"
let! _ = cmd.ExecuteNonQueryAsync ()
return Ok true
| None -> return Error "User does not exist"
}
/// Find a user by their e-mail address for the given web log
let findByEmail (email : string) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND email = @email"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@email", email) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toWebLogUser rdr) else None
} }
/// Get all users for the given web log /// Get all users for the given web log
let findByWebLog webLogId = backgroundTask { let findByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId" cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId ORDER BY LOWER(preferred_name)"
addWebLogId cmd webLogId addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toWebLogUser rdr return toList Map.toWebLogUser rdr
@@ -71,18 +91,14 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// 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 = backgroundTask { let findNames webLogId userIds = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND id IN (" let nameSql, nameParams = inClause "AND id" "id" WebLogUserId.toString userIds
userIds cmd.CommandText <- $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {nameSql}"
|> List.iteri (fun idx userId ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@id{idx}"
cmd.Parameters.AddWithValue ($"@id{idx}", WebLogUserId.toString userId) |> ignore)
cmd.CommandText <- $"{cmd.CommandText})"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddRange nameParams
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return return
toList Map.toWebLogUser rdr toList Map.toWebLogUser rdr
|> List.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u }) |> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
} }
/// Restore users from a backup /// Restore users from a backup
@@ -91,30 +107,49 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
do! add user do! add user
} }
/// Set a user's last seen date/time to now
let setLastSeen userId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"UPDATE web_log_user
SET last_seen_on = @lastSeenOn
WHERE id = @id
AND web_log_id = @webLogId"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId)
cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Noda.now ()))
] |> ignore
let! _ = cmd.ExecuteNonQueryAsync ()
()
}
/// Update a user /// Update a user
let update user = backgroundTask { let update user = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
UPDATE web_log_user "UPDATE web_log_user
SET user_name = @userName, SET email = @email,
first_name = @firstName, first_name = @firstName,
last_name = @lastName, last_name = @lastName,
preferred_name = @preferredName, preferred_name = @preferredName,
password_hash = @passwordHash, password_hash = @passwordHash,
salt = @salt, url = @url,
url = @url, access_level = @accessLevel,
authorization_level = @authorizationLevel created_on = @createdOn,
WHERE id = @id last_seen_on = @lastSeenOn
AND web_log_id = @webLogId""" WHERE id = @id
AND web_log_id = @webLogId"
addWebLogUserParameters cmd user addWebLogUserParameters cmd user
do! write cmd do! write cmd
} }
interface IWebLogUserData with interface IWebLogUserData with
member _.add user = add user member _.Add user = add user
member _.findByEmail email webLogId = findByEmail email webLogId member _.Delete userId webLogId = delete userId webLogId
member _.findById userId webLogId = findById userId webLogId member _.FindByEmail email webLogId = findByEmail email webLogId
member _.findByWebLog webLogId = findByWebLog webLogId member _.FindById userId webLogId = findById userId webLogId
member _.findNames webLogId userIds = findNames webLogId userIds member _.FindByWebLog webLogId = findByWebLog webLogId
member this.restore users = restore users member _.FindNames webLogId userIds = findNames webLogId userIds
member _.update user = update user member _.Restore users = restore users
member _.SetLastSeen userId webLogId = setLastSeen userId webLogId
member _.Update user = update user

View File

@@ -2,18 +2,543 @@ namespace MyWebLog.Data
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data.SQLite open MyWebLog.Data.SQLite
open Newtonsoft.Json
open NodaTime
/// SQLite myWebLog data implementation /// SQLite myWebLog data implementation
type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) = type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonSerializer) =
let ensureTables () = backgroundTask {
/// Determine if the given table exists
let tableExists (table : string) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(*) FROM sqlite_master WHERE type = 'table' AND name = @table"
cmd.Parameters.AddWithValue ("@table", table) |> ignore let! tables = backgroundTask {
let! count = count cmd cmd.CommandText <- "SELECT name FROM sqlite_master WHERE type = 'table'"
return count = 1 let! rdr = cmd.ExecuteReaderAsync ()
let mutable tableList = []
while rdr.Read() do
tableList <- Map.getString "name" rdr :: tableList
do! rdr.CloseAsync ()
return tableList
}
let needsTable table =
not (List.contains table tables)
seq {
// Theme tables
if needsTable "theme" then
"CREATE TABLE theme (
id TEXT PRIMARY KEY,
name TEXT NOT NULL,
version TEXT NOT NULL)"
if needsTable "theme_template" then
"CREATE TABLE theme_template (
theme_id TEXT NOT NULL REFERENCES theme (id),
name TEXT NOT NULL,
template TEXT NOT NULL,
PRIMARY KEY (theme_id, name))"
if needsTable "theme_asset" then
"CREATE TABLE theme_asset (
theme_id TEXT NOT NULL REFERENCES theme (id),
path TEXT NOT NULL,
updated_on TEXT NOT NULL,
data BLOB NOT NULL,
PRIMARY KEY (theme_id, path))"
// Web log tables
if needsTable "web_log" then
"CREATE TABLE web_log (
id TEXT PRIMARY KEY,
name TEXT NOT NULL,
slug TEXT NOT NULL,
subtitle TEXT,
default_page TEXT NOT NULL,
posts_per_page INTEGER NOT NULL,
theme_id TEXT NOT NULL REFERENCES theme (id),
url_base TEXT NOT NULL,
time_zone TEXT NOT NULL,
auto_htmx INTEGER NOT NULL DEFAULT 0,
uploads TEXT NOT NULL,
is_feed_enabled INTEGER NOT NULL DEFAULT 0,
feed_name TEXT NOT NULL,
items_in_feed INTEGER,
is_category_enabled INTEGER NOT NULL DEFAULT 0,
is_tag_enabled INTEGER NOT NULL DEFAULT 0,
copyright TEXT);
CREATE INDEX web_log_theme_idx ON web_log (theme_id)"
if needsTable "web_log_feed" then
"CREATE TABLE web_log_feed (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
source TEXT NOT NULL,
path TEXT NOT NULL,
podcast TEXT);
CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"
// Category table
if needsTable "category" then
"CREATE TABLE category (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
name TEXT NOT NULL,
slug TEXT NOT NULL,
description TEXT,
parent_id TEXT);
CREATE INDEX category_web_log_idx ON category (web_log_id)"
// Web log user table
if needsTable "web_log_user" then
"CREATE TABLE web_log_user (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
email TEXT NOT NULL,
first_name TEXT NOT NULL,
last_name TEXT NOT NULL,
preferred_name TEXT NOT NULL,
password_hash TEXT NOT NULL,
url TEXT,
access_level TEXT NOT NULL,
created_on TEXT NOT NULL,
last_seen_on TEXT);
CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id);
CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)"
// Page tables
if needsTable "page" then
"CREATE TABLE page (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id),
title TEXT NOT NULL,
permalink TEXT NOT NULL,
published_on TEXT NOT NULL,
updated_on TEXT NOT NULL,
is_in_page_list INTEGER NOT NULL DEFAULT 0,
template TEXT,
page_text TEXT NOT NULL,
meta_items TEXT);
CREATE INDEX page_web_log_idx ON page (web_log_id);
CREATE INDEX page_author_idx ON page (author_id);
CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)"
if needsTable "page_permalink" then
"CREATE TABLE page_permalink (
page_id TEXT NOT NULL REFERENCES page (id),
permalink TEXT NOT NULL,
PRIMARY KEY (page_id, permalink))"
if needsTable "page_revision" then
"CREATE TABLE page_revision (
page_id TEXT NOT NULL REFERENCES page (id),
as_of TEXT NOT NULL,
revision_text TEXT NOT NULL,
PRIMARY KEY (page_id, as_of))"
// Post tables
if needsTable "post" then
"CREATE TABLE post (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id),
status TEXT NOT NULL,
title TEXT NOT NULL,
permalink TEXT NOT NULL,
published_on TEXT,
updated_on TEXT NOT NULL,
template TEXT,
post_text TEXT NOT NULL,
meta_items TEXT,
episode TEXT);
CREATE INDEX post_web_log_idx ON post (web_log_id);
CREATE INDEX post_author_idx ON post (author_id);
CREATE INDEX post_status_idx ON post (web_log_id, status, updated_on);
CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)"
if needsTable "post_category" then
"CREATE TABLE post_category (
post_id TEXT NOT NULL REFERENCES post (id),
category_id TEXT NOT NULL REFERENCES category (id),
PRIMARY KEY (post_id, category_id));
CREATE INDEX post_category_category_idx ON post_category (category_id)"
if needsTable "post_tag" then
"CREATE TABLE post_tag (
post_id TEXT NOT NULL REFERENCES post (id),
tag TEXT NOT NULL,
PRIMARY KEY (post_id, tag))"
if needsTable "post_permalink" then
"CREATE TABLE post_permalink (
post_id TEXT NOT NULL REFERENCES post (id),
permalink TEXT NOT NULL,
PRIMARY KEY (post_id, permalink))"
if needsTable "post_revision" then
"CREATE TABLE post_revision (
post_id TEXT NOT NULL REFERENCES post (id),
as_of TEXT NOT NULL,
revision_text TEXT NOT NULL,
PRIMARY KEY (post_id, as_of))"
if needsTable "post_comment" then
"CREATE TABLE post_comment (
id TEXT PRIMARY KEY,
post_id TEXT NOT NULL REFERENCES post(id),
in_reply_to_id TEXT,
name TEXT NOT NULL,
email TEXT NOT NULL,
url TEXT,
status TEXT NOT NULL,
posted_on TEXT NOT NULL,
comment_text TEXT NOT NULL);
CREATE INDEX post_comment_post_idx ON post_comment (post_id)"
// Tag map table
if needsTable "tag_map" then
"CREATE TABLE tag_map (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
tag TEXT NOT NULL,
url_value TEXT NOT NULL);
CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)"
// Uploaded file table
if needsTable "upload" then
"CREATE TABLE upload (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
path TEXT NOT NULL,
updated_on TEXT NOT NULL,
data BLOB NOT NULL);
CREATE INDEX upload_web_log_idx ON upload (web_log_id);
CREATE INDEX upload_path_idx ON upload (web_log_id, path)"
// Database version table
if needsTable "db_version" then
"CREATE TABLE db_version (id TEXT PRIMARY KEY);
INSERT INTO db_version VALUES ('v2-rc1')"
}
|> Seq.map (fun sql ->
log.LogInformation $"Creating {(sql.Split ' ')[2]} table..."
cmd.CommandText <- sql
write cmd |> Async.AwaitTask |> Async.RunSynchronously)
|> List.ofSeq
|> ignore
}
/// Set the database version to the specified version
let setDbVersion version = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')"
do! write cmd
}
/// Implement the changes between v2-rc1 and v2-rc2
let migrateV2Rc1ToV2Rc2 () = backgroundTask {
let logStep = Utils.logMigrationStep log "v2-rc1 to v2-rc2"
// Move meta items, podcast settings, and episode details to JSON-encoded text fields
use cmd = conn.CreateCommand ()
logStep "Adding new columns"
cmd.CommandText <-
"ALTER TABLE web_log_feed ADD COLUMN podcast TEXT;
ALTER TABLE page ADD COLUMN meta_items TEXT;
ALTER TABLE post ADD COLUMN meta_items TEXT;
ALTER TABLE post ADD COLUMN episode TEXT"
do! write cmd
logStep "Migrating meta items"
let migrateMeta entity = backgroundTask {
cmd.CommandText <- $"SELECT * FROM %s{entity}_meta"
use! metaRdr = cmd.ExecuteReaderAsync ()
let allMetas =
seq {
while metaRdr.Read () do
Map.getString $"{entity}_id" metaRdr,
{ Name = Map.getString "name" metaRdr; Value = Map.getString "value" metaRdr }
} |> List.ofSeq
metaRdr.Close ()
let metas =
allMetas
|> List.map fst
|> List.distinct
|> List.map (fun it -> it, allMetas |> List.filter (fun meta -> fst meta = it))
metas
|> List.iter (fun (entityId, items) ->
cmd.CommandText <-
"UPDATE post
SET meta_items = @metaItems
WHERE id = @postId"
[ cmd.Parameters.AddWithValue ("@metaItems", Utils.serialize ser items)
cmd.Parameters.AddWithValue ("@id", entityId) ] |> ignore
let _ = cmd.ExecuteNonQuery ()
cmd.Parameters.Clear ())
}
do! migrateMeta "page"
do! migrateMeta "post"
logStep "Migrating podcasts and episodes"
cmd.CommandText <- "SELECT * FROM web_log_feed_podcast"
use! podcastRdr = cmd.ExecuteReaderAsync ()
let podcasts =
seq {
while podcastRdr.Read () do
CustomFeedId (Map.getString "feed_id" podcastRdr),
{ Title = Map.getString "title" podcastRdr
Subtitle = Map.tryString "subtitle" podcastRdr
ItemsInFeed = Map.getInt "items_in_feed" podcastRdr
Summary = Map.getString "summary" podcastRdr
DisplayedAuthor = Map.getString "displayed_author" podcastRdr
Email = Map.getString "email" podcastRdr
ImageUrl = Map.getString "image_url" podcastRdr |> Permalink
AppleCategory = Map.getString "apple_category" podcastRdr
AppleSubcategory = Map.tryString "apple_subcategory" podcastRdr
Explicit = Map.getString "explicit" podcastRdr |> ExplicitRating.parse
DefaultMediaType = Map.tryString "default_media_type" podcastRdr
MediaBaseUrl = Map.tryString "media_base_url" podcastRdr
PodcastGuid = Map.tryGuid "podcast_guid" podcastRdr
FundingUrl = Map.tryString "funding_url" podcastRdr
FundingText = Map.tryString "funding_text" podcastRdr
Medium = Map.tryString "medium" podcastRdr
|> Option.map PodcastMedium.parse
}
} |> List.ofSeq
podcastRdr.Close ()
podcasts
|> List.iter (fun (feedId, podcast) ->
cmd.CommandText <- "UPDATE web_log_feed SET podcast = @podcast WHERE id = @id"
[ cmd.Parameters.AddWithValue ("@podcast", Utils.serialize ser podcast)
cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feedId) ] |> ignore
let _ = cmd.ExecuteNonQuery ()
cmd.Parameters.Clear ())
cmd.CommandText <- "SELECT * FROM post_episode"
use! epRdr = cmd.ExecuteReaderAsync ()
let episodes =
seq {
while epRdr.Read () do
PostId (Map.getString "post_id" epRdr),
{ Media = Map.getString "media" epRdr
Length = Map.getLong "length" epRdr
Duration = Map.tryTimeSpan "duration" epRdr
|> Option.map Duration.FromTimeSpan
MediaType = Map.tryString "media_type" epRdr
ImageUrl = Map.tryString "image_url" epRdr
Subtitle = Map.tryString "subtitle" epRdr
Explicit = Map.tryString "explicit" epRdr
|> Option.map ExplicitRating.parse
ChapterFile = Map.tryString "chapter_file" epRdr
ChapterType = Map.tryString "chapter_type" epRdr
TranscriptUrl = Map.tryString "transcript_url" epRdr
TranscriptType = Map.tryString "transcript_type" epRdr
TranscriptLang = Map.tryString "transcript_lang" epRdr
TranscriptCaptions = Map.tryBoolean "transcript_captions" epRdr
SeasonNumber = Map.tryInt "season_number" epRdr
SeasonDescription = Map.tryString "season_description" epRdr
EpisodeNumber = Map.tryString "episode_number" epRdr
|> Option.map System.Double.Parse
EpisodeDescription = Map.tryString "episode_description" epRdr
}
} |> List.ofSeq
epRdr.Close ()
episodes
|> List.iter (fun (postId, episode) ->
cmd.CommandText <- "UPDATE post SET episode = @episode WHERE id = @id"
[ cmd.Parameters.AddWithValue ("@episode", Utils.serialize ser episode)
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) ] |> ignore
let _ = cmd.ExecuteNonQuery ()
cmd.Parameters.Clear ())
logStep "Migrating dates/times"
let inst (dt : System.DateTime) =
System.DateTime (dt.Ticks, System.DateTimeKind.Utc)
|> (Instant.FromDateTimeUtc >> Noda.toSecondsPrecision)
// page.updated_on, page.published_on
cmd.CommandText <- "SELECT id, updated_on, published_on FROM page"
use! pageRdr = cmd.ExecuteReaderAsync ()
let toUpdate =
seq {
while pageRdr.Read () do
Map.getString "id" pageRdr,
inst (Map.getDateTime "updated_on" pageRdr),
inst (Map.getDateTime "published_on" pageRdr)
} |> List.ofSeq
pageRdr.Close ()
cmd.CommandText <- "UPDATE page SET updated_on = @updatedOn, published_on = @publishedOn WHERE id = @id"
[ cmd.Parameters.Add ("@id", SqliteType.Text)
cmd.Parameters.Add ("@updatedOn", SqliteType.Text)
cmd.Parameters.Add ("@publishedOn", SqliteType.Text)
] |> ignore
toUpdate
|> List.iter (fun (pageId, updatedOn, publishedOn) ->
cmd.Parameters["@id" ].Value <- pageId
cmd.Parameters["@updatedOn" ].Value <- instantParam updatedOn
cmd.Parameters["@publishedOn"].Value <- instantParam publishedOn
let _ = cmd.ExecuteNonQuery ()
())
cmd.Parameters.Clear ()
// page_revision.as_of
cmd.CommandText <- "SELECT * FROM page_revision"
use! pageRevRdr = cmd.ExecuteReaderAsync ()
let toUpdate =
seq {
while pageRevRdr.Read () do
let asOf = Map.getDateTime "as_of" pageRevRdr
Map.getString "page_id" pageRevRdr, asOf, inst asOf, Map.getString "revision_text" pageRevRdr
} |> List.ofSeq
pageRevRdr.Close ()
cmd.CommandText <-
"DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @oldAsOf;
INSERT INTO page_revision (page_id, as_of, revision_text) VALUES (@pageId, @asOf, @text)"
[ cmd.Parameters.Add ("@pageId", SqliteType.Text)
cmd.Parameters.Add ("@oldAsOf", SqliteType.Text)
cmd.Parameters.Add ("@asOf", SqliteType.Text)
cmd.Parameters.Add ("@text", SqliteType.Text)
] |> ignore
toUpdate
|> List.iter (fun (pageId, oldAsOf, asOf, text) ->
cmd.Parameters["@pageId" ].Value <- pageId
cmd.Parameters["@oldAsOf"].Value <- oldAsOf
cmd.Parameters["@asOf" ].Value <- instantParam asOf
cmd.Parameters["@text" ].Value <- text
let _ = cmd.ExecuteNonQuery ()
())
cmd.Parameters.Clear ()
// post.updated_on, post.published_on (opt)
cmd.CommandText <- "SELECT id, updated_on, published_on FROM post"
use! postRdr = cmd.ExecuteReaderAsync ()
let toUpdate =
seq {
while postRdr.Read () do
Map.getString "id" postRdr,
inst (Map.getDateTime "updated_on" postRdr),
(Map.tryDateTime "published_on" postRdr |> Option.map inst)
} |> List.ofSeq
postRdr.Close ()
cmd.CommandText <- "UPDATE post SET updated_on = @updatedOn, published_on = @publishedOn WHERE id = @id"
[ cmd.Parameters.Add ("@id", SqliteType.Text)
cmd.Parameters.Add ("@updatedOn", SqliteType.Text)
cmd.Parameters.Add ("@publishedOn", SqliteType.Text)
] |> ignore
toUpdate
|> List.iter (fun (postId, updatedOn, publishedOn) ->
cmd.Parameters["@id" ].Value <- postId
cmd.Parameters["@updatedOn" ].Value <- instantParam updatedOn
cmd.Parameters["@publishedOn"].Value <- maybeInstant publishedOn
let _ = cmd.ExecuteNonQuery ()
())
cmd.Parameters.Clear ()
// post_revision.as_of
cmd.CommandText <- "SELECT * FROM post_revision"
use! postRevRdr = cmd.ExecuteReaderAsync ()
let toUpdate =
seq {
while postRevRdr.Read () do
let asOf = Map.getDateTime "as_of" postRevRdr
Map.getString "post_id" postRevRdr, asOf, inst asOf, Map.getString "revision_text" postRevRdr
} |> List.ofSeq
postRevRdr.Close ()
cmd.CommandText <-
"DELETE FROM post_revision WHERE post_id = @postId AND as_of = @oldAsOf;
INSERT INTO post_revision (post_id, as_of, revision_text) VALUES (@postId, @asOf, @text)"
[ cmd.Parameters.Add ("@postId", SqliteType.Text)
cmd.Parameters.Add ("@oldAsOf", SqliteType.Text)
cmd.Parameters.Add ("@asOf", SqliteType.Text)
cmd.Parameters.Add ("@text", SqliteType.Text)
] |> ignore
toUpdate
|> List.iter (fun (postId, oldAsOf, asOf, text) ->
cmd.Parameters["@postId" ].Value <- postId
cmd.Parameters["@oldAsOf"].Value <- oldAsOf
cmd.Parameters["@asOf" ].Value <- instantParam asOf
cmd.Parameters["@text" ].Value <- text
let _ = cmd.ExecuteNonQuery ()
())
cmd.Parameters.Clear ()
// theme_asset.updated_on
cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset"
use! assetRdr = cmd.ExecuteReaderAsync ()
let toUpdate =
seq {
while assetRdr.Read () do
Map.getString "theme_id" assetRdr, Map.getString "path" assetRdr,
inst (Map.getDateTime "updated_on" assetRdr)
} |> List.ofSeq
assetRdr.Close ()
cmd.CommandText <- "UPDATE theme_asset SET updated_on = @updatedOn WHERE theme_id = @themeId AND path = @path"
[ cmd.Parameters.Add ("@updatedOn", SqliteType.Text)
cmd.Parameters.Add ("@themeId", SqliteType.Text)
cmd.Parameters.Add ("@path", SqliteType.Text)
] |> ignore
toUpdate
|> List.iter (fun (themeId, path, updatedOn) ->
cmd.Parameters["@themeId" ].Value <- themeId
cmd.Parameters["@path" ].Value <- path
cmd.Parameters["@updatedOn"].Value <- instantParam updatedOn
let _ = cmd.ExecuteNonQuery ()
())
cmd.Parameters.Clear ()
// upload.updated_on
cmd.CommandText <- "SELECT id, updated_on FROM upload"
use! upRdr = cmd.ExecuteReaderAsync ()
let toUpdate =
seq {
while upRdr.Read () do
Map.getString "id" upRdr, inst (Map.getDateTime "updated_on" upRdr)
} |> List.ofSeq
upRdr.Close ()
cmd.CommandText <- "UPDATE upload SET updated_on = @updatedOn WHERE id = @id"
[ cmd.Parameters.Add ("@updatedOn", SqliteType.Text)
cmd.Parameters.Add ("@id", SqliteType.Text)
] |> ignore
toUpdate
|> List.iter (fun (upId, updatedOn) ->
cmd.Parameters["@id" ].Value <- upId
cmd.Parameters["@updatedOn"].Value <- instantParam updatedOn
let _ = cmd.ExecuteNonQuery ()
())
cmd.Parameters.Clear ()
// web_log_user.created_on, web_log_user.last_seen_on (opt)
cmd.CommandText <- "SELECT id, created_on, last_seen_on FROM web_log_user"
use! userRdr = cmd.ExecuteReaderAsync ()
let toUpdate =
seq {
while userRdr.Read () do
Map.getString "id" userRdr,
inst (Map.getDateTime "created_on" userRdr),
(Map.tryDateTime "last_seen_on" userRdr |> Option.map inst)
} |> List.ofSeq
userRdr.Close ()
cmd.CommandText <- "UPDATE web_log_user SET created_on = @createdOn, last_seen_on = @lastSeenOn WHERE id = @id"
[ cmd.Parameters.Add ("@id", SqliteType.Text)
cmd.Parameters.Add ("@createdOn", SqliteType.Text)
cmd.Parameters.Add ("@lastSeenOn", SqliteType.Text)
] |> ignore
toUpdate
|> List.iter (fun (userId, createdOn, lastSeenOn) ->
cmd.Parameters["@id" ].Value <- userId
cmd.Parameters["@createdOn" ].Value <- instantParam createdOn
cmd.Parameters["@lastSeenOn"].Value <- maybeInstant lastSeenOn
let _ = cmd.ExecuteNonQuery ()
())
cmd.Parameters.Clear ()
conn.Close ()
conn.Open ()
logStep "Dropping old tables and columns"
cmd.CommandText <-
"ALTER TABLE web_log_user DROP COLUMN salt;
DROP TABLE post_episode;
DROP TABLE post_meta;
DROP TABLE page_meta;
DROP TABLE web_log_feed_podcast"
do! write cmd
logStep "Setting database version to v2-rc2"
do! setDbVersion "v2-rc2"
}
/// Migrate data among versions (up only)
let migrate version = backgroundTask {
match version with
| Some v when v = "v2-rc2" -> ()
| Some v when v = "v2-rc1" -> do! migrateV2Rc1ToV2Rc2 ()
| Some _
| None ->
log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
do! setDbVersion Utils.currentDbVersion
} }
/// The connection for this instance /// The connection for this instance
@@ -31,353 +556,26 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
interface IData with interface IData with
member _.Category = SQLiteCategoryData conn member _.Category = SQLiteCategoryData conn
member _.Page = SQLitePageData conn member _.Page = SQLitePageData (conn, ser)
member _.Post = SQLitePostData conn member _.Post = SQLitePostData (conn, ser)
member _.TagMap = SQLiteTagMapData conn member _.TagMap = SQLiteTagMapData conn
member _.Theme = SQLiteThemeData conn member _.Theme = SQLiteThemeData conn
member _.ThemeAsset = SQLiteThemeAssetData conn member _.ThemeAsset = SQLiteThemeAssetData conn
member _.Upload = SQLiteUploadData conn member _.Upload = SQLiteUploadData conn
member _.WebLog = SQLiteWebLogData conn member _.WebLog = SQLiteWebLogData (conn, ser)
member _.WebLogUser = SQLiteWebLogUserData conn member _.WebLogUser = SQLiteWebLogUserData conn
member _.startUp () = backgroundTask { member _.Serializer = ser
member _.StartUp () = backgroundTask {
do! ensureTables ()
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT id FROM db_version"
// Theme tables use! rdr = cmd.ExecuteReaderAsync ()
match! tableExists "theme" with let version = if rdr.Read () then Some (Map.getString "id" rdr) else None
| true -> () match version with
| false -> | Some v when v = "v2-rc2" -> ()
log.LogInformation "Creating theme table..." | Some _
cmd.CommandText <- """ | None -> do! migrate version
CREATE TABLE theme (
id TEXT PRIMARY KEY,
name TEXT NOT NULL,
version TEXT NOT NULL)"""
do! write cmd
match! tableExists "theme_template" with
| true -> ()
| false ->
log.LogInformation "Creating theme_template table..."
cmd.CommandText <- """
CREATE TABLE theme_template (
theme_id TEXT NOT NULL REFERENCES theme (id),
name TEXT NOT NULL,
template TEXT NOT NULL,
PRIMARY KEY (theme_id, name))"""
do! write cmd
match! tableExists "theme_asset" with
| true -> ()
| false ->
log.LogInformation "Creating theme_asset table..."
cmd.CommandText <- """
CREATE TABLE theme_asset (
theme_id TEXT NOT NULL REFERENCES theme (id),
path TEXT NOT NULL,
updated_on TEXT NOT NULL,
data BLOB NOT NULL,
PRIMARY KEY (theme_id, path))"""
do! write cmd
// Web log tables
match! tableExists "web_log" with
| true -> ()
| false ->
log.LogInformation "Creating web_log table..."
cmd.CommandText <- """
CREATE TABLE web_log (
id TEXT PRIMARY KEY,
name TEXT NOT NULL,
slug TEXT NOT NULL,
subtitle TEXT,
default_page TEXT NOT NULL,
posts_per_page INTEGER NOT NULL,
theme_id TEXT NOT NULL REFERENCES theme (id),
url_base TEXT NOT NULL,
time_zone TEXT NOT NULL,
auto_htmx INTEGER NOT NULL DEFAULT 0,
uploads TEXT NOT NULL,
feed_enabled INTEGER NOT NULL DEFAULT 0,
feed_name TEXT NOT NULL,
items_in_feed INTEGER,
category_enabled INTEGER NOT NULL DEFAULT 0,
tag_enabled INTEGER NOT NULL DEFAULT 0,
copyright TEXT);
CREATE INDEX web_log_theme_idx ON web_log (theme_id)"""
do! write cmd
match! tableExists "web_log_feed" with
| true -> ()
| false ->
log.LogInformation "Creating web_log_feed table..."
cmd.CommandText <- """
CREATE TABLE web_log_feed (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
source TEXT NOT NULL,
path TEXT NOT NULL);
CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"""
do! write cmd
match! tableExists "web_log_feed_podcast" with
| true -> ()
| false ->
log.LogInformation "Creating web_log_feed_podcast table..."
cmd.CommandText <- """
CREATE TABLE web_log_feed_podcast (
feed_id TEXT PRIMARY KEY REFERENCES web_log_feed (id),
title TEXT NOT NULL,
subtitle TEXT,
items_in_feed INTEGER NOT NULL,
summary TEXT NOT NULL,
displayed_author TEXT NOT NULL,
email TEXT NOT NULL,
image_url TEXT NOT NULL,
itunes_category TEXT NOT NULL,
itunes_subcategory TEXT,
explicit TEXT NOT NULL,
default_media_type TEXT,
media_base_url TEXT,
guid TEXT,
funding_url TEXT,
funding_text TEXT,
medium TEXT)"""
do! write cmd
// Category table
match! tableExists "category" with
| true -> ()
| false ->
log.LogInformation "Creating category table..."
cmd.CommandText <- """
CREATE TABLE category (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
name TEXT NOT NULL,
slug TEXT NOT NULL,
description TEXT,
parent_id TEXT);
CREATE INDEX category_web_log_idx ON category (web_log_id)"""
do! write cmd
// Web log user table
match! tableExists "web_log_user" with
| true -> ()
| false ->
log.LogInformation "Creating web_log_user table..."
cmd.CommandText <- """
CREATE TABLE web_log_user (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
user_name TEXT NOT NULL,
first_name TEXT NOT NULL,
last_name TEXT NOT NULL,
preferred_name TEXT NOT NULL,
password_hash TEXT NOT NULL,
salt TEXT NOT NULL,
url TEXT,
authorization_level TEXT NOT NULL);
CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id);
CREATE INDEX web_log_user_user_name_idx ON web_log_user (web_log_id, user_name)"""
do! write cmd
// Page tables
match! tableExists "page" with
| true -> ()
| false ->
log.LogInformation "Creating page table..."
cmd.CommandText <- """
CREATE TABLE page (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id),
title TEXT NOT NULL,
permalink TEXT NOT NULL,
published_on TEXT NOT NULL,
updated_on TEXT NOT NULL,
show_in_page_list INTEGER NOT NULL DEFAULT 0,
template TEXT,
page_text TEXT NOT NULL);
CREATE INDEX page_web_log_idx ON page (web_log_id);
CREATE INDEX page_author_idx ON page (author_id);
CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)"""
do! write cmd
match! tableExists "page_meta" with
| true -> ()
| false ->
log.LogInformation "Creating page_meta table..."
cmd.CommandText <- """
CREATE TABLE page_meta (
page_id TEXT NOT NULL REFERENCES page (id),
name TEXT NOT NULL,
value TEXT NOT NULL,
PRIMARY KEY (page_id, name, value))"""
do! write cmd
match! tableExists "page_permalink" with
| true -> ()
| false ->
log.LogInformation "Creating page_permalink table..."
cmd.CommandText <- """
CREATE TABLE page_permalink (
page_id TEXT NOT NULL REFERENCES page (id),
permalink TEXT NOT NULL,
PRIMARY KEY (page_id, permalink))"""
do! write cmd
match! tableExists "page_revision" with
| true -> ()
| false ->
log.LogInformation "Creating page_revision table..."
cmd.CommandText <- """
CREATE TABLE page_revision (
page_id TEXT NOT NULL REFERENCES page (id),
as_of TEXT NOT NULL,
revision_text TEXT NOT NULL,
PRIMARY KEY (page_id, as_of))"""
do! write cmd
// Post tables
match! tableExists "post" with
| true -> ()
| false ->
log.LogInformation "Creating post table..."
cmd.CommandText <- """
CREATE TABLE post (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id),
status TEXT NOT NULL,
title TEXT NOT NULL,
permalink TEXT NOT NULL,
published_on TEXT,
updated_on TEXT NOT NULL,
template TEXT,
post_text TEXT NOT NULL);
CREATE INDEX post_web_log_idx ON post (web_log_id);
CREATE INDEX post_author_idx ON post (author_id);
CREATE INDEX post_status_idx ON post (web_log_id, status, updated_on);
CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)"""
do! write cmd
match! tableExists "post_category" with
| true -> ()
| false ->
log.LogInformation "Creating post_category table..."
cmd.CommandText <- """
CREATE TABLE post_category (
post_id TEXT NOT NULL REFERENCES post (id),
category_id TEXT NOT NULL REFERENCES category (id),
PRIMARY KEY (post_id, category_id));
CREATE INDEX post_category_category_idx ON post_category (category_id)"""
do! write cmd
match! tableExists "post_episode" with
| true -> ()
| false ->
log.LogInformation "Creating post_episode table..."
cmd.CommandText <- """
CREATE TABLE post_episode (
post_id TEXT PRIMARY KEY REFERENCES post(id),
media TEXT NOT NULL,
length INTEGER NOT NULL,
duration TEXT,
media_type TEXT,
image_url TEXT,
subtitle TEXT,
explicit TEXT,
chapter_file TEXT,
chapter_type TEXT,
transcript_url TEXT,
transcript_type TEXT,
transcript_lang TEXT,
transcript_captions INTEGER,
season_number INTEGER,
season_description TEXT,
episode_number TEXT,
episode_description TEXT)"""
do! write cmd
match! tableExists "post_tag" with
| true -> ()
| false ->
log.LogInformation "Creating post_tag table..."
cmd.CommandText <- """
CREATE TABLE post_tag (
post_id TEXT NOT NULL REFERENCES post (id),
tag TEXT NOT NULL,
PRIMARY KEY (post_id, tag))"""
do! write cmd
match! tableExists "post_meta" with
| true -> ()
| false ->
log.LogInformation "Creating post_meta table..."
cmd.CommandText <- """
CREATE TABLE post_meta (
post_id TEXT NOT NULL REFERENCES post (id),
name TEXT NOT NULL,
value TEXT NOT NULL,
PRIMARY KEY (post_id, name, value))"""
do! write cmd
match! tableExists "post_permalink" with
| true -> ()
| false ->
log.LogInformation "Creating post_permalink table..."
cmd.CommandText <- """
CREATE TABLE post_permalink (
post_id TEXT NOT NULL REFERENCES post (id),
permalink TEXT NOT NULL,
PRIMARY KEY (post_id, permalink))"""
do! write cmd
match! tableExists "post_revision" with
| true -> ()
| false ->
log.LogInformation "Creating post_revision table..."
cmd.CommandText <- """
CREATE TABLE post_revision (
post_id TEXT NOT NULL REFERENCES post (id),
as_of TEXT NOT NULL,
revision_text TEXT NOT NULL,
PRIMARY KEY (post_id, as_of))"""
do! write cmd
match! tableExists "post_comment" with
| true -> ()
| false ->
log.LogInformation "Creating post_comment table..."
cmd.CommandText <- """
CREATE TABLE post_comment (
id TEXT PRIMARY KEY,
post_id TEXT NOT NULL REFERENCES post(id),
in_reply_to_id TEXT,
name TEXT NOT NULL,
email TEXT NOT NULL,
url TEXT,
status TEXT NOT NULL,
posted_on TEXT NOT NULL,
comment_text TEXT NOT NULL);
CREATE INDEX post_comment_post_idx ON post_comment (post_id)"""
do! write cmd
// Tag map table
match! tableExists "tag_map" with
| true -> ()
| false ->
log.LogInformation "Creating tag_map table..."
cmd.CommandText <- """
CREATE TABLE tag_map (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
tag TEXT NOT NULL,
url_value TEXT NOT NULL);
CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)"""
do! write cmd
// Uploaded file table
match! tableExists "upload" with
| true -> ()
| false ->
log.LogInformation "Creating upload table..."
cmd.CommandText <- """
CREATE TABLE upload (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
path TEXT NOT NULL,
updated_on TEXT NOT NULL,
data BLOB NOT NULL);
CREATE INDEX upload_web_log_idx ON upload (web_log_id);
CREATE INDEX upload_path_idx ON upload (web_log_id, path)"""
do! write cmd
} }

View File

@@ -5,18 +5,54 @@ module internal MyWebLog.Data.Utils
open MyWebLog open MyWebLog
open MyWebLog.ViewModels open MyWebLog.ViewModels
/// The current database version
let currentDbVersion = "v2-rc2"
/// Create a category hierarchy from the given list of categories /// Create a category hierarchy from the given list of categories
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
{ id = CategoryId.toString cat.id { Id = CategoryId.toString cat.Id
slug = fullSlug Slug = fullSlug
name = cat.name Name = cat.Name
description = cat.description Description = cat.Description
parentNames = Array.ofList parentNames ParentNames = Array.ofList parentNames
// Post counts are filled on a second pass // Post counts are filled on a second pass
postCount = 0 PostCount = 0
} }
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
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))
List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems
/// Find meta items added and removed
let diffMetaItems (oldItems : MetaItem list) newItems =
diffLists oldItems newItems (fun item -> $"{item.Name}|{item.Value}")
/// Find the permalinks added and removed
let diffPermalinks oldLinks newLinks =
diffLists oldLinks newLinks Permalink.toString
/// Find the revisions added and removed
let diffRevisions oldRevs newRevs =
diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.ToUnixTimeTicks ()}|{MarkupText.toString rev.Text}")
open MyWebLog.Converters
open Newtonsoft.Json
/// Serialize an object to JSON
let serialize<'T> ser (item : 'T) =
JsonConvert.SerializeObject (item, Json.settings ser)
/// Deserialize a JSON string
let deserialize<'T> (ser : JsonSerializer) value =
JsonConvert.DeserializeObject<'T> (value, Json.settings ser)
open Microsoft.Extensions.Logging
/// Log a migration step
let logMigrationStep<'T> (log : ILogger<'T>) migration message =
log.LogInformation $"Migrating %s{migration}: %s{message}"

View File

@@ -2,27 +2,28 @@
open System open System
open MyWebLog open MyWebLog
open NodaTime
/// A category under which a post may be identified /// A category under which a post may be identified
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Category = type Category =
{ /// The ID of the category { /// The ID of the category
id : CategoryId Id : CategoryId
/// The ID of the web log to which the category belongs /// The ID of the web log to which the category belongs
webLogId : WebLogId WebLogId : WebLogId
/// The displayed name /// The displayed name
name : string Name : string
/// The slug (used in category URLs) /// The slug (used in category URLs)
slug : string Slug : string
/// A longer description of the category /// A longer description of the category
description : string option Description : string option
/// The parent ID of this category (if a subcategory) /// The parent ID of this category (if a subcategory)
parentId : CategoryId option ParentId : CategoryId option
} }
/// Functions to support categories /// Functions to support categories
@@ -30,12 +31,12 @@ module Category =
/// An empty category /// An empty category
let empty = let empty =
{ id = CategoryId.empty { Id = CategoryId.empty
webLogId = WebLogId.empty WebLogId = WebLogId.empty
name = "" Name = ""
slug = "" Slug = ""
description = None Description = None
parentId = None ParentId = None
} }
@@ -43,31 +44,31 @@ module Category =
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Comment = type Comment =
{ /// The ID of the comment { /// The ID of the comment
id : CommentId Id : CommentId
/// The ID of the post to which this comment applies /// The ID of the post to which this comment applies
postId : PostId PostId : PostId
/// The ID of the comment to which this comment is a reply /// The ID of the comment to which this comment is a reply
inReplyToId : CommentId option InReplyToId : CommentId option
/// The name of the commentor /// The name of the commentor
name : string Name : string
/// The e-mail address of the commentor /// The e-mail address of the commentor
email : string Email : string
/// The URL of the commentor's personal website /// The URL of the commentor's personal website
url : string option Url : string option
/// The status of the comment /// The status of the comment
status : CommentStatus Status : CommentStatus
/// When the comment was posted /// When the comment was posted
postedOn : DateTime PostedOn : Instant
/// The text of the comment /// The text of the comment
text : string Text : string
} }
/// Functions to support comments /// Functions to support comments
@@ -75,15 +76,15 @@ module Comment =
/// An empty comment /// An empty comment
let empty = let empty =
{ id = CommentId.empty { Id = CommentId.empty
postId = PostId.empty PostId = PostId.empty
inReplyToId = None InReplyToId = None
name = "" Name = ""
email = "" Email = ""
url = None Url = None
status = Pending Status = Pending
postedOn = DateTime.UtcNow PostedOn = Noda.epoch
text = "" Text = ""
} }
@@ -91,43 +92,43 @@ module Comment =
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Page = type Page =
{ /// The ID of this page { /// The ID of this page
id : PageId Id : PageId
/// The ID of the web log to which this page belongs /// The ID of the web log to which this page belongs
webLogId : WebLogId WebLogId : WebLogId
/// The ID of the author of this page /// The ID of the author of this page
authorId : WebLogUserId AuthorId : WebLogUserId
/// The title of the page /// The title of the page
title : string Title : string
/// The link at which this page is displayed /// The link at which this page is displayed
permalink : Permalink Permalink : Permalink
/// When this page was published /// When this page was published
publishedOn : DateTime PublishedOn : Instant
/// When this page was last updated /// When this page was last updated
updatedOn : DateTime UpdatedOn : Instant
/// Whether this page shows as part of the web log's navigation /// Whether this page shows as part of the web log's navigation
showInPageList : bool IsInPageList : bool
/// The template to use when rendering this page /// The template to use when rendering this page
template : string option Template : string option
/// The current text of the page /// The current text of the page
text : string Text : string
/// Metadata for this page /// Metadata for this page
metadata : MetaItem list Metadata : MetaItem list
/// Permalinks at which this page may have been previously served (useful for migrated content) /// Permalinks at which this page may have been previously served (useful for migrated content)
priorPermalinks : Permalink list PriorPermalinks : Permalink list
/// Revisions of this page /// Revisions of this page
revisions : Revision list Revisions : Revision list
} }
/// Functions to support pages /// Functions to support pages
@@ -135,19 +136,19 @@ module Page =
/// An empty page /// An empty page
let empty = let empty =
{ id = PageId.empty { Id = PageId.empty
webLogId = WebLogId.empty WebLogId = WebLogId.empty
authorId = WebLogUserId.empty AuthorId = WebLogUserId.empty
title = "" Title = ""
permalink = Permalink.empty Permalink = Permalink.empty
publishedOn = DateTime.MinValue PublishedOn = Noda.epoch
updatedOn = DateTime.MinValue UpdatedOn = Noda.epoch
showInPageList = false IsInPageList = false
template = None Template = None
text = "" Text = ""
metadata = [] Metadata = []
priorPermalinks = [] PriorPermalinks = []
revisions = [] Revisions = []
} }
@@ -155,52 +156,52 @@ module Page =
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Post = type Post =
{ /// The ID of this post { /// The ID of this post
id : PostId Id : PostId
/// The ID of the web log to which this post belongs /// The ID of the web log to which this post belongs
webLogId : WebLogId WebLogId : WebLogId
/// The ID of the author of this post /// The ID of the author of this post
authorId : WebLogUserId AuthorId : WebLogUserId
/// The status /// The status
status : PostStatus Status : PostStatus
/// The title /// The title
title : string Title : string
/// The link at which the post resides /// The link at which the post resides
permalink : Permalink Permalink : Permalink
/// The instant on which the post was originally published /// The instant on which the post was originally published
publishedOn : DateTime option PublishedOn : Instant option
/// The instant on which the post was last updated /// The instant on which the post was last updated
updatedOn : DateTime UpdatedOn : Instant
/// The template to use in displaying the post /// The template to use in displaying the post
template : string option Template : string option
/// The text of the post in HTML (ready to display) format /// The text of the post in HTML (ready to display) format
text : string Text : string
/// The Ids of the categories to which this is assigned /// The Ids of the categories to which this is assigned
categoryIds : CategoryId list CategoryIds : CategoryId list
/// The tags for the post /// The tags for the post
tags : string list Tags : string list
/// Podcast episode information for this post /// Podcast episode information for this post
episode : Episode option Episode : Episode option
/// Metadata for the post /// Metadata for the post
metadata : MetaItem list Metadata : MetaItem list
/// Permalinks at which this post may have been previously served (useful for migrated content) /// Permalinks at which this post may have been previously served (useful for migrated content)
priorPermalinks : Permalink list PriorPermalinks : Permalink list
/// The revisions for this post /// The revisions for this post
revisions : Revision list Revisions : Revision list
} }
/// Functions to support posts /// Functions to support posts
@@ -208,38 +209,38 @@ module Post =
/// An empty post /// An empty post
let empty = let empty =
{ id = PostId.empty { Id = PostId.empty
webLogId = WebLogId.empty WebLogId = WebLogId.empty
authorId = WebLogUserId.empty AuthorId = WebLogUserId.empty
status = Draft Status = Draft
title = "" Title = ""
permalink = Permalink.empty Permalink = Permalink.empty
publishedOn = None PublishedOn = None
updatedOn = DateTime.MinValue UpdatedOn = Noda.epoch
text = "" Text = ""
template = None Template = None
categoryIds = [] CategoryIds = []
tags = [] Tags = []
episode = None Episode = None
metadata = [] Metadata = []
priorPermalinks = [] PriorPermalinks = []
revisions = [] Revisions = []
} }
/// 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")
type TagMap = type TagMap =
{ /// The ID of this tag mapping { /// The ID of this tag mapping
id : TagMapId Id : TagMapId
/// The ID of the web log to which this tag mapping belongs /// The ID of the web log to which this tag mapping belongs
webLogId : WebLogId WebLogId : WebLogId
/// The tag which should be mapped to a different value in links /// The tag which should be mapped to a different value in links
tag : string Tag : string
/// The value by which the tag should be linked /// The value by which the tag should be linked
urlValue : string UrlValue : string
} }
/// Functions to support tag mappings /// Functions to support tag mappings
@@ -247,26 +248,26 @@ module TagMap =
/// An empty tag mapping /// An empty tag mapping
let empty = let empty =
{ id = TagMapId.empty { Id = TagMapId.empty
webLogId = WebLogId.empty WebLogId = WebLogId.empty
tag = "" Tag = ""
urlValue = "" UrlValue = ""
} }
/// A theme /// A theme
type Theme = type Theme =
{ /// The ID / path of the theme { /// The ID / path of the theme
id : ThemeId Id : ThemeId
/// A long name of the theme /// A long name of the theme
name : string Name : string
/// The version of the theme /// The version of the theme
version : string Version : string
/// The templates for this theme /// The templates for this theme
templates: ThemeTemplate list Templates: ThemeTemplate list
} }
/// Functions to support themes /// Functions to support themes
@@ -274,10 +275,10 @@ module Theme =
/// An empty theme /// An empty theme
let empty = let empty =
{ id = ThemeId "" { Id = ThemeId ""
name = "" Name = ""
version = "" Version = ""
templates = [] Templates = []
} }
@@ -285,85 +286,95 @@ module Theme =
type ThemeAsset = type ThemeAsset =
{ {
/// The ID of the asset (consists of theme and path) /// The ID of the asset (consists of theme and path)
id : ThemeAssetId Id : ThemeAssetId
/// The updated date (set from the file date from the ZIP archive) /// The updated date (set from the file date from the ZIP archive)
updatedOn : DateTime UpdatedOn : Instant
/// The data for the asset /// The data for the asset
data : byte[] Data : byte[]
} }
/// Functions to support theme assets
module ThemeAsset =
/// An empty theme asset
let empty =
{ Id = ThemeAssetId (ThemeId "", "")
UpdatedOn = Noda.epoch
Data = [||]
}
/// An uploaded file /// An uploaded file
type Upload = type Upload =
{ /// The ID of the upload { /// The ID of the upload
id : UploadId Id : UploadId
/// The ID of the web log to which this upload belongs /// The ID of the web log to which this upload belongs
webLogId : WebLogId WebLogId : WebLogId
/// The link at which this upload is served /// The link at which this upload is served
path : Permalink Path : Permalink
/// The updated date/time for this upload /// The updated date/time for this upload
updatedOn : DateTime UpdatedOn : Instant
/// The data for the upload /// The data for the upload
data : byte[] Data : byte[]
} }
/// Functions to support uploaded files /// Functions to support uploaded files
module Upload = module Upload =
/// An empty upload /// An empty upload
let empty = { let empty =
id = UploadId.empty { Id = UploadId.empty
webLogId = WebLogId.empty WebLogId = WebLogId.empty
path = Permalink.empty Path = Permalink.empty
updatedOn = DateTime.MinValue UpdatedOn = Noda.epoch
data = [||] Data = [||]
} }
/// A web log /// A web log
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type WebLog = type WebLog =
{ /// The ID of the web log { /// The ID of the web log
id : WebLogId Id : WebLogId
/// The name of the web log /// The name of the web log
name : string Name : string
/// The slug of the web log /// The slug of the web log
slug : string Slug : string
/// A subtitle for the web log /// A subtitle for the web log
subtitle : string option Subtitle : string option
/// The default page ("posts" or a page Id) /// The default page ("posts" or a page Id)
defaultPage : string DefaultPage : string
/// The number of posts to display on pages of posts /// The number of posts to display on pages of posts
postsPerPage : int PostsPerPage : int
/// The path of the theme (within /themes) /// The ID of the theme (also the path within /themes)
themePath : string ThemeId : ThemeId
/// The URL base /// The URL base
urlBase : string UrlBase : string
/// The time zone in which dates/times should be displayed /// The time zone in which dates/times should be displayed
timeZone : string TimeZone : string
/// The RSS options for this web log /// The RSS options for this web log
rss : RssOptions Rss : RssOptions
/// Whether to automatically load htmx /// Whether to automatically load htmx
autoHtmx : bool AutoHtmx : bool
/// Where uploads are placed /// Where uploads are placed
uploads : UploadDestination Uploads : UploadDestination
} }
/// Functions to support web logs /// Functions to support web logs
@@ -371,78 +382,77 @@ module WebLog =
/// An empty web log /// An empty web log
let empty = let empty =
{ id = WebLogId.empty { Id = WebLogId.empty
name = "" Name = ""
slug = "" Slug = ""
subtitle = None Subtitle = None
defaultPage = "" DefaultPage = ""
postsPerPage = 10 PostsPerPage = 10
themePath = "default" ThemeId = ThemeId "default"
urlBase = "" UrlBase = ""
timeZone = "" TimeZone = ""
rss = RssOptions.empty Rss = RssOptions.empty
autoHtmx = false AutoHtmx = false
uploads = Database Uploads = Database
} }
/// Get the host (including scheme) and extra path from the URL base /// Get the host (including scheme) and extra path from the URL base
let hostAndPath webLog = let hostAndPath webLog =
let scheme = webLog.urlBase.Split "://" let scheme = webLog.UrlBase.Split "://"
let host = scheme[1].Split "/" let host = scheme[1].Split "/"
$"{scheme[0]}://{host[0]}", if host.Length > 1 then $"""/{String.Join ("/", host |> Array.skip 1)}""" else "" $"{scheme[0]}://{host[0]}", if host.Length > 1 then $"""/{String.Join ("/", host |> Array.skip 1)}""" else ""
/// Generate an absolute URL for the given link /// Generate an absolute URL for the given link
let absoluteUrl webLog permalink = let absoluteUrl webLog permalink =
$"{webLog.urlBase}/{Permalink.toString permalink}" $"{webLog.UrlBase}/{Permalink.toString permalink}"
/// Generate a relative URL for the given link /// Generate a relative URL for the given link
let relativeUrl webLog permalink = let relativeUrl webLog permalink =
let _, leadPath = hostAndPath webLog let _, leadPath = hostAndPath webLog
$"{leadPath}/{Permalink.toString permalink}" $"{leadPath}/{Permalink.toString permalink}"
/// Convert a UTC date/time to the web log's local date/time /// Convert an Instant (UTC reference) to the web log's local date/time
let localTime webLog (date : DateTime) = let localTime webLog (date : Instant) =
TimeZoneInfo.ConvertTimeFromUtc match DateTimeZoneProviders.Tzdb[webLog.TimeZone] with
(DateTime (date.Ticks, DateTimeKind.Utc), TimeZoneInfo.FindSystemTimeZoneById webLog.timeZone) | null -> date.ToDateTimeUtc ()
| tz -> date.InZone(tz).ToDateTimeUnspecified ()
/// Convert a date/time in the web log's local date/time to UTC
let utcTime webLog (date : DateTime) =
TimeZoneInfo.ConvertTimeToUtc
(DateTime (date.Ticks, DateTimeKind.Unspecified), TimeZoneInfo.FindSystemTimeZoneById webLog.timeZone)
/// A user of the web log /// A user of the web log
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type WebLogUser = type WebLogUser =
{ /// The ID of the user { /// The ID of the user
id : WebLogUserId Id : WebLogUserId
/// The ID of the web log to which this user belongs /// The ID of the web log to which this user belongs
webLogId : WebLogId WebLogId : WebLogId
/// The user name (e-mail address) /// The user name (e-mail address)
userName : string Email : string
/// The user's first name /// The user's first name
firstName : string FirstName : string
/// The user's last name /// The user's last name
lastName : string LastName : string
/// The user's preferred name /// The user's preferred name
preferredName : string PreferredName : string
/// The hash of the user's password /// The hash of the user's password
passwordHash : string PasswordHash : string
/// Salt used to calculate the user's password hash
salt : Guid
/// The URL of the user's personal site /// The URL of the user's personal site
url : string option Url : string option
/// The user's authorization level /// The user's access level
authorizationLevel : AuthorizationLevel AccessLevel : AccessLevel
/// When the user was created
CreatedOn : Instant
/// When the user last logged on
LastSeenOn : Instant option
} }
/// Functions to support web log users /// Functions to support web log users
@@ -450,21 +460,26 @@ module WebLogUser =
/// An empty web log user /// An empty web log user
let empty = let empty =
{ id = WebLogUserId.empty { Id = WebLogUserId.empty
webLogId = WebLogId.empty WebLogId = WebLogId.empty
userName = "" Email = ""
firstName = "" FirstName = ""
lastName = "" LastName = ""
preferredName = "" PreferredName = ""
passwordHash = "" PasswordHash = ""
salt = Guid.Empty Url = None
url = None AccessLevel = Author
authorizationLevel = User CreatedOn = Noda.epoch
LastSeenOn = None
} }
/// Get the user's displayed name /// Get the user's displayed name
let displayName user = let displayName user =
let name = let name =
seq { match user.preferredName with "" -> user.firstName | n -> n; " "; user.lastName } seq { match user.PreferredName with "" -> user.FirstName | n -> n; " "; user.LastName }
|> Seq.reduce (+) |> Seq.reduce (+)
name.Trim () name.Trim ()
/// Does a user have the required access level?
let hasAccess level user =
AccessLevel.hasAccess level user.AccessLevel

View File

@@ -1,11 +1,5 @@
<Project Sdk="Microsoft.NET.Sdk"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net6.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<DebugType>embedded</DebugType>
</PropertyGroup>
<ItemGroup> <ItemGroup>
<Compile Include="SupportTypes.fs" /> <Compile Include="SupportTypes.fs" />
<Compile Include="DataTypes.fs" /> <Compile Include="DataTypes.fs" />
@@ -13,9 +7,10 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Markdig" Version="0.30.2" /> <PackageReference Include="Markdig" Version="0.30.3" />
<PackageReference Update="FSharp.Core" Version="6.0.5" /> <PackageReference Update="FSharp.Core" Version="6.0.5" />
<PackageReference Include="Markdown.ColorCode" Version="1.0.1" /> <PackageReference Include="Markdown.ColorCode" Version="1.0.1" />
<PackageReference Include="NodaTime" Version="3.1.2" />
</ItemGroup> </ItemGroup>
</Project> </Project>

View File

@@ -1,6 +1,7 @@
namespace MyWebLog namespace MyWebLog
open System open System
open NodaTime
/// Support functions for domain definition /// Support functions for domain definition
[<AutoOpen>] [<AutoOpen>]
@@ -8,8 +9,76 @@ module private Helpers =
/// Create a new ID (short GUID) /// Create a new ID (short GUID)
// https://www.madskristensen.net/blog/A-shorter-and-URL-friendly-GUID // https://www.madskristensen.net/blog/A-shorter-and-URL-friendly-GUID
let newId() = let newId () =
Convert.ToBase64String(Guid.NewGuid().ToByteArray()).Replace('/', '_').Replace('+', '-').Substring (0, 22) Convert.ToBase64String(Guid.NewGuid().ToByteArray ()).Replace('/', '_').Replace('+', '-').Substring (0, 22)
/// Functions to support NodaTime manipulation
module Noda =
/// The clock to use when getting "now" (will make mutable for testing)
let clock : IClock = SystemClock.Instance
/// The Unix epoch
let epoch = Instant.FromUnixTimeSeconds 0L
/// Truncate an instant to remove fractional seconds
let toSecondsPrecision (value : Instant) =
Instant.FromUnixTimeSeconds (value.ToUnixTimeSeconds ())
/// The current Instant, with fractional seconds truncated
let now () =
toSecondsPrecision (clock.GetCurrentInstant ())
/// Convert a date/time to an Instant with whole seconds
let fromDateTime (dt : DateTime) =
toSecondsPrecision (Instant.FromDateTimeUtc (DateTime (dt.Ticks, DateTimeKind.Utc)))
/// A user's access level
type AccessLevel =
/// The user may create and publish posts and edit the ones they have created
| Author
/// The user may edit posts they did not create, but may not delete them
| Editor
/// The user may delete posts and configure web log settings
| WebLogAdmin
/// The user may manage themes (which affects all web logs for an installation)
| Administrator
/// Functions to support access levels
module AccessLevel =
/// Weightings for access levels
let private weights =
[ Author, 10
Editor, 20
WebLogAdmin, 30
Administrator, 40
]
|> Map.ofList
/// Convert an access level to its string representation
let toString =
function
| Author -> "Author"
| Editor -> "Editor"
| WebLogAdmin -> "WebLogAdmin"
| Administrator -> "Administrator"
/// Parse an access level from its string representation
let parse it =
match it with
| "Author" -> Author
| "Editor" -> Editor
| "WebLogAdmin" -> WebLogAdmin
| "Administrator" -> Administrator
| _ -> invalidOp $"{it} is not a valid access level"
/// Does a given access level allow an action that requires a certain access level?
let hasAccess needed held =
weights[needed] <= weights[held]
/// An identifier for a category /// An identifier for a category
@@ -92,83 +161,89 @@ module ExplicitRating =
| x -> raise (invalidArg "rating" $"{x} is not a valid explicit rating") | x -> raise (invalidArg "rating" $"{x} is not a valid explicit rating")
open NodaTime.Text
/// A podcast episode /// A podcast episode
type Episode = type Episode =
{ /// The URL to the media file for the episode (may be permalink) { /// The URL to the media file for the episode (may be permalink)
media : string Media : string
/// The length of the media file, in bytes /// The length of the media file, in bytes
length : int64 Length : int64
/// The duration of the episode /// The duration of the episode
duration : TimeSpan option Duration : Duration option
/// The media type of the file (overrides podcast default if present) /// The media type of the file (overrides podcast default if present)
mediaType : string option MediaType : string option
/// The URL to the image file for this episode (overrides podcast image if present, may be permalink) /// The URL to the image file for this episode (overrides podcast image if present, may be permalink)
imageUrl : string option ImageUrl : string option
/// A subtitle for this episode /// A subtitle for this episode
subtitle : string option Subtitle : string option
/// This episode's explicit rating (overrides podcast rating if present) /// This episode's explicit rating (overrides podcast rating if present)
explicit : ExplicitRating option Explicit : ExplicitRating option
/// A link to a chapter file /// A link to a chapter file
chapterFile : string option ChapterFile : string option
/// The MIME type for the chapter file /// The MIME type for the chapter file
chapterType : string option ChapterType : string option
/// The URL for the transcript of the episode (may be permalink) /// The URL for the transcript of the episode (may be permalink)
transcriptUrl : string option TranscriptUrl : string option
/// The MIME type of the transcript /// The MIME type of the transcript
transcriptType : string option TranscriptType : string option
/// The language in which the transcript is written /// The language in which the transcript is written
transcriptLang : string option TranscriptLang : string option
/// If true, the transcript will be declared (in the feed) to be a captions file /// If true, the transcript will be declared (in the feed) to be a captions file
transcriptCaptions : bool option TranscriptCaptions : bool option
/// The season number (for serialized podcasts) /// The season number (for serialized podcasts)
seasonNumber : int option SeasonNumber : int option
/// A description of the season /// A description of the season
seasonDescription : string option SeasonDescription : string option
/// The episode number /// The episode number
episodeNumber : double option EpisodeNumber : double option
/// A description of the episode /// A description of the episode
episodeDescription : string option EpisodeDescription : string option
} }
/// Functions to support episodes /// Functions to support episodes
module Episode = module Episode =
/// An empty episode /// An empty episode
let empty = { let empty =
media = "" { Media = ""
length = 0L Length = 0L
duration = None Duration = None
mediaType = None MediaType = None
imageUrl = None ImageUrl = None
subtitle = None Subtitle = None
explicit = None Explicit = None
chapterFile = None ChapterFile = None
chapterType = None ChapterType = None
transcriptUrl = None TranscriptUrl = None
transcriptType = None TranscriptType = None
transcriptLang = None TranscriptLang = None
transcriptCaptions = None TranscriptCaptions = None
seasonNumber = None SeasonNumber = None
seasonDescription = None SeasonDescription = None
episodeNumber = None EpisodeNumber = None
episodeDescription = None EpisodeDescription = None
} }
/// Format a duration for an episode
let formatDuration ep =
ep.Duration |> Option.map (DurationPattern.CreateWithInvariantCulture("H:mm:ss").Format)
open Markdig open Markdig
@@ -211,10 +286,10 @@ module MarkupText =
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type MetaItem = type MetaItem =
{ /// The name of the metadata value { /// The name of the metadata value
name : string Name : string
/// The metadata value /// The metadata value
value : string Value : string
} }
/// Functions to support metadata items /// Functions to support metadata items
@@ -222,17 +297,16 @@ module MetaItem =
/// An empty metadata item /// An empty metadata item
let empty = let empty =
{ name = ""; value = "" } { Name = ""; Value = "" }
/// A revision of a page or post /// A revision of a page or post
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Revision = type Revision =
{ /// When this revision was saved { /// When this revision was saved
asOf : DateTime AsOf : Instant
/// The text of the revision /// The text of the revision
text : MarkupText Text : MarkupText
} }
/// Functions to support revisions /// Functions to support revisions
@@ -240,8 +314,8 @@ module Revision =
/// An empty revision /// An empty revision
let empty = let empty =
{ asOf = DateTime.UtcNow { AsOf = Noda.epoch
text = Html "" Text = Html ""
} }
@@ -391,68 +465,68 @@ module CustomFeedSource =
/// Options for a feed that describes a podcast /// Options for a feed that describes a podcast
type PodcastOptions = type PodcastOptions =
{ /// The title of the podcast { /// The title of the podcast
title : string Title : string
/// A subtitle for the podcast /// A subtitle for the podcast
subtitle : string option Subtitle : string option
/// The number of items in the podcast feed /// The number of items in the podcast feed
itemsInFeed : int ItemsInFeed : int
/// A summary of the podcast (iTunes field) /// A summary of the podcast (iTunes field)
summary : string Summary : string
/// The display name of the podcast author (iTunes field) /// The display name of the podcast author (iTunes field)
displayedAuthor : string DisplayedAuthor : string
/// The e-mail address of the user who registered the podcast at iTunes /// The e-mail address of the user who registered the podcast at iTunes
email : string Email : string
/// The link to the image for the podcast /// The link to the image for the podcast
imageUrl : Permalink ImageUrl : Permalink
/// The category from iTunes under which this podcast is categorized /// The category from Apple Podcasts (iTunes) under which this podcast is categorized
iTunesCategory : string AppleCategory : string
/// A further refinement of the categorization of this podcast (iTunes field / values) /// A further refinement of the categorization of this podcast (Apple Podcasts/iTunes field / values)
iTunesSubcategory : string option AppleSubcategory : string option
/// The explictness rating (iTunes field) /// The explictness rating (iTunes field)
explicit : ExplicitRating Explicit : ExplicitRating
/// The default media type for files in this podcast /// The default media type for files in this podcast
defaultMediaType : string option DefaultMediaType : string option
/// The base URL for relative URL media files for this podcast (optional; defaults to web log base) /// The base URL for relative URL media files for this podcast (optional; defaults to web log base)
mediaBaseUrl : string option MediaBaseUrl : string option
/// A GUID for this podcast /// A GUID for this podcast
guid : Guid option PodcastGuid : Guid option
/// A URL at which information on supporting the podcast may be found (supports permalinks) /// A URL at which information on supporting the podcast may be found (supports permalinks)
fundingUrl : string option FundingUrl : string option
/// The text to be displayed in the funding item within the feed /// The text to be displayed in the funding item within the feed
fundingText : string option FundingText : string option
/// The medium (what the podcast IS, not what it is ABOUT) /// The medium (what the podcast IS, not what it is ABOUT)
medium : PodcastMedium option Medium : PodcastMedium option
} }
/// A custom feed /// A custom feed
type CustomFeed = type CustomFeed =
{ /// The ID of the custom feed { /// The ID of the custom feed
id : CustomFeedId Id : CustomFeedId
/// The source for the custom feed /// The source for the custom feed
source : CustomFeedSource Source : CustomFeedSource
/// The path for the custom feed /// The path for the custom feed
path : Permalink Path : Permalink
/// Podcast options, if the feed defines a podcast /// Podcast options, if the feed defines a podcast
podcast : PodcastOptions option Podcast : PodcastOptions option
} }
/// Functions to support custom feeds /// Functions to support custom feeds
@@ -460,10 +534,10 @@ module CustomFeed =
/// An empty custom feed /// An empty custom feed
let empty = let empty =
{ id = CustomFeedId "" { Id = CustomFeedId ""
source = Category (CategoryId "") Source = Category (CategoryId "")
path = Permalink "" Path = Permalink ""
podcast = None Podcast = None
} }
@@ -471,25 +545,25 @@ module CustomFeed =
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type RssOptions = type RssOptions =
{ /// Whether the site feed of posts is enabled { /// Whether the site feed of posts is enabled
feedEnabled : bool IsFeedEnabled : bool
/// The name of the file generated for the site feed /// The name of the file generated for the site feed
feedName : string FeedName : string
/// Override the "posts per page" setting for the site feed /// Override the "posts per page" setting for the site feed
itemsInFeed : int option ItemsInFeed : int option
/// Whether feeds are enabled for all categories /// Whether feeds are enabled for all categories
categoryEnabled : bool IsCategoryEnabled : bool
/// Whether feeds are enabled for all tags /// Whether feeds are enabled for all tags
tagEnabled : bool IsTagEnabled : bool
/// A copyright string to be placed in all feeds /// A copyright string to be placed in all feeds
copyright : string option Copyright : string option
/// Custom feeds for this web log /// Custom feeds for this web log
customFeeds: CustomFeed list CustomFeeds: CustomFeed list
} }
/// Functions to support RSS options /// Functions to support RSS options
@@ -497,13 +571,13 @@ module RssOptions =
/// An empty set of RSS options /// An empty set of RSS options
let empty = let empty =
{ feedEnabled = true { IsFeedEnabled = true
feedName = "feed.xml" FeedName = "feed.xml"
itemsInFeed = None ItemsInFeed = None
categoryEnabled = true IsCategoryEnabled = true
tagEnabled = true IsTagEnabled = true
copyright = None Copyright = None
customFeeds = [] CustomFeeds = []
} }
@@ -549,12 +623,21 @@ module ThemeAssetId =
/// A template for a theme /// A template for a theme
type ThemeTemplate = type ThemeTemplate =
{ /// The name of the template { /// The name of the template
name : string Name : string
/// The text of the template /// The text of the template
text : string Text : string
} }
/// Functions to support theme templates
module ThemeTemplate =
/// An empty theme template
let empty =
{ Name = ""
Text = ""
}
/// Where uploads should be placed /// Where uploads should be placed
type UploadDestination = type UploadDestination =
@@ -565,13 +648,13 @@ type UploadDestination =
module UploadDestination = module UploadDestination =
/// Convert an upload destination to its string representation /// Convert an upload destination to its string representation
let toString = function Database -> "database" | Disk -> "disk" let toString = function Database -> "Database" | Disk -> "Disk"
/// Parse an upload destination from its string representation /// Parse an upload destination from its string representation
let parse value = let parse value =
match value with match value with
| "database" -> Database | "Database" -> Database
| "disk" -> Disk | "Disk" -> Disk
| it -> invalidOp $"{it} is not a valid upload destination" | it -> invalidOp $"{it} is not a valid upload destination"
@@ -607,26 +690,6 @@ module WebLogId =
let create () = WebLogId (newId ()) let create () = WebLogId (newId ())
/// A level of authorization for a given web log
type AuthorizationLevel =
/// <summary>The user may administer all aspects of a web log</summary>
| Administrator
/// <summary>The user is a known user of a web log</summary>
| User
/// Functions to support authorization levels
module AuthorizationLevel =
/// Convert an authorization level to a string
let toString = function Administrator -> "Administrator" | User -> "User"
/// Parse a string into an authorization level
let parse value =
match value with
| "Administrator" -> Administrator
| "User" -> User
| it -> invalidOp $"{it} is not a valid authorization level"
/// An identifier for a web log user /// An identifier for a web log user
type WebLogUserId = WebLogUserId of string type WebLogUserId = WebLogUserId of string

File diff suppressed because it is too large Load Diff

View File

@@ -7,15 +7,54 @@ open MyWebLog.Data
[<AutoOpen>] [<AutoOpen>]
module Extensions = module Extensions =
open System.Security.Claims
open Microsoft.AspNetCore.Antiforgery
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.DependencyInjection
/// Hold variable for the configured generator string
let mutable private generatorString : string option = None
type HttpContext with type HttpContext with
/// The web log for the current request
member this.WebLog = this.Items["webLog"] :?> WebLog /// The anti-CSRF service
member this.AntiForgery = this.RequestServices.GetRequiredService<IAntiforgery> ()
/// The cross-site request forgery token set for this request
member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this
/// The data implementation /// The data implementation
member this.Data = this.RequestServices.GetRequiredService<IData> () member this.Data = this.RequestServices.GetRequiredService<IData> ()
/// The generator string
member this.Generator =
match generatorString with
| Some gen -> gen
| None ->
let cfg = this.RequestServices.GetRequiredService<IConfiguration> ()
generatorString <-
match Option.ofObj cfg["Generator"] with
| Some gen -> Some gen
| None -> Some "generator not configured"
generatorString.Value
/// The access level for the current user
member this.UserAccessLevel =
this.User.Claims
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.Role)
|> Option.map (fun claim -> AccessLevel.parse claim.Value)
/// The user ID for the current request
member this.UserId =
WebLogUserId (this.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value
/// The web log for the current request
member this.WebLog = this.Items["webLog"] :?> WebLog
/// Does the current user have the requested level of access?
member this.HasAccessLevel level =
defaultArg (this.UserAccessLevel |> Option.map (AccessLevel.hasAccess level)) false
open System.Collections.Concurrent open System.Collections.Concurrent
@@ -32,20 +71,28 @@ module WebLogCache =
/// Try to get the web log for the current request (longest matching URL base wins) /// Try to get the web log for the current request (longest matching URL base wins)
let tryGet (path : string) = let tryGet (path : string) =
_cache _cache
|> List.filter (fun wl -> path.StartsWith wl.urlBase) |> List.filter (fun wl -> path.StartsWith wl.UrlBase)
|> List.sortByDescending (fun wl -> wl.urlBase.Length) |> List.sortByDescending (fun wl -> wl.UrlBase.Length)
|> List.tryHead |> List.tryHead
/// Cache the web log for a particular host /// Cache the web log for a particular host
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))
/// Get all cached web logs
let all () =
_cache
/// Fill the web log cache from the database /// Fill the web log cache from the database
let fill (data : IData) = backgroundTask { let fill (data : IData) = backgroundTask {
let! webLogs = data.WebLog.all () let! webLogs = data.WebLog.All ()
_cache <- webLogs _cache <- webLogs
} }
/// Is the given theme in use by any web logs?
let isThemeInUse themeId =
_cache |> List.exists (fun wl -> wl.ThemeId = themeId)
/// A cache of page information needed to display the page list in templates /// A cache of page information needed to display the page list in templates
module PageListCache = module PageListCache =
@@ -53,22 +100,30 @@ module PageListCache =
open MyWebLog.ViewModels open MyWebLog.ViewModels
/// Cache of displayed pages /// Cache of displayed pages
let private _cache = ConcurrentDictionary<string, DisplayPage[]> () let private _cache = ConcurrentDictionary<WebLogId, DisplayPage[]> ()
let private fillPages (webLog : WebLog) pages =
_cache[webLog.Id] <-
pages
|> List.map (fun pg -> DisplayPage.fromPage webLog { pg with Text = "" })
|> Array.ofList
/// Are there pages cached for this web log? /// Are there pages cached for this web log?
let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.urlBase let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.Id
/// Get the pages for the web log for this request /// Get the pages for the web log for this request
let get (ctx : HttpContext) = _cache[ctx.WebLog.urlBase] let get (ctx : HttpContext) = _cache[ctx.WebLog.Id]
/// Update the pages for the current web log /// Update the pages for the current web log
let update (ctx : HttpContext) = backgroundTask { let update (ctx : HttpContext) = backgroundTask {
let webLog = ctx.WebLog let! pages = ctx.Data.Page.FindListed ctx.WebLog.Id
let! pages = ctx.Data.Page.findListed webLog.id fillPages ctx.WebLog pages
_cache[webLog.urlBase] <- }
pages
|> List.map (fun pg -> DisplayPage.fromPage webLog { pg with text = "" }) /// Refresh the pages for the given web log
|> Array.ofList let refresh (webLog : WebLog) (data : IData) = backgroundTask {
let! pages = data.Page.FindListed webLog.Id
fillPages webLog pages
} }
@@ -78,18 +133,24 @@ module CategoryCache =
open MyWebLog.ViewModels open MyWebLog.ViewModels
/// The cache itself /// The cache itself
let private _cache = ConcurrentDictionary<string, DisplayCategory[]> () let private _cache = ConcurrentDictionary<WebLogId, DisplayCategory[]> ()
/// Are there categories cached for this web log? /// Are there categories cached for this web log?
let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.urlBase let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.Id
/// Get the categories for the web log for this request /// Get the categories for the web log for this request
let get (ctx : HttpContext) = _cache[ctx.WebLog.urlBase] let get (ctx : HttpContext) = _cache[ctx.WebLog.Id]
/// Update the cache with fresh data /// Update the cache with fresh data
let update (ctx : HttpContext) = backgroundTask { let update (ctx : HttpContext) = backgroundTask {
let! cats = ctx.Data.Category.findAllForView ctx.WebLog.id let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.Id
_cache[ctx.WebLog.urlBase] <- cats _cache[ctx.WebLog.Id] <- cats
}
/// Refresh the category cache for the given web log
let refresh webLogId (data : IData) = backgroundTask {
let! cats = data.Category.FindAllForView webLogId
_cache[webLogId] <- cats
} }
@@ -107,30 +168,55 @@ module TemplateCache =
let private hasInclude = Regex ("""{% include_template \"(.*)\" %}""", RegexOptions.None, TimeSpan.FromSeconds 2) let private hasInclude = Regex ("""{% include_template \"(.*)\" %}""", RegexOptions.None, TimeSpan.FromSeconds 2)
/// Get a template for the given theme and template name /// Get a template for the given theme and template name
let get (themeId : string) (templateName : string) (data : IData) = backgroundTask { let get (themeId : ThemeId) (templateName : string) (data : IData) = backgroundTask {
let templatePath = $"{themeId}/{templateName}" let templatePath = $"{ThemeId.toString themeId}/{templateName}"
match _cache.ContainsKey templatePath with match _cache.ContainsKey templatePath with
| true -> () | true -> return Ok _cache[templatePath]
| false -> | false ->
match! data.Theme.findById (ThemeId themeId) with match! data.Theme.FindById themeId with
| Some theme -> | Some theme ->
let mutable text = (theme.templates |> List.find (fun t -> t.name = templateName)).text match theme.Templates |> List.tryFind (fun t -> t.Name = templateName) with
while hasInclude.IsMatch text do | Some template ->
let child = hasInclude.Match text let mutable text = template.Text
let childText = (theme.templates |> List.find (fun t -> t.name = child.Groups[1].Value)).text let mutable childNotFound = ""
text <- text.Replace (child.Value, childText) while hasInclude.IsMatch text do
_cache[templatePath] <- Template.Parse (text, SyntaxCompatibility.DotLiquid22) let child = hasInclude.Match text
| None -> () let childText =
return _cache[templatePath] 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.toString themeId} does not have a template named {templateName}"
| None -> return Result.Error $"Theme ID {ThemeId.toString 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 /// Invalidate all template cache entries for the given theme ID
let invalidateTheme (themeId : string) = let invalidateTheme (themeId : ThemeId) =
let keyPrefix = ThemeId.toString themeId
_cache.Keys _cache.Keys
|> Seq.filter (fun key -> key.StartsWith themeId) |> Seq.filter (fun key -> key.StartsWith keyPrefix)
|> List.ofSeq |> List.ofSeq
|> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ()) |> 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 /// A cache of asset names by themes
module ThemeAssetCache = module ThemeAssetCache =
@@ -143,15 +229,15 @@ module ThemeAssetCache =
/// Refresh the list of assets for the given theme /// Refresh the list of assets for the given theme
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 /// Fill the theme asset cache
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
let (ThemeAssetId (themeId, path)) = asset.id let (ThemeAssetId (themeId, path)) = asset.Id
if not (_cache.ContainsKey themeId) then _cache[themeId] <- [] if not (_cache.ContainsKey themeId) then _cache[themeId] <- []
_cache[themeId] <- path :: _cache[themeId] _cache[themeId] <- path :: _cache[themeId]
} }

View File

@@ -8,24 +8,28 @@ open DotLiquid
open Giraffe.ViewEngine open Giraffe.ViewEngine
open MyWebLog.ViewModels open MyWebLog.ViewModels
/// Get the current web log from the DotLiquid context /// Extensions on the DotLiquid Context object
let webLog (ctx : Context) = type Context with
ctx.Environments[0].["web_log"] :?> WebLog
/// Get the current web log from the DotLiquid context
member this.WebLog =
this.Environments[0].["web_log"] :?> WebLog
/// Does an asset exist for the current theme? /// Does an asset exist for the current theme?
let assetExists fileName (webLog : WebLog) = let assetExists fileName (webLog : WebLog) =
ThemeAssetCache.get (ThemeId webLog.themePath) |> List.exists (fun it -> it = fileName) ThemeAssetCache.get webLog.ThemeId |> List.exists (fun it -> it = fileName)
/// Obtain the link from known types /// Obtain the link from known types
let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> string) = let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> string) =
match item with match item with
| :? String as link -> Some link | :? String as link -> Some link
| :? DisplayPage as page -> Some page.permalink | :? DisplayPage as page -> Some page.Permalink
| :? PostListItem as post -> Some post.permalink | :? PostListItem as post -> Some post.Permalink
| :? DropProxy as proxy -> Option.ofObj proxy["permalink"] |> Option.map string | :? DropProxy as proxy -> Option.ofObj proxy["Permalink"] |> Option.map string
| _ -> None | _ -> None
|> function |> function
| Some link -> linkFunc (webLog ctx) (Permalink link) | Some link -> linkFunc ctx.WebLog (Permalink link)
| None -> $"alert('unknown item type {item.GetType().Name}')" | None -> $"alert('unknown item type {item.GetType().Name}')"
@@ -39,11 +43,11 @@ type AbsoluteLinkFilter () =
type CategoryLinkFilter () = type CategoryLinkFilter () =
static member CategoryLink (ctx : Context, catObj : obj) = static member CategoryLink (ctx : Context, catObj : obj) =
match catObj with match catObj with
| :? DisplayCategory as cat -> Some cat.slug | :? DisplayCategory as cat -> Some cat.Slug
| :? DropProxy as proxy -> Option.ofObj proxy["slug"] |> Option.map string | :? DropProxy as proxy -> Option.ofObj proxy["Slug"] |> Option.map string
| _ -> None | _ -> None
|> function |> function
| Some slug -> WebLog.relativeUrl (webLog ctx) (Permalink $"category/{slug}/") | Some slug -> WebLog.relativeUrl ctx.WebLog (Permalink $"category/{slug}/")
| None -> $"alert('unknown category object type {catObj.GetType().Name}')" | None -> $"alert('unknown category object type {catObj.GetType().Name}')"
@@ -51,12 +55,12 @@ type CategoryLinkFilter () =
type EditPageLinkFilter () = type EditPageLinkFilter () =
static member EditPageLink (ctx : Context, pageObj : obj) = static member EditPageLink (ctx : Context, pageObj : obj) =
match pageObj with match pageObj with
| :? DisplayPage as page -> Some page.id | :? DisplayPage as page -> Some page.Id
| :? DropProxy as proxy -> Option.ofObj proxy["id"] |> Option.map string | :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId | :? String as theId -> Some theId
| _ -> None | _ -> None
|> function |> function
| Some pageId -> WebLog.relativeUrl (webLog ctx) (Permalink $"admin/page/{pageId}/edit") | Some pageId -> WebLog.relativeUrl ctx.WebLog (Permalink $"admin/page/{pageId}/edit")
| None -> $"alert('unknown page object type {pageObj.GetType().Name}')" | None -> $"alert('unknown page object type {pageObj.GetType().Name}')"
@@ -64,38 +68,36 @@ type EditPageLinkFilter () =
type EditPostLinkFilter () = type EditPostLinkFilter () =
static member EditPostLink (ctx : Context, postObj : obj) = static member EditPostLink (ctx : Context, postObj : obj) =
match postObj with match postObj with
| :? PostListItem as post -> Some post.id | :? PostListItem as post -> Some post.Id
| :? DropProxy as proxy -> Option.ofObj proxy["id"] |> Option.map string | :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId | :? String as theId -> Some theId
| _ -> None | _ -> None
|> function |> function
| Some postId -> WebLog.relativeUrl (webLog ctx) (Permalink $"admin/post/{postId}/edit") | Some postId -> WebLog.relativeUrl ctx.WebLog (Permalink $"admin/post/{postId}/edit")
| None -> $"alert('unknown post object type {postObj.GetType().Name}')" | None -> $"alert('unknown post object type {postObj.GetType().Name}')"
/// A filter to generate nav links, highlighting the active link (exact match) /// A filter to generate nav links, highlighting the active link (exact match)
type NavLinkFilter () = type NavLinkFilter () =
static member NavLink (ctx : Context, url : string, text : string) = static member NavLink (ctx : Context, url : string, text : string) =
let webLog = webLog ctx let _, path = WebLog.hostAndPath ctx.WebLog
let _, path = WebLog.hostAndPath webLog
let path = if path = "" then path else $"{path.Substring 1}/" let path = if path = "" then path else $"{path.Substring 1}/"
seq { seq {
"<li class=\"nav-item\"><a class=\"nav-link" "<li class=\"nav-item\"><a class=\"nav-link"
if (string ctx.Environments[0].["current_page"]).StartsWith $"{path}{url}" then " active" if (string ctx.Environments[0].["current_page"]).StartsWith $"{path}{url}" then " active"
"\" href=\"" "\" href=\""
WebLog.relativeUrl webLog (Permalink url) WebLog.relativeUrl ctx.WebLog (Permalink url)
"\">" "\">"
text text
"</a></li>" "</a></li>"
} }
|> Seq.fold (+) "" |> String.concat ""
/// A filter to generate a link for theme asset (image, stylesheet, script, etc.) /// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
type ThemeAssetFilter () = type ThemeAssetFilter () =
static member ThemeAsset (ctx : Context, asset : string) = static member ThemeAsset (ctx : Context, asset : string) =
let webLog = webLog ctx WebLog.relativeUrl ctx.WebLog (Permalink $"themes/{ThemeId.toString ctx.WebLog.ThemeId}/{asset}")
WebLog.relativeUrl webLog (Permalink $"themes/{webLog.themePath}/{asset}")
/// Create various items in the page header based on the state of the page being generated /// Create various items in the page header based on the state of the page being generated
@@ -103,11 +105,11 @@ type PageHeadTag () =
inherit Tag () inherit Tag ()
override this.Render (context : Context, result : TextWriter) = override this.Render (context : Context, result : TextWriter) =
let webLog = webLog context let webLog = context.WebLog
// spacer // spacer
let s = " " let s = " "
let getBool name = let getBool name =
context.Environments[0].[name] |> Option.ofObj |> Option.map Convert.ToBoolean |> Option.defaultValue false defaultArg (context.Environments[0].[name] |> Option.ofObj |> Option.map Convert.ToBoolean) false
result.WriteLine $"""<meta name="generator" content="{context.Environments[0].["generator"]}">""" result.WriteLine $"""<meta name="generator" content="{context.Environments[0].["generator"]}">"""
@@ -123,26 +125,26 @@ type PageHeadTag () =
let relUrl = WebLog.relativeUrl webLog (Permalink url) let relUrl = WebLog.relativeUrl webLog (Permalink url)
$"""{s}<link rel="alternate" type="application/rss+xml" title="{escTitle}" href="{relUrl}">""" $"""{s}<link rel="alternate" type="application/rss+xml" title="{escTitle}" href="{relUrl}">"""
if webLog.rss.feedEnabled && getBool "is_home" then if webLog.Rss.IsFeedEnabled && getBool "is_home" then
result.WriteLine (feedLink webLog.name webLog.rss.feedName) result.WriteLine (feedLink webLog.Name webLog.Rss.FeedName)
result.WriteLine $"""{s}<link rel="canonical" href="{WebLog.absoluteUrl webLog Permalink.empty}">""" result.WriteLine $"""{s}<link rel="canonical" href="{WebLog.absoluteUrl webLog Permalink.empty}">"""
if webLog.rss.categoryEnabled && getBool "is_category_home" then if webLog.Rss.IsCategoryEnabled && getBool "is_category_home" then
let slug = context.Environments[0].["slug"] :?> string let slug = context.Environments[0].["slug"] :?> string
result.WriteLine (feedLink webLog.name $"category/{slug}/{webLog.rss.feedName}") result.WriteLine (feedLink webLog.Name $"category/{slug}/{webLog.Rss.FeedName}")
if webLog.rss.tagEnabled && getBool "is_tag_home" then if webLog.Rss.IsTagEnabled && getBool "is_tag_home" then
let slug = context.Environments[0].["slug"] :?> string let slug = context.Environments[0].["slug"] :?> string
result.WriteLine (feedLink webLog.name $"tag/{slug}/{webLog.rss.feedName}") result.WriteLine (feedLink webLog.Name $"tag/{slug}/{webLog.Rss.FeedName}")
if getBool "is_post" then if getBool "is_post" then
let post = context.Environments[0].["model"] :?> PostDisplay let post = context.Environments[0].["model"] :?> PostDisplay
let url = WebLog.absoluteUrl webLog (Permalink post.posts[0].permalink) let url = WebLog.absoluteUrl webLog (Permalink post.Posts[0].Permalink)
result.WriteLine $"""{s}<link rel="canonical" href="{url}">""" result.WriteLine $"""{s}<link rel="canonical" href="{url}">"""
if getBool "is_page" then if getBool "is_page" then
let page = context.Environments[0].["page"] :?> DisplayPage let page = context.Environments[0].["page"] :?> DisplayPage
let url = WebLog.absoluteUrl webLog (Permalink page.permalink) let url = WebLog.absoluteUrl webLog (Permalink page.Permalink)
result.WriteLine $"""{s}<link rel="canonical" href="{url}">""" result.WriteLine $"""{s}<link rel="canonical" href="{url}">"""
@@ -151,11 +153,11 @@ type PageFootTag () =
inherit Tag () inherit Tag ()
override this.Render (context : Context, result : TextWriter) = override this.Render (context : Context, result : TextWriter) =
let webLog = webLog context let webLog = context.WebLog
// spacer // spacer
let s = " " let s = " "
if webLog.autoHtmx then if webLog.AutoHtmx then
result.WriteLine $"{s}{RenderView.AsString.htmlNode Htmx.Script.minified}" result.WriteLine $"{s}{RenderView.AsString.htmlNode Htmx.Script.minified}"
if assetExists "script.js" webLog then if assetExists "script.js" webLog then
@@ -172,11 +174,11 @@ type RelativeLinkFilter () =
type TagLinkFilter () = type TagLinkFilter () =
static member TagLink (ctx : Context, tag : string) = static member TagLink (ctx : Context, tag : string) =
ctx.Environments[0].["tag_mappings"] :?> TagMap list ctx.Environments[0].["tag_mappings"] :?> TagMap list
|> List.tryFind (fun it -> it.tag = tag) |> List.tryFind (fun it -> it.Tag = tag)
|> function |> function
| Some tagMap -> tagMap.urlValue | Some tagMap -> tagMap.UrlValue
| None -> tag.Replace (" ", "+") | None -> tag.Replace (" ", "+")
|> function tagUrl -> WebLog.relativeUrl (webLog ctx) (Permalink $"tag/{tagUrl}/") |> function tagUrl -> WebLog.relativeUrl ctx.WebLog (Permalink $"tag/{tagUrl}/")
/// Create links for a user to log on or off, and a dashboard link if they are logged off /// Create links for a user to log on or off, and a dashboard link if they are logged off
@@ -184,11 +186,10 @@ type UserLinksTag () =
inherit Tag () inherit Tag ()
override this.Render (context : Context, result : TextWriter) = override this.Render (context : Context, result : TextWriter) =
let webLog = webLog context let link it = WebLog.relativeUrl context.WebLog (Permalink it)
let link it = WebLog.relativeUrl webLog (Permalink it)
seq { seq {
"""<ul class="navbar-nav flex-grow-1 justify-content-end">""" """<ul class="navbar-nav flex-grow-1 justify-content-end">"""
match Convert.ToBoolean context.Environments[0].["logged_on"] with match Convert.ToBoolean context.Environments[0].["is_logged_on"] with
| true -> | true ->
$"""<li class="nav-item"><a class="nav-link" href="{link "admin/dashboard"}">Dashboard</a></li>""" $"""<li class="nav-item"><a class="nav-link" href="{link "admin/dashboard"}">Dashboard</a></li>"""
$"""<li class="nav-item"><a class="nav-link" href="{link "user/log-off"}">Log Off</a></li>""" $"""<li class="nav-item"><a class="nav-link" href="{link "user/log-off"}">Log Off</a></li>"""
@@ -199,11 +200,11 @@ type UserLinksTag () =
|> Seq.iter result.WriteLine |> Seq.iter result.WriteLine
/// A filter to retrieve the value of a meta item from a list /// A filter to retrieve the value of a meta item from a list
// (shorter than `{% assign item = list | where: "name", [name] | first %}{{ item.value }}`) // (shorter than `{% assign item = list | where: "Name", [name] | first %}{{ item.value }}`)
type ValueFilter () = type ValueFilter () =
static member Value (_ : Context, items : MetaItem list, name : string) = static member Value (_ : Context, items : MetaItem list, name : string) =
match items |> List.tryFind (fun it -> it.name = name) with match items |> List.tryFind (fun it -> it.Name = name) with
| Some item -> item.value | Some item -> item.Value
| None -> $"-- {name} not found --" | None -> $"-- {name} not found --"
@@ -222,17 +223,18 @@ let register () =
Template.RegisterTag<PageFootTag> "page_foot" Template.RegisterTag<PageFootTag> "page_foot"
Template.RegisterTag<UserLinksTag> "user_links" Template.RegisterTag<UserLinksTag> "user_links"
[ // Domain types [ // Domain types
typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>; typeof<MetaItem>; typeof<Page> typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>; typeof<MetaItem>; typeof<Page>
typeof<RssOptions>; typeof<TagMap>; typeof<UploadDestination>; typeof<WebLog> typeof<RssOptions>; typeof<TagMap>; typeof<UploadDestination>; typeof<WebLog>
// View models // View models
typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayCustomFeed>; typeof<DisplayPage> typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayCustomFeed>; typeof<DisplayPage>
typeof<DisplayUpload>; typeof<EditCategoryModel>; typeof<EditCustomFeedModel>; typeof<EditPageModel> typeof<DisplayRevision>; typeof<DisplayTheme>; typeof<DisplayUpload>; typeof<DisplayUser>
typeof<EditPostModel>; typeof<EditRssModel>; typeof<EditTagMapModel>; typeof<EditUserModel> typeof<EditCategoryModel>; typeof<EditCustomFeedModel>; typeof<EditMyInfoModel>; typeof<EditPageModel>
typeof<LogOnModel>; typeof<ManagePermalinksModel>; typeof<PostDisplay>; typeof<PostListItem> typeof<EditPostModel>; typeof<EditRssModel>; typeof<EditTagMapModel>; typeof<EditUserModel>
typeof<SettingsModel>; typeof<UserMessage> typeof<LogOnModel>; typeof<ManagePermalinksModel>; typeof<ManageRevisionsModel>; typeof<PostDisplay>
// Framework types typeof<PostListItem>; typeof<SettingsModel>; typeof<UserMessage>
typeof<AntiforgeryTokenSet>; typeof<DateTime option>; typeof<int option>; typeof<KeyValuePair> // Framework types
typeof<MetaItem list>; typeof<string list>; typeof<string option>; typeof<TagMap list> typeof<AntiforgeryTokenSet>; typeof<DateTime option>; typeof<int option>; typeof<KeyValuePair>
typeof<MetaItem list>; typeof<string list>; typeof<string option>; typeof<TagMap list>
] ]
|> List.iter (fun it -> Template.RegisterSafeType (it, [| "*" |])) |> List.iter (fun it -> Template.RegisterSafeType (it, [| "*" |]))

File diff suppressed because it is too large Load Diff

View File

@@ -1,22 +0,0 @@
/// Handlers for error conditions
module MyWebLog.Handlers.Error
open System.Net
open System.Threading.Tasks
open Giraffe
open Microsoft.AspNetCore.Http
open MyWebLog
/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
let notAuthorized : HttpHandler = fun next ctx -> task {
if ctx.Request.Method = "GET" then
let returnUrl = WebUtility.UrlEncode ctx.Request.Path
return!
redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink $"user/log-on?returnUrl={returnUrl}")) next ctx
else
return! (setStatusCode 401 >=> fun _ _ -> Task.FromResult<HttpContext option> None) next ctx
}
/// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there
let notFound : HttpHandler =
setStatusCode 404 >=> text "Not found"

View File

@@ -26,22 +26,22 @@ type FeedType =
let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option = let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
let webLog = ctx.WebLog let webLog = ctx.WebLog
let debug = debug "Feed" ctx let debug = debug "Feed" ctx
let name = $"/{webLog.rss.feedName}" let name = $"/{webLog.Rss.FeedName}"
let postCount = defaultArg webLog.rss.itemsInFeed webLog.postsPerPage let postCount = defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage
debug (fun () -> $"Considering potential feed for {feedPath} (configured feed name {name})") debug (fun () -> $"Considering potential feed for {feedPath} (configured feed name {name})")
// Standard feed // Standard feed
match webLog.rss.feedEnabled && feedPath = name with match webLog.Rss.IsFeedEnabled && feedPath = name with
| true -> | true ->
debug (fun () -> "Found standard feed") debug (fun () -> "Found standard feed")
Some (StandardFeed feedPath, postCount) Some (StandardFeed feedPath, postCount)
| false -> | false ->
// Category and tag feeds are handled by defined routes; check for custom feed // Category and tag feeds are handled by defined routes; check for custom feed
match webLog.rss.customFeeds match webLog.Rss.CustomFeeds
|> List.tryFind (fun it -> feedPath.EndsWith (Permalink.toString it.path)) with |> List.tryFind (fun it -> feedPath.EndsWith (Permalink.toString it.Path)) with
| Some feed -> | Some feed ->
debug (fun () -> "Found custom feed") debug (fun () -> "Found custom feed")
Some (Custom (feed, feedPath), Some (Custom (feed, feedPath),
feed.podcast |> Option.map (fun p -> p.itemsInFeed) |> Option.defaultValue postCount) feed.Podcast |> Option.map (fun p -> p.ItemsInFeed) |> Option.defaultValue postCount)
| None -> | None ->
debug (fun () -> $"No matching feed found") debug (fun () -> $"No matching feed found")
None None
@@ -49,17 +49,17 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
/// Determine the function to retrieve posts for the given feed /// Determine the function to retrieve posts for the given feed
let private getFeedPosts ctx feedType = let private getFeedPosts ctx feedType =
let childIds catId = let childIds catId =
let cat = CategoryCache.get ctx |> Array.find (fun c -> c.id = CategoryId.toString catId) let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = CategoryId.toString catId)
getCategoryIds cat.slug ctx getCategoryIds cat.Slug ctx
let data = ctx.Data let data = ctx.Data
match feedType with match feedType with
| StandardFeed _ -> data.Post.findPageOfPublishedPosts ctx.WebLog.id 1 | StandardFeed _ -> data.Post.FindPageOfPublishedPosts ctx.WebLog.Id 1
| CategoryFeed (catId, _) -> data.Post.findPageOfCategorizedPosts ctx.WebLog.id (childIds catId) 1 | CategoryFeed (catId, _) -> data.Post.FindPageOfCategorizedPosts ctx.WebLog.Id (childIds catId) 1
| TagFeed (tag, _) -> data.Post.findPageOfTaggedPosts ctx.WebLog.id tag 1 | TagFeed (tag, _) -> data.Post.FindPageOfTaggedPosts ctx.WebLog.Id tag 1
| Custom (feed, _) -> | Custom (feed, _) ->
match feed.source with match feed.Source with
| Category catId -> data.Post.findPageOfCategorizedPosts ctx.WebLog.id (childIds catId) 1 | Category catId -> data.Post.FindPageOfCategorizedPosts ctx.WebLog.Id (childIds catId) 1
| Tag tag -> data.Post.findPageOfTaggedPosts ctx.WebLog.id tag 1 | Tag tag -> data.Post.FindPageOfTaggedPosts ctx.WebLog.Id tag 1
/// Strip HTML from a string /// Strip HTML from a string
let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace (text, "<(.|\n)*?>", "") let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace (text, "<(.|\n)*?>", "")
@@ -90,13 +90,13 @@ module private Namespace =
let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[]) (tagMaps : TagMap list) let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[]) (tagMaps : TagMap list)
(post : Post) = (post : Post) =
let plainText = let plainText =
let endingP = post.text.IndexOf "</p>" let endingP = post.Text.IndexOf "</p>"
stripHtml <| if endingP >= 0 then post.text[..(endingP - 1)] else post.text stripHtml <| if endingP >= 0 then post.Text[..(endingP - 1)] else post.Text
let item = SyndicationItem ( let item = SyndicationItem (
Id = WebLog.absoluteUrl webLog post.permalink, Id = WebLog.absoluteUrl webLog post.Permalink,
Title = TextSyndicationContent.CreateHtmlContent post.title, Title = TextSyndicationContent.CreateHtmlContent post.Title,
PublishDate = DateTimeOffset post.publishedOn.Value, PublishDate = post.PublishedOn.Value.ToDateTimeOffset (),
LastUpdatedTime = DateTimeOffset post.updatedOn, LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset (),
Content = TextSyndicationContent.CreatePlaintextContent plainText) Content = TextSyndicationContent.CreatePlaintextContent plainText)
item.AddPermalink (Uri item.Id) item.AddPermalink (Uri item.Id)
@@ -104,25 +104,25 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[
let encoded = let encoded =
let txt = let txt =
post.text post.Text
.Replace("src=\"/", $"src=\"{webLog.urlBase}/") .Replace("src=\"/", $"src=\"{webLog.UrlBase}/")
.Replace ("href=\"/", $"href=\"{webLog.urlBase}/") .Replace ("href=\"/", $"href=\"{webLog.UrlBase}/")
let it = xmlDoc.CreateElement ("content", "encoded", Namespace.content) let it = xmlDoc.CreateElement ("content", "encoded", Namespace.content)
let _ = it.AppendChild (xmlDoc.CreateCDataSection txt) let _ = it.AppendChild (xmlDoc.CreateCDataSection txt)
it it
item.ElementExtensions.Add encoded item.ElementExtensions.Add encoded
item.Authors.Add (SyndicationPerson ( item.Authors.Add (SyndicationPerson (
Name = (authors |> List.find (fun a -> a.name = WebLogUserId.toString post.authorId)).value)) Name = (authors |> List.find (fun a -> a.Name = WebLogUserId.toString post.AuthorId)).Value))
[ post.categoryIds [ post.CategoryIds
|> List.map (fun catId -> |> List.map (fun catId ->
let cat = cats |> Array.find (fun c -> c.id = CategoryId.toString catId) let cat = cats |> Array.find (fun c -> c.Id = CategoryId.toString catId)
SyndicationCategory (cat.name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.slug}/"), cat.name)) SyndicationCategory (cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name))
post.tags post.Tags
|> List.map (fun tag -> |> List.map (fun tag ->
let urlTag = let urlTag =
match tagMaps |> List.tryFind (fun tm -> tm.tag = tag) with match tagMaps |> List.tryFind (fun tm -> tm.Tag = tag) with
| Some tm -> tm.urlValue | Some tm -> tm.UrlValue
| None -> tag.Replace (" ", "+") | None -> tag.Replace (" ", "+")
SyndicationCategory (tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)")) SyndicationCategory (tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)"))
] ]
@@ -137,19 +137,19 @@ let toAbsolute webLog (link : string) =
/// Add episode information to a podcast feed item /// Add episode information to a podcast feed item
let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (post : Post) (item : SyndicationItem) = let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (post : Post) (item : SyndicationItem) =
let epMediaUrl = let epMediaUrl =
match episode.media with match episode.Media with
| link when link.StartsWith "http" -> link | link when link.StartsWith "http" -> link
| link when Option.isSome podcast.mediaBaseUrl -> $"{podcast.mediaBaseUrl.Value}{link}" | link when Option.isSome podcast.MediaBaseUrl -> $"{podcast.MediaBaseUrl.Value}{link}"
| link -> WebLog.absoluteUrl webLog (Permalink link) | link -> WebLog.absoluteUrl webLog (Permalink link)
let epMediaType = [ episode.mediaType; podcast.defaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
let epImageUrl = defaultArg episode.imageUrl (Permalink.toString podcast.imageUrl) |> toAbsolute webLog let epImageUrl = defaultArg episode.ImageUrl (Permalink.toString podcast.ImageUrl) |> toAbsolute webLog
let epExplicit = defaultArg episode.explicit podcast.explicit |> ExplicitRating.toString let epExplicit = defaultArg episode.Explicit podcast.Explicit |> ExplicitRating.toString
let xmlDoc = XmlDocument () let xmlDoc = XmlDocument ()
let enclosure = let enclosure =
let it = xmlDoc.CreateElement "enclosure" let it = xmlDoc.CreateElement "enclosure"
it.SetAttribute ("url", epMediaUrl) it.SetAttribute ("url", epMediaUrl)
it.SetAttribute ("length", string episode.length) it.SetAttribute ("length", string episode.Length)
epMediaType |> Option.iter (fun typ -> it.SetAttribute ("type", typ)) epMediaType |> Option.iter (fun typ -> it.SetAttribute ("type", typ))
it it
let image = let image =
@@ -159,18 +159,18 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
item.ElementExtensions.Add enclosure item.ElementExtensions.Add enclosure
item.ElementExtensions.Add image item.ElementExtensions.Add image
item.ElementExtensions.Add ("creator", Namespace.dc, podcast.displayedAuthor) item.ElementExtensions.Add ("creator", Namespace.dc, podcast.DisplayedAuthor)
item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.displayedAuthor) item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor)
item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit) item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit)
episode.subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it)) episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it))
episode.duration Episode.formatDuration episode
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.ToString """hh\:mm\:ss""")) |> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it))
match episode.chapterFile with match episode.ChapterFile with
| Some chapters -> | Some chapters ->
let url = toAbsolute webLog chapters let url = toAbsolute webLog chapters
let typ = let typ =
match episode.chapterType with match episode.ChapterType with
| Some mime -> Some mime | Some mime -> Some mime
| None when chapters.EndsWith ".json" -> Some "application/json+chapters" | None when chapters.EndsWith ".json" -> Some "application/json+chapters"
| None -> None | None -> None
@@ -180,21 +180,21 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
item.ElementExtensions.Add elt item.ElementExtensions.Add elt
| None -> () | None -> ()
match episode.transcriptUrl with match episode.TranscriptUrl with
| Some transcript -> | Some transcript ->
let url = toAbsolute webLog transcript let url = toAbsolute webLog transcript
let elt = xmlDoc.CreateElement ("podcast", "transcript", Namespace.podcast) let elt = xmlDoc.CreateElement ("podcast", "transcript", Namespace.podcast)
elt.SetAttribute ("url", url) elt.SetAttribute ("url", url)
elt.SetAttribute ("type", Option.get episode.transcriptType) elt.SetAttribute ("type", Option.get episode.TranscriptType)
episode.transcriptLang |> Option.iter (fun it -> elt.SetAttribute ("language", it)) episode.TranscriptLang |> Option.iter (fun it -> elt.SetAttribute ("language", it))
if defaultArg episode.transcriptCaptions false then if defaultArg episode.TranscriptCaptions false then
elt.SetAttribute ("rel", "captions") elt.SetAttribute ("rel", "captions")
item.ElementExtensions.Add elt item.ElementExtensions.Add elt
| None -> () | None -> ()
match episode.seasonNumber with match episode.SeasonNumber with
| Some season -> | Some season ->
match episode.seasonDescription with match episode.SeasonDescription with
| Some desc -> | Some desc ->
let elt = xmlDoc.CreateElement ("podcast", "season", Namespace.podcast) let elt = xmlDoc.CreateElement ("podcast", "season", Namespace.podcast)
elt.SetAttribute ("name", desc) elt.SetAttribute ("name", desc)
@@ -203,9 +203,9 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
| None -> item.ElementExtensions.Add ("season", Namespace.podcast, string season) | None -> item.ElementExtensions.Add ("season", Namespace.podcast, string season)
| None -> () | None -> ()
match episode.episodeNumber with match episode.EpisodeNumber with
| Some epNumber -> | Some epNumber ->
match episode.episodeDescription with match episode.EpisodeDescription with
| Some desc -> | Some desc ->
let elt = xmlDoc.CreateElement ("podcast", "episode", Namespace.podcast) let elt = xmlDoc.CreateElement ("podcast", "episode", Namespace.podcast)
elt.SetAttribute ("name", desc) elt.SetAttribute ("name", desc)
@@ -214,15 +214,15 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
| None -> item.ElementExtensions.Add ("episode", Namespace.podcast, string epNumber) | None -> item.ElementExtensions.Add ("episode", Namespace.podcast, string epNumber)
| None -> () | None -> ()
if post.metadata |> List.exists (fun it -> it.name = "chapter") then if post.Metadata |> List.exists (fun it -> it.Name = "chapter") then
try try
let chapters = xmlDoc.CreateElement ("psc", "chapters", Namespace.psc) let chapters = xmlDoc.CreateElement ("psc", "chapters", Namespace.psc)
chapters.SetAttribute ("version", "1.2") chapters.SetAttribute ("version", "1.2")
post.metadata post.Metadata
|> List.filter (fun it -> it.name = "chapter") |> List.filter (fun it -> it.Name = "chapter")
|> List.map (fun it -> |> List.map (fun it ->
TimeSpan.Parse (it.value.Split(" ")[0]), it.value.Substring (it.value.IndexOf(" ") + 1)) TimeSpan.Parse (it.Value.Split(" ")[0]), it.Value.Substring (it.Value.IndexOf(" ") + 1))
|> List.sortBy fst |> List.sortBy fst
|> List.iter (fun chap -> |> List.iter (fun chap ->
let chapter = xmlDoc.CreateElement ("psc", "chapter", Namespace.psc) let chapter = xmlDoc.CreateElement ("psc", "chapter", Namespace.psc)
@@ -247,12 +247,12 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
child.InnerText <- value child.InnerText <- value
elt elt
let podcast = Option.get feed.podcast let podcast = Option.get feed.Podcast
let feedUrl = WebLog.absoluteUrl webLog feed.path let feedUrl = WebLog.absoluteUrl webLog feed.Path
let imageUrl = let imageUrl =
match podcast.imageUrl with match podcast.ImageUrl with
| Permalink link when link.StartsWith "http" -> link | Permalink link when link.StartsWith "http" -> link
| Permalink _ -> WebLog.absoluteUrl webLog podcast.imageUrl | Permalink _ -> WebLog.absoluteUrl webLog podcast.ImageUrl
let xmlDoc = XmlDocument () let xmlDoc = XmlDocument ()
@@ -266,15 +266,15 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
let categorization = let categorization =
let it = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes) let it = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
it.SetAttribute ("text", podcast.iTunesCategory) it.SetAttribute ("text", podcast.AppleCategory)
podcast.iTunesSubcategory podcast.AppleSubcategory
|> Option.iter (fun subCat -> |> Option.iter (fun subCat ->
let subCatElt = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes) let subCatElt = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
subCatElt.SetAttribute ("text", subCat) subCatElt.SetAttribute ("text", subCat)
it.AppendChild subCatElt |> ignore) it.AppendChild subCatElt |> ignore)
it it
let image = let image =
[ "title", podcast.title [ "title", podcast.Title
"url", imageUrl "url", imageUrl
"link", feedUrl "link", feedUrl
] ]
@@ -284,8 +284,8 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
it.SetAttribute ("href", imageUrl) it.SetAttribute ("href", imageUrl)
it it
let owner = let owner =
[ "name", podcast.displayedAuthor [ "name", podcast.DisplayedAuthor
"email", podcast.email "email", podcast.Email
] ]
|> List.fold (fun elt (name, value) -> addChild xmlDoc Namespace.iTunes "itunes" name value elt) |> List.fold (fun elt (name, value) -> addChild xmlDoc Namespace.iTunes "itunes" name value elt)
(xmlDoc.CreateElement ("itunes", "owner", Namespace.iTunes)) (xmlDoc.CreateElement ("itunes", "owner", Namespace.iTunes))
@@ -300,62 +300,62 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
rssFeed.ElementExtensions.Add categorization rssFeed.ElementExtensions.Add categorization
rssFeed.ElementExtensions.Add iTunesImage rssFeed.ElementExtensions.Add iTunesImage
rssFeed.ElementExtensions.Add rawVoice rssFeed.ElementExtensions.Add rawVoice
rssFeed.ElementExtensions.Add ("summary", Namespace.iTunes, podcast.summary) rssFeed.ElementExtensions.Add ("summary", Namespace.iTunes, podcast.Summary)
rssFeed.ElementExtensions.Add ("author", Namespace.iTunes, podcast.displayedAuthor) rssFeed.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor)
rssFeed.ElementExtensions.Add ("explicit", Namespace.iTunes, ExplicitRating.toString podcast.explicit) rssFeed.ElementExtensions.Add ("explicit", Namespace.iTunes, ExplicitRating.toString podcast.Explicit)
podcast.subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub)) podcast.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub))
podcast.fundingUrl podcast.FundingUrl
|> Option.iter (fun url -> |> Option.iter (fun url ->
let funding = xmlDoc.CreateElement ("podcast", "funding", Namespace.podcast) let funding = xmlDoc.CreateElement ("podcast", "funding", Namespace.podcast)
funding.SetAttribute ("url", toAbsolute webLog url) funding.SetAttribute ("url", toAbsolute webLog url)
funding.InnerText <- defaultArg podcast.fundingText "Support This Podcast" funding.InnerText <- defaultArg podcast.FundingText "Support This Podcast"
rssFeed.ElementExtensions.Add funding) rssFeed.ElementExtensions.Add funding)
podcast.guid podcast.PodcastGuid
|> Option.iter (fun guid -> |> Option.iter (fun guid ->
rssFeed.ElementExtensions.Add ("guid", Namespace.podcast, guid.ToString().ToLowerInvariant ())) rssFeed.ElementExtensions.Add ("guid", Namespace.podcast, guid.ToString().ToLowerInvariant ()))
podcast.medium podcast.Medium
|> Option.iter (fun med -> rssFeed.ElementExtensions.Add ("medium", Namespace.podcast, PodcastMedium.toString med)) |> Option.iter (fun med -> rssFeed.ElementExtensions.Add ("medium", Namespace.podcast, PodcastMedium.toString med))
/// Get the feed's self reference and non-feed link /// Get the feed's self reference and non-feed link
let private selfAndLink webLog feedType ctx = let private selfAndLink webLog feedType ctx =
let withoutFeed (it : string) = Permalink (it.Replace ($"/{webLog.rss.feedName}", "")) let withoutFeed (it : string) = Permalink (it.Replace ($"/{webLog.Rss.FeedName}", ""))
match feedType with match feedType with
| StandardFeed path | StandardFeed path
| CategoryFeed (_, path) | CategoryFeed (_, path)
| TagFeed (_, path) -> Permalink path[1..], withoutFeed path | TagFeed (_, path) -> Permalink path[1..], withoutFeed path
| Custom (feed, _) -> | Custom (feed, _) ->
match feed.source with match feed.Source with
| Category (CategoryId catId) -> | Category (CategoryId catId) ->
feed.path, Permalink $"category/{(CategoryCache.get ctx |> Array.find (fun c -> c.id = catId)).slug}" feed.Path, Permalink $"category/{(CategoryCache.get ctx |> Array.find (fun c -> c.Id = catId)).Slug}"
| Tag tag -> feed.path, Permalink $"""tag/{tag.Replace(" ", "+")}/""" | Tag tag -> feed.Path, Permalink $"""tag/{tag.Replace(" ", "+")}/"""
/// Set the title and description of the feed based on its source /// Set the title and description of the feed based on its source
let private setTitleAndDescription feedType (webLog : WebLog) (cats : DisplayCategory[]) (feed : SyndicationFeed) = let private setTitleAndDescription feedType (webLog : WebLog) (cats : DisplayCategory[]) (feed : SyndicationFeed) =
let cleanText opt def = TextSyndicationContent (stripHtml (defaultArg opt def)) let cleanText opt def = TextSyndicationContent (stripHtml (defaultArg opt def))
match feedType with match feedType with
| StandardFeed _ -> | StandardFeed _ ->
feed.Title <- cleanText None webLog.name feed.Title <- cleanText None webLog.Name
feed.Description <- cleanText webLog.subtitle webLog.name feed.Description <- cleanText webLog.Subtitle webLog.Name
| CategoryFeed (CategoryId catId, _) -> | CategoryFeed (CategoryId catId, _) ->
let cat = cats |> Array.find (fun it -> it.id = catId) let cat = cats |> Array.find (fun it -> it.Id = catId)
feed.Title <- cleanText None $"""{webLog.name} - "{stripHtml cat.name}" Category""" feed.Title <- cleanText None $"""{webLog.Name} - "{stripHtml cat.Name}" Category"""
feed.Description <- cleanText cat.description $"""Posts categorized under "{cat.name}" """ feed.Description <- cleanText cat.Description $"""Posts categorized under "{cat.Name}" """
| TagFeed (tag, _) -> | TagFeed (tag, _) ->
feed.Title <- cleanText None $"""{webLog.name} - "{tag}" Tag""" feed.Title <- cleanText None $"""{webLog.Name} - "{tag}" Tag"""
feed.Description <- cleanText None $"""Posts with the "{tag}" tag""" feed.Description <- cleanText None $"""Posts with the "{tag}" tag"""
| Custom (custom, _) -> | Custom (custom, _) ->
match custom.podcast with match custom.Podcast with
| Some podcast -> | Some podcast ->
feed.Title <- cleanText None podcast.title feed.Title <- cleanText None podcast.Title
feed.Description <- cleanText podcast.subtitle podcast.title feed.Description <- cleanText podcast.Subtitle podcast.Title
| None -> | None ->
match custom.source with match custom.Source with
| Category (CategoryId catId) -> | Category (CategoryId catId) ->
let cat = cats |> Array.find (fun it -> it.id = catId) let cat = cats |> Array.find (fun it -> it.Id = catId)
feed.Title <- cleanText None $"""{webLog.name} - "{stripHtml cat.name}" Category""" feed.Title <- cleanText None $"""{webLog.Name} - "{stripHtml cat.Name}" Category"""
feed.Description <- cleanText cat.description $"""Posts categorized under "{cat.name}" """ feed.Description <- cleanText cat.Description $"""Posts categorized under "{cat.Name}" """
| Tag tag -> | Tag tag ->
feed.Title <- cleanText None $"""{webLog.name} - "{tag}" Tag""" feed.Title <- cleanText None $"""{webLog.Name} - "{tag}" Tag"""
feed.Description <- cleanText None $"""Posts with the "{tag}" tag""" feed.Description <- cleanText None $"""Posts with the "{tag}" tag"""
/// Create a feed with a known non-zero-length list of posts /// Create a feed with a known non-zero-length list of posts
@@ -365,15 +365,15 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
let! authors = getAuthors webLog posts data let! authors = getAuthors webLog posts data
let! tagMaps = getTagMappings webLog posts data let! tagMaps = getTagMappings webLog posts data
let cats = CategoryCache.get ctx let cats = CategoryCache.get ctx
let podcast = match feedType with Custom (feed, _) when Option.isSome feed.podcast -> Some feed | _ -> None let podcast = match feedType with Custom (feed, _) when Option.isSome feed.Podcast -> Some feed | _ -> None
let self, link = selfAndLink webLog feedType ctx let self, link = selfAndLink webLog feedType ctx
let toItem post = let toItem post =
let item = toFeedItem webLog authors cats tagMaps post let item = toFeedItem webLog authors cats tagMaps post
match podcast, post.episode with match podcast, post.Episode with
| Some feed, Some episode -> addEpisode webLog (Option.get feed.podcast) episode post item | Some feed, Some episode -> addEpisode webLog (Option.get feed.Podcast) episode post item
| Some _, _ -> | Some _, _ ->
warn "Feed" ctx $"[{webLog.name} {Permalink.toString self}] \"{stripHtml post.title}\" has no media" warn "Feed" ctx $"[{webLog.Name} {Permalink.toString self}] \"{stripHtml post.Title}\" has no media"
item item
| _ -> item | _ -> item
@@ -381,12 +381,12 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
addNamespace feed "content" Namespace.content addNamespace feed "content" Namespace.content
setTitleAndDescription feedType webLog cats feed setTitleAndDescription feedType webLog cats feed
feed.LastUpdatedTime <- (List.head posts).updatedOn |> DateTimeOffset feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset ()
feed.Generator <- generator ctx feed.Generator <- ctx.Generator
feed.Items <- posts |> Seq.ofList |> Seq.map toItem feed.Items <- posts |> Seq.ofList |> Seq.map toItem
feed.Language <- "en" feed.Language <- "en"
feed.Id <- WebLog.absoluteUrl webLog link feed.Id <- WebLog.absoluteUrl webLog link
webLog.rss.copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy) webLog.Rss.Copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy)
feed.Links.Add (SyndicationLink (Uri (WebLog.absoluteUrl webLog self), "self", "", "application/rss+xml", 0L)) feed.Links.Add (SyndicationLink (Uri (WebLog.absoluteUrl webLog self), "self", "", "application/rss+xml", 0L))
feed.ElementExtensions.Add ("link", "", WebLog.absoluteUrl webLog link) feed.ElementExtensions.Add ("link", "", WebLog.absoluteUrl webLog link)
@@ -414,111 +414,88 @@ let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> bac
// ~~ FEED ADMINISTRATION ~~ // ~~ FEED ADMINISTRATION ~~
open DotLiquid // POST /admin/settings/rss
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
// GET: /admin/settings/rss
let editSettings : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let feeds =
webLog.rss.customFeeds
|> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx))
|> Array.ofList
return! Hash.FromAnonymousObject
{| csrf = csrfToken ctx
page_title = "RSS Settings"
model = EditRssModel.fromRssOptions webLog.rss
custom_feeds = feeds
|}
|> viewForTheme "admin" "rss-settings" next ctx
}
// POST: /admin/settings/rss
let saveSettings : HttpHandler = fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
let! model = ctx.BindFormAsync<EditRssModel> () let! model = ctx.BindFormAsync<EditRssModel> ()
match! data.WebLog.findById ctx.WebLog.id with match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog -> | Some webLog ->
let webLog = { webLog with rss = model.updateOptions webLog.rss } let webLog = { webLog with Rss = model.UpdateOptions webLog.Rss }
do! data.WebLog.updateRssOptions webLog do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog WebLogCache.set webLog
do! addMessage ctx { UserMessage.success with message = "RSS settings updated successfully" } do! addMessage ctx { UserMessage.success with Message = "RSS settings updated successfully" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings/rss")) next ctx return! redirectToGet "admin/settings#rss-settings" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// GET: /admin/settings/rss/{id}/edit // GET /admin/settings/rss/{id}/edit
let editCustomFeed feedId : HttpHandler = fun next ctx -> task { let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let customFeed = let customFeed =
match feedId with match feedId with
| "new" -> Some { CustomFeed.empty with id = CustomFeedId "new" } | "new" -> Some { CustomFeed.empty with Id = CustomFeedId "new" }
| _ -> ctx.WebLog.rss.customFeeds |> List.tryFind (fun f -> f.id = CustomFeedId feedId) | _ -> ctx.WebLog.Rss.CustomFeeds |> List.tryFind (fun f -> f.Id = CustomFeedId feedId)
match customFeed with match customFeed with
| Some f -> | Some f ->
return! Hash.FromAnonymousObject hashForPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
{| csrf = csrfToken ctx |> withAntiCsrf ctx
page_title = $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed""" |> addToHash ViewContext.Model (EditCustomFeedModel.fromFeed f)
model = EditCustomFeedModel.fromFeed f |> addToHash "medium_values" [|
categories = CategoryCache.get ctx KeyValuePair.Create ("", "&ndash; Unspecified &ndash;")
medium_values = [| KeyValuePair.Create (PodcastMedium.toString Podcast, "Podcast")
KeyValuePair.Create ("", "&ndash; Unspecified &ndash;") KeyValuePair.Create (PodcastMedium.toString Music, "Music")
KeyValuePair.Create (PodcastMedium.toString Podcast, "Podcast") KeyValuePair.Create (PodcastMedium.toString Video, "Video")
KeyValuePair.Create (PodcastMedium.toString Music, "Music") KeyValuePair.Create (PodcastMedium.toString Film, "Film")
KeyValuePair.Create (PodcastMedium.toString Video, "Video") KeyValuePair.Create (PodcastMedium.toString Audiobook, "Audiobook")
KeyValuePair.Create (PodcastMedium.toString Film, "Film") KeyValuePair.Create (PodcastMedium.toString Newsletter, "Newsletter")
KeyValuePair.Create (PodcastMedium.toString Audiobook, "Audiobook") KeyValuePair.Create (PodcastMedium.toString Blog, "Blog")
KeyValuePair.Create (PodcastMedium.toString Newsletter, "Newsletter") |]
KeyValuePair.Create (PodcastMedium.toString Blog, "Blog") |> adminView "custom-feed-edit" next ctx
|] | None -> Error.notFound next ctx
|}
|> viewForTheme "admin" "custom-feed-edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST: /admin/settings/rss/save // POST /admin/settings/rss/save
let saveCustomFeed : HttpHandler = fun next ctx -> task { let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
match! data.WebLog.findById ctx.WebLog.id with match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog -> | Some webLog ->
let! model = ctx.BindFormAsync<EditCustomFeedModel> () let! model = ctx.BindFormAsync<EditCustomFeedModel> ()
let theFeed = let theFeed =
match model.id with match model.Id with
| "new" -> Some { CustomFeed.empty with id = CustomFeedId.create () } | "new" -> Some { CustomFeed.empty with Id = CustomFeedId.create () }
| _ -> webLog.rss.customFeeds |> List.tryFind (fun it -> CustomFeedId.toString it.id = model.id) | _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> CustomFeedId.toString it.Id = model.Id)
match theFeed with match theFeed with
| Some feed -> | Some feed ->
let feeds = model.updateFeed feed :: (webLog.rss.customFeeds |> List.filter (fun it -> it.id <> feed.id)) let feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun it -> it.Id <> feed.Id))
let webLog = { webLog with rss = { webLog.rss with customFeeds = feeds } } let webLog = { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
do! data.WebLog.updateRssOptions webLog do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog WebLogCache.set webLog
do! addMessage ctx { do! addMessage ctx {
UserMessage.success with UserMessage.success with
message = $"""Successfully {if model.id = "new" then "add" else "sav"}ed custom feed""" Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed"""
} }
let nextUrl = $"admin/settings/rss/{CustomFeedId.toString feed.id}/edit" return! redirectToGet $"admin/settings/rss/{CustomFeedId.toString feed.Id}/edit" next ctx
return! redirectToGet (WebLog.relativeUrl webLog (Permalink nextUrl)) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// POST /admin/settings/rss/{id}/delete // POST /admin/settings/rss/{id}/delete
let deleteCustomFeed feedId : HttpHandler = fun next ctx -> task { let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
match! data.WebLog.findById ctx.WebLog.id with match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog -> | Some webLog ->
let customId = CustomFeedId feedId let customId = CustomFeedId feedId
if webLog.rss.customFeeds |> List.exists (fun f -> f.id = customId) then if webLog.Rss.CustomFeeds |> List.exists (fun f -> f.Id = customId) then
let webLog = { let webLog = {
webLog with webLog with
rss = { Rss = {
webLog.rss with webLog.Rss with
customFeeds = webLog.rss.customFeeds |> List.filter (fun f -> f.id <> customId) CustomFeeds = webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> customId)
} }
} }
do! data.WebLog.updateRssOptions webLog do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog WebLogCache.set webLog
do! addMessage ctx { UserMessage.success with message = "Custom feed deleted successfully" } do! addMessage ctx { UserMessage.success with Message = "Custom feed deleted successfully" }
else else
do! addMessage ctx { UserMessage.warning with message = "Custom feed not found; no action taken" } do! addMessage ctx { UserMessage.warning with Message = "Custom feed not found; no action taken" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings/rss")) next ctx return! redirectToGet "admin/settings#rss-settings" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }

View File

@@ -12,12 +12,117 @@ type ISession with
this.SetString (key, JsonSerializer.Serialize item) this.SetString (key, JsonSerializer.Serialize item)
/// Get an item from the session /// Get an item from the session
member this.Get<'T> key = member this.TryGet<'T> key =
match this.GetString key with match this.GetString key with
| null -> None | null -> None
| item -> Some (JsonSerializer.Deserialize<'T> item) | item -> Some (JsonSerializer.Deserialize<'T> item)
/// Keys used in the myWebLog-standard DotLiquid hash
module ViewContext =
/// The anti cross-site request forgery (CSRF) token set to use for form submissions
[<Literal>]
let AntiCsrfTokens = "csrf"
/// 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"
@@ -38,46 +143,42 @@ 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.Get<UserMessage list> "messages" with Some it -> it | None -> [] let msg = match ctx.Session.TryGet<UserMessage list> ViewContext.Messages with Some it -> it | None -> []
ctx.Session.Set ("messages", message :: msg) ctx.Session.Set (ViewContext.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.Get<UserMessage list> "messages" with match ctx.Session.TryGet<UserMessage list> ViewContext.Messages with
| Some msg -> | Some msg ->
ctx.Session.Remove "messages" ctx.Session.Remove ViewContext.Messages
return msg |> (List.rev >> Array.ofList) return msg |> (List.rev >> Array.ofList)
| None -> return [||] | None -> return [||]
} }
/// Hold variable for the configured generator string
let mutable private generatorString : string option = None
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection
/// Get the generator string
let generator (ctx : HttpContext) =
match generatorString with
| Some gen -> gen
| None ->
let cfg = ctx.RequestServices.GetRequiredService<IConfiguration> ()
generatorString <-
match Option.ofObj cfg["Generator"] with
| Some gen -> Some gen
| None -> Some "generator not configured"
generatorString.Value
open MyWebLog open MyWebLog
open DotLiquid open DotLiquid
/// Either get the web log from the hash, or get it from the cache and add it to the hash /// Shorthand for creating a DotLiquid hash from an anonymous object
let private deriveWebLogFromHash (hash : Hash) (ctx : HttpContext) = let makeHash (values : obj) =
if hash.ContainsKey "web_log" then () else hash.Add ("web_log", ctx.WebLog) Hash.FromAnonymousObject values
hash["web_log"] :?> WebLog
/// 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
/// Add anti-CSRF tokens to the given hash
let withAntiCsrf (ctx : HttpContext) =
addToHash ViewContext.AntiCsrfTokens ctx.CsrfTokenSet
open System.Security.Claims
open Giraffe open Giraffe
open Giraffe.Htmx open Giraffe.Htmx
open Giraffe.ViewEngine open Giraffe.ViewEngine
@@ -86,115 +187,205 @@ open Giraffe.ViewEngine
let private htmxScript = RenderView.AsString.htmlNode Htmx.Script.minified let private htmxScript = RenderView.AsString.htmlNode Htmx.Script.minified
/// Populate the DotLiquid hash with standard information /// Populate the DotLiquid hash with standard information
let private populateHash hash ctx = task { let addViewContext ctx (hash : Hash) = task {
// Don't need the web log, but this adds it to the hash if the function is called directly
let _ = deriveWebLogFromHash hash ctx
let! messages = messages ctx let! messages = messages ctx
hash.Add ("logged_on", ctx.User.Identity.IsAuthenticated)
hash.Add ("page_list", PageListCache.get ctx)
hash.Add ("current_page", ctx.Request.Path.Value.Substring 1)
hash.Add ("messages", messages)
hash.Add ("generator", generator ctx)
hash.Add ("htmx_script", htmxScript)
do! commitSession ctx do! commitSession ctx
return
if hash.ContainsKey ViewContext.HtmxScript && hash.ContainsKey ViewContext.Messages then
// We have already populated everything; just update messages
hash[ViewContext.Messages] <- Array.concat [ hash[ViewContext.Messages] :?> UserMessage[]; messages ]
hash
else
ctx.User.Claims
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.NameIdentifier)
|> Option.map (fun claim -> addToHash ViewContext.UserId claim.Value hash)
|> Option.defaultValue hash
|> addToHash ViewContext.WebLog ctx.WebLog
|> addToHash ViewContext.PageList (PageListCache.get ctx)
|> addToHash ViewContext.Categories (CategoryCache.get ctx)
|> addToHash ViewContext.CurrentPage ctx.Request.Path.Value[1..]
|> addToHash ViewContext.Messages messages
|> addToHash ViewContext.Generator ctx.Generator
|> addToHash ViewContext.HtmxScript htmxScript
|> addToHash ViewContext.IsLoggedOn ctx.User.Identity.IsAuthenticated
|> addToHash ViewContext.IsAuthor (ctx.HasAccessLevel Author)
|> addToHash ViewContext.IsEditor (ctx.HasAccessLevel Editor)
|> addToHash ViewContext.IsWebLogAdmin (ctx.HasAccessLevel WebLogAdmin)
|> addToHash ViewContext.IsAdministrator (ctx.HasAccessLevel Administrator)
} }
/// Is the request from htmx?
let isHtmx (ctx : HttpContext) =
ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
/// Convert messages to headers (used for htmx responses)
let messagesToHeaders (messages : UserMessage array) : HttpHandler =
seq {
yield!
messages
|> Array.map (fun m ->
match m.Detail with
| Some detail -> $"{m.Level}|||{m.Message}|||{detail}"
| None -> $"{m.Level}|||{m.Message}"
|> setHttpHeader "X-Message")
withHxNoPushUrl
}
|> Seq.reduce (>=>)
/// Redirect after doing some action; commits session and issues a temporary redirect
let redirectToGet url : HttpHandler = fun _ ctx -> task {
do! commitSession ctx
return! redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink url)) earlyReturn ctx
}
/// Handlers for error conditions
module Error =
open System.Net
/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
let notAuthorized : HttpHandler = fun next ctx ->
if ctx.Request.Method = "GET" then
let redirectUrl = $"user/log-on?returnUrl={WebUtility.UrlEncode ctx.Request.Path}"
if isHtmx ctx then (withHxRedirect redirectUrl >=> redirectToGet redirectUrl) next ctx
else redirectToGet redirectUrl next ctx
else
if isHtmx ctx then
let messages = [|
{ UserMessage.error with
Message = $"You are not authorized to access the URL {ctx.Request.Path.Value}"
}
|]
(messagesToHeaders messages >=> setStatusCode 401) earlyReturn ctx
else setStatusCode 401 earlyReturn ctx
/// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there
let notFound : HttpHandler =
handleContext (fun ctx ->
if isHtmx ctx then
let messages = [|
{ UserMessage.error with Message = $"The URL {ctx.Request.Path.Value} was not found" }
|]
RequestErrors.notFound (messagesToHeaders messages) earlyReturn ctx
else RequestErrors.NOT_FOUND "Not found" earlyReturn ctx)
let server message : HttpHandler =
handleContext (fun ctx ->
if isHtmx ctx then
let messages = [| { UserMessage.error with Message = message } |]
ServerErrors.internalError (messagesToHeaders messages) 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 hash
let viewForTheme theme template next ctx = fun (hash : Hash) -> task { let viewForTheme themeId template next ctx (hash : Hash) = task {
do! populateHash hash ctx let! hash = addViewContext ctx hash
// NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render; // NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render;
// the net effect is a "layout" capability similar to Razor or Pug // the net effect is a "layout" capability similar to Razor or Pug
// Render view content... // Render view content...
let! contentTemplate = TemplateCache.get theme template ctx.Data match! TemplateCache.get themeId template ctx.Data with
hash.Add ("content", contentTemplate.Render hash) | Ok contentTemplate ->
let _ = addToHash ViewContext.Content (contentTemplate.Render hash) hash
// ...then render that content with its layout // ...then render that content with its layout
let isHtmx = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh match! TemplateCache.get themeId (if isHtmx ctx then "layout-partial" else "layout") ctx.Data with
let! layoutTemplate = TemplateCache.get theme (if isHtmx then "layout-partial" else "layout") ctx.Data | Ok layoutTemplate -> return! htmlString (layoutTemplate.Render hash) next ctx
| Error message -> return! Error.server message next ctx
return! htmlString (layoutTemplate.Render hash) 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 hash
let bareForTheme theme template next ctx = fun (hash : Hash) -> task { let bareForTheme themeId template next ctx (hash : Hash) = task {
do! populateHash hash ctx let! hash = addViewContext ctx hash
let withContent = task {
// Bare templates are rendered with layout-bare if hash.ContainsKey ViewContext.Content then return Ok hash
let! contentTemplate = TemplateCache.get theme template ctx.Data else
hash.Add ("content", contentTemplate.Render hash) match! TemplateCache.get themeId template ctx.Data with
| Ok contentTemplate -> return Ok (addToHash ViewContext.Content (contentTemplate.Render hash) hash)
let! layoutTemplate = TemplateCache.get theme "layout-bare" ctx.Data | Error message -> return Error message
}
// add messages as HTTP headers match! withContent with
let messages = hash["messages"] :?> UserMessage[] | Ok completeHash ->
let actions = seq { // Bare templates are rendered with layout-bare
yield! match! TemplateCache.get themeId "layout-bare" ctx.Data with
messages | Ok layoutTemplate ->
|> Array.map (fun m -> return!
match m.detail with (messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage[])
| Some detail -> $"{m.level}|||{m.message}|||{detail}" >=> htmlString (layoutTemplate.Render completeHash))
| None -> $"{m.level}|||{m.message}" next ctx
|> setHttpHeader "X-Message") | Error message -> return! Error.server message next ctx
withHxNoPush | Error message -> return! Error.server message next ctx
htmlString (layoutTemplate.Render hash)
}
return! (actions |> Seq.reduce (>=>)) 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 = fun (hash : Hash) -> task { let themedView template next ctx hash = task {
return! viewForTheme (deriveWebLogFromHash hash ctx).themePath template next ctx hash let! hash = addViewContext ctx hash
return! viewForTheme (hash[ViewContext.WebLog] :?> WebLog).ThemeId template next ctx hash
} }
/// Redirect after doing some action; commits session and issues a temporary redirect /// The ID for the admin theme
let redirectToGet url : HttpHandler = fun next ctx -> task { let adminTheme = ThemeId "admin"
do! commitSession ctx
return! redirectTo false url next ctx
}
open System.Security.Claims /// Display a view for the admin theme
let adminView template =
viewForTheme adminTheme template
/// Get the user ID for the current request /// Display a bare view for the admin theme
let userId (ctx : HttpContext) = let adminBareView template =
WebLogUserId (ctx.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value bareForTheme adminTheme template
open Microsoft.AspNetCore.Antiforgery /// Validate the anti cross-site request forgery token in the current request
/// Get the Anti-CSRF service
let private antiForgery (ctx : HttpContext) = ctx.RequestServices.GetRequiredService<IAntiforgery> ()
/// Get the cross-site request forgery token set
let csrfToken (ctx : HttpContext) =
(antiForgery ctx).GetAndStoreTokens ctx
/// Validate the cross-site request forgery token in the current request
let validateCsrf : HttpHandler = fun next ctx -> task { let validateCsrf : HttpHandler = fun next ctx -> task {
match! (antiForgery ctx).IsRequestValidAsync ctx with match! ctx.AntiForgery.IsRequestValidAsync ctx with
| true -> return! next ctx | true -> return! next ctx
| false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" next ctx | false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" earlyReturn ctx
} }
/// Require a user to be logged on /// Require a user to be logged on
let requireUser : HttpHandler = requiresAuthentication Error.notAuthorized let requireUser : HttpHandler = requiresAuthentication Error.notAuthorized
/// Require a specific level of access for a route
let requireAccess level : HttpHandler = fun next ctx -> task {
match ctx.UserAccessLevel with
| Some userLevel when AccessLevel.hasAccess level userLevel -> return! next ctx
| Some userLevel ->
do! addMessage ctx
{ UserMessage.warning with
Message = $"The page you tried to access requires {AccessLevel.toString level} privileges"
Detail = Some $"Your account only has {AccessLevel.toString userLevel} privileges"
}
return! Error.notAuthorized next ctx
| None ->
do! addMessage ctx
{ UserMessage.warning with Message = "The page you tried to access required you to be logged on" }
return! Error.notAuthorized next ctx
}
/// Determine if a user is authorized to edit a page or post, given the author
let canEdit authorId (ctx : HttpContext) =
ctx.UserId = authorId || ctx.HasAccessLevel Editor
open System.Threading.Tasks
/// Create a Task with a Some result for the given object
let someTask<'T> (it : 'T) = Task.FromResult (Some it)
open System.Collections.Generic open System.Collections.Generic
open MyWebLog.Data open MyWebLog.Data
/// Get the templates available for the current web log's theme (in a key/value pair list) /// Get the templates available for the current web log's theme (in a key/value pair list)
let templatesForTheme (ctx : HttpContext) (typ : string) = backgroundTask { let templatesForTheme (ctx : HttpContext) (typ : string) = backgroundTask {
match! ctx.Data.Theme.findByIdWithoutText (ThemeId ctx.WebLog.themePath) with match! ctx.Data.Theme.FindByIdWithoutText ctx.WebLog.ThemeId with
| Some theme -> | Some theme ->
return seq { return seq {
KeyValuePair.Create ("", $"- Default (single-{typ}) -") KeyValuePair.Create ("", $"- Default (single-{typ}) -")
yield! yield!
theme.templates theme.Templates
|> Seq.ofList |> Seq.ofList
|> Seq.filter (fun it -> it.name.EndsWith $"-{typ}" && it.name <> $"single-{typ}") |> Seq.filter (fun it -> it.Name.EndsWith $"-{typ}" && it.Name <> $"single-{typ}")
|> Seq.map (fun it -> KeyValuePair.Create (it.name, it.name)) |> Seq.map (fun it -> KeyValuePair.Create (it.Name, it.Name))
} }
|> Array.ofSeq |> Array.ofSeq
| None -> return [| KeyValuePair.Create ("", $"- Default (single-{typ}) -") |] | None -> return [| KeyValuePair.Create ("", $"- Default (single-{typ}) -") |]
@@ -203,29 +394,38 @@ let templatesForTheme (ctx : HttpContext) (typ : string) = backgroundTask {
/// Get all authors for a list of posts as metadata items /// Get all authors for a list of posts as metadata items
let getAuthors (webLog : WebLog) (posts : Post list) (data : IData) = let getAuthors (webLog : WebLog) (posts : Post list) (data : IData) =
posts posts
|> List.map (fun p -> p.authorId) |> List.map (fun p -> p.AuthorId)
|> List.distinct |> List.distinct
|> data.WebLogUser.findNames webLog.id |> data.WebLogUser.FindNames webLog.Id
/// Get all tag mappings for a list of posts as metadata items /// Get all tag mappings for a list of posts as metadata items
let getTagMappings (webLog : WebLog) (posts : Post list) (data : IData) = let getTagMappings (webLog : WebLog) (posts : Post list) (data : IData) =
posts posts
|> List.map (fun p -> p.tags) |> List.map (fun p -> p.Tags)
|> List.concat |> List.concat
|> List.distinct |> List.distinct
|> fun tags -> data.TagMap.findMappingForTags tags webLog.id |> fun tags -> data.TagMap.FindMappingForTags tags webLog.Id
/// Get all category IDs for the given slug (includes owned subcategories) /// Get all category IDs for the given slug (includes owned subcategories)
let getCategoryIds slug ctx = let getCategoryIds slug ctx =
let allCats = CategoryCache.get ctx let allCats = CategoryCache.get ctx
let cat = allCats |> Array.find (fun cat -> cat.slug = slug) let cat = allCats |> Array.find (fun cat -> cat.Slug = slug)
// Category pages include posts in subcategories // Category pages include posts in subcategories
allCats allCats
|> Seq.ofArray |> Seq.ofArray
|> Seq.filter (fun c -> c.id = cat.id || Array.contains cat.name c.parentNames) |> Seq.filter (fun c -> c.Id = cat.Id || Array.contains cat.Name c.ParentNames)
|> Seq.map (fun c -> CategoryId c.id) |> Seq.map (fun c -> CategoryId c.Id)
|> List.ofSeq |> List.ofSeq
open System
open System.Globalization
open NodaTime
/// Parse a date/time to UTC
let parseToUtc (date : string) =
Instant.FromDateTimeUtc (DateTime.Parse (date, null, DateTimeStyles.AdjustToUniversal))
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
/// Log level for debugging /// Log level for debugging

View File

@@ -0,0 +1,194 @@
/// Handlers to manipulate pages
module MyWebLog.Handlers.Page
open Giraffe
open MyWebLog
open MyWebLog.ViewModels
// GET /admin/pages
// GET /admin/pages/page/{pageNbr}
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! pages = ctx.Data.Page.FindPageOfPages ctx.WebLog.Id pageNbr
return!
hashForPage "Pages"
|> withAntiCsrf ctx
|> addToHash "pages" (pages |> List.map (DisplayPage.fromPageMinimal ctx.WebLog))
|> addToHash "page_nbr" pageNbr
|> addToHash "prev_page" (if pageNbr = 2 then "" else $"/page/{pageNbr - 1}")
|> addToHash "next_page" $"/page/{pageNbr + 1}"
|> adminView "page-list" next ctx
}
// GET /admin/page/{id}/edit
let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! result = task {
match pgId with
| "new" -> return Some ("Add a New Page", { Page.empty with Id = PageId "new"; AuthorId = ctx.UserId })
| _ ->
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some page -> return Some ("Edit Page", page)
| None -> return None
}
match result with
| Some (title, page) when canEdit page.AuthorId ctx ->
let model = EditPageModel.fromPage page
let! templates = templatesForTheme ctx "page"
return!
hashForPage title
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "metadata" (
Array.zip model.MetaNames model.MetaValues
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]))
|> addToHash "templates" templates
|> adminView "page-edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/page/{id}/delete
let delete pgId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Page.Delete (PageId pgId) ctx.WebLog.Id with
| true ->
do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Page deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with Message = "Page not found; nothing deleted" }
return! redirectToGet "admin/pages" next ctx
}
// GET /admin/page/{id}/permalinks
let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
hashForPage "Manage Prior Permalinks"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManagePermalinksModel.fromPage pg)
|> adminView "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/page/permalinks
let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let pageId = PageId model.Id
match! ctx.Data.Page.FindById pageId ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
let links = model.Prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Page.UpdatePriorPermalinks pageId ctx.WebLog.Id links with
| true ->
do! addMessage ctx { UserMessage.success with Message = "Page permalinks saved successfully" }
return! redirectToGet $"admin/page/{model.Id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/page/{id}/revisions
let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
hashForPage "Manage Page Revisions"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManageRevisionsModel.fromPage ctx.WebLog pg)
|> adminView "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/page/{id}/revisions/purge
let purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
match! data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg ->
do! data.Page.Update { pg with Revisions = [ List.head pg.Revisions ] }
do! addMessage ctx { UserMessage.success with Message = "Prior revisions purged successfully" }
return! redirectToGet $"admin/page/{pgId}/revisions" next ctx
| None -> return! Error.notFound next ctx
}
open Microsoft.AspNetCore.Http
/// Find the page and the requested revision
let private findPageRevision pgId revDate (ctx : HttpContext) = task {
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg ->
let asOf = parseToUtc revDate
return Some pg, pg.Revisions |> List.tryFind (fun r -> r.AsOf = asOf)
| None -> return None, None
}
// GET /admin/page/{id}/revision/{revision-date}/preview
let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
let _, extra = WebLog.hostAndPath ctx.WebLog
return! {|
content =
[ """<div class="mwl-revision-preview mb-3">"""
(MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text
"</div>"
]
|> String.concat ""
|}
|> makeHash |> adminBareView "" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/page/{id}/revision/{revision-date}/restore
let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update
{ pg with
Revisions = { rev with AsOf = Noda.now () }
:: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
}
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/page/{pgId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/page/{id}/revision/{revision-date}/delete
let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| 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! addMessage ctx { UserMessage.success with Message = "Revision deleted successfully" }
return! adminBareView "" next ctx (makeHash {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/page/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> ()
let data = ctx.Data
let now = Noda.now ()
let tryPage =
if model.IsNew then
{ Page.empty with
Id = PageId.create ()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
PublishedOn = now
} |> someTask
else data.Page.FindFullById (PageId model.PageId) ctx.WebLog.Id
match! tryPage with
| Some page when canEdit page.AuthorId ctx ->
let updateList = page.IsInPageList <> model.IsShownInPageList
let updatedPage = model.UpdatePage page now
do! (if model.IsNew then data.Page.Add else data.Page.Update) updatedPage
if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Page saved successfully" }
return! redirectToGet $"admin/page/{PageId.toString page.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}

View File

@@ -10,14 +10,13 @@ let private parseSlugAndPage webLog (slugAndPage : string seq) =
let fullPath = slugAndPage |> Seq.head let fullPath = slugAndPage |> Seq.head
let slugPath = slugAndPage |> Seq.skip 1 |> Seq.head let slugPath = slugAndPage |> Seq.skip 1 |> Seq.head
let slugs, isFeed = let slugs, isFeed =
let feedName = $"/{webLog.rss.feedName}" let feedName = $"/{webLog.Rss.FeedName}"
let notBlank = Array.filter (fun it -> it <> "") let notBlank = Array.filter (fun it -> it <> "")
if ( (webLog.rss.categoryEnabled && fullPath.StartsWith "/category/") if ( (webLog.Rss.IsCategoryEnabled && fullPath.StartsWith "/category/")
|| (webLog.rss.tagEnabled && fullPath.StartsWith "/tag/" )) || (webLog.Rss.IsTagEnabled && fullPath.StartsWith "/tag/" ))
&& slugPath.EndsWith feedName then && slugPath.EndsWith feedName then
notBlank (slugPath.Replace(feedName, "").Split "/"), true notBlank (slugPath.Replace(feedName, "").Split "/"), true
else else notBlank (slugPath.Split "/"), false
notBlank (slugPath.Split "/"), false
let pageIdx = Array.IndexOf (slugs, "page") let pageIdx = Array.IndexOf (slugs, "page")
let pageNbr = let pageNbr =
match pageIdx with match pageIdx with
@@ -36,12 +35,11 @@ type ListType =
| TagList | TagList
open System.Threading.Tasks open System.Threading.Tasks
open DotLiquid
open MyWebLog.Data open MyWebLog.Data
open MyWebLog.ViewModels open MyWebLog.ViewModels
/// Convert a list of posts into items ready to be displayed /// Convert a list of posts into items ready to be displayed
let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (data : IData) = task { let preparePostList webLog posts listType (url : string) pageNbr perPage (data : IData) = task {
let! authors = getAuthors webLog posts data let! authors = getAuthors webLog posts data
let! tagMappings = getTagMappings webLog posts data let! tagMappings = getTagMappings webLog posts data
let relUrl it = Some <| WebLog.relativeUrl webLog (Permalink it) let relUrl it = Some <| WebLog.relativeUrl webLog (Permalink it)
@@ -54,63 +52,65 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (da
let! olderPost, newerPost = let! olderPost, newerPost =
match listType with match listType with
| SinglePost -> | SinglePost ->
let post = List.head posts let post = List.head posts
let dateTime = defaultArg post.publishedOn post.updatedOn let target = defaultArg post.PublishedOn post.UpdatedOn
data.Post.findSurroundingPosts webLog.id dateTime data.Post.FindSurroundingPosts webLog.Id target
| _ -> Task.FromResult (None, None) | _ -> Task.FromResult (None, None)
let newerLink = let newerLink =
match listType, pageNbr with match listType, pageNbr with
| SinglePost, _ -> newerPost |> Option.map (fun p -> Permalink.toString p.permalink) | SinglePost, _ -> newerPost |> Option.map (fun p -> Permalink.toString p.Permalink)
| _, 1 -> None | _, 1 -> None
| PostList, 2 when webLog.defaultPage = "posts" -> Some "" | PostList, 2 when webLog.DefaultPage = "posts" -> Some ""
| PostList, _ -> relUrl $"page/{pageNbr - 1}" | PostList, _ -> relUrl $"page/{pageNbr - 1}"
| CategoryList, 2 -> relUrl $"category/{url}/" | CategoryList, 2 -> relUrl $"category/{url}/"
| CategoryList, _ -> relUrl $"category/{url}/page/{pageNbr - 1}" | CategoryList, _ -> relUrl $"category/{url}/page/{pageNbr - 1}"
| TagList, 2 -> relUrl $"tag/{url}/" | TagList, 2 -> relUrl $"tag/{url}/"
| TagList, _ -> relUrl $"tag/{url}/page/{pageNbr - 1}" | TagList, _ -> relUrl $"tag/{url}/page/{pageNbr - 1}"
| AdminList, 2 -> relUrl "admin/posts" | AdminList, 2 -> relUrl "admin/posts"
| AdminList, _ -> relUrl $"admin/posts/page/{pageNbr - 1}" | AdminList, _ -> relUrl $"admin/posts/page/{pageNbr - 1}"
let olderLink = let olderLink =
match listType, List.length posts > perPage with match listType, List.length posts > perPage with
| SinglePost, _ -> olderPost |> Option.map (fun p -> Permalink.toString p.permalink) | SinglePost, _ -> olderPost |> Option.map (fun p -> Permalink.toString p.Permalink)
| _, false -> None | _, false -> None
| PostList, true -> relUrl $"page/{pageNbr + 1}" | PostList, true -> relUrl $"page/{pageNbr + 1}"
| CategoryList, true -> relUrl $"category/{url}/page/{pageNbr + 1}" | CategoryList, true -> relUrl $"category/{url}/page/{pageNbr + 1}"
| TagList, true -> relUrl $"tag/{url}/page/{pageNbr + 1}" | TagList, true -> relUrl $"tag/{url}/page/{pageNbr + 1}"
| AdminList, true -> relUrl $"admin/posts/page/{pageNbr + 1}" | AdminList, true -> relUrl $"admin/posts/page/{pageNbr + 1}"
let model = let model =
{ posts = postItems { Posts = postItems
authors = authors Authors = authors
subtitle = None Subtitle = None
newerLink = newerLink NewerLink = newerLink
newerName = newerPost |> Option.map (fun p -> p.title) NewerName = newerPost |> Option.map (fun p -> p.Title)
olderLink = olderLink OlderLink = olderLink
olderName = olderPost |> Option.map (fun p -> p.title) OlderName = olderPost |> Option.map (fun p -> p.Title)
} }
return Hash.FromAnonymousObject {| return
model = model makeHash {||}
categories = CategoryCache.get ctx |> addToHash ViewContext.Model model
tag_mappings = tagMappings |> addToHash "tag_mappings" tagMappings
is_post = match listType with SinglePost -> true | _ -> false |> addToHash ViewContext.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 webLog = ctx.WebLog let count = ctx.WebLog.PostsPerPage
let data = ctx.Data let data = ctx.Data
let! posts = data.Post.findPageOfPublishedPosts webLog.id pageNbr webLog.postsPerPage let! posts = data.Post.FindPageOfPublishedPosts ctx.WebLog.Id pageNbr count
let! hash = preparePostList webLog posts PostList "" pageNbr webLog.postsPerPage ctx data let! hash = preparePostList ctx.WebLog posts PostList "" pageNbr count data
let title = let title =
match pageNbr, 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"
match title with Some ttl -> hash.Add ("page_title", ttl) | None -> () return!
if pageNbr = 1 && webLog.defaultPage = "posts" then hash.Add ("is_home", true) match title with Some ttl -> addToHash ViewContext.PageTitle ttl hash | None -> hash
return! themedView "index" next ctx hash |> function
| hash ->
if pageNbr = 1 && ctx.WebLog.DefaultPage = "posts" then addToHash ViewContext.IsHome true hash else hash
|> themedView "index" next ctx
} }
// GET /page/{pageNbr}/ // GET /page/{pageNbr}/
@@ -124,23 +124,24 @@ let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
match parseSlugAndPage webLog slugAndPage with match parseSlugAndPage webLog slugAndPage with
| Some pageNbr, slug, isFeed -> | Some pageNbr, slug, isFeed ->
match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.slug = slug) with match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.Slug = slug) with
| Some cat when isFeed -> | Some cat when isFeed ->
return! Feed.generate (Feed.CategoryFeed ((CategoryId cat.id), $"category/{slug}/{webLog.rss.feedName}")) return! Feed.generate (Feed.CategoryFeed ((CategoryId cat.Id), $"category/{slug}/{webLog.Rss.FeedName}"))
(defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx (defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage) next ctx
| Some cat -> | Some cat ->
// Category pages include posts in subcategories // Category pages include posts in subcategories
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 ctx data let! hash = 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>"""
hash.Add ("page_title", $"{cat.name}: Category Archive{pgTitle}") return!
hash.Add ("subtitle", defaultArg cat.description "") addToHash ViewContext.PageTitle $"{cat.Name}: Category Archive{pgTitle}" hash
hash.Add ("is_category", true) |> addToHash "subtitle" (defaultArg cat.Description "")
hash.Add ("is_category_home", (pageNbr = 1)) |> addToHash ViewContext.IsCategory true
hash.Add ("slug", slug) |> addToHash ViewContext.IsCategoryHome (pageNbr = 1)
return! themedView "index" next ctx hash |> addToHash ViewContext.Slug slug
|> 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
| None, _, _ -> return! Error.notFound next ctx | None, _, _ -> return! Error.notFound next ctx
@@ -157,27 +158,28 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
| Some pageNbr, rawTag, isFeed -> | Some pageNbr, rawTag, isFeed ->
let urlTag = HttpUtility.UrlDecode rawTag let urlTag = HttpUtility.UrlDecode rawTag
let! tag = backgroundTask { let! tag = backgroundTask {
match! data.TagMap.findByUrlValue urlTag webLog.id with match! data.TagMap.FindByUrlValue urlTag webLog.Id with
| Some m -> return m.tag | Some m -> return m.Tag
| None -> return urlTag | None -> return urlTag
} }
if isFeed then if isFeed then
return! Feed.generate (Feed.TagFeed (tag, $"tag/{rawTag}/{webLog.rss.feedName}")) return! Feed.generate (Feed.TagFeed (tag, $"tag/{rawTag}/{webLog.Rss.FeedName}"))
(defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx (defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage) next ctx
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 ctx data let! hash = 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>"""
hash.Add ("page_title", $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}") return!
hash.Add ("is_tag", true) addToHash ViewContext.PageTitle $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}" hash
hash.Add ("is_tag_home", (pageNbr = 1)) |> addToHash ViewContext.IsTag true
hash.Add ("slug", rawTag) |> addToHash ViewContext.IsTagHome (pageNbr = 1)
return! themedView "index" next ctx hash |> addToHash ViewContext.Slug rawTag
|> 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
| _ -> | _ ->
let spacedTag = tag.Replace ("-", " ") let spacedTag = tag.Replace ("-", " ")
match! data.Post.findPageOfTaggedPosts webLog.id spacedTag pageNbr 1 with match! data.Post.FindPageOfTaggedPosts webLog.Id spacedTag pageNbr 1 with
| posts when List.length posts > 0 -> | posts when List.length posts > 0 ->
let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}" let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}"
return! return!
@@ -191,158 +193,224 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
// GET / // GET /
let home : HttpHandler = fun next ctx -> task { let home : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog let webLog = ctx.WebLog
match webLog.defaultPage with match webLog.DefaultPage with
| "posts" -> return! pageOfPosts 1 next ctx | "posts" -> return! pageOfPosts 1 next ctx
| pageId -> | pageId ->
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!
Hash.FromAnonymousObject {| hashForPage page.Title
page = DisplayPage.fromPage webLog page |> addToHash "page" (DisplayPage.fromPage webLog page)
categories = CategoryCache.get ctx |> addToHash ViewContext.IsHome true
page_title = page.title |> themedView (defaultArg page.Template "single-page") next ctx
is_home = true
|}
|> themedView (defaultArg page.template "single-page") next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// GET /admin/posts // GET /admin/posts
// GET /admin/posts/page/{pageNbr} // GET /admin/posts/page/{pageNbr}
let all pageNbr : HttpHandler = fun next ctx -> task { let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let webLog = ctx.WebLog let data = ctx.Data
let data = ctx.Data let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25
let! posts = data.Post.findPageOfPosts webLog.id pageNbr 25 let! hash = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data
let! hash = preparePostList webLog posts AdminList "" pageNbr 25 ctx data return!
hash.Add ("page_title", "Posts") addToHash ViewContext.PageTitle "Posts" hash
hash.Add ("csrf", csrfToken ctx) |> withAntiCsrf ctx
return! viewForTheme "admin" "post-list" next ctx hash |> adminView "post-list" next ctx
} }
// GET /admin/post/{id}/edit // GET /admin/post/{id}/edit
let edit postId : HttpHandler = fun next ctx -> task { let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let webLog = ctx.WebLog
let data = ctx.Data let data = ctx.Data
let! result = task { let! result = task {
match postId with match postId with
| "new" -> return Some ("Write a New Post", { Post.empty with id = PostId "new" }) | "new" -> return Some ("Write a New Post", { Post.empty with Id = PostId "new" })
| _ -> | _ ->
match! data.Post.findFullById (PostId postId) webLog.id with match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post -> return Some ("Edit Post", post) | Some post -> return Some ("Edit Post", post)
| None -> return None | None -> return None
} }
match result with match result with
| Some (title, post) -> | Some (title, post) when canEdit post.AuthorId ctx ->
let! cats = data.Category.findAllForView webLog.id
let! templates = templatesForTheme ctx "post" let! templates = templatesForTheme ctx "post"
let model = EditPostModel.fromPost webLog post let model = EditPostModel.fromPost ctx.WebLog post
return! return!
Hash.FromAnonymousObject {| hashForPage title
csrf = csrfToken ctx |> withAntiCsrf ctx
model = model |> addToHash ViewContext.Model model
metadata = Array.zip model.metaNames model.metaValues |> addToHash "metadata" (
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]) Array.zip model.MetaNames model.MetaValues
page_title = title |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]))
templates = templates |> addToHash "templates" templates
categories = cats |> addToHash "explicit_values" [|
explicit_values = [| KeyValuePair.Create ("", "&ndash; Default &ndash;")
KeyValuePair.Create ("", "&ndash; Default &ndash;") KeyValuePair.Create (ExplicitRating.toString Yes, "Yes")
KeyValuePair.Create (ExplicitRating.toString Yes, "Yes") KeyValuePair.Create (ExplicitRating.toString No, "No")
KeyValuePair.Create (ExplicitRating.toString No, "No") KeyValuePair.Create (ExplicitRating.toString Clean, "Clean")
KeyValuePair.Create (ExplicitRating.toString Clean, "Clean") |]
|] |> adminView "post-edit" next ctx
|} | Some _ -> return! Error.notAuthorized next ctx
|> viewForTheme "admin" "post-edit" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// POST /admin/post/{id}/delete
let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Post.Delete (PostId postId) ctx.WebLog.Id with
| true -> do! addMessage ctx { UserMessage.success with Message = "Post deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with Message = "Post not found; nothing deleted" }
return! redirectToGet "admin/posts" next ctx
}
// GET /admin/post/{id}/permalinks // GET /admin/post/{id}/permalinks
let editPermalinks postId : HttpHandler = fun next ctx -> task { let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post -> | Some post when canEdit post.AuthorId ctx ->
return! return!
Hash.FromAnonymousObject {| hashForPage "Manage Prior Permalinks"
csrf = csrfToken ctx |> withAntiCsrf ctx
model = ManagePermalinksModel.fromPost post |> addToHash ViewContext.Model (ManagePermalinksModel.fromPost post)
page_title = $"Manage Prior Permalinks" |> adminView "permalinks" next ctx
|} | Some _ -> return! Error.notAuthorized next ctx
|> viewForTheme "admin" "permalinks" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// POST /admin/post/permalinks // POST /admin/post/permalinks
let savePermalinks : HttpHandler = fun next ctx -> task { let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let webLog = ctx.WebLog
let! model = ctx.BindFormAsync<ManagePermalinksModel> () let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let links = model.prior |> Array.map Permalink |> List.ofArray let postId = PostId model.Id
match! ctx.Data.Post.updatePriorPermalinks (PostId model.id) webLog.id links with match! ctx.Data.Post.FindById postId ctx.WebLog.Id with
| true -> | Some post when canEdit post.AuthorId ctx ->
do! addMessage ctx { UserMessage.success with message = "Post permalinks saved successfully" } let links = model.Prior |> Array.map Permalink |> List.ofArray
return! redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{model.id}/permalinks")) next ctx match! ctx.Data.Post.UpdatePriorPermalinks postId ctx.WebLog.Id links with
| false -> return! Error.notFound next ctx | true ->
} do! addMessage ctx { UserMessage.success with Message = "Post permalinks saved successfully" }
return! redirectToGet $"admin/post/{model.Id}/permalinks" next ctx
// POST /admin/post/{id}/delete | false -> return! Error.notFound next ctx
let delete postId : HttpHandler = fun next ctx -> task { | Some _ -> return! Error.notAuthorized next ctx
let webLog = ctx.WebLog | None -> return! Error.notFound next ctx
match! ctx.Data.Post.delete (PostId postId) webLog.id with }
| true -> do! addMessage ctx { UserMessage.success with message = "Post deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with message = "Post not found; nothing deleted" } // GET /admin/post/{id}/revisions
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/posts")) next ctx let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
} match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
#nowarn "3511" return!
hashForPage "Manage Post Revisions"
// POST /admin/post/save |> withAntiCsrf ctx
let save : HttpHandler = fun next ctx -> task { |> addToHash ViewContext.Model (ManageRevisionsModel.fromPost ctx.WebLog post)
let! model = ctx.BindFormAsync<EditPostModel> () |> adminView "revisions" next ctx
let webLog = ctx.WebLog | Some _ -> return! Error.notAuthorized next ctx
let data = ctx.Data | None -> return! Error.notFound next ctx
let now = DateTime.UtcNow }
let! pst = task {
match model.postId with // GET /admin/post/{id}/revisions/purge
| "new" -> let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
return Some let data = ctx.Data
{ Post.empty with match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
id = PostId.create () | Some post when canEdit post.AuthorId ctx ->
webLogId = webLog.id do! data.Post.Update { post with Revisions = [ List.head post.Revisions ] }
authorId = userId ctx do! addMessage ctx { UserMessage.success with Message = "Prior revisions purged successfully" }
} return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| postId -> return! data.Post.findFullById (PostId postId) webLog.id | Some _ -> return! Error.notAuthorized next ctx
} | None -> return! Error.notFound next ctx
match pst with }
| Some post ->
let revision = { asOf = now; text = MarkupText.parse $"{model.source}: {model.text}" } open Microsoft.AspNetCore.Http
// Detect a permalink change, and add the prior one to the prior list
let post = /// Find the post and the requested revision
match Permalink.toString post.permalink with let private findPostRevision postId revDate (ctx : HttpContext) = task {
| "" -> post match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| link when link = model.permalink -> post | Some post ->
| _ -> { post with priorPermalinks = post.permalink :: post.priorPermalinks } let asOf = parseToUtc revDate
let post = model.updatePost post revision now return Some post, post.Revisions |> List.tryFind (fun r -> r.AsOf = asOf)
let post = | None -> return None, None
match model.setPublished with }
| true ->
let dt = WebLog.utcTime webLog model.pubOverride.Value // GET /admin/post/{id}/revision/{revision-date}/preview
match model.setUpdated with let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
| true -> match! findPostRevision postId revDate ctx with
{ post with | Some post, Some rev when canEdit post.AuthorId ctx ->
publishedOn = Some dt let _, extra = WebLog.hostAndPath ctx.WebLog
updatedOn = dt return! {|
revisions = [ { (List.head post.revisions) with asOf = dt } ] content =
} [ """<div class="mwl-revision-preview mb-3">"""
| false -> { post with publishedOn = Some dt } (MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text
| false -> post "</div>"
do! (if model.postId = "new" then data.Post.add else data.Post.update) post ]
// If the post was published or its categories changed, refresh the category cache |> String.concat ""
if model.doPublish |}
|| not (pst.Value.categoryIds |> makeHash |> adminBareView "" next ctx
|> List.append post.categoryIds | Some _, Some _ -> return! Error.notAuthorized next ctx
|> List.distinct | None, _
|> List.length = List.length pst.Value.categoryIds) then | _, None -> return! Error.notFound next ctx
do! CategoryCache.update ctx }
do! addMessage ctx { UserMessage.success with message = "Post saved successfully" }
return! // POST /admin/post/{id}/revision/{revision-date}/restore
redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{PostId.toString post.id}/edit")) next ctx let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update
{ post with
Revisions = { rev with AsOf = Noda.now () }
:: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
}
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/revision/{revision-date}/delete
let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| 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! addMessage ctx { UserMessage.success with Message = "Revision deleted successfully" }
return! adminBareView "" next ctx (makeHash {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/post/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel> ()
let data = ctx.Data
let tryPost =
if model.IsNew then
{ Post.empty with
Id = PostId.create ()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
} |> someTask
else data.Post.FindFullById (PostId model.PostId) ctx.WebLog.Id
match! tryPost with
| Some post when canEdit post.AuthorId ctx ->
let priorCats = post.CategoryIds
let updatedPost =
model.UpdatePost post (Noda.now ())
|> function
| post ->
if model.SetPublished then
let dt = parseToUtc (model.PubOverride.Value.ToString "o")
if model.SetUpdated then
{ post with
PublishedOn = Some dt
UpdatedOn = dt
Revisions = [ { (List.head post.Revisions) with AsOf = dt } ]
}
else { post with PublishedOn = Some dt }
else post
do! (if model.PostId = "new" then data.Post.Add else data.Post.Update) updatedPost
// If the post was published or its categories changed, refresh the category cache
if model.DoPublish
|| not (priorCats
|> List.append updatedPost.CategoryIds
|> List.distinct
|> List.length = List.length priorCats) then
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Post saved successfully" }
return! redirectToGet $"admin/post/{PostId.toString post.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }

View File

@@ -8,7 +8,6 @@ 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 DotLiquid
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
@@ -27,67 +26,62 @@ module CatchAll =
if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.empty) if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.empty)
let permalink = Permalink (textLink.Substring 1) let permalink = Permalink (textLink.Substring 1)
// Current post // Current post
match data.Post.findByPermalink permalink webLog.id |> await with match data.Post.FindByPermalink permalink webLog.Id |> await with
| Some post -> | Some post ->
debug (fun () -> $"Found post by permalink") debug (fun () -> "Found post by permalink")
let model = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 ctx data |> await let hash = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 data |> await
model.Add ("page_title", post.title) yield fun next ctx ->
yield fun next ctx -> themedView (defaultArg post.template "single-post") next ctx model addToHash ViewContext.PageTitle post.Title hash
|> themedView (defaultArg post.Template "single-post") next ctx
| None -> () | None -> ()
// Current page // Current page
match data.Page.findByPermalink permalink webLog.id |> await with match data.Page.FindByPermalink permalink webLog.Id |> await with
| Some page -> | Some page ->
debug (fun () -> $"Found page by permalink") debug (fun () -> "Found page by permalink")
yield fun next ctx -> yield fun next ctx ->
Hash.FromAnonymousObject {| hashForPage page.Title
page = DisplayPage.fromPage webLog page |> addToHash "page" (DisplayPage.fromPage webLog page)
categories = CategoryCache.get ctx |> addToHash ViewContext.IsPage true
page_title = page.title |> themedView (defaultArg page.Template "single-page") next ctx
is_page = true
|}
|> themedView (defaultArg page.template "single-page") next ctx
| None -> () | None -> ()
// RSS feed // RSS feed
match Feed.deriveFeedType ctx textLink with match Feed.deriveFeedType ctx textLink with
| Some (feedType, postCount) -> | Some (feedType, postCount) ->
debug (fun () -> $"Found RSS feed") debug (fun () -> "Found RSS feed")
yield Feed.generate feedType postCount yield Feed.generate feedType postCount
| None -> () | None -> ()
// Post differing only by trailing slash // Post differing only by trailing slash
let altLink = let altLink =
Permalink (if textLink.EndsWith "/" then textLink[1..textLink.Length - 2] else $"{textLink[1..]}/") Permalink (if textLink.EndsWith "/" then textLink[1..textLink.Length - 2] else $"{textLink[1..]}/")
match data.Post.findByPermalink altLink webLog.id |> await with match data.Post.FindByPermalink altLink webLog.Id |> await with
| Some post -> | Some post ->
debug (fun () -> $"Found post by trailing-slash-agnostic permalink") debug (fun () -> "Found post by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog post.permalink) yield redirectTo true (WebLog.relativeUrl webLog post.Permalink)
| None -> () | None -> ()
// Page differing only by trailing slash // Page differing only by trailing slash
match data.Page.findByPermalink altLink webLog.id |> await with match data.Page.FindByPermalink altLink webLog.Id |> await with
| Some page -> | Some page ->
debug (fun () -> $"Found page by trailing-slash-agnostic permalink") debug (fun () -> "Found page by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog page.permalink) yield redirectTo true (WebLog.relativeUrl webLog page.Permalink)
| None -> () | None -> ()
// Prior post // Prior post
match data.Post.findCurrentPermalink [ permalink; altLink ] webLog.id |> await with match data.Post.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with
| Some link -> | Some link ->
debug (fun () -> $"Found post by prior permalink") debug (fun () -> "Found post by prior permalink")
yield redirectTo true (WebLog.relativeUrl webLog link) yield redirectTo true (WebLog.relativeUrl webLog link)
| None -> () | None -> ()
// Prior page // Prior page
match data.Page.findCurrentPermalink [ permalink; altLink ] webLog.id |> await with match data.Page.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with
| Some link -> | Some link ->
debug (fun () -> $"Found page by prior permalink") debug (fun () -> "Found page by prior permalink")
yield redirectTo true (WebLog.relativeUrl webLog link) yield redirectTo true (WebLog.relativeUrl webLog link)
| None -> () | None -> ()
debug (fun () -> $"No content found") debug (fun () -> "No content found")
} }
// GET {all-of-the-above} // GET {all-of-the-above}
let route : HttpHandler = fun next ctx -> task { let route : HttpHandler = fun next ctx ->
match deriveAction ctx |> Seq.tryHead with match deriveAction ctx |> Seq.tryHead with Some handler -> handler next ctx | None -> Error.notFound next ctx
| Some handler -> return! handler next ctx
| None -> return! Error.notFound next ctx
}
/// Serve theme assets /// Serve theme assets
@@ -96,11 +90,11 @@ module Asset =
// GET /theme/{theme}/{**path} // GET /theme/{theme}/{**path}
let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task { let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
let path = urlParts |> Seq.skip 1 |> Seq.head let path = urlParts |> Seq.skip 1 |> Seq.head
match! ctx.Data.ThemeAsset.findById (ThemeAssetId.ofString path) with match! ctx.Data.ThemeAsset.FindById (ThemeAssetId.ofString path) with
| Some asset -> | Some asset ->
match Upload.checkModified asset.updatedOn ctx with match Upload.checkModified asset.UpdatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx | Some threeOhFour -> return! threeOhFour next ctx
| None -> return! Upload.sendFile asset.updatedOn path asset.data next ctx | None -> return! Upload.sendFile (asset.UpdatedOn.ToDateTimeUtc ()) path asset.Data next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@@ -112,77 +106,102 @@ let router : HttpHandler = choose [
] ]
subRoute "/admin" (requireUser >=> choose [ subRoute "/admin" (requireUser >=> choose [
GET_HEAD >=> choose [ GET_HEAD >=> choose [
route "/administration" >=> Admin.Dashboard.admin
subRoute "/categor" (choose [ subRoute "/categor" (choose [
route "ies" >=> Admin.listCategories route "ies" >=> Admin.Category.all
route "ies/bare" >=> Admin.listCategoriesBare route "ies/bare" >=> Admin.Category.bare
routef "y/%s/edit" Admin.editCategory routef "y/%s/edit" Admin.Category.edit
]) ])
route "/dashboard" >=> Admin.dashboard route "/dashboard" >=> Admin.Dashboard.user
route "/my-info" >=> User.myInfo
subRoute "/page" (choose [ subRoute "/page" (choose [
route "s" >=> Admin.listPages 1 route "s" >=> Page.all 1
routef "s/page/%i" Admin.listPages routef "s/page/%i" Page.all
routef "/%s/edit" Admin.editPage routef "/%s/edit" Page.edit
routef "/%s/permalinks" Admin.editPagePermalinks routef "/%s/permalinks" Page.editPermalinks
routef "/%s/revision/%s/preview" Page.previewRevision
routef "/%s/revisions" Page.editRevisions
]) ])
subRoute "/post" (choose [ subRoute "/post" (choose [
route "s" >=> Post.all 1 route "s" >=> Post.all 1
routef "s/page/%i" Post.all routef "s/page/%i" Post.all
routef "/%s/edit" Post.edit routef "/%s/edit" Post.edit
routef "/%s/permalinks" Post.editPermalinks routef "/%s/permalinks" Post.editPermalinks
routef "/%s/revision/%s/preview" Post.previewRevision
routef "/%s/revisions" Post.editRevisions
]) ])
subRoute "/settings" (choose [ subRoute "/settings" (choose [
route "" >=> Admin.settings route "" >=> Admin.WebLog.settings
subRoute "/rss" (choose [ routef "/rss/%s/edit" Feed.editCustomFeed
route "" >=> Feed.editSettings subRoute "/user" (choose [
routef "/%s/edit" Feed.editCustomFeed route "s" >=> User.all
routef "/%s/edit" User.edit
]) ])
subRoute "/tag-mapping" (choose [ subRoute "/tag-mapping" (choose [
route "s" >=> Admin.tagMappings route "s" >=> Admin.TagMapping.all
route "s/bare" >=> Admin.tagMappingsBare routef "/%s/edit" Admin.TagMapping.edit
routef "/%s/edit" Admin.editMapping
]) ])
]) ])
route "/theme/update" >=> Admin.themeUpdatePage subRoute "/theme" (choose [
route "/list" >=> Admin.Theme.all
route "/new" >=> Admin.Theme.add
])
subRoute "/upload" (choose [ subRoute "/upload" (choose [
route "s" >=> Upload.list route "s" >=> Upload.list
route "/new" >=> Upload.showNew route "/new" >=> Upload.showNew
]) ])
route "/user/edit" >=> User.edit
] ]
POST >=> validateCsrf >=> choose [ POST >=> validateCsrf >=> choose [
subRoute "/category" (choose [ subRoute "/cache" (choose [
route "/save" >=> Admin.saveCategory routef "/theme/%s/refresh" Admin.Cache.refreshTheme
routef "/%s/delete" Admin.deleteCategory routef "/web-log/%s/refresh" Admin.Cache.refreshWebLog
]) ])
subRoute "/category" (choose [
route "/save" >=> Admin.Category.save
routef "/%s/delete" Admin.Category.delete
])
route "/my-info" >=> User.saveMyInfo
subRoute "/page" (choose [ subRoute "/page" (choose [
route "/save" >=> Admin.savePage route "/save" >=> Page.save
route "/permalinks" >=> Admin.savePagePermalinks route "/permalinks" >=> Page.savePermalinks
routef "/%s/delete" Admin.deletePage routef "/%s/delete" Page.delete
routef "/%s/revision/%s/delete" Page.deleteRevision
routef "/%s/revision/%s/restore" Page.restoreRevision
routef "/%s/revisions/purge" Page.purgeRevisions
]) ])
subRoute "/post" (choose [ subRoute "/post" (choose [
route "/save" >=> Post.save route "/save" >=> Post.save
route "/permalinks" >=> Post.savePermalinks route "/permalinks" >=> Post.savePermalinks
routef "/%s/delete" Post.delete routef "/%s/delete" Post.delete
routef "/%s/revision/%s/delete" Post.deleteRevision
routef "/%s/revision/%s/restore" Post.restoreRevision
routef "/%s/revisions/purge" Post.purgeRevisions
]) ])
subRoute "/settings" (choose [ subRoute "/settings" (choose [
route "" >=> Admin.saveSettings route "" >=> Admin.WebLog.saveSettings
subRoute "/rss" (choose [ subRoute "/rss" (choose [
route "" >=> Feed.saveSettings route "" >=> Feed.saveSettings
route "/save" >=> Feed.saveCustomFeed route "/save" >=> Feed.saveCustomFeed
routef "/%s/delete" Feed.deleteCustomFeed routef "/%s/delete" Feed.deleteCustomFeed
]) ])
subRoute "/tag-mapping" (choose [ subRoute "/tag-mapping" (choose [
route "/save" >=> Admin.saveMapping route "/save" >=> Admin.TagMapping.save
routef "/%s/delete" Admin.deleteMapping routef "/%s/delete" Admin.TagMapping.delete
])
subRoute "/user" (choose [
route "/save" >=> User.save
routef "/%s/delete" User.delete
]) ])
]) ])
route "/theme/update" >=> Admin.updateTheme subRoute "/theme" (choose [
route "/new" >=> Admin.Theme.save
routef "/%s/delete" Admin.Theme.delete
])
subRoute "/upload" (choose [ subRoute "/upload" (choose [
route "/save" >=> Upload.save route "/save" >=> Upload.save
routexp "/delete/(.*)" Upload.deleteFromDisk routexp "/delete/(.*)" Upload.deleteFromDisk
routef "/%s/delete" Upload.deleteFromDb routef "/%s/delete" Upload.deleteFromDb
]) ])
route "/user/save" >=> User.save
] ]
]) ])
GET_HEAD >=> routexp "/category/(.*)" Post.pageOfCategorizedPosts GET_HEAD >=> routexp "/category/(.*)" Post.pageOfCategorizedPosts
@@ -209,10 +228,10 @@ let routerWithPath extraPath : HttpHandler =
subRoute extraPath router subRoute extraPath router
/// Handler to apply Giraffe routing with a possible sub-route /// Handler to apply Giraffe routing with a possible sub-route
let handleRoute : HttpHandler = fun next ctx -> task { let handleRoute : HttpHandler = fun next ctx ->
let _, extraPath = WebLog.hostAndPath ctx.WebLog let _, extraPath = WebLog.hostAndPath ctx.WebLog
return! (if extraPath = "" then router else routerWithPath extraPath) next ctx (if extraPath = "" then router else routerWithPath extraPath) next ctx
}
open Giraffe.EndpointRouting open Giraffe.EndpointRouting

View File

@@ -3,10 +3,7 @@ module MyWebLog.Handlers.Upload
open System open System
open System.IO open System.IO
open Giraffe
open Microsoft.AspNetCore.Http
open Microsoft.Net.Http.Headers open Microsoft.Net.Http.Headers
open MyWebLog
/// Helper functions for this module /// Helper functions for this module
[<AutoOpen>] [<AutoOpen>]
@@ -30,12 +27,19 @@ module private Helpers =
let uploadDir = Path.Combine ("wwwroot", "upload") let uploadDir = Path.Combine ("wwwroot", "upload")
// ~~ SERVING UPLOADS ~~
open System.Globalization
open Giraffe
open Microsoft.AspNetCore.Http
open NodaTime
/// Determine if the file has been modified since the date/time specified by the If-Modified-Since header /// Determine if the file has been modified since the date/time specified by the If-Modified-Since header
let checkModified since (ctx : HttpContext) : HttpHandler option = let checkModified since (ctx : HttpContext) : HttpHandler option =
match ctx.Request.Headers.IfModifiedSince with match ctx.Request.Headers.IfModifiedSince with
| it when it.Count < 1 -> None | it when it.Count < 1 -> None
| it when since > DateTime.Parse it[0] -> None | it when since > Instant.FromDateTimeUtc (DateTime.Parse (it[0], null, DateTimeStyles.AdjustToUniversal)) -> None
| _ -> Some (setStatusCode 304 >=> setBodyFromString "Not Modified") | _ -> Some (setStatusCode 304)
open Microsoft.AspNetCore.Http.Headers open Microsoft.AspNetCore.Http.Headers
@@ -45,51 +49,52 @@ let deriveMimeType path =
match mimeMap.TryGetContentType path with true, typ -> typ | false, _ -> "application/octet-stream" match mimeMap.TryGetContentType path with true, typ -> typ | false, _ -> "application/octet-stream"
/// Send a file, caching the response for 30 days /// Send a file, caching the response for 30 days
let sendFile updatedOn path (data : byte[]) : HttpHandler = fun next ctx -> task { let sendFile updatedOn path (data : byte[]) : HttpHandler = fun next ctx ->
let headers = ResponseHeaders ctx.Response.Headers let headers = ResponseHeaders ctx.Response.Headers
headers.ContentType <- (deriveMimeType >> MediaTypeHeaderValue) path headers.ContentType <- (deriveMimeType >> MediaTypeHeaderValue) path
headers.CacheControl <- cacheForThirtyDays headers.CacheControl <- cacheForThirtyDays
let stream = new MemoryStream (data) let stream = new MemoryStream (data)
return! streamData true stream None (Some (DateTimeOffset updatedOn)) next ctx streamData true stream None (Some (DateTimeOffset updatedOn)) next ctx
}
open MyWebLog
// GET /upload/{web-log-slug}/{**path} // GET /upload/{web-log-slug}/{**path}
let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task { let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog let webLog = ctx.WebLog
let parts = (urlParts |> Seq.skip 1 |> Seq.head).Split '/' let parts = (urlParts |> Seq.skip 1 |> Seq.head).Split '/'
let slug = Array.head parts let slug = Array.head parts
if slug = webLog.slug then if slug = webLog.Slug then
// Static file middleware will not work in subdirectories; check for an actual file first // Static file middleware will not work in subdirectories; check for an actual file first
let fileName = Path.Combine ("wwwroot", (Seq.head urlParts)[1..]) let fileName = Path.Combine ("wwwroot", (Seq.head urlParts)[1..])
if File.Exists fileName then if File.Exists fileName then
return! streamFile true fileName None None next ctx return! streamFile true fileName None None next ctx
else else
let path = String.Join ('/', Array.skip 1 parts) let path = String.Join ('/', Array.skip 1 parts)
match! ctx.Data.Upload.findByPath path webLog.id with match! ctx.Data.Upload.FindByPath path webLog.Id with
| Some upload -> | Some upload ->
match checkModified upload.updatedOn ctx with match checkModified upload.UpdatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx | Some threeOhFour -> return! threeOhFour next ctx
| None -> return! sendFile upload.updatedOn path upload.data next ctx | None -> return! sendFile (upload.UpdatedOn.ToDateTimeUtc ()) path upload.Data next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
else else
return! Error.notFound next ctx return! Error.notFound next ctx
} }
// ADMIN // ~~ ADMINISTRATION ~~
open System.Text.RegularExpressions open System.Text.RegularExpressions
open DotLiquid
open MyWebLog.ViewModels open MyWebLog.ViewModels
/// Turn a string into a lowercase URL-safe slug /// Turn a string into a lowercase URL-safe slug
let makeSlug it = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 ]").Replace (it, ""), "-")).ToLowerInvariant () let makeSlug it = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 -]").Replace (it, ""), "-")).ToLowerInvariant ()
// GET /admin/uploads // GET /admin/uploads
let list : HttpHandler = fun next ctx -> task { let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let webLog = ctx.WebLog let webLog = ctx.WebLog
let! dbUploads = ctx.Data.Upload.findByWebLog webLog.id let! dbUploads = ctx.Data.Upload.FindByWebLog webLog.Id
let diskUploads = let diskUploads =
let path = Path.Combine (uploadDir, webLog.slug) let path = Path.Combine (uploadDir, webLog.Slug)
try try
Directory.EnumerateFiles (path, "*", SearchOption.AllDirectories) Directory.EnumerateFiles (path, "*", SearchOption.AllDirectories)
|> Seq.map (fun file -> |> Seq.map (fun file ->
@@ -98,11 +103,11 @@ let list : HttpHandler = fun next ctx -> task {
match File.GetCreationTime (Path.Combine (path, file)) with match File.GetCreationTime (Path.Combine (path, file)) with
| dt when dt > DateTime.UnixEpoch -> Some dt | dt when dt > DateTime.UnixEpoch -> Some dt
| _ -> None | _ -> None
{ DisplayUpload.id = "" { DisplayUpload.Id = ""
name = name Name = name
path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace (slash, '/') Path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace (slash, '/')
updatedOn = create UpdatedOn = create
source = UploadDestination.toString Disk Source = UploadDestination.toString Disk
}) })
|> List.ofSeq |> List.ofSeq
with with
@@ -114,77 +119,67 @@ let list : HttpHandler = fun next ctx -> task {
dbUploads dbUploads
|> List.map (DisplayUpload.fromUpload webLog Database) |> List.map (DisplayUpload.fromUpload webLog Database)
|> List.append diskUploads |> List.append diskUploads
|> List.sortByDescending (fun file -> file.updatedOn, file.path) |> List.sortByDescending (fun file -> file.UpdatedOn, file.Path)
return! return!
Hash.FromAnonymousObject {| hashForPage "Uploaded Files"
csrf = csrfToken ctx |> withAntiCsrf ctx
page_title = "Uploaded Files" |> addToHash "files" allFiles
files = allFiles |> adminView "upload-list" next ctx
|} }
|> viewForTheme "admin" "upload-list" next ctx
}
// GET /admin/upload/new // GET /admin/upload/new
let showNew : HttpHandler = fun next ctx -> task { let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
return! hashForPage "Upload a File"
Hash.FromAnonymousObject {| |> withAntiCsrf ctx
csrf = csrfToken ctx |> addToHash "destination" (UploadDestination.toString ctx.WebLog.Uploads)
destination = UploadDestination.toString ctx.WebLog.uploads |> adminView "upload-new" next ctx
page_title = "Upload a File"
|}
|> viewForTheme "admin" "upload-new" next ctx
}
/// Redirect to the upload list /// Redirect to the upload list
let showUploads : HttpHandler = fun next ctx -> task { let showUploads : HttpHandler =
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/uploads")) next ctx redirectToGet "admin/uploads"
}
// POST /admin/upload/save // POST /admin/upload/save
let save : HttpHandler = fun next ctx -> task { let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let upload = Seq.head ctx.Request.Form.Files let upload = Seq.head ctx.Request.Form.Files
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName), let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
Path.GetExtension(upload.FileName).ToLowerInvariant ()) Path.GetExtension(upload.FileName).ToLowerInvariant ())
let webLog = ctx.WebLog let now = Noda.now ()
let localNow = WebLog.localTime webLog DateTime.Now let localNow = WebLog.localTime ctx.WebLog now
let year = localNow.ToString "yyyy" let year = localNow.ToString "yyyy"
let month = localNow.ToString "MM" let month = localNow.ToString "MM"
let! form = ctx.BindFormAsync<UploadFileModel> () let! form = ctx.BindFormAsync<UploadFileModel> ()
match UploadDestination.parse form.destination with match UploadDestination.parse form.Destination with
| Database -> | Database ->
use stream = new MemoryStream () use stream = new MemoryStream ()
do! upload.CopyToAsync stream do! upload.CopyToAsync stream
let file = let file =
{ id = UploadId.create () { Id = UploadId.create ()
webLogId = webLog.id WebLogId = ctx.WebLog.Id
path = Permalink $"{year}/{month}/{fileName}" Path = Permalink $"{year}/{month}/{fileName}"
updatedOn = DateTime.UtcNow UpdatedOn = now
data = stream.ToArray () Data = stream.ToArray ()
} }
do! ctx.Data.Upload.add file do! ctx.Data.Upload.Add file
| Disk -> | Disk ->
let fullPath = Path.Combine (uploadDir, webLog.slug, year, month) let fullPath = Path.Combine (uploadDir, ctx.WebLog.Slug, year, month)
let _ = Directory.CreateDirectory fullPath let _ = Directory.CreateDirectory fullPath
use stream = new FileStream (Path.Combine (fullPath, fileName), FileMode.Create) use stream = new FileStream (Path.Combine (fullPath, fileName), FileMode.Create)
do! upload.CopyToAsync stream do! upload.CopyToAsync stream
do! addMessage ctx { UserMessage.success with message = $"File uploaded to {form.destination} successfully" } do! addMessage ctx { UserMessage.success with Message = $"File uploaded to {form.Destination} successfully" }
return! showUploads next ctx return! showUploads next ctx
else else
return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx
} }
// POST /admin/upload/{id}/delete // POST /admin/upload/{id}/delete
let deleteFromDb upId : HttpHandler = fun next ctx -> task { let deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let uploadId = UploadId upId match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.Id with
let webLog = ctx.WebLog
let data = ctx.Data
match! data.Upload.delete uploadId webLog.id with
| Ok fileName -> | Ok fileName ->
do! addMessage ctx { UserMessage.success with message = $"{fileName} deleted successfully" } do! addMessage ctx { UserMessage.success with Message = $"{fileName} deleted successfully" }
return! showUploads next ctx return! showUploads next ctx
| Error _ -> return! Error.notFound next ctx | Error _ -> return! Error.notFound next ctx
} }
@@ -194,22 +189,20 @@ let removeEmptyDirectories (webLog : WebLog) (filePath : string) =
let mutable path = Path.GetDirectoryName filePath let mutable path = Path.GetDirectoryName filePath
let mutable finished = false let mutable finished = false
while (not finished) && path > "" do while (not finished) && path > "" do
let fullPath = Path.Combine (uploadDir, webLog.slug, path) let fullPath = Path.Combine (uploadDir, webLog.Slug, path)
if Directory.EnumerateFileSystemEntries fullPath |> Seq.isEmpty then if Directory.EnumerateFileSystemEntries fullPath |> Seq.isEmpty then
Directory.Delete fullPath Directory.Delete fullPath
path <- String.Join(slash, path.Split slash |> Array.rev |> Array.skip 1 |> Array.rev) path <- String.Join(slash, path.Split slash |> Array.rev |> Array.skip 1 |> Array.rev)
else else finished <- true
finished <- true
// POST /admin/upload/delete/{**path} // POST /admin/upload/delete/{**path}
let deleteFromDisk urlParts : HttpHandler = fun next ctx -> task { let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let filePath = urlParts |> Seq.skip 1 |> Seq.head let filePath = urlParts |> Seq.skip 1 |> Seq.head
let path = Path.Combine (uploadDir, ctx.WebLog.slug, filePath) let path = Path.Combine (uploadDir, ctx.WebLog.Slug, filePath)
if File.Exists path then if File.Exists path then
File.Delete path File.Delete path
removeEmptyDirectories ctx.WebLog filePath removeEmptyDirectories ctx.WebLog filePath
do! addMessage ctx { UserMessage.success with message = $"{filePath} deleted successfully" } do! addMessage ctx { UserMessage.success with Message = $"{filePath} deleted successfully" }
return! showUploads next ctx return! showUploads next ctx
else else return! Error.notFound next ctx
return! Error.notFound next ctx
} }

View File

@@ -2,117 +2,237 @@
module MyWebLog.Handlers.User module MyWebLog.Handlers.User
open System open System
open System.Security.Cryptography open Microsoft.AspNetCore.Http
open System.Text open Microsoft.AspNetCore.Identity
open MyWebLog
open NodaTime
/// Hash a password for a given user // ~~ LOG ON / LOG OFF ~~
let hashedPassword (plainText : string) (email : string) (salt : Guid) =
let allSalt = Array.concat [ salt.ToByteArray (); Encoding.UTF8.GetBytes email ] /// Create a password hash a password for a given user
use alg = new Rfc2898DeriveBytes (plainText, allSalt, 2_048) let createPasswordHash user password =
Convert.ToBase64String (alg.GetBytes 64) PasswordHasher<WebLogUser>().HashPassword (user, password)
/// Verify whether a password is valid
let verifyPassword user password (ctx : HttpContext) = backgroundTask {
match user with
| Some usr ->
let hasher = PasswordHasher<WebLogUser> ()
match hasher.VerifyHashedPassword (usr, usr.PasswordHash, password) with
| PasswordVerificationResult.Success -> return Ok ()
| PasswordVerificationResult.SuccessRehashNeeded ->
do! ctx.Data.WebLogUser.Update { usr with PasswordHash = hasher.HashPassword (usr, password) }
return Ok ()
| _ -> return Error "Log on attempt unsuccessful"
| None -> return Error "Log on attempt unsuccessful"
}
open DotLiquid
open Giraffe open Giraffe
open MyWebLog.ViewModels open MyWebLog.ViewModels
// GET /user/log-on // GET /user/log-on
let logOn returnUrl : HttpHandler = fun next ctx -> task { let logOn returnUrl : HttpHandler = fun next ctx ->
let returnTo = let returnTo =
match returnUrl with match returnUrl with
| Some _ -> returnUrl | Some _ -> returnUrl
| None -> | None -> if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None
match ctx.Request.Query.ContainsKey "returnUrl" with hashForPage "Log On"
| true -> Some ctx.Request.Query["returnUrl"].[0] |> withAntiCsrf ctx
| false -> None |> addToHash ViewContext.Model { LogOnModel.empty with ReturnTo = returnTo }
return! |> adminView "log-on" next ctx
Hash.FromAnonymousObject {|
model = { LogOnModel.empty with returnTo = returnTo }
page_title = "Log On"
csrf = csrfToken ctx
|}
|> viewForTheme "admin" "log-on" next ctx
}
open System.Security.Claims open System.Security.Claims
open Microsoft.AspNetCore.Authentication open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies open Microsoft.AspNetCore.Authentication.Cookies
open MyWebLog
// POST /user/log-on // POST /user/log-on
let doLogOn : HttpHandler = fun next ctx -> task { let doLogOn : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel> () let! model = ctx.BindFormAsync<LogOnModel> ()
let webLog = ctx.WebLog let data = ctx.Data
match! ctx.Data.WebLogUser.findByEmail model.emailAddress webLog.id with let! tryUser = data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id
| Some user when user.passwordHash = hashedPassword model.password user.userName user.salt -> match! verifyPassword tryUser model.Password ctx with
| Ok _ ->
let user = tryUser.Value
let claims = seq { let claims = seq {
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.id) Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id)
Claim (ClaimTypes.Name, $"{user.firstName} {user.lastName}") Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
Claim (ClaimTypes.GivenName, user.preferredName) Claim (ClaimTypes.GivenName, user.PreferredName)
Claim (ClaimTypes.Role, user.authorizationLevel.ToString ()) Claim (ClaimTypes.Role, AccessLevel.toString user.AccessLevel)
} }
let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme) let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity, do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity,
AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow)) AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow))
do! data.WebLogUser.SetLastSeen user.Id user.WebLogId
do! addMessage ctx do! addMessage ctx
{ UserMessage.success with message = $"Logged on successfully | Welcome to {webLog.name}!" } { UserMessage.success with
return! redirectToGet (defaultArg model.returnTo (WebLog.relativeUrl webLog (Permalink "admin/dashboard"))) Message = "Log on successful"
next ctx Detail = Some $"Welcome to {ctx.WebLog.Name}!"
| _ -> }
do! addMessage ctx { UserMessage.error with message = "Log on attempt unsuccessful" } return!
return! logOn model.returnTo next ctx match model.ReturnTo with
| Some url -> redirectTo false url next ctx
| None -> redirectToGet "admin/dashboard" next ctx
| Error msg ->
do! addMessage ctx { UserMessage.error with Message = msg }
return! logOn model.ReturnTo next ctx
} }
// GET /user/log-off // GET /user/log-off
let logOff : HttpHandler = fun next ctx -> task { let logOff : HttpHandler = fun next ctx -> task {
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
do! addMessage ctx { UserMessage.info with message = "Log off successful" } do! addMessage ctx { UserMessage.info with Message = "Log off successful" }
return! redirectToGet (WebLog.relativeUrl ctx.WebLog Permalink.empty) next ctx return! redirectToGet "" next ctx
} }
/// Display the user edit page, with information possibly filled in // ~~ ADMINISTRATION ~~
let private showEdit (hash : Hash) : HttpHandler = fun next ctx -> task {
hash.Add ("page_title", "Edit Your Information") open System.Collections.Generic
hash.Add ("csrf", csrfToken ctx) open Giraffe.Htmx
return! viewForTheme "admin" "user-edit" next ctx hash
/// Got no time for URL/form manipulators...
let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?"
// GET /admin/settings/users
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id
return!
hashForPage "User Administration"
|> withAntiCsrf ctx
|> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList)
|> adminBareView "user-list-body" next ctx
} }
// GET /admin/user/edit /// Show the edit user page
let edit : HttpHandler = fun next ctx -> task { let private showEdit (model : EditUserModel) : HttpHandler = fun next ctx ->
match! ctx.Data.WebLogUser.findById (userId ctx) ctx.WebLog.id with hashForPage (if model.IsNew then "Add a New User" else "Edit User")
| Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) next ctx |> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "access_levels" [|
KeyValuePair.Create (AccessLevel.toString Author, "Author")
KeyValuePair.Create (AccessLevel.toString Editor, "Editor")
KeyValuePair.Create (AccessLevel.toString WebLogAdmin, "Web Log Admin")
if ctx.HasAccessLevel Administrator then
KeyValuePair.Create (AccessLevel.toString Administrator, "Administrator")
|]
|> adminBareView "user-edit" next ctx
// GET /admin/settings/user/{id}/edit
let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let isNew = usrId = "new"
let userId = WebLogUserId usrId
let tryUser =
if isNew then someTask { WebLogUser.empty with Id = userId }
else ctx.Data.WebLogUser.FindById userId ctx.WebLog.Id
match! tryUser with
| Some user -> return! showEdit (EditUserModel.fromUser user) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// POST /admin/user/save // POST /admin/settings/user/{id}/delete
let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel> () let data = ctx.Data
if model.newPassword = model.newPasswordConfirm then match! data.WebLogUser.FindById (WebLogUserId userId) ctx.WebLog.Id with
let data = ctx.Data | Some user ->
match! data.WebLogUser.findById (userId ctx) ctx.WebLog.id with if user.AccessLevel = Administrator && not (ctx.HasAccessLevel Administrator) then
| Some user -> return! goAway next ctx
let pw, salt = else
if model.newPassword = "" then match! data.WebLogUser.Delete user.Id user.WebLogId with
user.passwordHash, user.salt | Ok _ ->
else do! addMessage ctx
let newSalt = Guid.NewGuid () { UserMessage.success with
hashedPassword model.newPassword user.userName newSalt, newSalt Message = $"User {WebLogUser.displayName user} deleted successfully"
let user = }
{ user with return! all next ctx
firstName = model.firstName | Error msg ->
lastName = model.lastName do! addMessage ctx
preferredName = model.preferredName { UserMessage.error with
passwordHash = pw Message = $"User {WebLogUser.displayName user} was not deleted"
salt = salt Detail = Some msg
} }
do! data.WebLogUser.update user return! all next ctx
let pwMsg = if model.newPassword = "" then "" else " and updated your password" | None -> return! Error.notFound next ctx
do! addMessage ctx { UserMessage.success with message = $"Saved your information{pwMsg} successfully" } }
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/user/edit")) next ctx
| None -> return! Error.notFound next ctx /// Display the user "my info" page, with information possibly filled in
else let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandler = fun next ctx ->
do! addMessage ctx { UserMessage.error with message = "Passwords did not match; no updates made" } hashForPage "Edit Your Information"
return! showEdit (Hash.FromAnonymousObject {| |> withAntiCsrf ctx
model = { model with newPassword = ""; newPasswordConfirm = "" } |> addToHash ViewContext.Model model
|}) next ctx |> addToHash "access_level" (AccessLevel.toString user.AccessLevel)
|> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn)
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog
(defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
|> adminView "my-info" next ctx
// GET /admin/my-info
let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user -> return! showMyInfo (EditMyInfoModel.fromUser user) user next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/my-info
let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditMyInfoModel> ()
let data = ctx.Data
match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user when model.NewPassword = model.NewPasswordConfirm ->
let pw = if model.NewPassword = "" then user.PasswordHash else createPasswordHash user model.NewPassword
let user =
{ user with
FirstName = model.FirstName
LastName = model.LastName
PreferredName = model.PreferredName
PasswordHash = pw
}
do! data.WebLogUser.Update user
let pwMsg = if model.NewPassword = "" then "" else " and updated your password"
do! addMessage ctx { UserMessage.success with Message = $"Saved your information{pwMsg} successfully" }
return! redirectToGet "admin/my-info" next ctx
| Some user ->
do! addMessage ctx { UserMessage.error with Message = "Passwords did not match; no updates made" }
return! showMyInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user next ctx
| None -> return! Error.notFound next ctx
}
// User save is not statically compilable; not sure why, but we'll revisit it at some point
#nowarn "3511"
// POST /admin/settings/user/save
let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel> ()
let data = ctx.Data
let tryUser =
if model.IsNew then
{ WebLogUser.empty with
Id = WebLogUserId.create ()
WebLogId = ctx.WebLog.Id
CreatedOn = Noda.now ()
} |> someTask
else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
match! tryUser with
| Some user when model.Password = model.PasswordConfirm ->
let updatedUser = model.UpdateUser user
if updatedUser.AccessLevel = Administrator && not (ctx.HasAccessLevel Administrator) then
return! goAway next ctx
else
let toUpdate =
if model.Password = "" then updatedUser
else { updatedUser with PasswordHash = createPasswordHash updatedUser model.Password }
do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate
do! addMessage ctx
{ UserMessage.success with
Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully"""
}
return! all next ctx
| Some _ ->
do! addMessage ctx { UserMessage.error with Message = "The passwords did not match; nothing saved" }
return!
(withHxRetarget $"#user_{model.Id}" >=> showEdit { model with Password = ""; PasswordConfirm = "" })
next ctx
| None -> return! Error.notFound next ctx
} }

View File

@@ -4,6 +4,7 @@ open System
open System.IO open System.IO
open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.DependencyInjection
open MyWebLog.Data open MyWebLog.Data
open NodaTime
/// Create the web log information /// Create the web log information
let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
@@ -25,65 +26,75 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
let homePageId = PageId.create () let homePageId = PageId.create ()
let slug = Handlers.Upload.makeSlug args[2] let slug = Handlers.Upload.makeSlug args[2]
do! data.WebLog.add // If this is the first web log being created, the user will be an installation admin; otherwise, they will be an
// admin just over their web log
let! webLogs = data.WebLog.All ()
let accessLevel = if List.isEmpty webLogs then Administrator else WebLogAdmin
do! data.WebLog.Add
{ WebLog.empty with { WebLog.empty with
id = webLogId Id = webLogId
name = args[2] Name = args[2]
slug = slug Slug = slug
urlBase = args[1] UrlBase = args[1]
defaultPage = PageId.toString homePageId DefaultPage = PageId.toString homePageId
timeZone = timeZone TimeZone = timeZone
} }
// Create the admin user // Create the admin user
let salt = Guid.NewGuid () let now = Noda.now ()
let user =
do! data.WebLogUser.add { WebLogUser.empty with
{ WebLogUser.empty with Id = userId
id = userId WebLogId = webLogId
webLogId = webLogId Email = args[3]
userName = args[3] FirstName = "Admin"
firstName = "Admin" LastName = "User"
lastName = "User" PreferredName = "Admin"
preferredName = "Admin" AccessLevel = accessLevel
passwordHash = Handlers.User.hashedPassword args[4] args[3] salt CreatedOn = now
salt = salt }
authorizationLevel = Administrator do! data.WebLogUser.Add { user with PasswordHash = Handlers.User.createPasswordHash user args[4] }
}
// Create the default home page // Create the default home page
do! data.Page.add do! data.Page.Add
{ Page.empty with { Page.empty with
id = homePageId Id = homePageId
webLogId = webLogId WebLogId = webLogId
authorId = userId AuthorId = userId
title = "Welcome to myWebLog!" Title = "Welcome to myWebLog!"
permalink = Permalink "welcome-to-myweblog.html" Permalink = Permalink "welcome-to-myweblog.html"
publishedOn = DateTime.UtcNow PublishedOn = now
updatedOn = DateTime.UtcNow UpdatedOn = now
text = "<p>This is your default home page.</p>" Text = "<p>This is your default home page.</p>"
revisions = [ Revisions = [
{ asOf = DateTime.UtcNow { AsOf = now
text = Html "<p>This is your default home page.</p>" Text = Html "<p>This is your default home page.</p>"
} }
] ]
} }
printfn $"Successfully initialized database for {args[2]} with URL base {args[1]}" printfn $"Successfully initialized database for {args[2]} with URL base {args[1]}"
match accessLevel with
| Administrator -> printfn $" ({args[3]} is an installation administrator)"
| WebLogAdmin ->
printfn $" ({args[3]} is a web log administrator;"
printfn """ use "upgrade-user" to promote to installation administrator)"""
| _ -> ()
} }
/// Create a new web log /// Create a new web log
let createWebLog args sp = task { let createWebLog args sp = task {
match args |> Array.length with match args |> Array.length with
| 5 -> do! doCreateWebLog args sp | 5 -> do! doCreateWebLog args sp
| _ -> printfn "Usage: MyWebLog init [url] [name] [admin-email] [admin-pw]" | _ -> eprintfn "Usage: myWebLog init [url] [name] [admin-email] [admin-pw]"
} }
/// Import prior permalinks from a text files with lines in the format "[old] [new]" /// Import prior permalinks from a text files with lines in the format "[old] [new]"
let importPriorPermalinks urlBase file (sp : IServiceProvider) = task { let private importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
let data = sp.GetRequiredService<IData> () let data = sp.GetRequiredService<IData> ()
match! data.WebLog.findByHost urlBase with match! data.WebLog.FindByHost urlBase with
| Some webLog -> | Some webLog ->
let mapping = let mapping =
@@ -94,13 +105,13 @@ let importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
Permalink parts[0], Permalink parts[1]) Permalink parts[0], Permalink parts[1])
for old, current in mapping do for old, current in mapping do
match! data.Post.findByPermalink current webLog.id with match! data.Post.FindByPermalink current webLog.Id with
| Some post -> | Some post ->
let! withLinks = data.Post.findFullById post.id post.webLogId let! withLinks = data.Post.FindFullById post.Id post.WebLogId
let! _ = data.Post.updatePriorPermalinks post.id post.webLogId let! _ = data.Post.UpdatePriorPermalinks post.Id post.WebLogId
(old :: withLinks.Value.priorPermalinks) (old :: withLinks.Value.PriorPermalinks)
printfn $"{Permalink.toString old} -> {Permalink.toString current}" printfn $"{Permalink.toString old} -> {Permalink.toString current}"
| None -> printfn $"Cannot find current post for {Permalink.toString current}" | None -> eprintfn $"Cannot find current post for {Permalink.toString current}"
printfn "Done!" printfn "Done!"
| None -> eprintfn $"No web log found at {urlBase}" | None -> eprintfn $"No web log found at {urlBase}"
} }
@@ -109,158 +120,158 @@ let importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
let importLinks args sp = task { let importLinks args sp = task {
match args |> Array.length with match args |> Array.length with
| 3 -> do! importPriorPermalinks args[1] args[2] sp | 3 -> do! importPriorPermalinks args[1] args[2] sp
| _ -> printfn "Usage: MyWebLog import-links [url] [file-name]" | _ -> eprintfn "Usage: myWebLog import-links [url] [file-name]"
} }
// Loading a theme and restoring a backup are not statically compilable; this is OK // Loading a theme and restoring a backup are not statically compilable; this is OK
#nowarn "3511" #nowarn "3511"
open Microsoft.Extensions.Logging
/// Load a theme from the given ZIP file /// Load a theme from the given ZIP file
let loadTheme (args : string[]) (sp : IServiceProvider) = task { let loadTheme (args : string[]) (sp : IServiceProvider) = task {
if args.Length > 1 then if args.Length = 2 then
let fileName = let fileName =
match args[1].LastIndexOf Path.DirectorySeparatorChar with match args[1].LastIndexOf Path.DirectorySeparatorChar with
| -1 -> args[1] | -1 -> args[1]
| it -> args[1][(it + 1)..] | it -> args[1][(it + 1)..]
match Handlers.Admin.getThemeName fileName with match Handlers.Admin.Theme.deriveIdFromFileName fileName with
| Ok themeName -> | Ok themeId ->
let data = sp.GetRequiredService<IData> () let data = sp.GetRequiredService<IData> ()
let clean = if args.Length > 2 then bool.Parse args[2] else true
use stream = File.Open (args[1], FileMode.Open) use stream = File.Open (args[1], FileMode.Open)
use copy = new MemoryStream () use copy = new MemoryStream ()
do! stream.CopyToAsync copy do! stream.CopyToAsync copy
do! Handlers.Admin.loadThemeFromZip themeName copy clean data let! theme = Handlers.Admin.Theme.loadFromZip themeId copy data
printfn $"Theme {themeName} loaded successfully" let fac = sp.GetRequiredService<ILoggerFactory> ()
let log = fac.CreateLogger "MyWebLog.Themes"
log.LogInformation $"{theme.Name} v{theme.Version} ({ThemeId.toString theme.Id}) loaded"
| Error message -> eprintfn $"{message}" | Error message -> eprintfn $"{message}"
else else
printfn "Usage: MyWebLog load-theme [theme-zip-file-name] [*clean-load]" eprintfn "Usage: myWebLog load-theme [theme-zip-file-name]"
printfn " * optional, defaults to true"
} }
/// Back up a web log's data /// Back up a web log's data
module Backup = module Backup =
open System.Threading.Tasks
open MyWebLog.Converters open MyWebLog.Converters
open Newtonsoft.Json open Newtonsoft.Json
/// A theme asset, with the data base-64 encoded /// A theme asset, with the data base-64 encoded
type EncodedAsset = type EncodedAsset =
{ /// The ID of the theme asset { /// The ID of the theme asset
id : ThemeAssetId Id : ThemeAssetId
/// The updated date for this asset /// The updated date for this asset
updatedOn : DateTime UpdatedOn : Instant
/// The data for this asset, base-64 encoded /// The data for this asset, base-64 encoded
data : string Data : string
} }
/// Create an encoded theme asset from the original theme asset /// Create an encoded theme asset from the original theme asset
static member fromAsset (asset : ThemeAsset) = static member fromAsset (asset : ThemeAsset) =
{ id = asset.id { Id = asset.Id
updatedOn = asset.updatedOn UpdatedOn = asset.UpdatedOn
data = Convert.ToBase64String asset.data Data = Convert.ToBase64String asset.Data
} }
/// Create a theme asset from an encoded theme asset /// Create a theme asset from an encoded theme asset
static member fromEncoded (encoded : EncodedAsset) : ThemeAsset = static member toAsset (encoded : EncodedAsset) : ThemeAsset =
{ id = encoded.id { Id = encoded.Id
updatedOn = encoded.updatedOn UpdatedOn = encoded.UpdatedOn
data = Convert.FromBase64String encoded.data Data = Convert.FromBase64String encoded.Data
} }
/// An uploaded file, with the data base-64 encoded /// An uploaded file, with the data base-64 encoded
type EncodedUpload = type EncodedUpload =
{ /// The ID of the upload { /// The ID of the upload
id : UploadId Id : UploadId
/// The ID of the web log to which the upload belongs /// The ID of the web log to which the upload belongs
webLogId : WebLogId WebLogId : WebLogId
/// The path at which this upload is served /// The path at which this upload is served
path : Permalink Path : Permalink
/// The date/time this upload was last updated (file time) /// The date/time this upload was last updated (file time)
updatedOn : DateTime UpdatedOn : Instant
/// The data for the upload, base-64 encoded /// The data for the upload, base-64 encoded
data : string Data : string
} }
/// Create an encoded uploaded file from the original uploaded file /// Create an encoded uploaded file from the original uploaded file
static member fromUpload (upload : Upload) : EncodedUpload = static member fromUpload (upload : Upload) : EncodedUpload =
{ id = upload.id { Id = upload.Id
webLogId = upload.webLogId WebLogId = upload.WebLogId
path = upload.path Path = upload.Path
updatedOn = upload.updatedOn UpdatedOn = upload.UpdatedOn
data = Convert.ToBase64String upload.data Data = Convert.ToBase64String upload.Data
} }
/// Create an uploaded file from an encoded uploaded file /// Create an uploaded file from an encoded uploaded file
static member fromEncoded (encoded : EncodedUpload) : Upload = static member toUpload (encoded : EncodedUpload) : Upload =
{ id = encoded.id { Id = encoded.Id
webLogId = encoded.webLogId WebLogId = encoded.WebLogId
path = encoded.path Path = encoded.Path
updatedOn = encoded.updatedOn UpdatedOn = encoded.UpdatedOn
data = Convert.FromBase64String encoded.data Data = Convert.FromBase64String encoded.Data
} }
/// A unified archive for a web log /// A unified archive for a web log
type Archive = type Archive =
{ /// The web log to which this archive belongs { /// The web log to which this archive belongs
webLog : WebLog WebLog : WebLog
/// The users for this web log /// The users for this web log
users : WebLogUser list Users : WebLogUser list
/// The theme used by this web log at the time the archive was made /// The theme used by this web log at the time the archive was made
theme : Theme Theme : Theme
/// Assets for the theme used by this web log at the time the archive was made /// Assets for the theme used by this web log at the time the archive was made
assets : EncodedAsset list Assets : EncodedAsset list
/// The categories for this web log /// The categories for this web log
categories : Category list Categories : Category list
/// The tag mappings for this web log /// The tag mappings for this web log
tagMappings : TagMap list TagMappings : TagMap list
/// The pages for this web log (containing only the most recent revision) /// The pages for this web log (containing only the most recent revision)
pages : Page list Pages : Page list
/// The posts for this web log (containing only the most recent revision) /// The posts for this web log (containing only the most recent revision)
posts : Post list Posts : Post list
/// The uploaded files for this web log /// The uploaded files for this web log
uploads : EncodedUpload list Uploads : EncodedUpload list
} }
/// Create a JSON serializer (uses RethinkDB data implementation's JSON converters) /// Create a JSON serializer
let private getSerializer prettyOutput = let private getSerializer prettyOutput =
let serializer = JsonSerializer.CreateDefault () let serializer = Json.configure (JsonSerializer.CreateDefault ())
Json.all () |> Seq.iter serializer.Converters.Add
if prettyOutput then serializer.Formatting <- Formatting.Indented if prettyOutput then serializer.Formatting <- Formatting.Indented
serializer serializer
/// Display statistics for a backup archive /// Display statistics for a backup archive
let private displayStats (msg : string) (webLog : WebLog) archive = let private displayStats (msg : string) (webLog : WebLog) archive =
let userCount = List.length archive.users let userCount = List.length archive.Users
let assetCount = List.length archive.assets let assetCount = List.length archive.Assets
let categoryCount = List.length archive.categories let categoryCount = List.length archive.Categories
let tagMapCount = List.length archive.tagMappings let tagMapCount = List.length archive.TagMappings
let pageCount = List.length archive.pages let pageCount = List.length archive.Pages
let postCount = List.length archive.posts let postCount = List.length archive.Posts
let uploadCount = List.length archive.uploads let uploadCount = List.length archive.Uploads
// Create a pluralized output based on the count // Create a pluralized output based on the count
let plural count ifOne ifMany = let plural count ifOne ifMany =
if count = 1 then ifOne else ifMany if count = 1 then ifOne else ifMany
printfn "" printfn ""
printfn $"""{msg.Replace ("<>NAME<>", webLog.name)}""" printfn $"""{msg.Replace ("<>NAME<>", webLog.Name)}"""
printfn $""" - The theme "{archive.theme.name}" with {assetCount} asset{plural assetCount "" "s"}""" printfn $""" - The theme "{archive.Theme.Name}" with {assetCount} asset{plural assetCount "" "s"}"""
printfn $""" - {userCount} user{plural userCount "" "s"}""" printfn $""" - {userCount} user{plural userCount "" "s"}"""
printfn $""" - {categoryCount} categor{plural categoryCount "y" "ies"}""" printfn $""" - {categoryCount} categor{plural categoryCount "y" "ies"}"""
printfn $""" - {tagMapCount} tag mapping{plural tagMapCount "" "s"}""" printfn $""" - {tagMapCount} tag mapping{plural tagMapCount "" "s"}"""
@@ -271,40 +282,38 @@ module Backup =
/// Create a backup archive /// Create a backup archive
let private createBackup webLog (fileName : string) prettyOutput (data : IData) = task { let private createBackup webLog (fileName : string) prettyOutput (data : IData) = task {
// Create the data structure // Create the data structure
let themeId = ThemeId webLog.themePath
printfn "- Exporting theme..." printfn "- Exporting theme..."
let! theme = data.Theme.findById themeId let! theme = data.Theme.FindById webLog.ThemeId
let! assets = data.ThemeAsset.findByThemeWithData themeId let! assets = data.ThemeAsset.FindByThemeWithData webLog.ThemeId
printfn "- Exporting users..." printfn "- Exporting users..."
let! users = data.WebLogUser.findByWebLog webLog.id let! users = data.WebLogUser.FindByWebLog webLog.Id
printfn "- Exporting categories and tag mappings..." printfn "- Exporting categories and tag mappings..."
let! categories = data.Category.findByWebLog webLog.id let! categories = data.Category.FindByWebLog webLog.Id
let! tagMaps = data.TagMap.findByWebLog webLog.id let! tagMaps = data.TagMap.FindByWebLog webLog.Id
printfn "- Exporting pages..." printfn "- Exporting pages..."
let! pages = data.Page.findFullByWebLog webLog.id let! pages = data.Page.FindFullByWebLog webLog.Id
printfn "- Exporting posts..." printfn "- Exporting posts..."
let! posts = data.Post.findFullByWebLog webLog.id let! posts = data.Post.FindFullByWebLog webLog.Id
printfn "- Exporting uploads..." printfn "- Exporting uploads..."
let! uploads = data.Upload.findByWebLogWithData webLog.id let! uploads = data.Upload.FindByWebLogWithData webLog.Id
printfn "- Writing archive..." printfn "- Writing archive..."
let archive = { let archive =
webLog = webLog { WebLog = webLog
users = users Users = users
theme = Option.get theme Theme = Option.get theme
assets = assets |> List.map EncodedAsset.fromAsset Assets = assets |> List.map EncodedAsset.fromAsset
categories = categories Categories = categories
tagMappings = tagMaps TagMappings = tagMaps
pages = pages |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions }) Pages = pages |> List.map (fun p -> { p with Revisions = List.truncate 1 p.Revisions })
posts = posts |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions }) Posts = posts |> List.map (fun p -> { p with Revisions = List.truncate 1 p.Revisions })
uploads = uploads |> List.map EncodedUpload.fromUpload Uploads = uploads |> List.map EncodedUpload.fromUpload
} }
// Write the structure to the backup file // Write the structure to the backup file
if File.Exists fileName then File.Delete fileName if File.Exists fileName then File.Delete fileName
@@ -318,83 +327,85 @@ module Backup =
let private doRestore archive newUrlBase (data : IData) = task { let private doRestore archive newUrlBase (data : IData) = task {
let! restore = task { let! restore = task {
match! data.WebLog.findById archive.webLog.id with match! data.WebLog.FindById archive.WebLog.Id with
| Some webLog when defaultArg newUrlBase webLog.urlBase = webLog.urlBase -> | Some webLog when defaultArg newUrlBase webLog.UrlBase = webLog.UrlBase ->
do! data.WebLog.delete webLog.id do! data.WebLog.Delete webLog.Id
return { archive with webLog = { archive.webLog with urlBase = defaultArg newUrlBase webLog.urlBase } } return { archive with WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase webLog.UrlBase } }
| Some _ -> | Some _ ->
// Err'body gets new IDs... // Err'body gets new IDs...
let newWebLogId = WebLogId.create () let newWebLogId = WebLogId.create ()
let newCatIds = archive.categories |> List.map (fun cat -> cat.id, CategoryId.create ()) |> dict let newCatIds = archive.Categories |> List.map (fun cat -> cat.Id, CategoryId.create ()) |> dict
let newMapIds = archive.tagMappings |> List.map (fun tm -> tm.id, TagMapId.create ()) |> dict let newMapIds = archive.TagMappings |> List.map (fun tm -> tm.Id, TagMapId.create ()) |> dict
let newPageIds = archive.pages |> List.map (fun page -> page.id, PageId.create ()) |> dict let newPageIds = archive.Pages |> List.map (fun page -> page.Id, PageId.create ()) |> dict
let newPostIds = archive.posts |> List.map (fun post -> post.id, PostId.create ()) |> dict let newPostIds = archive.Posts |> List.map (fun post -> post.Id, PostId.create ()) |> dict
let newUserIds = archive.users |> List.map (fun user -> user.id, WebLogUserId.create ()) |> dict let newUserIds = archive.Users |> List.map (fun user -> user.Id, WebLogUserId.create ()) |> dict
let newUpIds = archive.uploads |> List.map (fun up -> up.id, UploadId.create ()) |> dict let newUpIds = archive.Uploads |> List.map (fun up -> up.Id, UploadId.create ()) |> dict
return return
{ archive with { archive with
webLog = { archive.webLog with id = newWebLogId; urlBase = Option.get newUrlBase } WebLog = { archive.WebLog with Id = newWebLogId; UrlBase = Option.get newUrlBase }
users = archive.users Users = archive.Users
|> List.map (fun u -> { u with id = newUserIds[u.id]; webLogId = newWebLogId }) |> List.map (fun u -> { u with Id = newUserIds[u.Id]; WebLogId = newWebLogId })
categories = archive.categories Categories = archive.Categories
|> List.map (fun c -> { c with id = newCatIds[c.id]; webLogId = newWebLogId }) |> List.map (fun c -> { c with Id = newCatIds[c.Id]; WebLogId = newWebLogId })
tagMappings = archive.tagMappings TagMappings = archive.TagMappings
|> List.map (fun tm -> { tm with id = newMapIds[tm.id]; webLogId = newWebLogId }) |> List.map (fun tm -> { tm with Id = newMapIds[tm.Id]; WebLogId = newWebLogId })
pages = archive.pages Pages = archive.Pages
|> List.map (fun page -> |> List.map (fun page ->
{ page with { page with
id = newPageIds[page.id] Id = newPageIds[page.Id]
webLogId = newWebLogId WebLogId = newWebLogId
authorId = newUserIds[page.authorId] AuthorId = newUserIds[page.AuthorId]
}) })
posts = archive.posts Posts = archive.Posts
|> List.map (fun post -> |> List.map (fun post ->
{ post with { post with
id = newPostIds[post.id] Id = newPostIds[post.Id]
webLogId = newWebLogId WebLogId = newWebLogId
authorId = newUserIds[post.authorId] AuthorId = newUserIds[post.AuthorId]
categoryIds = post.categoryIds |> List.map (fun c -> newCatIds[c]) CategoryIds = post.CategoryIds |> List.map (fun c -> newCatIds[c])
}) })
uploads = archive.uploads Uploads = archive.Uploads
|> List.map (fun u -> { u with id = newUpIds[u.id]; webLogId = newWebLogId }) |> List.map (fun u -> { u with Id = newUpIds[u.Id]; WebLogId = newWebLogId })
} }
| None -> | None ->
return return
{ archive with { archive with
webLog = { archive.webLog with urlBase = defaultArg newUrlBase archive.webLog.urlBase } WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase archive.WebLog.UrlBase }
} }
} }
// Restore theme and assets (one at a time, as assets can be large) // Restore theme and assets (one at a time, as assets can be large)
printfn "" printfn ""
printfn "- Importing theme..." printfn "- Importing theme..."
do! data.Theme.save restore.theme do! data.Theme.Save restore.Theme
let! _ = restore.assets |> List.map (EncodedAsset.fromEncoded >> data.ThemeAsset.save) |> Task.WhenAll restore.Assets
|> List.iter (EncodedAsset.toAsset >> data.ThemeAsset.Save >> Async.AwaitTask >> Async.RunSynchronously)
// Restore web log data // Restore web log data
printfn "- Restoring web log..." printfn "- Restoring web log..."
do! data.WebLog.add restore.webLog do! data.WebLog.Add restore.WebLog
printfn "- Restoring users..." printfn "- Restoring users..."
do! data.WebLogUser.restore restore.users do! data.WebLogUser.Restore restore.Users
printfn "- Restoring categories and tag mappings..." printfn "- Restoring categories and tag mappings..."
do! data.TagMap.restore restore.tagMappings if not (List.isEmpty restore.TagMappings) then do! data.TagMap.Restore restore.TagMappings
do! data.Category.restore restore.categories if not (List.isEmpty restore.Categories) then do! data.Category.Restore restore.Categories
printfn "- Restoring pages..." printfn "- Restoring pages..."
do! data.Page.restore restore.pages if not (List.isEmpty restore.Pages) then do! data.Page.Restore restore.Pages
printfn "- Restoring posts..." printfn "- Restoring posts..."
do! data.Post.restore restore.posts if not (List.isEmpty restore.Posts) then do! data.Post.Restore restore.Posts
// TODO: comments not yet implemented // TODO: comments not yet implemented
printfn "- Restoring uploads..." printfn "- Restoring uploads..."
do! data.Upload.restore (restore.uploads |> List.map EncodedUpload.fromEncoded) if not (List.isEmpty restore.Uploads) then
do! data.Upload.Restore (restore.Uploads |> List.map EncodedUpload.toUpload)
displayStats "Restored for <>NAME<>:" restore.webLog restore displayStats "Restored for <>NAME<>:" restore.WebLog restore
} }
/// Decide whether to restore a backup /// Decide whether to restore a backup
@@ -418,31 +429,29 @@ module Backup =
if doOverwrite then if doOverwrite then
do! doRestore archive newUrlBase data do! doRestore archive newUrlBase data
else else
printfn $"{archive.webLog.name} backup restoration canceled" printfn $"{archive.WebLog.Name} backup restoration canceled"
} }
/// Generate a backup archive /// Generate a backup archive
let generateBackup (args : string[]) (sp : IServiceProvider) = task { let generateBackup (args : string[]) (sp : IServiceProvider) = task {
let showUsage () =
printfn """Usage: MyWebLog backup [url-base] [*backup-file-name] [**"pretty"]"""
printfn """ * optional - default is [web-log-slug].json"""
printfn """ ** optional - default is non-pretty JSON output"""
if args.Length > 1 && args.Length < 5 then if args.Length > 1 && args.Length < 5 then
let data = sp.GetRequiredService<IData> () let data = sp.GetRequiredService<IData> ()
match! data.WebLog.findByHost args[1] with match! data.WebLog.FindByHost args[1] with
| Some webLog -> | Some webLog ->
let fileName = let fileName =
if args.Length = 2 || (args.Length = 3 && args[2] = "pretty") then if args.Length = 2 || (args.Length = 3 && args[2] = "pretty") then
$"{webLog.slug}.json" $"{webLog.Slug}.json"
elif args[2].EndsWith ".json" then elif args[2].EndsWith ".json" then
args[2] args[2]
else else
$"{args[2]}.json" $"{args[2]}.json"
let prettyOutput = (args.Length = 3 && args[2] = "pretty") || (args.Length = 4 && args[3] = "pretty") let prettyOutput = (args.Length = 3 && args[2] = "pretty") || (args.Length = 4 && args[3] = "pretty")
do! createBackup webLog fileName prettyOutput data do! createBackup webLog fileName prettyOutput data
| None -> printfn $"Error: no web log found for {args[1]}" | None -> eprintfn $"Error: no web log found for {args[1]}"
else else
showUsage () eprintfn """Usage: myWebLog backup [url-base] [*backup-file-name] [**"pretty"]"""
eprintfn """ * optional - default is [web-log-slug].json"""
eprintfn """ ** optional - default is non-pretty JSON output"""
} }
/// Restore a backup archive /// Restore a backup archive
@@ -452,8 +461,49 @@ module Backup =
let newUrlBase = if args.Length = 3 then Some args[2] else None let newUrlBase = if args.Length = 3 then Some args[2] else None
do! restoreBackup args[1] newUrlBase (args[0] <> "do-restore") data do! restoreBackup args[1] newUrlBase (args[0] <> "do-restore") data
else else
printfn "Usage: MyWebLog restore [backup-file-name] [*url-base]" eprintfn "Usage: myWebLog restore [backup-file-name] [*url-base]"
printfn " * optional - will restore to original URL base if omitted" eprintfn " * optional - will restore to original URL base if omitted"
printfn " (use do-restore to skip confirmation prompt)" eprintfn " (use do-restore to skip confirmation prompt)"
} }
/// Upgrade a WebLogAdmin user to an Administrator user
let private doUserUpgrade urlBase email (data : IData) = task {
match! data.WebLog.FindByHost urlBase with
| Some webLog ->
match! data.WebLogUser.FindByEmail email webLog.Id with
| Some user ->
match user.AccessLevel with
| WebLogAdmin ->
do! data.WebLogUser.Update { user with AccessLevel = Administrator }
printfn $"{email} is now an Administrator user"
| other -> eprintfn $"ERROR: {email} is an {AccessLevel.toString other}, not a WebLogAdmin"
| None -> eprintfn $"ERROR: no user {email} found at {urlBase}"
| None -> eprintfn $"ERROR: no web log found for {urlBase}"
}
/// Upgrade a WebLogAdmin user to an Administrator user if the command-line arguments are good
let upgradeUser (args : string[]) (sp : IServiceProvider) = task {
match args.Length with
| 3 -> do! doUserUpgrade args[1] args[2] (sp.GetRequiredService<IData> ())
| _ -> eprintfn "Usage: myWebLog upgrade-user [web-log-url-base] [email-address]"
}
/// Set a user's password
let doSetPassword urlBase email password (data : IData) = task {
match! data.WebLog.FindByHost urlBase with
| Some webLog ->
match! data.WebLogUser.FindByEmail email webLog.Id with
| Some user ->
do! data.WebLogUser.Update { user with PasswordHash = Handlers.User.createPasswordHash user password }
printfn $"Password for user {email} at {webLog.Name} set successfully"
| None -> eprintfn $"ERROR: no user {email} found at {urlBase}"
| None -> eprintfn $"ERROR: no web log found for {urlBase}"
}
/// Set a user's password if the command-line arguments are good
let setPassword (args : string[]) (sp : IServiceProvider) = task {
match args.Length with
| 4 -> do! doSetPassword args[1] args[2] args[3] (sp.GetRequiredService<IData> ())
| _ -> eprintfn "Usage: myWebLog set-password [web-log-url-base] [email-address] [password]"
}

View File

@@ -2,20 +2,17 @@
<PropertyGroup> <PropertyGroup>
<OutputType>Exe</OutputType> <OutputType>Exe</OutputType>
<TargetFramework>net6.0</TargetFramework>
<PublishSingleFile>true</PublishSingleFile> <PublishSingleFile>true</PublishSingleFile>
<SelfContained>false</SelfContained> <SelfContained>false</SelfContained>
<DebugType>embedded</DebugType>
<NoWarn>3391</NoWarn>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Content Include="appsettings*.json" CopyToOutputDirectory="Always" /> <Content Include="appsettings*.json" CopyToOutputDirectory="Always" />
<Compile Include="Caches.fs" /> <Compile Include="Caches.fs" />
<Compile Include="Handlers\Error.fs" />
<Compile Include="Handlers\Helpers.fs" /> <Compile Include="Handlers\Helpers.fs" />
<Compile Include="Handlers\Admin.fs" /> <Compile Include="Handlers\Admin.fs" />
<Compile Include="Handlers\Feed.fs" /> <Compile Include="Handlers\Feed.fs" />
<Compile Include="Handlers\Page.fs" />
<Compile Include="Handlers\Post.fs" /> <Compile Include="Handlers\Post.fs" />
<Compile Include="Handlers\User.fs" /> <Compile Include="Handlers\User.fs" />
<Compile Include="Handlers\Upload.fs" /> <Compile Include="Handlers\Upload.fs" />
@@ -28,8 +25,8 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="DotLiquid" Version="2.2.656" /> <PackageReference Include="DotLiquid" Version="2.2.656" />
<PackageReference Include="Giraffe" Version="6.0.0" /> <PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.7.0" /> <PackageReference Include="Giraffe.Htmx" Version="1.8.0" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.7.0" /> <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.0" />
<PackageReference Include="NeoSmart.Caching.Sqlite" Version="6.0.1" /> <PackageReference Include="NeoSmart.Caching.Sqlite" Version="6.0.1" />
<PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" /> <PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" />
<PackageReference Update="FSharp.Core" Version="6.0.5" /> <PackageReference Update="FSharp.Core" Version="6.0.5" />

View File

@@ -15,7 +15,7 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>)
let path = $"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{ctx.Request.Path.Value}" let path = $"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{ctx.Request.Path.Value}"
match WebLogCache.tryGet path with match WebLogCache.tryGet path with
| Some webLog -> | Some webLog ->
if isDebug then log.LogDebug $"Resolved web log {WebLogId.toString webLog.id} for {path}" if isDebug then log.LogDebug $"Resolved web log {WebLogId.toString webLog.Id} for {path}"
ctx.Items["webLog"] <- webLog ctx.Items["webLog"] <- webLog
if PageListCache.exists ctx then () else do! PageListCache.update ctx if PageListCache.exists ctx then () else do! PageListCache.update ctx
if CategoryCache.exists ctx then () else do! CategoryCache.update ctx if CategoryCache.exists ctx then () else do! CategoryCache.update ctx
@@ -29,43 +29,76 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>)
open System open System
open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.DependencyInjection
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open Npgsql
/// Logic to obtain a data connection and implementation based on configured values /// Logic to obtain a data connection and implementation based on configured values
module DataImplementation = module DataImplementation =
open MyWebLog.Converters open MyWebLog.Converters
// open Npgsql.Logging
open RethinkDb.Driver.FSharp open RethinkDb.Driver.FSharp
open RethinkDb.Driver.Net open RethinkDb.Driver.Net
/// Get the configured data implementation /// Get the configured data implementation
let get (sp : IServiceProvider) : IData = let get (sp : IServiceProvider) : IData =
let config = sp.GetRequiredService<IConfiguration> () let config = sp.GetRequiredService<IConfiguration> ()
if (config.GetConnectionString >> isNull >> not) "SQLite" then let await it = (Async.AwaitTask >> Async.RunSynchronously) it
let connStr name = config.GetConnectionString name
let hasConnStr name = (connStr >> isNull >> not) name
let createSQLite connStr : IData =
let log = sp.GetRequiredService<ILogger<SQLiteData>> () let log = sp.GetRequiredService<ILogger<SQLiteData>> ()
let conn = new SqliteConnection (config.GetConnectionString "SQLite") let conn = new SqliteConnection (connStr)
log.LogInformation $"Using SQL database {conn.DataSource}" log.LogInformation $"Using SQLite database {conn.DataSource}"
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously await (SQLiteData.setUpConnection conn)
upcast SQLiteData (conn, sp.GetRequiredService<ILogger<SQLiteData>> ()) SQLiteData (conn, log, Json.configure (JsonSerializer.CreateDefault ()))
elif (config.GetSection "RethinkDB").Exists () then
let log = sp.GetRequiredService<ILogger<RethinkDbData>> () if hasConnStr "SQLite" then
Json.all () |> Seq.iter Converter.Serializer.Converters.Add createSQLite (connStr "SQLite")
let rethinkCfg = DataConfig.FromConfiguration (config.GetSection "RethinkDB") elif hasConnStr "RethinkDB" then
let conn = rethinkCfg.CreateConnectionAsync () |> Async.AwaitTask |> Async.RunSynchronously let log = sp.GetRequiredService<ILogger<RethinkDbData>> ()
log.LogInformation $"Using RethinkDB database {rethinkCfg.Database}" let _ = Json.configure Converter.Serializer
upcast RethinkDbData (conn, rethinkCfg, sp.GetRequiredService<ILogger<RethinkDbData>> ()) let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB")
let conn = await (rethinkCfg.CreateConnectionAsync log)
RethinkDbData (conn, rethinkCfg, log)
elif hasConnStr "PostgreSQL" then
let log = sp.GetRequiredService<ILogger<PostgresData>> ()
// NpgsqlLogManager.Provider <- ConsoleLoggingProvider NpgsqlLogLevel.Debug
let conn = new NpgsqlConnection (connStr "PostgreSQL")
log.LogInformation $"Using PostgreSQL database {conn.Host}:{conn.Port}/{conn.Database}"
PostgresData (conn, log, Json.configure (JsonSerializer.CreateDefault ()))
else else
let log = sp.GetRequiredService<ILogger<SQLiteData>> () createSQLite "Data Source=./myweblog.db;Cache=Shared"
log.LogInformation "Using default SQLite database myweblog.db"
let conn = new SqliteConnection ("Data Source=./myweblog.db;Cache=Shared")
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
upcast SQLiteData (conn, log)
open System.Threading.Tasks
/// Show a list of valid command-line interface commands
let showHelp () =
printfn " "
printfn "COMMAND WHAT IT DOES"
printfn "----------- ------------------------------------------------------"
printfn "backup Create a JSON file backup of a web log"
printfn "do-restore Restore a JSON file backup (overwrite data silently)"
printfn "help Display this information"
printfn "import-links Import prior permalinks"
printfn "init Initializes a new web log"
printfn "load-theme Load a theme"
printfn "restore Restore a JSON file backup (prompt before overwriting)"
printfn "set-password Set a password for a specific user"
printfn "upgrade-user Upgrade a WebLogAdmin user to a full Administrator"
printfn " "
printfn "For more information on a particular command, run it with no options."
Task.FromResult ()
open System.IO
open Giraffe open Giraffe
open Giraffe.EndpointRouting open Giraffe.EndpointRouting
open Microsoft.AspNetCore.Authentication.Cookies 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 NeoSmart.Caching.Sqlite open NeoSmart.Caching.Sqlite
open RethinkDB.DistributedCache open RethinkDB.DistributedCache
@@ -86,11 +119,12 @@ let rec main args =
let _ = builder.Services.AddAuthorization () let _ = builder.Services.AddAuthorization ()
let _ = builder.Services.AddAntiforgery () let _ = builder.Services.AddAntiforgery ()
let sp = builder.Services.BuildServiceProvider () let sp = builder.Services.BuildServiceProvider ()
let data = DataImplementation.get sp let data = DataImplementation.get sp
let _ = builder.Services.AddSingleton<JsonSerializer> data.Serializer
task { task {
do! data.startUp () do! data.StartUp ()
do! WebLogCache.fill data do! WebLogCache.fill data
do! ThemeAssetCache.fill data do! ThemeAssetCache.fill data
} |> Async.AwaitTask |> Async.RunSynchronously } |> Async.AwaitTask |> Async.RunSynchronously
@@ -99,23 +133,36 @@ let rec main args =
match data with match data with
| :? RethinkDbData as rethink -> | :? RethinkDbData as rethink ->
// A RethinkDB connection is designed to work as a singleton // A RethinkDB connection is designed to work as a singleton
builder.Services.AddSingleton<IData> data |> ignore let _ = builder.Services.AddSingleton<IData> data
builder.Services.AddDistributedRethinkDBCache (fun opts -> let _ =
opts.TableName <- "Session" builder.Services.AddDistributedRethinkDBCache (fun opts ->
opts.Connection <- rethink.Conn) opts.TableName <- "Session"
|> ignore opts.Connection <- rethink.Conn)
()
| :? SQLiteData as sql -> | :? SQLiteData as sql ->
// ADO.NET connections are designed to work as per-request instantiation // ADO.NET connections are designed to work as per-request instantiation
let cfg = sp.GetRequiredService<IConfiguration> () let cfg = sp.GetRequiredService<IConfiguration> ()
builder.Services.AddScoped<SqliteConnection> (fun sp -> let _ =
let conn = new SqliteConnection (sql.Conn.ConnectionString) builder.Services.AddScoped<SqliteConnection> (fun sp ->
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously let conn = new SqliteConnection (sql.Conn.ConnectionString)
conn) SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
|> ignore conn)
builder.Services.AddScoped<IData, SQLiteData> () |> ignore let _ = builder.Services.AddScoped<IData, SQLiteData> () |> ignore
// Use SQLite for caching as well // Use SQLite for caching as well
let cachePath = Option.ofObj (cfg.GetConnectionString "SQLiteCachePath") |> Option.defaultValue "./session.db" let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./session.db"
builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath) |> ignore let _ = builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath)
()
| :? PostgresData ->
// ADO.NET connections are designed to work as per-request instantiation
let cfg = sp.GetRequiredService<IConfiguration> ()
let _ =
builder.Services.AddScoped<NpgsqlConnection> (fun sp ->
new NpgsqlConnection (cfg.GetConnectionString "PostgreSQL"))
let _ = builder.Services.AddScoped<IData, PostgresData> ()
let _ =
builder.Services.AddSingleton<IDistributedCache> (fun sp ->
Postgres.DistributedCache (cfg.GetConnectionString "PostgreSQL") :> IDistributedCache)
()
| _ -> () | _ -> ()
let _ = builder.Services.AddSession(fun opts -> let _ = builder.Services.AddSession(fun opts ->
@@ -136,7 +183,17 @@ let rec main args =
| Some it when it = "backup" -> Maintenance.Backup.generateBackup args app.Services | Some it when it = "backup" -> Maintenance.Backup.generateBackup args app.Services
| Some it when it = "restore" -> Maintenance.Backup.restoreFromBackup args app.Services | Some it when it = "restore" -> Maintenance.Backup.restoreFromBackup args app.Services
| Some it when it = "do-restore" -> Maintenance.Backup.restoreFromBackup args app.Services | Some it when it = "do-restore" -> Maintenance.Backup.restoreFromBackup args app.Services
| _ -> | Some it when it = "upgrade-user" -> Maintenance.upgradeUser args app.Services
| Some it when it = "set-password" -> Maintenance.setPassword args app.Services
| Some it when it = "help" -> showHelp ()
| Some it ->
printfn $"""Unrecognized command "{it}" - valid commands are:"""
showHelp ()
| None -> task {
// Load all themes in the application directory
for themeFile in Directory.EnumerateFiles (".", "*-theme.zip") do
do! Maintenance.loadTheme [| ""; themeFile |] app.Services
let _ = app.UseForwardedHeaders () let _ = app.UseForwardedHeaders ()
let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict)) let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
let _ = app.UseMiddleware<WebLogMiddleware> () let _ = app.UseMiddleware<WebLogMiddleware> ()
@@ -146,7 +203,8 @@ let rec main args =
let _ = app.UseSession () let _ = app.UseSession ()
let _ = app.UseGiraffe Handlers.Routes.endpoint let _ = app.UseGiraffe Handlers.Routes.endpoint
System.Threading.Tasks.Task.FromResult (app.Run ()) app.Run ()
}
|> Async.AwaitTask |> Async.RunSynchronously |> Async.AwaitTask |> Async.RunSynchronously
0 // Exit code 0 // Exit code

View File

@@ -1,5 +1,5 @@
{ {
"Generator": "myWebLog 2.0-beta03", "Generator": "myWebLog 2.0-rc2",
"Logging": { "Logging": {
"LogLevel": { "LogLevel": {
"MyWebLog.Handlers": "Information" "MyWebLog.Handlers": "Information"

View File

@@ -0,0 +1,32 @@
<div class="form-floating pb-3">
<input type="text" name="Title" id="title" class="form-control" placeholder="Title" autofocus required
value="{{ model.title }}">
<label for="title">Title</label>
</div>
<div class="form-floating pb-3">
<input type="text" name="Permalink" id="permalink" class="form-control" placeholder="Permalink" required
value="{{ model.permalink }}">
<label for="permalink">Permalink</label>
{%- unless model.is_new %}
{%- assign entity_url_base = "admin/" | append: entity | append: "/" | append: entity_id -%}
<span class="form-text">
<a href="{{ entity_url_base | append: "/permalinks" | relative_link }}">Manage Permalinks</a>
<span class="text-muted"> &bull; </span>
<a href="{{ entity_url_base | append: "/revisions" | relative_link }}">Manage Revisions</a>
</span>
{%- endunless -%}
</div>
<div class="mb-2">
<label for="text">Text</label> &nbsp; &nbsp;
<div class="btn-group btn-group-sm" role="group" aria-label="Text format button group">
<input type="radio" name="Source" id="source_html" class="btn-check" value="HTML"
{%- if model.source == "HTML" %} checked="checked"{% endif %}>
<label class="btn btn-sm btn-outline-secondary" for="source_html">HTML</label>
<input type="radio" name="Source" id="source_md" class="btn-check" value="Markdown"
{%- if model.source == "Markdown" %} checked="checked"{% endif %}>
<label class="btn btn-sm btn-outline-secondary" for="source_md">Markdown</label>
</div>
</div>
<div class="pb-3">
<textarea name="Text" id="text" class="form-control" rows="20">{{ model.text }}</textarea>
</div>

View File

@@ -7,21 +7,42 @@
<span class="navbar-toggler-icon"></span> <span class="navbar-toggler-icon"></span>
</button> </button>
<div class="collapse navbar-collapse" id="navbarText"> <div class="collapse navbar-collapse" id="navbarText">
{% if logged_on -%} {%- if is_logged_on %}
<ul class="navbar-nav"> <ul class="navbar-nav">
{{ "admin/dashboard" | nav_link: "Dashboard" }} {{ "admin/dashboard" | nav_link: "Dashboard" }}
{{ "admin/pages" | nav_link: "Pages" }} {%- if is_author %}
{{ "admin/posts" | nav_link: "Posts" }} {{ "admin/pages" | nav_link: "Pages" }}
{{ "admin/uploads" | nav_link: "Uploads" }} {{ "admin/posts" | nav_link: "Posts" }}
{{ "admin/categories" | nav_link: "Categories" }} {{ "admin/uploads" | nav_link: "Uploads" }}
{{ "admin/settings" | nav_link: "Settings" }} {%- endif %}
{%- if is_web_log_admin %}
{{ "admin/categories" | nav_link: "Categories" }}
{{ "admin/settings" | nav_link: "Settings" }}
{%- endif %}
{%- if is_administrator %}
{{ "admin/administration" | nav_link: "Admin" }}
{%- endif %}
</ul> </ul>
{%- endif %} {%- endif %}
<ul class="navbar-nav flex-grow-1 justify-content-end"> <ul class="navbar-nav flex-grow-1 justify-content-end">
{% if logged_on -%} {%- if is_logged_on %}
{{ "admin/user/edit" | nav_link: "Edit User" }} {{ "admin/my-info" | nav_link: "My Info" }}
{{ "user/log-off" | nav_link: "Log Off" }} <li class="nav-item">
<a class="nav-link" href="https://bitbadger.solutions/open-source/myweblog/#how-to-use-myweblog"
target="_blank">
Docs
</a>
</li>
<li class="nav-item">
<a class="nav-link" href="{{ "user/log-off" | relative_link }}" hx-boost="false">Log Off</a>
</li>
{%- else -%} {%- else -%}
<li class="nav-item">
<a class="nav-link" href="https://bitbadger.solutions/open-source/myweblog/#how-to-use-myweblog"
target="_blank">
Docs
</a>
</li>
{{ "user/log-on" | nav_link: "Log On" }} {{ "user/log-on" | nav_link: "Log On" }}
{%- endif %} {%- endif %}
</ul> </ul>
@@ -29,27 +50,36 @@
</div> </div>
</nav> </nav>
</header> </header>
<main class="mx-3 mt-3"> <div id="toastHost" class="position-fixed top-0 w-100" aria-live="polite" aria-atomic="true">
<div class="messages mt-2" id="msgContainer"> <div id="toasts" class="toast-container position-absolute p-3 mt-5 top-0 end-0">
{% for msg in messages %} {% for msg in messages %}
<div role="alert" class="alert alert-{{ msg.level }} alert-dismissible fade show"> <div class="toast" role="alert" aria-live="assertive" aria-atomic="true"
{{ msg.message }} {%- unless msg.level == "success" %} data-bs-autohide="false"{% endunless %}>
<button type="button" class="btn-close" data-bs-dismiss="alert" aria-label="Close"></button> <div class="toast-header bg-{{ msg.level }}{% unless msg.level == "warning" %} text-white{% endunless %}">
{% if msg.detail %} <strong class="me-auto text-uppercase">
<hr> {% if msg.level == "danger" %}error{% else %}{{ msg.level}}{% endif %}
{{ msg.detail.value }} </strong>
{% endif %} <button type="button" class="btn-close" data-bs-dismiss="toast" aria-label="Close"></button>
</div>
<div class="toast-body bg-{{ msg.level }} bg-opacity-25">
{{ msg.message }}
{%- if msg.detail %}
<hr>
{{ msg.detail.value }}
{%- endif %}
</div>
</div> </div>
{% endfor %} {% endfor %}
</div> </div>
</div>
<main class="mx-3 mt-3">
<div class="load-overlay p-5" id="loadOverlay"><h1 class="p-3">Loading&hellip;</h1></div>
{{ content }} {{ content }}
</main> </main>
<footer class="position-fixed bottom-0 w-100"> <footer class="position-fixed bottom-0 w-100">
<div class="container-fluid"> <div class="text-end text-white me-2">
<div class="row"> {%- assign version = generator | split: " " -%}
<div class="col-xs-12 text-end"> <small class="me-1 align-baseline">v{{ version[1] }}</small>
<img src="{{ "themes/admin/logo-light.png" | relative_link }}" alt="myWebLog" width="120" height="34"> <img src="{{ "themes/admin/logo-light.png" | relative_link }}" alt="myWebLog" width="120" height="34">
</div>
</div>
</div> </div>
</footer> </footer>

View File

@@ -0,0 +1,3 @@
{%- assign theme_col = "col-12 col-md-6" -%}
{%- assign slug_col = "d-none d-md-block col-md-3" -%}
{%- assign tmpl_col = "d-none d-md-block col-md-3" -%}

View File

@@ -0,0 +1,4 @@
{%- assign user_col = "col-12 col-md-4 col-xl-3" -%}
{%- assign email_col = "col-12 col-md-4 col-xl-4" -%}
{%- assign cre8_col = "d-none d-xl-block col-xl-2" -%}
{%- assign last_col = "col-12 col-md-4 col-xl-3" -%}

View File

@@ -0,0 +1,108 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<fieldset class="container mb-3 pb-0">
<legend>Themes</legend>
<a href="{{ "admin/theme/new" | relative_link }}" class="btn btn-primary btn-sm mb-3"
hx-target="#theme_new">
Upload a New Theme
</a>
<div class="container g-0">
{% include_template "_theme-list-columns" %}
<div class="row mwl-table-heading">
<div class="{{ theme_col }}">Theme</div>
<div class="{{ slug_col }} d-none d-md-inline-block">Slug</div>
<div class="{{ tmpl_col }} d-none d-md-inline-block">Templates</div>
</div>
</div>
<div class="row mwl-table-detail" id="theme_new"></div>
{{ theme_list }}
</fieldset>
<fieldset class="container mb-3 pb-0">
{%- assign cache_base_url = "admin/cache/" -%}
<legend>Caches</legend>
<div class="row pb-2">
<div class="col">
<p>
myWebLog uses a few caches to ensure that it serves pages as fast as possible.
(<a href="https://bitbadger.solutions/open-source/myweblog/advanced.html#cache-management"
target="_blank">more information</a>)
</p>
</div>
</div>
<div class="row">
<div class="col-12 col-lg-6 pb-3">
<div class="card">
<header class="card-header text-white bg-secondary">Web Logs</header>
<div class="card-body pb-0">
<h6 class="card-subtitle text-muted pb-3">
These caches include the page list and categories for each web log
</h6>
{%- assign web_log_base_url = cache_base_url | append: "web-log/" -%}
<form method="post" class="container g-0" hx-boost="false" hx-target="body"
hx-swap="innerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<button type="submit" class="btn btn-sm btn-primary mb-2"
hx-post="{{ web_log_base_url | append: "all/refresh" | relative_link }}">
Refresh All
</button>
<div class="row mwl-table-heading">
<div class="col">Web Log</div>
</div>
{%- for web_log in web_logs %}
<div class="row mwl-table-detail">
<div class="col">
{{ web_log[1] }}<br>
<small>
<span class="text-muted">{{ web_log[2] }}</span><br>
{%- assign refresh_url = web_log_base_url | append: web_log[0] | append: "/refresh" | relative_link -%}
<a href="{{ refresh_url }}" hx-post="{{ refresh_url }}">Refresh</a>
</small>
</div>
</div>
{%- endfor %}
</form>
</div>
</div>
</div>
<div class="col-12 col-lg-6 pb-3">
<div class="card">
<header class="card-header text-white bg-secondary">Themes</header>
<div class="card-body pb-0">
<h6 class="card-subtitle text-muted pb-3">
The theme template cache is filled on demand as pages are displayed; refreshing a theme with no cached
templates will still refresh its asset cache
</h6>
{%- assign theme_base_url = cache_base_url | append: "theme/" -%}
<form method="post" class="container g-0" hx-boost="false" hx-target="body"
hx-swap="innerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<button type="submit" class="btn btn-sm btn-primary mb-2"
hx-post="{{ theme_base_url | append: "all/refresh" | relative_link }}">
Refresh All
</button>
<div class="row mwl-table-heading">
<div class="col-8">Theme</div>
<div class="col-4">Cached</div>
</div>
{%- for theme in cached_themes %}
{% unless theme[0] == "admin" %}
<div class="row mwl-table-detail">
<div class="col-8">
{{ theme[1] }}<br>
<small>
<span class="text-muted">{{ theme[0] }} &bull; </span>
{%- assign refresh_url = theme_base_url | append: theme[0] | append: "/refresh" | relative_link -%}
<a href="{{ refresh_url }}" hx-post="{{ refresh_url }}">Refresh</a>
</small>
</div>
<div class="col-4">{{ theme[2] }}</div>
</div>
{% endunless %}
{%- endfor %}
</form>
</div>
</div>
</div>
</div>
</fieldset>
</article>

View File

@@ -3,25 +3,25 @@
<form hx-post="{{ "admin/category/save" | relative_link }}" method="post" class="container" <form hx-post="{{ "admin/category/save" | relative_link }}" method="post" class="container"
hx-target="#catList" hx-swap="outerHTML show:window:top"> hx-target="#catList" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="categoryId" value="{{ model.category_id }}"> <input type="hidden" name="CategoryId" value="{{ model.category_id }}">
<div class="row"> <div class="row">
<div class="col-12 col-sm-6 col-lg-4 col-xxl-3 offset-xxl-1 mb-3"> <div class="col-12 col-sm-6 col-lg-4 col-xxl-3 offset-xxl-1 mb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="name" id="name" class="form-control form-control-sm" placeholder="Name" autofocus <input type="text" name="Name" id="name" class="form-control" placeholder="Name" autofocus required
required value="{{ model.name | escape }}"> value="{{ model.name | escape }}">
<label for="name">Name</label> <label for="name">Name</label>
</div> </div>
</div> </div>
<div class="col-12 col-sm-6 col-lg-4 col-xxl-3 mb-3"> <div class="col-12 col-sm-6 col-lg-4 col-xxl-3 mb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="slug" id="slug" class="form-control form-control-sm" placeholder="Slug" required <input type="text" name="Slug" id="slug" class="form-control" placeholder="Slug" required
value="{{ model.slug | escape }}"> value="{{ model.slug | escape }}">
<label for="slug">Slug</label> <label for="slug">Slug</label>
</div> </div>
</div> </div>
<div class="col-12 col-lg-4 col-xxl-3 offset-xxl-1 mb-3"> <div class="col-12 col-lg-4 col-xxl-3 offset-xxl-1 mb-3">
<div class="form-floating"> <div class="form-floating">
<select name="parentId" id="parentId" class="form-control form-control-sm"> <select name="ParentId" id="parentId" class="form-control">
<option value=""{% if model.parent_id == "" %} selected="selected"{% endif %}> <option value=""{% if model.parent_id == "" %} selected="selected"{% endif %}>
&ndash; None &ndash; &ndash; None &ndash;
</option> </option>
@@ -38,7 +38,7 @@
</div> </div>
<div class="col-12 col-xl-10 offset-xl-1 mb-3"> <div class="col-12 col-xl-10 offset-xl-1 mb-3">
<div class="form-floating"> <div class="form-floating">
<input name="description" id="description" class="form-control form-control-sm" <input name="Description" id="description" class="form-control"
placeholder="A short description of this category" value="{{ model.description | escape }}"> placeholder="A short description of this category" value="{{ model.description | escape }}">
<label for="description">Description</label> <label for="description">Description</label>
</div> </div>

View File

@@ -1,46 +1,57 @@
<form method="post" id="catList" class="container" hx-target="this" hx-swap="outerHTML show:window:top"> <div id="catList" class="container">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <div class="row">
<div class="row mwl-table-detail" id="cat_new"></div> <div class="col">
{%- assign cat_count = categories | size -%} {%- assign cat_count = categories | size -%}
{% if cat_count > 0 %} {% if cat_count > 0 %}
{%- assign cat_col = "col-12 col-md-6 col-xl-5 col-xxl-4" -%} {%- assign cat_col = "col-12 col-md-6 col-xl-5 col-xxl-4" -%}
{%- assign desc_col = "col-12 col-md-6 col-xl-7 col-xxl-8" -%} {%- assign desc_col = "col-12 col-md-6 col-xl-7 col-xxl-8" -%}
{% for cat in categories -%} <div class="container">
<div class="row mwl-table-detail" id="cat_{{ cat.id }}"> <div class="row mwl-table-heading">
<div class="{{ cat_col }} no-wrap"> <div class="{{ cat_col }}">Category<span class="d-md-none">; Description</span></div>
{%- if cat.parent_names %} <div class="{{ desc_col }} d-none d-md-inline-block">Description</div>
<small class="text-muted">{% for name in cat.parent_names %}{{ name }} &rang; {% endfor %}</small> </div>
{%- endif %}
{{ cat.name }}<br>
<small>
{%- if cat.post_count > 0 %}
<a href="{{ cat | category_link }}" target="_blank">
View {{ cat.post_count }} Post{% unless cat.post_count == 1 %}s{% endunless -%}
</a>
<span class="text-muted"> &bull; </span>
{%- endif %}
{%- capture cat_edit %}admin/category/{{ cat.id }}/edit{% endcapture -%}
<a href="{{ cat_edit | relative_link }}" hx-target="#cat_{{ cat.id }}"
hx-swap="innerHTML show:#cat_{{ cat.id }}:top">
Edit
</a>
<span class="text-muted"> &bull; </span>
{%- capture cat_del %}admin/category/{{ cat.id }}/delete{% endcapture -%}
{%- capture cat_del_link %}{{ cat_del | relative_link }}{% endcapture -%}
<a href="{{ cat_del_link }}" hx-post="{{ cat_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the category &ldquo;{{ cat.name }}&rdquo;? This action cannot be undone.">
Delete
</a>
</small>
</div> </div>
<div class="{{ desc_col }}"> <form method="post" class="container" hx-target="#catList" hx-swap="outerHTML show:window:top">
{%- if cat.description %}{{ cat.description.value }}{% else %}<em class="text-muted">none</em>{% endif %} <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row mwl-table-detail" id="cat_new"></div>
{% for cat in categories -%}
<div class="row mwl-table-detail" id="cat_{{ cat.id }}">
<div class="{{ cat_col }} no-wrap">
{%- if cat.parent_names %}
<small class="text-muted">{% for name in cat.parent_names %}{{ name }} &rang; {% endfor %}</small>
{%- endif %}
{{ cat.name }}<br>
<small>
{%- assign cat_url_base = "admin/category/" | append: cat.id -%}
{%- if cat.post_count > 0 %}
<a href="{{ cat | category_link }}" target="_blank">
View {{ cat.post_count }} Post{% unless cat.post_count == 1 %}s{% endunless -%}
</a>
<span class="text-muted"> &bull; </span>
{%- endif %}
<a href="{{ cat_url_base | append: "/edit" | relative_link }}" hx-target="#cat_{{ cat.id }}"
hx-swap="innerHTML show:#cat_{{ cat.id }}:top">
Edit
</a>
<span class="text-muted"> &bull; </span>
{%- assign cat_del_link = cat_url_base | append: "/delete" | relative_link -%}
<a href="{{ cat_del_link }}" hx-post="{{ cat_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the category &ldquo;{{ cat.name }}&rdquo;? This action cannot be undone.">
Delete
</a>
</small>
</div>
<div class="{{ desc_col }}">
{%- if cat.description %}{{ cat.description.value }}{% else %}<em class="text-muted">none</em>{% endif %}
</div>
</div>
{%- endfor %}
</form>
{%- else -%}
<div id="cat_new">
<p class="text-muted fst-italic text-center">This web log has no categores defined</p>
</div> </div>
</div> {%- endif %}
{%- endfor %}
{%- else -%}
<div class="row">
<div class="col-12 text-muted fst-italic text-center">This web log has no categores defined</div>
</div> </div>
{%- endif %} </div>
</form> </div>

View File

@@ -4,13 +4,5 @@
hx-target="#cat_new"> hx-target="#cat_new">
Add a New Category Add a New Category
</a> </a>
<div class="container">
{%- assign cat_col = "col-12 col-md-6 col-xl-5 col-xxl-4" -%}
{%- assign desc_col = "col-12 col-md-6 col-xl-7 col-xxl-8" -%}
<div class="row mwl-table-heading">
<div class="{{ cat_col }}">Category<span class="d-md-none">; Description</span></div>
<div class="{{ desc_col }} d-none d-md-inline-block">Description</div>
</div>
</div>
{{ category_list }} {{ category_list }}
</article> </article>

View File

@@ -2,7 +2,7 @@
<article> <article>
<form action="{{ "admin/settings/rss/save" | relative_link }}" method="post"> <form action="{{ "admin/settings/rss/save" | relative_link }}" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="id" value="{{ model.id }}"> <input type="hidden" name="Id" value="{{ model.id }}">
{%- assign typ = model.source_type -%} {%- assign typ = model.source_type -%}
<div class="container"> <div class="container">
<div class="row pb-3"> <div class="row pb-3">
@@ -17,7 +17,7 @@
<div class="row"> <div class="row">
<div class="col"> <div class="col">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="path" id="path" class="form-control" placeholder="Relative Feed Path" <input type="text" name="Path" id="path" class="form-control" placeholder="Relative Feed Path"
value="{{ model.path }}"> value="{{ model.path }}">
<label for="path">Relative Feed Path</label> <label for="path">Relative Feed Path</label>
<span class="form-text fst-italic">Appended to {{ web_log.url_base }}/</span> <span class="form-text fst-italic">Appended to {{ web_log.url_base }}/</span>
@@ -27,7 +27,7 @@
<div class="row"> <div class="row">
<div class="col py-3 d-flex align-self-center justify-content-center"> <div class="col py-3 d-flex align-self-center justify-content-center">
<div class="form-check form-switch"> <div class="form-check form-switch">
<input type="checkbox" name="isPodcast" id="isPodcast" class="form-check-input" value="true" <input type="checkbox" name="IsPodcast" id="isPodcast" class="form-check-input" value="true"
{%- if model.is_podcast %} checked="checked"{% endif %} onclick="Admin.checkPodcast()"> {%- if model.is_podcast %} checked="checked"{% endif %} onclick="Admin.checkPodcast()">
<label for="isPodcast" class="form-check-label">This Is a Podcast Feed</label> <label for="isPodcast" class="form-check-label">This Is a Podcast Feed</label>
</div> </div>
@@ -41,7 +41,7 @@
<div class="row d-flex align-items-center"> <div class="row d-flex align-items-center">
<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">
<input type="radio" name="sourceType" id="sourceTypeCat" class="form-check-input" value="category" <input type="radio" name="SourceType" id="sourceTypeCat" class="form-check-input" value="category"
{%- unless typ == "tag" %} checked="checked" {% endunless -%} {%- unless typ == "tag" %} checked="checked" {% endunless -%}
onclick="Admin.customFeedBy('category')"> onclick="Admin.customFeedBy('category')">
<label for="sourceTypeCat" class="form-check-label d-none">Category</label> <label for="sourceTypeCat" class="form-check-label d-none">Category</label>
@@ -49,7 +49,7 @@
</div> </div>
<div class="col-11 pb-3"> <div class="col-11 pb-3">
<div class="form-floating"> <div class="form-floating">
<select name="sourceValue" id="sourceValueCat" class="form-control" required <select name="SourceValue" id="sourceValueCat" class="form-control" required
{%- if typ == "tag" %} disabled="disabled"{% endif %}> {%- if typ == "tag" %} disabled="disabled"{% endif %}>
<option value="">&ndash; Select Category &ndash;</option> <option value="">&ndash; Select Category &ndash;</option>
{% for cat in categories -%} {% for cat in categories -%}
@@ -64,14 +64,14 @@
</div> </div>
<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">
<input type="radio" name="sourceType" id="sourceTypeTag" class="form-check-input" value="tag" <input type="radio" name="SourceType" id="sourceTypeTag" class="form-check-input" value="tag"
{%- if typ == "tag" %} checked="checked"{% endif %} onclick="Admin.customFeedBy('tag')"> {%- if typ == "tag" %} checked="checked"{% endif %} onclick="Admin.customFeedBy('tag')">
<label for="sourceTypeTag" class="form-check-label d-none">Tag</label> <label for="sourceTypeTag" class="form-check-label d-none">Tag</label>
</div> </div>
</div> </div>
<div class="col-11 pb-3"> <div class="col-11 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="sourceValue" id="sourceValueTag" class="form-control" placeholder="Tag" <input type="text" name="SourceValue" id="sourceValueTag" class="form-control" placeholder="Tag"
{%- unless typ == "tag" %} disabled="disabled"{% endunless %} required {%- unless typ == "tag" %} disabled="disabled"{% endunless %} required
{%- if typ == "tag" %} value="{{ model.source_value }}"{% endif %}> {%- if typ == "tag" %} value="{{ model.source_value }}"{% endif %}>
<label for="sourceValueTag">Tag</label> <label for="sourceValueTag">Tag</label>
@@ -88,21 +88,21 @@
<div class="row"> <div class="row">
<div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3"> <div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="title" id="title" class="form-control" placeholder="Title" required <input type="text" name="Title" id="title" class="form-control" placeholder="Title" required
value="{{ model.title }}"> value="{{ model.title }}">
<label for="title">Title</label> <label for="title">Title</label>
</div> </div>
</div> </div>
<div class="col-12 col-md-4 col-lg-4 pb-3"> <div class="col-12 col-md-4 col-lg-4 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="subtitle" id="subtitle" class="form-control" placeholder="Subtitle" <input type="text" name="Subtitle" id="subtitle" class="form-control" placeholder="Subtitle"
value="{{ model.subtitle }}"> value="{{ model.subtitle }}">
<label for="subtitle">Podcast Subtitle</label> <label for="subtitle">Podcast Subtitle</label>
</div> </div>
</div> </div>
<div class="col-12 col-md-3 col-lg-2 pb-3"> <div class="col-12 col-md-3 col-lg-2 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="number" name="itemsInFeed" id="itemsInFeed" class="form-control" placeholder="Items" <input type="number" name="ItemsInFeed" id="itemsInFeed" class="form-control" placeholder="Items"
required value="{{ model.items_in_feed }}"> required value="{{ model.items_in_feed }}">
<label for="itemsInFeed"># Episodes</label> <label for="itemsInFeed"># Episodes</label>
</div> </div>
@@ -111,9 +111,9 @@
<div class="row"> <div class="row">
<div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3"> <div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="itunesCategory" id="itunesCategory" class="form-control" <input type="text" name="AppleCategory" id="appleCategory" class="form-control"
placeholder="iTunes Category" required value="{{ model.itunes_category }}"> placeholder="iTunes Category" required value="{{ model.apple_category }}">
<label for="itunesCategory">iTunes Category</label> <label for="appleCategory">iTunes Category</label>
<span class="form-text fst-italic"> <span class="form-text fst-italic">
<a href="https://www.thepodcasthost.com/planning/itunes-podcast-categories/" target="_blank" <a href="https://www.thepodcasthost.com/planning/itunes-podcast-categories/" target="_blank"
rel="noopener"> rel="noopener">
@@ -124,14 +124,14 @@
</div> </div>
<div class="col-12 col-md-4 pb-3"> <div class="col-12 col-md-4 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="itunesSubcategory" id="itunesSubcategory" class="form-control" <input type="text" name="AppleSubcategory" id="appleSubcategory" class="form-control"
placeholder="iTunes Subcategory" value="{{ model.itunes_subcategory }}"> placeholder="iTunes Subcategory" value="{{ model.apple_subcategory }}">
<label for="itunesSubcategory">iTunes Subcategory</label> <label for="appleSubcategory">iTunes Subcategory</label>
</div> </div>
</div> </div>
<div class="col-12 col-md-3 col-lg-2 pb-3"> <div class="col-12 col-md-3 col-lg-2 pb-3">
<div class="form-floating"> <div class="form-floating">
<select name="explicit" id="explicit" class="form-control" required> <select name="Explicit" id="explicit" class="form-control" required>
<option value="yes"{% if model.explicit == "yes" %} selected="selected"{% endif %}>Yes</option> <option value="yes"{% if model.explicit == "yes" %} selected="selected"{% endif %}>Yes</option>
<option value="no"{% if model.explicit == "no" %} selected="selected"{% endif %}>No</option> <option value="no"{% if model.explicit == "no" %} selected="selected"{% endif %}>No</option>
<option value="clean"{% if model.explicit == "clean" %} selected="selected"{% endif %}> <option value="clean"{% if model.explicit == "clean" %} selected="selected"{% endif %}>
@@ -145,14 +145,14 @@
<div class="row"> <div class="row">
<div class="col-12 col-md-6 col-lg-4 offset-xxl-1 pb-3"> <div class="col-12 col-md-6 col-lg-4 offset-xxl-1 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="displayedAuthor" id="displayedAuthor" class="form-control" <input type="text" name="DisplayedAuthor" id="displayedAuthor" class="form-control"
placeholder="Author" required value="{{ model.displayed_author }}"> placeholder="Author" required value="{{ model.displayed_author }}">
<label for="displayedAuthor">Displayed Author</label> <label for="displayedAuthor">Displayed Author</label>
</div> </div>
</div> </div>
<div class="col-12 col-md-6 col-lg-4 pb-3"> <div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="email" name="email" id="email" class="form-control" placeholder="Email" required <input type="email" name="Email" id="email" class="form-control" placeholder="Email" required
value="{{ model.email }}"> value="{{ model.email }}">
<label for="email">Author E-mail</label> <label for="email">Author E-mail</label>
<span class="form-text fst-italic">For iTunes, must match registered e-mail</span> <span class="form-text fst-italic">For iTunes, must match registered e-mail</span>
@@ -160,7 +160,7 @@
</div> </div>
<div class="col-12 col-sm-5 col-md-4 col-lg-4 col-xl-3 offset-xl-1 col-xxl-2 offset-xxl-0"> <div class="col-12 col-sm-5 col-md-4 col-lg-4 col-xl-3 offset-xl-1 col-xxl-2 offset-xxl-0">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="defaultMediaType" id="defaultMediaType" class="form-control" <input type="text" name="DefaultMediaType" id="defaultMediaType" class="form-control"
placeholder="Media Type" value="{{ model.default_media_type }}"> placeholder="Media Type" value="{{ model.default_media_type }}">
<label for="defaultMediaType">Default Media Type</label> <label for="defaultMediaType">Default Media Type</label>
<span class="form-text fst-italic">Optional; blank for no default</span> <span class="form-text fst-italic">Optional; blank for no default</span>
@@ -168,7 +168,7 @@
</div> </div>
<div class="col-12 col-sm-7 col-md-8 col-lg-10 offset-lg-1"> <div class="col-12 col-sm-7 col-md-8 col-lg-10 offset-lg-1">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="imageUrl" id="imageUrl" class="form-control" placeholder="Image URL" required <input type="text" name="ImageUrl" id="imageUrl" class="form-control" placeholder="Image URL" required
value="{{ model.image_url }}"> value="{{ model.image_url }}">
<label for="imageUrl">Image URL</label> <label for="imageUrl">Image URL</label>
<span class="form-text fst-italic">Relative URL will be appended to {{ web_log.url_base }}/</span> <span class="form-text fst-italic">Relative URL will be appended to {{ web_log.url_base }}/</span>
@@ -178,7 +178,7 @@
<div class="row pb-3"> <div class="row pb-3">
<div class="col-12 col-lg-10 offset-lg-1"> <div class="col-12 col-lg-10 offset-lg-1">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="summary" id="summary" class="form-control" placeholder="Summary" required <input type="text" name="Summary" id="summary" class="form-control" placeholder="Summary" required
value="{{ model.summary }}"> value="{{ model.summary }}">
<label for="summary">Summary</label> <label for="summary">Summary</label>
<span class="form-text fst-italic">Displayed in podcast directories</span> <span class="form-text fst-italic">Displayed in podcast directories</span>
@@ -188,7 +188,7 @@
<div class="row pb-3"> <div class="row pb-3">
<div class="col-12 col-lg-10 offset-lg-1"> <div class="col-12 col-lg-10 offset-lg-1">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="mediaBaseUrl" id="mediaBaseUrl" class="form-control" <input type="text" name="MediaBaseUrl" id="mediaBaseUrl" class="form-control"
placeholder="Media Base URL" value="{{ model.media_base_url }}"> placeholder="Media Base URL" value="{{ model.media_base_url }}">
<label for="mediaBaseUrl">Media Base URL</label> <label for="mediaBaseUrl">Media Base URL</label>
<span class="form-text fst-italic">Optional; prepended to episode media file if present</span> <span class="form-text fst-italic">Optional; prepended to episode media file if present</span>
@@ -198,7 +198,7 @@
<div class="row"> <div class="row">
<div class="col-12 col-lg-5 offset-lg-1 pb-3"> <div class="col-12 col-lg-5 offset-lg-1 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="fundingUrl" id="fundingUrl" class="form-control" placeholder="Funding URL" <input type="text" name="FundingUrl" id="fundingUrl" class="form-control" placeholder="Funding URL"
value="{{ model.funding_url }}"> value="{{ model.funding_url }}">
<label for="fundingUrl">Funding URL</label> <label for="fundingUrl">Funding URL</label>
<span class="form-text fst-italic"> <span class="form-text fst-italic">
@@ -208,7 +208,7 @@
</div> </div>
<div class="col-12 col-lg-5 pb-3"> <div class="col-12 col-lg-5 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="fundingText" id="fundingText" class="form-control" maxlength="128" <input type="text" name="FundingText" id="fundingText" class="form-control" maxlength="128"
placeholder="Funding Text" value="{{ model.funding_text }}"> placeholder="Funding Text" value="{{ model.funding_text }}">
<label for="fundingText">Funding Text</label> <label for="fundingText">Funding Text</label>
<span class="form-text fst-italic">Optional; text for the funding link</span> <span class="form-text fst-italic">Optional; text for the funding link</span>
@@ -218,8 +218,8 @@
<div class="row pb-3"> <div class="row pb-3">
<div class="col-8 col-lg-5 offset-lg-1 pb-3"> <div class="col-8 col-lg-5 offset-lg-1 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="guid" id="guid" class="form-control" placeholder="GUID" <input type="text" name="PodcastGuid" id="guid" class="form-control" placeholder="GUID"
value="{{ model.guid }}"> value="{{ model.podcast_guid }}">
<label for="guid">Podcast GUID</label> <label for="guid">Podcast GUID</label>
<span class="form-text fst-italic"> <span class="form-text fst-italic">
Optional; v5 UUID uniquely identifying this podcast; once entered, do not change this value Optional; v5 UUID uniquely identifying this podcast; once entered, do not change this value
@@ -230,7 +230,7 @@
</div> </div>
<div class="col-4 col-lg-3 offset-lg-2 pb-3"> <div class="col-4 col-lg-3 offset-lg-2 pb-3">
<div class="form-floating"> <div class="form-floating">
<select name="medium" id="medium" class="form-control"> <select name="Medium" id="medium" class="form-control">
{% for med in medium_values -%} {% for med in medium_values -%}
<option value="{{ med[0] }}"{% if model.medium == med[0] %} selected{% endif %}> <option value="{{ med[0] }}"{% if model.medium == med[0] %} selected{% endif %}>
{{ med[1] }} {{ med[1] }}

View File

@@ -9,8 +9,10 @@
Published <span class="badge rounded-pill bg-secondary">{{ model.posts }}</span> Published <span class="badge rounded-pill bg-secondary">{{ model.posts }}</span>
&nbsp; Drafts <span class="badge rounded-pill bg-secondary">{{ model.drafts }}</span> &nbsp; Drafts <span class="badge rounded-pill bg-secondary">{{ model.drafts }}</span>
</h6> </h6>
<a href="{{ "admin/posts" | relative_link }}" class="btn btn-secondary me-2">View All</a> {% if is_author %}
<a href="{{ "admin/post/new/edit" | relative_link }}" class="btn btn-primary">Write a New Post</a> <a href="{{ "admin/posts" | relative_link }}" class="btn btn-secondary me-2">View All</a>
<a href="{{ "admin/post/new/edit" | relative_link }}" class="btn btn-primary">Write a New Post</a>
{% endif %}
</div> </div>
</div> </div>
</section> </section>
@@ -22,8 +24,10 @@
All <span class="badge rounded-pill bg-secondary">{{ model.pages }}</span> All <span class="badge rounded-pill bg-secondary">{{ model.pages }}</span>
&nbsp; Shown in Page List <span class="badge rounded-pill bg-secondary">{{ model.listed_pages }}</span> &nbsp; Shown in Page List <span class="badge rounded-pill bg-secondary">{{ model.listed_pages }}</span>
</h6> </h6>
<a href="{{ "admin/pages" | relative_link }}" class="btn btn-secondary me-2">View All</a> {% if is_author %}
<a href="{{ "admin/page/new/edit" | relative_link }}" class="btn btn-primary">Create a New Page</a> <a href="{{ "admin/pages" | relative_link }}" class="btn btn-secondary me-2">View All</a>
<a href="{{ "admin/page/new/edit" | relative_link }}" class="btn btn-primary">Create a New Page</a>
{% endif %}
</div> </div>
</div> </div>
</section> </section>
@@ -37,15 +41,19 @@
All <span class="badge rounded-pill bg-secondary">{{ model.categories }}</span> All <span class="badge rounded-pill bg-secondary">{{ model.categories }}</span>
&nbsp; Top Level <span class="badge rounded-pill bg-secondary">{{ model.top_level_categories }}</span> &nbsp; Top Level <span class="badge rounded-pill bg-secondary">{{ model.top_level_categories }}</span>
</h6> </h6>
<a href="{{ "admin/categories" | relative_link }}" class="btn btn-secondary me-2">View All</a> {% if is_web_log_admin %}
<a href="{{ "admin/category/new/edit" | relative_link }}" class="btn btn-secondary">Add a New Category</a> <a href="{{ "admin/categories" | relative_link }}" class="btn btn-secondary me-2">View All</a>
<a href="{{ "admin/category/new/edit" | relative_link }}" class="btn btn-secondary">Add a New Category</a>
{% endif %}
</div> </div>
</div> </div>
</section> </section>
</div> </div>
<div class="row pb-3"> {% if is_web_log_admin %}
<div class="col text-end"> <div class="row pb-3">
<a href="{{ "admin/settings" | relative_link }}" class="btn btn-secondary">Modify Settings</a> <div class="col text-end">
<a href="{{ "admin/settings" | relative_link }}" class="btn btn-secondary">Modify Settings</a>
</div>
</div> </div>
</div> {% endif %}
</article> </article>

View File

@@ -5,6 +5,5 @@
</head> </head>
<body> <body>
{% include_template "_layout" %} {% include_template "_layout" %}
<script>Admin.dismissSuccesses()</script>
</body> </body>
</html> </html>

View File

@@ -4,29 +4,16 @@
<meta name="viewport" content="width=device-width, initial-scale=1"> <meta name="viewport" content="width=device-width, initial-scale=1">
<meta name="generator" content="{{ generator }}"> <meta name="generator" content="{{ generator }}">
<title>{{ page_title | strip_html }} &laquo; Admin &laquo; {{ web_log.name | strip_html }}</title> <title>{{ page_title | strip_html }} &laquo; Admin &laquo; {{ web_log.name | strip_html }}</title>
<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css" <link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@5.1.3/dist/css/bootstrap.min.css"
integrity="sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" crossorigin="anonymous"> integrity="sha384-1BmE4kWBq78iYhFldvKuhfTAU6auU8tT94WrHftjDbrCEXSU1oBoqyl2QvZ6jIW3" crossorigin="anonymous">
<link rel="stylesheet" href="{{ "themes/admin/admin.css" | relative_link }}"> <link rel="stylesheet" href="{{ "themes/admin/admin.css" | relative_link }}">
</head> </head>
<body hx-boost="true"> <body hx-boost="true" hx-indicator="#loadOverlay">
{% include_template "_layout" %} {% include_template "_layout" %}
<script src="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/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-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM" integrity="sha384-ka7Sk0Gln4gmtz2MlQnikT1wXgYsOg+OMhuP+IlRH9sENBO0LRn5q+8nbTov4+1p"
crossorigin="anonymous"></script> crossorigin="anonymous"></script>
{{ htmx_script }} {{ htmx_script }}
<script>
const cssLoaded = [...document.styleSheets].filter(it => it.href.indexOf("bootstrap.min.css") > -1).length > 0
if (!cssLoaded) {
const local = document.createElement("link")
local.rel = "stylesheet"
local.href = "{{ "themes/admin/bootstrap.min.css" | relative_link }}"
document.getElementsByTagName("link")[0].prepend(local)
}
setTimeout(function () {
if (!bootstrap) document.write('<script src=\"{{ "script/bootstrap.bundle.min.js" | relative_link }}\"><\/script>')
}, 2000)
</script>
<script src="{{ "themes/admin/admin.js" | relative_link }}"></script> <script src="{{ "themes/admin/admin.js" | relative_link }}"></script>
<script>Admin.dismissSuccesses()</script>
</body> </body>
</html> </html>

View File

@@ -3,19 +3,19 @@
<form action="{{ "user/log-on" | relative_link }}" method="post" hx-push-url="true"> <form action="{{ "user/log-on" | relative_link }}" method="post" hx-push-url="true">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
{% if model.return_to %} {% if model.return_to %}
<input type="hidden" name="returnTo" value="{{ model.return_to.value }}"> <input type="hidden" name="ReturnTo" value="{{ model.return_to.value }}">
{% endif %} {% endif %}
<div class="container"> <div class="container">
<div class="row"> <div class="row">
<div class="col-12 col-md-6 col-lg-4 offset-lg-2 pb-3"> <div class="col-12 col-md-6 col-lg-4 offset-lg-2 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="email" id="email" name="emailAddress" class="form-control" autofocus required> <input type="email" id="email" name="EmailAddress" class="form-control" autofocus required>
<label for="email">E-mail Address</label> <label for="email">E-mail Address</label>
</div> </div>
</div> </div>
<div class="col-12 col-md-6 col-lg-4 pb-3"> <div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="password" id="password" name="password" class="form-control" required> <input type="password" id="password" name="Password" class="form-control" required>
<label for="password">Password</label> <label for="password">Password</label>
</div> </div>
</div> </div>

View File

@@ -0,0 +1,77 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="{{ "admin/my-info" | relative_link }}" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="d-flex flex-row flex-wrap justify-content-around">
<div class="text-center mb-3 lh-sm">
<strong class="text-decoration-underline">Access Level</strong><br>{{ access_level }}
</div>
<div class="text-center mb-3 lh-sm">
<strong class="text-decoration-underline">Created</strong><br>{{ created_on | date: "MMMM d, yyyy" }}
</div>
<div class="text-center mb-3 lh-sm">
<strong class="text-decoration-underline">Last Log On</strong><br>
{{ last_seen_on | date: "MMMM d, yyyy" }} at {{ last_seen_on | date: "h:mmtt" | downcase }}
</div>
</div>
<div class="container">
<div class="row"><div class="col"><hr class="mt-0"></div></div>
<div class="row mb-3">
<div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="FirstName" id="firstName" class="form-control" autofocus required
placeholder="First" value="{{ model.first_name }}">
<label for="firstName">First Name</label>
</div>
</div>
<div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="LastName" id="lastName" class="form-control" required
placeholder="Last" value="{{ model.last_name }}">
<label for="lastName">Last Name</label>
</div>
</div>
<div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="PreferredName" id="preferredName" class="form-control" required
placeholder="Preferred" value="{{ model.preferred_name }}">
<label for="preferredName">Preferred Name</label>
</div>
</div>
</div>
<div class="row mb-3">
<div class="col">
<fieldset class="p-2">
<legend class="ps-1">Change Password</legend>
<div class="row">
<div class="col">
<p class="form-text">Optional; leave blank to keep your current password</p>
</div>
</div>
<div class="row">
<div class="col-12 col-md-6 pb-3">
<div class="form-floating">
<input type="password" name="NewPassword" id="newPassword" class="form-control"
placeholder="Password">
<label for="newPassword">New Password</label>
</div>
</div>
<div class="col-12 col-md-6 pb-3">
<div class="form-floating">
<input type="password" name="NewPasswordConfirm" id="newPasswordConfirm" class="form-control"
placeholder="Confirm">
<label for="newPasswordConfirm">Confirm New Password</label>
</div>
</div>
</div>
</fieldset>
</div>
</div>
<div class="row">
<div class="col text-center mb-3">
<button type="submit" class="btn btn-primary">Save Changes</button>
</div>
</div>
</div>
</form>
</article>

View File

@@ -2,40 +2,17 @@
<article> <article>
<form action="{{ "admin/page/save" | relative_link }}" method="post" hx-push-url="true"> <form action="{{ "admin/page/save" | relative_link }}" method="post" hx-push-url="true">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="pageId" value="{{ model.page_id }}"> <input type="hidden" name="PageId" value="{{ model.page_id }}">
<div class="container"> <div class="container">
<div class="row mb-3"> <div class="row mb-3">
<div class="col-9"> <div class="col-9">
<div class="form-floating pb-3"> {%- assign entity = "page" -%}
<input type="text" name="title" id="title" class="form-control" autofocus required {%- assign entity_id = model.page_id -%}
value="{{ model.title }}"> {% include_template "_edit-common" %}
<label for="title">Title</label>
</div>
<div class="form-floating pb-3">
<input type="text" name="permalink" id="permalink" class="form-control" required
value="{{ model.permalink }}">
<label for="permalink">Permalink</label>
{%- if model.page_id != "new" %}
{%- capture perm_edit %}admin/page/{{ model.page_id }}/permalinks{% endcapture -%}
<span class="form-text"><a href="{{ perm_edit | relative_link }}">Manage Permalinks</a></span>
{% endif -%}
</div>
<div class="mb-2">
<label for="text">Text</label> &nbsp; &nbsp;
<input type="radio" name="source" id="source_html" class="btn-check" value="HTML"
{%- if model.source == "HTML" %} checked="checked"{% endif %}>
<label class="btn btn-sm btn-outline-secondary" for="source_html">HTML</label>
<input type="radio" name="source" id="source_md" class="btn-check" value="Markdown"
{%- if model.source == "Markdown" %} checked="checked"{% endif %}>
<label class="btn btn-sm btn-outline-secondary" for="source_md">Markdown</label>
</div>
<div class="mb-3">
<textarea name="text" id="text" class="form-control">{{ model.text }}</textarea>
</div>
</div> </div>
<div class="col-3"> <div class="col-3">
<div class="form-floating pb-3"> <div class="form-floating pb-3">
<select name="template" id="template" class="form-control"> <select name="Template" id="template" class="form-control">
{% for tmpl in templates -%} {% for tmpl in templates -%}
<option value="{{ tmpl[0] }}"{% if model.template == tmpl[0] %} selected="selected"{% endif %}> <option value="{{ tmpl[0] }}"{% if model.template == tmpl[0] %} selected="selected"{% endif %}>
{{ tmpl[1] }} {{ tmpl[1] }}
@@ -45,7 +22,7 @@
<label for="template">Page Template</label> <label for="template">Page Template</label>
</div> </div>
<div class="form-check form-switch"> <div class="form-check form-switch">
<input type="checkbox" name="isShownInPageList" id="showList" class="form-check-input" value="true" <input type="checkbox" name="IsShownInPageList" id="showList" class="form-check-input" value="true"
{%- if model.is_shown_in_page_list %} checked="checked"{% endif %}> {%- if model.is_shown_in_page_list %} checked="checked"{% endif %}>
<label for="showList" class="form-check-label">Show in Page List</label> <label for="showList" class="form-check-label">Show in Page List</label>
</div> </div>
@@ -77,14 +54,14 @@
</div> </div>
<div class="col-3"> <div class="col-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="metaNames" id="metaNames_{{ meta[0] }}" class="form-control" <input type="text" name="MetaNames" id="metaNames_{{ meta[0] }}" class="form-control"
placeholder="Name" value="{{ meta[1] }}"> placeholder="Name" value="{{ meta[1] }}">
<label for="metaNames_{{ meta[0] }}">Name</label> <label for="metaNames_{{ meta[0] }}">Name</label>
</div> </div>
</div> </div>
<div class="col-8"> <div class="col-8">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="metaValues" id="metaValues_{{ meta[0] }}" class="form-control" <input type="text" name="MetaValues" id="metaValues_{{ meta[0] }}" class="form-control"
placeholder="Value" value="{{ meta[2] }}"> placeholder="Value" value="{{ meta[2] }}">
<label for="metaValues_{{ meta[0] }}">Value</label> <label for="metaValues_{{ meta[0] }}">Value</label>
</div> </div>

View File

@@ -2,37 +2,40 @@
<article> <article>
<a href="{{ "admin/page/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3">Create a New Page</a> <a href="{{ "admin/page/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3">Create a New Page</a>
{%- assign page_count = pages | size -%} {%- assign page_count = pages | size -%}
{%- assign title_col = "col-12 col-md-5" -%} {% if page_count > 0 %}
{%- assign link_col = "col-12 col-md-5" -%} {%- assign title_col = "col-12 col-md-5" -%}
{%- assign upd8_col = "col-12 col-md-2" -%} {%- assign link_col = "col-12 col-md-5" -%}
<form method="post" class="container" hx-target="body"> {%- assign upd8_col = "col-12 col-md-2" -%}
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <form method="post" class="container" hx-target="body">
<div class="row mwl-table-heading"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="{{ title_col }}"> <div class="row mwl-table-heading">
<span class="d-none d-md-inline">Title</span><span class="d-md-none">Page</span> <div class="{{ title_col }}">
<span class="d-none d-md-inline">Title</span><span class="d-md-none">Page</span>
</div>
<div class="{{ link_col }} d-none d-md-inline-block">Permalink</div>
<div class="{{ upd8_col }} d-none d-md-inline-block">Updated</div>
</div> </div>
<div class="{{ link_col }} d-none d-md-inline-block">Permalink</div>
<div class="{{ upd8_col }} d-none d-md-inline-block">Updated</div>
</div>
{% if page_count > 0 %}
{% for pg in pages -%} {% for pg in pages -%}
<div class="row mwl-table-detail"> <div class="row mwl-table-detail">
<div class="{{ title_col }}"> <div class="{{ title_col }}">
{{ pg.title }} {{ pg.title }}
{%- if pg.is_default %} &nbsp; <span class="badge bg-success">HOME PAGE</span>{% endif -%} {%- if pg.is_default %} &nbsp; <span class="badge bg-success">HOME PAGE</span>{% endif -%}
{%- if pg.show_in_page_list %} &nbsp; <span class="badge bg-primary">IN PAGE LIST</span> {% endif -%}<br> {%- if pg.is_in_page_list %} &nbsp; <span class="badge bg-primary">IN PAGE LIST</span> {% endif -%}<br>
<small> <small>
{%- capture pg_link %}{% unless pg.is_default %}{{ pg.permalink }}{% endunless %}{% endcapture -%} {%- capture pg_link %}{% unless pg.is_default %}{{ pg.permalink }}{% endunless %}{% endcapture -%}
<a href="{{ pg_link | relative_link }}" target="_blank">View Page</a> <a href="{{ pg_link | relative_link }}" target="_blank">View Page</a>
<span class="text-muted"> &bull; </span> {% if is_editor or is_author and user_id == pg.author_id %}
<a href="{{ pg | edit_page_link }}">Edit</a> <span class="text-muted"> &bull; </span>
<span class="text-muted"> &bull; </span> <a href="{{ pg | edit_page_link }}">Edit</a>
{%- capture pg_del %}admin/page/{{ pg.id }}/delete{% endcapture -%} {% endif %}
{%- capture pg_del_link %}{{ pg_del | relative_link }}{% endcapture -%} {% if is_web_log_admin %}
<a href="{{ pg_del_link }}" hx-post="{{ pg_del_link }}" class="text-danger" <span class="text-muted"> &bull; </span>
hx-confirm="Are you sure you want to delete the page &ldquo;{{ pg.title | strip_html | escape }}&rdquo;? This action cannot be undone."> {%- assign pg_del_link = "admin/page/" | append: pg.id | append: "/delete" | relative_link -%}
Delete <a href="{{ pg_del_link }}" hx-post="{{ pg_del_link }}" class="text-danger"
</a> hx-confirm="Are you sure you want to delete the page &ldquo;{{ pg.title | strip_html | escape }}&rdquo;? This action cannot be undone.">
Delete
</a>
{% endif %}
</small> </small>
</div> </div>
<div class="{{ link_col }}"> <div class="{{ link_col }}">
@@ -45,26 +48,30 @@
</div> </div>
</div> </div>
{%- endfor %} {%- endfor %}
{% else %} </form>
<div class="row"> {% if page_nbr > 1 or page_count == 25 %}
<div class="col text-muted fst-italic text-center">This web log has no pages</div> <div class="d-flex justify-content-evenly mb-3">
<div>
{% if page_nbr > 1 %}
<p>
<a class="btn btn-secondary" href="{{ "admin/pages" | append: prev_page | relative_link }}">
&laquo; Previous
</a>
</p>
{% endif %}
</div>
<div class="text-right">
{% if page_count == 25 %}
<p>
<a class="btn btn-secondary" href="{{ "admin/pages" | append: next_page | relative_link }}">
Next &raquo;
</a>
</p>
{% endif %}
</div>
</div> </div>
{% endif %} {% endif %}
</form> {% else %}
{% if page_nbr > 1 or page_count == 25 %} <p class="text-muted fst-italic text-center">This web log has no pages</p>
<div class="d-flex justify-content-evenly pb-3">
<div>
{% if page_nbr > 1 %}
{%- capture prev_link %}admin/pages{{ prev_page }}{% endcapture -%}
<p><a class="btn btn-default" href="{{ prev_link | relative_link }}">&laquo; Previous</a></p>
{% endif %}
</div>
<div class="text-right">
{% if page_count == 25 %}
{%- capture next_link %}admin/pages{{ next_page }}{% endcapture -%}
<p><a class="btn btn-default" href="{{ next_link | relative_link }}">Next &raquo;</a></p>
{% endif %}
</div>
</div>
{% endif %} {% endif %}
</article> </article>

View File

@@ -1,9 +1,9 @@
<h2 class="my-3">{{ page_title }}</h2> <h2 class="my-3">{{ page_title }}</h2>
<article> <article>
{%- capture form_action %}admin/{{ model.entity }}/permalinks{% endcapture -%} {%- assign base_url = "admin/" | append: model.entity | append: "/" -%}
<form action="{{ form_action | relative_link }}" method="post"> <form action="{{ base_url | append: "permalinks" | relative_link }}" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="id" value="{{ model.id }}"> <input type="hidden" name="Id" value="{{ model.id }}">
<div class="container"> <div class="container">
<div class="row"> <div class="row">
<div class="col"> <div class="col">
@@ -11,8 +11,9 @@
<strong>{{ model.current_title }}</strong><br> <strong>{{ model.current_title }}</strong><br>
<small class="text-muted"> <small class="text-muted">
<span class="fst-italic">{{ model.current_permalink }}</span><br> <span class="fst-italic">{{ model.current_permalink }}</span><br>
{%- capture back_link %}admin/{{ model.entity }}/{{ model.id }}/edit{% endcapture -%} <a href="{{ base_url | append: model.id | append: "/edit" | relative_link }}">
<a href="{{ back_link | relative_link }}">&laquo; Back to Edit {{ model.entity | capitalize }}</a> &laquo; Back to Edit {{ model.entity | capitalize }}
</a>
</small> </small>
</p> </p>
</div> </div>
@@ -35,7 +36,7 @@
</div> </div>
<div class="col-11"> <div class="col-11">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="prior" id="prior_{{ link_count }}" class="form-control" <input type="text" name="Prior" id="prior_{{ link_count }}" class="form-control"
placeholder="Link" value="{{ link }}"> placeholder="Link" value="{{ link }}">
<label for="prior_{{ link_count }}">Link</label> <label for="prior_{{ link_count }}">Link</label>
</div> </div>

View File

@@ -2,47 +2,22 @@
<article> <article>
<form action="{{ "admin/post/save" | relative_link }}" method="post" hx-push-url="true"> <form action="{{ "admin/post/save" | relative_link }}" method="post" hx-push-url="true">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="postId" value="{{ model.post_id }}"> <input type="hidden" name="PostId" value="{{ model.post_id }}">
<div class="container"> <div class="container">
<div class="row mb-3"> <div class="row mb-3">
<div class="col-12 col-lg-9"> <div class="col-12 col-lg-9">
{%- assign entity = "post" -%}
{%- assign entity_id = model.post_id -%}
{% include_template "_edit-common" %}
<div class="form-floating pb-3"> <div class="form-floating pb-3">
<input type="text" name="title" id="title" class="form-control" placeholder="Title" autofocus required <input type="text" name="Tags" id="tags" class="form-control" placeholder="Tags"
value="{{ model.title }}">
<label for="title">Title</label>
</div>
<div class="form-floating pb-3">
<input type="text" name="permalink" id="permalink" class="form-control" placeholder="Permalink" required
value="{{ model.permalink }}">
<label for="permalink">Permalink</label>
{%- if model.post_id != "new" %}
{%- capture perm_edit %}admin/post/{{ model.post_id }}/permalinks{% endcapture -%}
<span class="form-text"><a href="{{ perm_edit | relative_link }}">Manage Permalinks</a></span>
{% endif -%}
</div>
<div class="mb-2">
<label for="text">Text</label> &nbsp; &nbsp;
<div class="btn-group btn-group-sm" role="group" aria-label="Text format button group">
<input type="radio" name="source" id="source_html" class="btn-check" value="HTML"
{%- if model.source == "HTML" %} checked="checked"{% endif %}>
<label class="btn btn-sm btn-outline-secondary" for="source_html">HTML</label>
<input type="radio" name="source" id="source_md" class="btn-check" value="Markdown"
{%- if model.source == "Markdown" %} checked="checked"{% endif %}>
<label class="btn btn-sm btn-outline-secondary" for="source_md">Markdown</label>
</div>
</div>
<div class="pb-3">
<textarea name="text" id="text" class="form-control" rows="20">{{ model.text }}</textarea>
</div>
<div class="form-floating pb-3">
<input type="text" name="tags" id="tags" class="form-control" placeholder="Tags"
value="{{ model.tags }}"> value="{{ model.tags }}">
<label for="tags">Tags</label> <label for="tags">Tags</label>
<div class="form-text">comma-delimited</div> <div class="form-text">comma-delimited</div>
</div> </div>
{% if model.status == "Draft" %} {% if model.status == "Draft" %}
<div class="form-check form-switch pb-2"> <div class="form-check form-switch pb-2">
<input type="checkbox" name="doPublish" id="doPublish" class="form-check-input" value="true"> <input type="checkbox" name="DoPublish" id="doPublish" class="form-check-input" value="true">
<label for="doPublish" class="form-check-label">Publish This Post</label> <label for="doPublish" class="form-check-label">Publish This Post</label>
</div> </div>
{% endif %} {% endif %}
@@ -52,9 +27,9 @@
<legend> <legend>
<span class="form-check form-switch"> <span class="form-check form-switch">
<small> <small>
<input type="checkbox" name="isEpisode" id="isEpisode" class="form-check-input" value="true" <input type="checkbox" name="IsEpisode" id="isEpisode" class="form-check-input" value="true"
data-bs-toggle="collapse" data-bs-target="#episodeItems" onclick="Admin.toggleEpisodeFields()" data-bs-toggle="collapse" data-bs-target="#episodeItems" onclick="Admin.toggleEpisodeFields()"
{%- if model.is_episode %}checked="checked"{% endif %}> {%- if model.is_episode %} checked="checked"{% endif %}>
</small> </small>
<label for="isEpisode">Podcast Episode</label> <label for="isEpisode">Podcast Episode</label>
</span> </span>
@@ -63,7 +38,7 @@
<div class="row"> <div class="row">
<div class="col-12 col-md-8 pb-3"> <div class="col-12 col-md-8 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="media" id="media" class="form-control" placeholder="Media" required <input type="text" name="Media" id="media" class="form-control" placeholder="Media" required
value="{{ model.media }}"> value="{{ model.media }}">
<label for="media">Media File</label> <label for="media">Media File</label>
<div class="form-text"> <div class="form-text">
@@ -73,7 +48,7 @@
</div> </div>
<div class="col-12 col-md-4 pb-3"> <div class="col-12 col-md-4 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="mediaType" id="mediaType" class="form-control" placeholder="Media Type" <input type="text" name="MediaType" id="mediaType" class="form-control" placeholder="Media Type"
value="{{ model.media_type }}"> value="{{ model.media_type }}">
<label for="mediaType">Media MIME Type</label> <label for="mediaType">Media MIME Type</label>
<div class="form-text">Optional; overrides podcast default</div> <div class="form-text">Optional; overrides podcast default</div>
@@ -83,7 +58,7 @@
<div class="row pb-3"> <div class="row pb-3">
<div class="col"> <div class="col">
<div class="form-floating"> <div class="form-floating">
<input type="number" name="length" id="length" class="form-control" placeholder="Length" required <input type="number" name="Length" id="length" class="form-control" placeholder="Length" required
value="{{ model.length }}"> value="{{ model.length }}">
<label for="length">Media Length (bytes)</label> <label for="length">Media Length (bytes)</label>
<div class="form-text">TODO: derive from above file name</div> <div class="form-text">TODO: derive from above file name</div>
@@ -91,7 +66,7 @@
</div> </div>
<div class="col"> <div class="col">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="duration" id="duration" class="form-control" placeholder="Duration" <input type="text" name="Duration" id="duration" class="form-control" placeholder="Duration"
value="{{ model.duration }}"> value="{{ model.duration }}">
<label for="duration">Duration</label> <label for="duration">Duration</label>
<div class="form-text">Recommended; enter in <code>HH:MM:SS</code> format</div> <div class="form-text">Recommended; enter in <code>HH:MM:SS</code> format</div>
@@ -101,7 +76,7 @@
<div class="row pb-3"> <div class="row pb-3">
<div class="col"> <div class="col">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="subtitle" id="subtitle" class="form-control" placeholder="Subtitle" <input type="text" name="Subtitle" id="subtitle" class="form-control" placeholder="Subtitle"
value="{{ model.subtitle }}"> value="{{ model.subtitle }}">
<label for="subtitle">Subtitle</label> <label for="subtitle">Subtitle</label>
<div class="form-text">Optional; a subtitle for this episode</div> <div class="form-text">Optional; a subtitle for this episode</div>
@@ -111,7 +86,7 @@
<div class="row"> <div class="row">
<div class="col-12 col-md-8 pb-3"> <div class="col-12 col-md-8 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="imageUrl" id="imageUrl" class="form-control" placeholder="Image URL" <input type="text" name="ImageUrl" id="imageUrl" class="form-control" placeholder="Image URL"
value="{{ model.image_url }}"> value="{{ model.image_url }}">
<label for="imageUrl">Image URL</label> <label for="imageUrl">Image URL</label>
<div class="form-text"> <div class="form-text">
@@ -121,7 +96,7 @@
</div> </div>
<div class="col-12 col-md-4 pb-3"> <div class="col-12 col-md-4 pb-3">
<div class="form-floating"> <div class="form-floating">
<select name="explicit" id="explicit" class="form-control"> <select name="Explicit" id="explicit" class="form-control">
{% for exp_value in explicit_values %} {% for exp_value in explicit_values %}
<option value="{{ exp_value[0] }}" <option value="{{ exp_value[0] }}"
{%- if model.explicit == exp_value[0] %} selected="selected"{% endif -%}> {%- if model.explicit == exp_value[0] %} selected="selected"{% endif -%}>
@@ -137,7 +112,7 @@
<div class="row"> <div class="row">
<div class="col-12 col-md-8 pb-3"> <div class="col-12 col-md-8 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="chapterFile" id="chapterFile" class="form-control" <input type="text" name="ChapterFile" id="chapterFile" class="form-control"
placeholder="Chapter File" value="{{ model.chapter_file }}"> placeholder="Chapter File" value="{{ model.chapter_file }}">
<label for="chapterFile">Chapter File</label> <label for="chapterFile">Chapter File</label>
<div class="form-text">Optional; relative URL served from this web log</div> <div class="form-text">Optional; relative URL served from this web log</div>
@@ -145,7 +120,7 @@
</div> </div>
<div class="col-12 col-md-4 pb-3"> <div class="col-12 col-md-4 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="chapterType" id="chapterType" class="form-control" <input type="text" name="ChapterType" id="chapterType" class="form-control"
placeholder="Chapter Type" value="{{ model.chapter_type }}"> placeholder="Chapter Type" value="{{ model.chapter_type }}">
<label for="chapterType">Chapter MIME Type</label> <label for="chapterType">Chapter MIME Type</label>
<div class="form-text"> <div class="form-text">
@@ -158,7 +133,7 @@
<div class="row"> <div class="row">
<div class="col-12 col-md-8 pb-3"> <div class="col-12 col-md-8 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="transcriptUrl" id="transcriptUrl" class="form-control" <input type="text" name="TranscriptUrl" id="transcriptUrl" class="form-control"
placeholder="Transcript URL" value="{{ model.transcript_url }}" placeholder="Transcript URL" value="{{ model.transcript_url }}"
onkeyup="Admin.requireTranscriptType()"> onkeyup="Admin.requireTranscriptType()">
<label for="transcriptUrl">Transcript URL</label> <label for="transcriptUrl">Transcript URL</label>
@@ -167,7 +142,7 @@
</div> </div>
<div class="col-12 col-md-4 pb-3"> <div class="col-12 col-md-4 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="transcriptType" id="transcriptType" class="form-control" <input type="text" name="TranscriptType" id="transcriptType" class="form-control"
placeholder="Transcript Type" value="{{ model.transcript_type }}" placeholder="Transcript Type" value="{{ model.transcript_type }}"
{%- if model.transcript_url != "" %} required{% endif %}> {%- if model.transcript_url != "" %} required{% endif %}>
<label for="transcriptType">Transcript MIME Type</label> <label for="transcriptType">Transcript MIME Type</label>
@@ -178,7 +153,7 @@
<div class="row pb-3"> <div class="row pb-3">
<div class="col"> <div class="col">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="transcriptLang" id="transcriptLang" class="form-control" <input type="text" name="TranscriptLang" id="transcriptLang" class="form-control"
placeholder="Transcript Language" value="{{ model.transcript_lang }}"> placeholder="Transcript Language" value="{{ model.transcript_lang }}">
<label for="transcriptLang">Transcript Language</label> <label for="transcriptLang">Transcript Language</label>
<div class="form-text">Optional; overrides podcast default</div> <div class="form-text">Optional; overrides podcast default</div>
@@ -186,7 +161,7 @@
</div> </div>
<div class="col d-flex justify-content-center"> <div class="col d-flex justify-content-center">
<div class="form-check form-switch align-self-center pb-3"> <div class="form-check form-switch align-self-center pb-3">
<input type="checkbox" name="transcriptCaptions" id="transcriptCaptions" class="form-check-input" <input type="checkbox" name="TranscriptCaptions" id="transcriptCaptions" class="form-check-input"
value="true" {% if model.transcript_captions %} checked="checked"{% endif %}> value="true" {% if model.transcript_captions %} checked="checked"{% endif %}>
<label for="transcriptCaptions">This is a captions file</label> <label for="transcriptCaptions">This is a captions file</label>
</div> </div>
@@ -195,7 +170,7 @@
<div class="row pb-3"> <div class="row pb-3">
<div class="col col-md-4"> <div class="col col-md-4">
<div class="form-floating"> <div class="form-floating">
<input type="number" name="seasonNumber" id="seasonNumber" class="form-control" <input type="number" name="SeasonNumber" id="seasonNumber" class="form-control"
placeholder="Season Number" value="{{ model.season_number }}"> placeholder="Season Number" value="{{ model.season_number }}">
<label for="seasonNumber">Season Number</label> <label for="seasonNumber">Season Number</label>
<div class="form-text">Optional</div> <div class="form-text">Optional</div>
@@ -203,7 +178,7 @@
</div> </div>
<div class="col col-md-8"> <div class="col col-md-8">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="seasonDescription" id="seasonDescription" class="form-control" <input type="text" name="SeasonDescription" id="seasonDescription" class="form-control"
placeholder="Season Description" maxlength="128" value="{{ model.season_description }}"> placeholder="Season Description" maxlength="128" value="{{ model.season_description }}">
<label for="seasonDescription">Season Description</label> <label for="seasonDescription">Season Description</label>
<div class="form-text">Optional</div> <div class="form-text">Optional</div>
@@ -213,7 +188,7 @@
<div class="row pb-3"> <div class="row pb-3">
<div class="col col-md-4"> <div class="col col-md-4">
<div class="form-floating"> <div class="form-floating">
<input type="number" name="episodeNumber" id="episodeNumber" class="form-control" step="0.01" <input type="number" name="EpisodeNumber" id="episodeNumber" class="form-control" step="0.01"
placeholder="Episode Number" value="{{ model.episode_number }}"> placeholder="Episode Number" value="{{ model.episode_number }}">
<label for="episodeNumber">Episode Number</label> <label for="episodeNumber">Episode Number</label>
<div class="form-text">Optional; up to 2 decimal points</div> <div class="form-text">Optional; up to 2 decimal points</div>
@@ -221,7 +196,7 @@
</div> </div>
<div class="col col-md-8"> <div class="col col-md-8">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="episodeDescription" id="episodeDescription" class="form-control" <input type="text" name="EpisodeDescription" id="episodeDescription" class="form-control"
placeholder="Episode Description" maxlength="128" value="{{ model.episode_description }}"> placeholder="Episode Description" maxlength="128" value="{{ model.episode_description }}">
<label for="episodeDescription">Episode Description</label> <label for="episodeDescription">Episode Description</label>
<div class="form-text">Optional</div> <div class="form-text">Optional</div>
@@ -252,14 +227,14 @@
</div> </div>
<div class="col-3"> <div class="col-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="metaNames" id="metaNames_{{ meta[0] }}" class="form-control" <input type="text" name="MetaNames" id="metaNames_{{ meta[0] }}" class="form-control"
placeholder="Name" value="{{ meta[1] }}"> placeholder="Name" value="{{ meta[1] }}">
<label for="metaNames_{{ meta[0] }}">Name</label> <label for="metaNames_{{ meta[0] }}">Name</label>
</div> </div>
</div> </div>
<div class="col-8"> <div class="col-8">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="metaValues" id="metaValues_{{ meta[0] }}" class="form-control" <input type="text" name="MetaValues" id="metaValues_{{ meta[0] }}" class="form-control"
placeholder="Value" value="{{ meta[2] }}"> placeholder="Value" value="{{ meta[2] }}">
<label for="metaValues_{{ meta[0] }}">Value</label> <label for="metaValues_{{ meta[0] }}">Value</label>
</div> </div>
@@ -280,14 +255,14 @@
<div class="row"> <div class="row">
<div class="col align-self-center"> <div class="col align-self-center">
<div class="form-check form-switch pb-2"> <div class="form-check form-switch pb-2">
<input type="checkbox" name="setPublished" id="setPublished" class="form-check-input" <input type="checkbox" name="SetPublished" id="setPublished" class="form-check-input"
value="true"> value="true">
<label for="setPublished" class="form-check-label">Set Published Date</label> <label for="setPublished" class="form-check-label">Set Published Date</label>
</div> </div>
</div> </div>
<div class="col-4"> <div class="col-4">
<div class="form-floating"> <div class="form-floating">
<input type="datetime-local" name="pubOverride" id="pubOverride" class="form-control" <input type="datetime-local" name="PubOverride" id="pubOverride" class="form-control"
placeholder="Override Date" placeholder="Override Date"
{%- if model.pub_override -%} {%- if model.pub_override -%}
value="{{ model.pub_override | date: "yyyy-MM-dd\THH:mm" }}" value="{{ model.pub_override | date: "yyyy-MM-dd\THH:mm" }}"
@@ -297,7 +272,7 @@
</div> </div>
<div class="col-5 align-self-center"> <div class="col-5 align-self-center">
<div class="form-check form-switch pb-2"> <div class="form-check form-switch pb-2">
<input type="checkbox" name="setUpdated" id="setUpdated" class="form-check-input" value="true"> <input type="checkbox" name="SetUpdated" id="setUpdated" class="form-check-input" value="true">
<label for="setUpdated" class="form-check-label"> <label for="setUpdated" class="form-check-label">
Purge revisions and<br>set as updated date as well Purge revisions and<br>set as updated date as well
</label> </label>
@@ -310,7 +285,7 @@
</div> </div>
<div class="col-12 col-lg-3"> <div class="col-12 col-lg-3">
<div class="form-floating pb-3"> <div class="form-floating pb-3">
<select name="template" id="template" class="form-control"> <select name="Template" id="template" class="form-control">
{% for tmpl in templates -%} {% for tmpl in templates -%}
<option value="{{ tmpl[0] }}"{% if model.template == tmpl[0] %} selected="selected"{% endif %}> <option value="{{ tmpl[0] }}"{% if model.template == tmpl[0] %} selected="selected"{% endif %}>
{{ tmpl[1] }} {{ tmpl[1] }}
@@ -323,7 +298,7 @@
<legend>Categories</legend> <legend>Categories</legend>
{% for cat in categories %} {% for cat in categories %}
<div class="form-check"> <div class="form-check">
<input type="checkbox" name="categoryIds" id="categoryId_{{ cat.id }}" class="form-check-input" <input type="checkbox" name="CategoryIds" id="categoryId_{{ cat.id }}" class="form-check-input"
value="{{ cat.id }}" {% if model.category_ids contains cat.id %} checked="checked"{% endif %}> value="{{ cat.id }}" {% if model.category_ids contains cat.id %} checked="checked"{% endif %}>
<label for="categoryId_{{ cat.id }}" class="form-check-label" <label for="categoryId_{{ cat.id }}" class="form-check-label"
{%- if cat.description %} title="{{ cat.description.value | strip_html | escape }}"{% endif %}> {%- if cat.description %} title="{{ cat.description.value | strip_html | escape }}"{% endif %}>
@@ -337,3 +312,4 @@
</div> </div>
</form> </form>
</article> </article>
<script>window.setTimeout(() => Admin.toggleEpisodeFields(), 500)</script>

View File

@@ -1,22 +1,22 @@
<h2 class="my-3">{{ page_title }}</h2> <h2 class="my-3">{{ page_title }}</h2>
<article> <article>
<a href="{{ "admin/post/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3">Write a New Post</a> <a href="{{ "admin/post/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3">Write a New Post</a>
<form method="post" class="container" hx-target="body"> {%- assign post_count = model.posts | size -%}
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> {%- if post_count > 0 %}
{%- assign post_count = model.posts | size -%} <form method="post" class="container" hx-target="body">
{%- assign date_col = "col-xs-12 col-md-3 col-lg-2" -%} <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
{%- assign title_col = "col-xs-12 col-md-7 col-lg-6 col-xl-5 col-xxl-4" -%} {%- assign date_col = "col-xs-12 col-md-3 col-lg-2" -%}
{%- assign author_col = "col-xs-12 col-md-2 col-lg-1" -%} {%- assign title_col = "col-xs-12 col-md-7 col-lg-6 col-xl-5 col-xxl-4" -%}
{%- assign tag_col = "col-lg-3 col-xl-4 col-xxl-5 d-none d-lg-inline-block" -%} {%- assign author_col = "col-xs-12 col-md-2 col-lg-1" -%}
<div class="row mwl-table-heading"> {%- assign tag_col = "col-lg-3 col-xl-4 col-xxl-5 d-none d-lg-inline-block" -%}
<div class="{{ date_col }}"> <div class="row mwl-table-heading">
<span class="d-md-none">Post</span><span class="d-none d-md-inline">Date</span> <div class="{{ date_col }}">
<span class="d-md-none">Post</span><span class="d-none d-md-inline">Date</span>
</div>
<div class="{{ title_col }} d-none d-md-inline-block">Title</div>
<div class="{{ author_col }} d-none d-md-inline-block">Author</div>
<div class="{{ tag_col }}">Tags</div>
</div> </div>
<div class="{{ title_col }} d-none d-md-inline-block">Title</div>
<div class="{{ author_col }} d-none d-md-inline-block">Author</div>
<div class="{{ tag_col }}">Tags</div>
</div>
{%- if post_count > 0 %}
{% for post in model.posts -%} {% for post in model.posts -%}
<div class="row mwl-table-detail"> <div class="row mwl-table-detail">
<div class="{{ date_col }} no-wrap"> <div class="{{ date_col }} no-wrap">
@@ -46,15 +46,18 @@
{{ post.title }}<br> {{ post.title }}<br>
<small> <small>
<a href="{{ post | relative_link }}" target="_blank">View Post</a> <a href="{{ post | relative_link }}" target="_blank">View Post</a>
<span class="text-muted"> &bull; </span> {% if is_editor or is_author and user_id == post.author_id %}
<a href="{{ post | edit_post_link }}">Edit</a> <span class="text-muted"> &bull; </span>
<span class="text-muted"> &bull; </span> <a href="{{ post | edit_post_link }}">Edit</a>
{%- capture post_del %}admin/post/{{ post.id }}/delete{% endcapture -%} {% endif %}
{%- capture post_del_link %}{{ post_del | relative_link }}{% endcapture -%} {% if is_web_log_admin %}
<a href="{{ post_del_link }}" hx-post="{{ post_del_link }}" class="text-danger" <span class="text-muted"> &bull; </span>
hx-confirm="Are you sure you want to delete the page &ldquo;{{ post.title | strip_html | escape }}&rdquo;? This action cannot be undone."> {%- assign post_del_link = "admin/post/" | append: post.id | append: "/delete" | relative_link -%}
Delete <a href="{{ post_del_link }}" hx-post="{{ post_del_link }}" class="text-danger"
</a> hx-confirm="Are you sure you want to delete the page &ldquo;{{ post.title | strip_html | escape }}&rdquo;? This action cannot be undone.">
Delete
</a>
{% endif %}
</small> </small>
</div> </div>
<div class="{{ author_col }}"> <div class="{{ author_col }}">
@@ -74,24 +77,22 @@
</div> </div>
</div> </div>
{%- endfor %} {%- endfor %}
{% else %} </form>
<div class="row"> {% if model.newer_link or model.older_link %}
<div class="col text-muted fst-italic text-center">This web log has no posts</div> <div class="d-flex justify-content-evenly mb-3">
<div>
{% if model.newer_link %}
<p><a class="btn btn-secondary" href="{{ model.newer_link.value }}">&laquo; Newer Posts</a></p>
{% endif %}
</div>
<div class="text-right">
{% if model.older_link %}
<p><a class="btn btn-secondary" href="{{ model.older_link.value }}">Older Posts &raquo;</a></p>
{% endif %}
</div>
</div> </div>
{% endif %} {% endif %}
</form> {% else %}
{% if model.newer_link or model.older_link %} <p class="text-muted fst-italic text-center">This web log has no posts</p>
<div class="d-flex justify-content-evenly">
<div>
{% if model.newer_link %}
<p><a class="btn btn-default" href="{{ model.newer_link.value }}">&laquo; Newer Posts</a></p>
{% endif %}
</div>
<div class="text-right">
{% if model.older_link %}
<p><a class="btn btn-default" href="{{ model.older_link.value }}">Older Posts &raquo;</a></p>
{% endif %}
</div>
</div>
{% endif %} {% endif %}
</article> </article>

View File

@@ -0,0 +1,68 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form method="post" hx-target="body">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="id" value="{{ model.id }}">
<div class="container mb-3">
<div class="row">
<div class="col">
<p style="line-height:1.2rem;">
<strong>{{ model.current_title }}</strong><br>
<small class="text-muted">
<a href="{{ "admin/" | append: model.entity | append: "/" | append: model.id | append: "/edit" | relative_link }}">
&laquo; Back to Edit {{ model.entity | capitalize }}
</a>
</small>
</p>
</div>
</div>
{%- assign revision_count = model.revisions | size -%}
{%- assign rev_url_base = "admin/" | append: model.entity | append: "/" | append: model.id | append: "/revision" -%}
{%- if revision_count > 1 %}
<div class="row mb-3">
<div class="col">
<button type="button" class="btn btn-sm btn-danger"
hx-post="{{ rev_url_base | append: "s/purge" | relative_link }}"
hx-confirm="This will remove all revisions but the current one; are you sure this is what you wish to do?">
Delete All Prior Revisions
</button>
</div>
</div>
{%- endif %}
<div class="row mwl-table-heading">
<div class="col">Revision</div>
</div>
{% for rev in model.revisions %}
{%- assign as_of_string = rev.as_of | date: "o" -%}
{%- assign as_of_id = "rev_" | append: as_of_string | replace: "\.", "_" | replace: ":", "-" -%}
<div id="{{ as_of_id }}" class="row pb-3 mwl-table-detail">
<div class="col-12 mb-1">
{{ rev.as_of_local | date: "MMMM d, yyyy" }} at {{ rev.as_of_local | date: "h:mmtt" | downcase }}
<span class="badge bg-secondary text-uppercase ms-2">{{ rev.format }}</span>
{%- if forloop.first %}
<span class="badge bg-primary text-uppercase ms-2">Current Revision</span>
{%- endif %}<br>
{% unless forloop.first %}
{%- assign rev_url_prefix = rev_url_base | append: "/" | append: as_of_string -%}
{%- assign rev_restore = rev_url_prefix | append: "/restore" | relative_link -%}
{%- assign rev_delete = rev_url_prefix | append: "/delete" | relative_link -%}
<small>
<a href="{{ rev_url_prefix | append: "/preview" | relative_link }}" hx-target="#{{ as_of_id }}_preview">
Preview
</a>
<span class="text-muted"> &bull; </span>
<a href="{{ rev_restore }}" hx-post="{{ rev_restore }}">Restore as Current</a>
<span class="text-muted"> &bull; </span>
<a href="{{ rev_delete }}" hx-post="{{ rev_delete }}" hx-target="#{{ as_of_id }}" hx-swap="outerHTML"
class="text-danger">
Delete
</a>
</small>
{% endunless %}
</div>
{% unless forloop.first %}<div id="{{ as_of_id }}_preview" class="col-12"></div>{% endunless %}
</div>
{% endfor %}
</div>
</form>
</article>

View File

@@ -1,113 +0,0 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="{{ "admin/settings/rss" | relative_link }}" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="container">
<div class="row pb-3">
<div class="col col-xl-8 offset-xl-2">
<fieldset class="d-flex justify-content-evenly flex-row">
<legend>Feeds Enabled</legend>
<div class="form-check form-switch pb-2">
<input type="checkbox" name="feedEnabled" id="feedEnabled" class="form-check-input" value="true"
{% if model.feed_enabled %}checked="checked"{% endif %}>
<label for="feedEnabled" class="form-check-label">All Posts</label>
</div>
<div class="form-check form-switch pb-2">
<input type="checkbox" name="categoryEnabled" id="categoryEnabled" class="form-check-input" value="true"
{% if model.category_enabled %}checked="checked"{% endif %}>
<label for="categoryEnabled" class="form-check-label">Posts by Category</label>
</div>
<div class="form-check form-switch pb-2">
<input type="checkbox" name="tagEnabled" id="tagEnabled" class="form-check-input" value="true"
{% if model.tag_enabled %}checked="checked"{% endif %}>
<label for="tagEnabled" class="form-check-label">Posts by Tag</label>
</div>
</fieldset>
</div>
</div>
<div class="row">
<div class="col-12 col-sm-6 col-md-3 col-xl-2 offset-xl-2 pb-3">
<div class="form-floating">
<input type="text" name="feedName" id="feedName" class="form-control" placeholder="Feed File Name"
value="{{ model.feed_name }}">
<label for="feedName">Feed File Name</label>
<span class="form-text">Default is <code>feed.xml</code></span>
</div>
</div>
<div class="col-12 col-sm-6 col-md-4 col-xl-2 pb-3">
<div class="form-floating">
<input type="number" name="itemsInFeed" id="itemsInFeed" class="form-control" min="0"
placeholder="Items in Feed" required value="{{ model.items_in_feed }}">
<label for="itemsInFeed">Items in Feed</label>
<span class="form-text">Set to &ldquo;0&rdquo; to use &ldquo;Posts per Page&rdquo; setting ({{ web_log.posts_per_page }})</span>
</div>
</div>
<div class="col-12 col-md-5 col-xl-4 pb-3">
<div class="form-floating">
<input type="text" name="copyright" id="copyright" class="form-control" placeholder="Copyright String"
value="{{ model.copyright }}">
<label for="copyright">Copyright String</label>
<span class="form-text">
Can be a
<a href="https://creativecommons.org/share-your-work/" target="_blank" rel="noopener">
Creative Commons license string
</a>
</span>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col text-center">
<button type="submit" class="btn btn-primary">Save Changes</button>
</div>
</div>
</div>
</form>
<h3>Custom Feeds</h3>
<a class="btn btn-sm btn-secondary" href="{{ 'admin/settings/rss/new/edit' | relative_link }}">
Add a New Custom Feed
</a>
<form method="post" class="container" hx-target="body">
{%- assign source_col = "col-12 col-md-6" -%}
{%- assign path_col = "col-12 col-md-6" -%}
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row mwl-table-heading">
<div class="{{ source_col }}">
<span class="d-md-none">Feed</span><span class="d-none d-md-inline">Source</span>
</div>
<div class="{{ path_col }} d-none d-md-inline-block">Relative Path</div>
</div>
{%- assign feed_count = custom_feeds | size -%}
{% if feed_count > 0 %}
{% for feed in custom_feeds %}
<div class="row mwl-table-detail">
<div class="{{ source_col }}">
{{ feed.source }}
{%- if feed.is_podcast %} &nbsp; <span class="badge bg-primary">PODCAST</span>{% endif %}<br>
<small>
<a href="{{ feed.path | relative_link }}" target="_blank">View Feed</a>
<span class="text-muted"> &bull; </span>
{%- capture feed_edit %}admin/settings/rss/{{ feed.id }}/edit{% endcapture -%}
<a href="{{ feed_edit | relative_link }}">Edit</a>
<span class="text-muted"> &bull; </span>
{%- capture feed_del %}admin/settings/rss/{{ feed.id }}/delete{% endcapture -%}
{%- capture feed_del_link %}{{ feed_del | relative_link }}{% endcapture -%}
<a href="{{ feed_del_link }}" hx-post="{{ feed_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the custom RSS feed based on {{ feed.source | strip_html | escape }}? This action cannot be undone.">
Delete
</a>
</small>
</div>
<div class="{{ path_col }}">
<small class="d-md-none">Served at {{ feed.path }}</small>
<span class="d-none d-md-inline">{{ feed.path }}</span>
</div>
</div>
{% endfor %}
{% else %}
<tr>
<td colspan="3" class="text-muted fst-italic text-center">No custom feeds defined</td>
</tr>
{% endif %}
</form>
</article>

View File

@@ -1,106 +1,246 @@
<h2 class="my-3">{{ web_log.name }} Settings</h2> <h2 class="my-3">{{ web_log.name }} Settings</h2>
<p class="text-muted">
Other Settings: <a href="{{ "admin/settings/tag-mappings" | relative_link }}">Tag Mappings</a> &bull;
<a href="{{ "admin/settings/rss" | relative_link }}">RSS Settings</a>
</p>
<article> <article>
<form action="{{ "admin/settings" | relative_link }}" method="post"> <p class="text-muted">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> Go to: <a href="#users">Users</a> &bull; <a href="#rss-settings">RSS Settings</a> &bull;
<div class="container"> <a href="#tag-mappings">Tag Mappings</a>
<div class="row"> </p>
<div class="col-12 col-md-6 col-xl-4 pb-3"> <fieldset class="container mb-3">
<div class="form-floating"> <legend>Web Log Settings</legend>
<input type="text" name="name" id="name" class="form-control" placeholder="Name" required autofocus <form action="{{ "admin/settings" | relative_link }}" method="post">
value="{{ model.name }}"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<label for="name">Name</label> <div class="container">
<div class="row">
<div class="col-12 col-md-6 col-xl-4 pb-3">
<div class="form-floating">
<input type="text" name="Name" id="name" class="form-control" placeholder="Name" required autofocus
value="{{ model.name }}">
<label for="name">Name</label>
</div>
</div>
<div class="col-12 col-md-6 col-xl-4 pb-3">
<div class="form-floating">
<input type="text" name="Slug" id="slug" class="form-control" placeholder="Slug" required
value="{{ model.slug }}">
<label for="slug">Slug</label>
<span class="form-text">
<span class="badge rounded-pill bg-warning text-dark">WARNING</span> changing this value may break
links
(<a href="https://bitbadger.solutions/open-source/myweblog/configuring.html#blog-settings"
target="_blank">more</a>)
</span>
</div>
</div>
<div class="col-12 col-md-6 col-xl-4 pb-3">
<div class="form-floating">
<input type="text" name="Subtitle" id="subtitle" class="form-control" placeholder="Subtitle"
value="{{ model.subtitle }}">
<label for="subtitle">Subtitle</label>
</div>
</div>
<div class="col-12 col-md-6 col-xl-4 offset-xl-1 pb-3">
<div class="form-floating">
<select name="ThemeId" id="themeId" class="form-control" required>
{% for theme in themes -%}
<option value="{{ theme[0] }}"{% if model.theme_id == theme[0] %} selected="selected"{% endif %}>
{{ theme[1] }}
</option>
{%- endfor %}
</select>
<label for="themeId">Theme</label>
</div>
</div>
<div class="col-12 col-md-6 offset-md-1 col-xl-4 offset-xl-0 pb-3">
<div class="form-floating">
<select name="DefaultPage" id="defaultPage" class="form-control" required>
{%- for pg in pages %}
<option value="{{ pg[0] }}"{% if pg[0] == model.default_page %} selected="selected"{% endif %}>
{{ pg[1] }}
</option>
{%- endfor %}
</select>
<label for="defaultPage">Default Page</label>
</div>
</div>
<div class="col-12 col-md-4 col-xl-2 pb-3">
<div class="form-floating">
<input type="number" name="PostsPerPage" id="postsPerPage" class="form-control" min="0" max="50" required
value="{{ model.posts_per_page }}">
<label for="postsPerPage">Posts per Page</label>
</div>
</div> </div>
</div> </div>
<div class="col-12 col-md-6 col-xl-4 pb-3"> <div class="row">
<div class="form-floating"> <div class="col-12 col-md-4 col-xl-3 offset-xl-2 pb-3">
<input type="text" name="slug" id="slug" class="form-control" placeholder="Slug" required <div class="form-floating">
value="{{ model.slug }}"> <input type="text" name="TimeZone" id="timeZone" class="form-control" placeholder="Time Zone" required
<label for="slug">Slug</label> value="{{ model.time_zone }}">
<span class="form-text"> <label for="timeZone">Time Zone</label>
<span class="badge rounded-pill bg-warning text-dark">WARNING</span> changing this value may break links </div>
(<a href="https://bitbadger.solutions/open-source/myweblog/configuring.html#blog-settings" </div>
target="_blank">more</a>) <div class="col-12 col-md-4 col-xl-2">
<div class="form-check form-switch">
<input type="checkbox" name="AutoHtmx" id="autoHtmx" class="form-check-input" value="true"
{%- if model.auto_htmx %} checked="checked"{% endif %}>
<label for="autoHtmx" class="form-check-label">Auto-Load htmx</label>
</div>
<span class="form-text fst-italic">
<a href="https://htmx.org" target="_blank" rel="noopener">What is this?</a>
</span> </span>
</div> </div>
</div> <div class="col-12 col-md-4 col-xl-3 pb-3">
<div class="col-12 col-md-6 col-xl-4 pb-3"> <div class="form-floating">
<div class="form-floating"> <select name="Uploads" id="uploads" class="form-control">
<input type="text" name="subtitle" id="subtitle" class="form-control" placeholder="Subtitle" {%- for it in upload_values %}
value="{{ model.subtitle }}"> <option value="{{ it[0] }}"{% if model.uploads == it[0] %} selected{% endif %}>{{ it[1] }}</option>
<label for="subtitle">Subtitle</label> {%- endfor %}
</select>
<label for="uploads">Default Upload Destination</label>
</div>
</div> </div>
</div> </div>
<div class="col-12 col-md-6 col-xl-4 offset-xl-1 pb-3"> <div class="row pb-3">
<div class="form-floating"> <div class="col text-center">
<select name="themePath" id="themePath" class="form-control" required> <button type="submit" class="btn btn-primary">Save Changes</button>
{% for theme in themes -%}
<option value="{{ theme[0] }}"{% if model.theme_path == theme[0] %} selected="selected"{% endif %}>
{{ theme[1] }}
</option>
{%- endfor %}
</select>
<label for="themePath">Theme</label>
</div>
</div>
<div class="col-12 col-md-6 offset-md-1 col-xl-4 offset-xl-0 pb-3">
<div class="form-floating">
<select name="defaultPage" id="defaultPage" class="form-control" required>
{% for pg in pages -%}
<option value="{{ pg[0] }}"
{%- if pg[0] == model.default_page %} selected="selected"{% endif %}>
{{ pg[1] }}
</option>
{%- endfor %}
</select>
<label for="defaultPage">Default Page</label>
</div>
</div>
<div class="col-12 col-md-4 col-xl-2 pb-3">
<div class="form-floating">
<input type="number" name="postsPerPage" id="postsPerPage" class="form-control" min="0" max="50" required
value="{{ model.posts_per_page }}">
<label for="postsPerPage">Posts per Page</label>
</div> </div>
</div> </div>
</div> </div>
<div class="row"> </form>
<div class="col-12 col-md-4 col-xl-3 offset-xl-2 pb-3"> </fieldset>
<div class="form-floating"> <fieldset id="users" class="container mb-3 pb-0">
<input type="text" name="timeZone" id="timeZone" class="form-control" placeholder="Time Zone" required <legend>Users</legend>
value="{{ model.time_zone }}"> {% include_template "_user-list-columns" %}
<label for="timeZone">Time Zone</label> <a href="{{ "admin/settings/user/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3"
</div> hx-target="#user_new">
</div> Add a New User
<div class="col-12 col-md-4 col-xl-2"> </a>
<div class="form-check form-switch"> <div class="container g-0">
<input type="checkbox" name="autoHtmx" id="autoHtmx" class="form-check-input" value="true" <div class="row mwl-table-heading">
{%- if model.auto_htmx %} checked="checked"{% endif %}> <div class="{{ user_col }}">User<span class="d-md-none">; Full Name / E-mail; Last Log On</span></div>
<label for="autoHtmx" class="form-check-label">Auto-Load htmx</label> <div class="{{ email_col }} d-none d-md-inline-block">Full Name / E-mail</div>
</div> <div class="{{ cre8_col }}">Created</div>
<span class="form-text fst-italic"> <div class="{{ last_col }} d-none d-md-block">Last Log On</div>
<a href="https://htmx.org" target="_blank" rel="noopener">What is this?</a>
</span>
</div>
<div class="col-12 col-md-4 col-xl-3 pb-3">
<div class="form-floating">
<select name="uploads" id="uploads" class="form-control">
{%- for it in upload_values %}
<option value="{{ it[0] }}"{% if model.uploads == it[0] %} selected{% endif %}>{{ it[1] }}</option>
{%- endfor %}
</select>
<label for="uploads">Default Upload Destination</label>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col text-center">
<button type="submit" class="btn btn-primary">Save Changes</button>
</div>
</div> </div>
</div> </div>
</form> {{ user_list }}
</fieldset>
<fieldset id="rss-settings" class="container mb-3 pb-0">
<legend>RSS Settings</legend>
<form action="{{ "admin/settings/rss" | relative_link }}" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="container">
<div class="row pb-3">
<div class="col col-xl-8 offset-xl-2">
<fieldset class="d-flex justify-content-evenly flex-row">
<legend>Feeds Enabled</legend>
<div class="form-check form-switch pb-2">
<input type="checkbox" name="IsFeedEnabled" id="feedEnabled" class="form-check-input" value="true"
{%- if rss_model.is_feed_enabled %} checked="checked"{% endif %}>
<label for="feedEnabled" class="form-check-label">All Posts</label>
</div>
<div class="form-check form-switch pb-2">
<input type="checkbox" name="IsCategoryEnabled" id="categoryEnabled" class="form-check-input"
value="true" {%- if rss_model.is_category_enabled %} checked="checked"{% endif %}>
<label for="categoryEnabled" class="form-check-label">Posts by Category</label>
</div>
<div class="form-check form-switch pb-2">
<input type="checkbox" name="IsTagEnabled" id="tagEnabled" class="form-check-input" value="true"
{%- if rss_model.tag_enabled %} checked="checked"{% endif %}>
<label for="tagEnabled" class="form-check-label">Posts by Tag</label>
</div>
</fieldset>
</div>
</div>
<div class="row">
<div class="col-12 col-sm-6 col-md-3 col-xl-2 offset-xl-2 pb-3">
<div class="form-floating">
<input type="text" name="FeedName" id="feedName" class="form-control" placeholder="Feed File Name"
value="{{ rss_model.feed_name }}">
<label for="feedName">Feed File Name</label>
<span class="form-text">Default is <code>feed.xml</code></span>
</div>
</div>
<div class="col-12 col-sm-6 col-md-4 col-xl-2 pb-3">
<div class="form-floating">
<input type="number" name="ItemsInFeed" id="itemsInFeed" class="form-control" min="0"
placeholder="Items in Feed" required value="{{ rss_model.items_in_feed }}">
<label for="itemsInFeed">Items in Feed</label>
<span class="form-text">Set to &ldquo;0&rdquo; to use &ldquo;Posts per Page&rdquo; setting ({{ web_log.posts_per_page }})</span>
</div>
</div>
<div class="col-12 col-md-5 col-xl-4 pb-3">
<div class="form-floating">
<input type="text" name="Copyright" id="copyright" class="form-control" placeholder="Copyright String"
value="{{ rss_model.copyright }}">
<label for="copyright">Copyright String</label>
<span class="form-text">
Can be a
<a href="https://creativecommons.org/share-your-work/" target="_blank" rel="noopener">
Creative Commons license string
</a>
</span>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col text-center">
<button type="submit" class="btn btn-primary">Save Changes</button>
</div>
</div>
</div>
</form>
<fieldset class="container mb-3 pb-0">
<legend>Custom Feeds</legend>
<a class="btn btn-sm btn-secondary" href="{{ 'admin/settings/rss/new/edit' | relative_link }}">
Add a New Custom Feed
</a>
{%- assign feed_count = custom_feeds | size -%}
{%- if feed_count > 0 %}
<form method="post" class="container g-0" hx-target="body">
{%- assign source_col = "col-12 col-md-6" -%}
{%- assign path_col = "col-12 col-md-6" -%}
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row mwl-table-heading">
<div class="{{ source_col }}">
<span class="d-md-none">Feed</span><span class="d-none d-md-inline">Source</span>
</div>
<div class="{{ path_col }} d-none d-md-inline-block">Relative Path</div>
</div>
{% for feed in custom_feeds %}
<div class="row mwl-table-detail">
<div class="{{ source_col }}">
{{ feed.source }}
{%- if feed.is_podcast %} &nbsp; <span class="badge bg-primary">PODCAST</span>{% endif %}<br>
<small>
{%- assign feed_url = "admin/settings/rss/" | append: feed.id -%}
<a href="{{ feed.path | relative_link }}" target="_blank">View Feed</a>
<span class="text-muted"> &bull; </span>
<a href="{{ feed_url | append: "/edit" | relative_link }}">Edit</a>
<span class="text-muted"> &bull; </span>
{%- assign feed_del_link = feed_url | append: "/delete" | relative_link -%}
<a href="{{ feed_del_link }}" hx-post="{{ feed_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the custom RSS feed based on {{ feed.source | strip_html | escape }}? This action cannot be undone.">
Delete
</a>
</small>
</div>
<div class="{{ path_col }}">
<small class="d-md-none">Served at {{ feed.path }}</small>
<span class="d-none d-md-inline">{{ feed.path }}</span>
</div>
</div>
{%- endfor %}
</form>
{%- else %}
<p class="text-muted fst-italic text-center">No custom feeds defined</p>
{%- endif %}
</fieldset>
</fieldset>
<fieldset id="tag-mappings" class="container mb-3 pb-0">
<legend>Tag Mappings</legend>
<a href="{{ "admin/settings/tag-mapping/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3"
hx-target="#tag_new">
Add a New Tag Mapping
</a>
{{ tag_mapping_list }}
</fieldset>
</article> </article>

View File

@@ -2,18 +2,18 @@
<form hx-post="{{ "admin/settings/tag-mapping/save" | relative_link }}" method="post" class="container" <form hx-post="{{ "admin/settings/tag-mapping/save" | relative_link }}" method="post" class="container"
hx-target="#tagList" hx-swap="outerHTML show:window:top"> hx-target="#tagList" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="id" value="{{ model.id }}"> <input type="hidden" name="Id" value="{{ model.id }}">
<div class="row mb-3"> <div class="row mb-3">
<div class="col-6 col-lg-4 offset-lg-2"> <div class="col-6 col-lg-4 offset-lg-2">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="tag" id="tag" class="form-control" placeholder="Tag" autofocus required <input type="text" name="Tag" id="tag" class="form-control" placeholder="Tag" autofocus required
value="{{ model.tag }}"> value="{{ model.tag }}">
<label for="tag">Tag</label> <label for="tag">Tag</label>
</div> </div>
</div> </div>
<div class="col-6 col-lg-4"> <div class="col-6 col-lg-4">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="urlValue" id="urlValue" class="form-control" placeholder="URL Value" required <input type="text" name="UrlValue" id="urlValue" class="form-control" placeholder="URL Value" required
value="{{ model.url_value }}"> value="{{ model.url_value }}">
<label for="urlValue">URL Value</label> <label for="urlValue">URL Value</label>
</div> </div>
@@ -22,7 +22,7 @@
<div class="row mb-3"> <div class="row mb-3">
<div class="col text-center"> <div class="col text-center">
<button type="submit" class="btn btn-sm btn-primary">Save Changes</button> <button type="submit" class="btn btn-sm btn-primary">Save Changes</button>
<a href="{{ "admin/settings/tag-mappings/bare" | relative_link }}" class="btn btn-sm btn-secondary ms-3"> <a href="{{ "admin/settings/tag-mappings" | relative_link }}" class="btn btn-sm btn-secondary ms-3">
Cancel Cancel
</a> </a>
</div> </div>

View File

@@ -1,34 +1,45 @@
<form method="post" class="container" id="tagList" hx-target="this" hx-swap="outerHTML show:window:top"> <div id="tagList" class="container">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <div class="row">
<div class="row mwl-table-detail" id="tag_new"></div> <div class="col">
{%- assign map_count = mappings | size -%} {%- assign map_count = mappings | size -%}
{% if map_count > 0 -%} {% if map_count > 0 -%}
{% for map in mappings -%} <div class="container">
{%- assign map_id = mapping_ids | value: map.tag -%} <div class="row mwl-table-heading">
<div class="row mwl-table-detail" id="tag_{{ map_id }}"> <div class="col">Tag</div>
<div class="col no-wrap"> <div class="col">URL Value</div>
{{ map.tag }}<br> </div>
<small>
{%- capture map_edit %}admin/settings/tag-mapping/{{ map_id }}/edit{% endcapture -%}
<a href="{{ map_edit | relative_link }}" hx-target="#tag_{{ map_id }}"
hx-swap="innerHTML show:#tag_{{ map_id }}:top">
Edit
</a>
<span class="text-muted"> &bull; </span>
{%- capture map_del %}admin/settings/tag-mapping/{{ map_id }}/delete{% endcapture -%}
{%- capture map_del_link %}{{ map_del | relative_link }}{% endcapture -%}
<a href="{{ map_del_link }}" hx-post="{{ map_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the mapping for &ldquo;{{ map.tag }}&rdquo;? This action cannot be undone.">
Delete
</a>
</small>
</div> </div>
<div class="col">{{ map.url_value }}</div> <form method="post" class="container" hx-target="#tagList" hx-swap="outerHTML">
</div> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
{%- endfor %} <div class="row mwl-table-detail" id="tag_new"></div>
{%- else -%} {% for map in mappings -%}
<div class="row"> {%- assign map_id = mapping_ids | value: map.tag -%}
<div class="col text-muted text-center fst-italic">This web log has no tag mappings</div> <div class="row mwl-table-detail" id="tag_{{ map_id }}">
<div class="col no-wrap">
{{ map.tag }}<br>
<small>
{%- assign map_url = "admin/settings/tag-mapping/" | append: map_id -%}
<a href="{{ map_url | append: "/edit" | relative_link }}" hx-target="#tag_{{ map_id }}"
hx-swap="innerHTML show:#tag_{{ map_id }}:top">
Edit
</a>
<span class="text-muted"> &bull; </span>
{%- assign map_del_link = map_url | append: "/delete" | relative_link -%}
<a href="{{ map_del_link }}" hx-post="{{ map_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the mapping for &ldquo;{{ map.tag }}&rdquo;? This action cannot be undone.">
Delete
</a>
</small>
</div>
<div class="col">{{ map.url_value }}</div>
</div>
{%- endfor %}
</form>
{%- else -%}
<div id="tag_new">
<p class="text-muted text-center fst-italic">This web log has no tag mappings</p>
</div>
{%- endif %}
</div> </div>
{%- endif %} </div>
</form> </div>

View File

@@ -1,14 +0,0 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<a href="{{ "admin/settings/tag-mapping/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3"
hx-target="#tag_new">
Add a New Tag Mapping
</a>
<div class="container">
<div class="row mwl-table-heading">
<div class="col">Tag</div>
<div class="col">URL Value</div>
</div>
</div>
{{ tag_mapping_list }}
</article>

View File

@@ -0,0 +1,33 @@
<form method="post" id="themeList" class="container g-0" hx-target="this" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
{% include_template "_theme-list-columns" %}
{% for theme in themes -%}
<div class="row mwl-table-detail" id="theme_{{ theme.id }}">
<div class="{{ theme_col }} no-wrap">
{{ theme.name }}
{%- if theme.is_in_use %}
<span class="badge bg-primary ms-2">IN USE</span>
{%- endif %}
{%- unless theme.is_on_disk %}
<span class="badge bg-warning text-dark ms-2">NOT ON DISK</span>
{%- endunless %}<br>
<small>
<span class="text-muted">v{{ theme.version }}</span>
{% unless theme.is_in_use or theme.id == "default" %}
<span class="text-muted"> &bull; </span>
{%- assign theme_del_link = "admin/theme/" | append: theme.id | append: "/delete" | relative_link -%}
<a href="{{ theme_del_link }}" hx-post="{{ theme_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the theme &ldquo;{{ theme.name }}&rdquo;? This action cannot be undone.">
Delete
</a>
{% endunless %}
<span class="d-md-none text-muted">
<br>Slug: {{ theme.id }} &bull; {{ theme.template_count }} Templates
</span>
</small>
</div>
<div class="{{ slug_col }}">{{ theme.id }}</div>
<div class="{{ tmpl_col }}">{{ theme.template_count }}</div>
</div>
{%- endfor %}
</form>

View File

@@ -0,0 +1,30 @@
<div class="col">
<h5 class="mt-2">{{ page_title }}</h5>
<form action="{{ "admin/theme/new" | relative_link }}" method="post" class="container" enctype="multipart/form-data"
hx-boost="false">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row">
<div class="col-12 col-sm-6 pb-3">
<div class="form-floating">
<input type="file" id="file" name="file" class="form-control" accept=".zip" placeholder="Theme File" required>
<label for="file">Theme File</label>
</div>
</div>
<div class="col-12 col-sm-6 pb-3 d-flex justify-content-center align-items-center">
<div class="form-check form-switch pb-2">
<input type="checkbox" name="DoOverwrite" id="doOverwrite" class="form-check-input" value="true">
<label for="doOverwrite" class="form-check-label">Overwrite</label>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col text-center">
<button type="submit" class="btn btn-sm btn-primary">Upload Theme</button>
<button type="button" class="btn btn-sm btn-secondary ms-3"
onclick="document.getElementById('theme_new').innerHTML = ''">
Cancel
</button>
</div>
</div>
</form>
</div>

View File

@@ -7,27 +7,27 @@
<form method="post" class="container" hx-target="body"> <form method="post" class="container" hx-target="body">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row"> <div class="row">
<div class="col text-muted text-center"><em>Uploaded files served from</em><br>{{ upload_base }}</div> <div class="col text-center"><em class="text-muted">Uploaded files served from</em><br>{{ upload_base }}</div>
</div>
<div class="row mwl-table-heading">
<div class="col-6">File Name</div>
<div class="col-3">Path</div>
<div class="col-3">File Date/Time</div>
</div> </div>
{%- assign file_count = files | size -%} {%- assign file_count = files | size -%}
{%- if file_count > 0 %} {%- if file_count > 0 %}
<div class="row mwl-table-heading">
<div class="col-6">File Name</div>
<div class="col-3">Path</div>
<div class="col-3">File Date/Time</div>
</div>
{% for file in files %} {% for file in files %}
<div class="row mwl-table-detail"> <div class="row mwl-table-detail">
<div class="col-6"> <div class="col-6">
{%- capture badge_class -%} {%- capture badge_class -%}
{%- if file.source == "disk" %}secondary{% else %}primary{% endif -%} {%- if file.source == "Disk" %}secondary{% else %}primary{% endif -%}
{%- endcapture -%} {%- endcapture -%}
{%- capture rel_url %}{{ upload_base }}{{ file.path }}{{ file.name }}{% endcapture -%} {%- assign path_and_name = file.path | append: file.name -%}
{%- capture blog_rel %}{{ upload_path }}{{ file.path }}{{ file.name }}{% endcapture -%} {%- assign blog_rel = upload_path | append: path_and_name -%}
<span class="badge bg-{{ badge_class }} text-uppercase float-end mt-1">{{ file.source }}</span> <span class="badge bg-{{ badge_class }} text-uppercase float-end mt-1">{{ file.source }}</span>
{{ file.name }}<br> {{ file.name }}<br>
<small> <small>
<a href="{{ rel_url }}" target="_blank">View File</a> <a href="{{ upload_base | append: path_and_name }}" target="_blank">View File</a>
<span class="text-muted"> &bull; Copy </span> <span class="text-muted"> &bull; Copy </span>
<a href="{{ blog_rel | absolute_link }}" hx-boost="false" <a href="{{ blog_rel | absolute_link }}" hx-boost="false"
onclick="return Admin.copyText('{{ blog_rel | absolute_link }}', this)"> onclick="return Admin.copyText('{{ blog_rel | absolute_link }}', this)">
@@ -45,17 +45,20 @@
For Post For Post
</a> </a>
{%- endunless %} {%- endunless %}
<span class="text-muted"> Link &bull; </span> <span class="text-muted"> Link</span>
{%- capture delete_url -%} {% if is_web_log_admin %}
{%- if file.source == "disk" -%} <span class="text-muted"> &bull; </span>
admin/upload/delete/{{ file.path }}{{ file.name }} {%- capture delete_url -%}
{%- else -%} {%- if file.source == "Disk" -%}
admin/upload/{{ file.id }}/delete admin/upload/delete/{{ path_and_name }}
{%- endif -%} {%- else -%}
{%- endcapture -%} admin/upload/{{ file.id }}/delete
<a href="{{ delete_url | relative_link }}" hx-post="{{ delete_url | relative_link }}" {%- endif -%}
hx-confirm="Are you sure you want to delete {{ file.name }}? This action cannot be undone." {%- endcapture -%}
class="text-danger">Delete</a> <a href="{{ delete_url | relative_link }}" hx-post="{{ delete_url | relative_link }}"
hx-confirm="Are you sure you want to delete {{ file.name }}? This action cannot be undone."
class="text-danger">Delete</a>
{% endif %}
</small> </small>
</div> </div>
<div class="col-3">{{ file.path }}</div> <div class="col-3">{{ file.path }}</div>
@@ -66,7 +69,7 @@
{% endfor %} {% endfor %}
{%- else -%} {%- else -%}
<div class="row"> <div class="row">
<div class="col text-muted fst-italic text-center">This web log has uploaded files</div> <div class="col text-muted fst-italic text-center"><br>This web log has uploaded files</div>
</div> </div>
{%- endif %} {%- endif %}
</form> </form>

View File

@@ -6,18 +6,18 @@
<div class="row"> <div class="row">
<div class="col-12 col-md-6 pb-3"> <div class="col-12 col-md-6 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="file" id="file" name="file" class="form-control" placeholder="File" required> <input type="file" id="file" name="File" class="form-control" placeholder="File" required>
<label for="file">File to Upload</label> <label for="file">File to Upload</label>
</div> </div>
</div> </div>
<div class="col-12 col-md-6 pb-3 d-flex align-self-center justify-content-around"> <div class="col-12 col-md-6 pb-3 d-flex align-self-center justify-content-around">
Destination<br> Destination<br>
<div class="btn-group" role="group" aria-label="Upload destination button group"> <div class="btn-group" role="group" aria-label="Upload destination button group">
<input type="radio" name="destination" id="destination_db" class="btn-check" value="database" <input type="radio" name="Destination" id="destination_db" class="btn-check" value="Database"
{%- if destination == "database" %} checked="checked"{% endif %}> {%- if destination == "Database" %} checked="checked"{% endif %}>
<label class="btn btn-outline-primary" for="destination_db">Database</label> <label class="btn btn-outline-primary" for="destination_db">Database</label>
<input type="radio" name="destination" id="destination_disk" class="btn-check" value="disk" <input type="radio" name="Destination" id="destination_disk" class="btn-check" value="Disk"
{%- if destination == "disk" %} checked="checked"{% endif %}> {%- if destination == "Disk" %} checked="checked"{% endif %}>
<label class="btn btn-outline-secondary" for="destination_disk">Disk</label> <label class="btn btn-outline-secondary" for="destination_disk">Disk</label>
</div> </div>
</div> </div>

View File

@@ -1,26 +0,0 @@
<h2>Upload a Theme</h2>
<article>
<form action="{{ "admin/theme/update" | relative_link }}"
method="post" class="container" enctype="multipart/form-data" hx-boost="false">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row">
<div class="col-12 col-sm-6 offset-sm-3 pb-3">
<div class="form-floating">
<input type="file" id="file" name="file" class="form-control" accept=".zip" placeholder="Theme File" required>
<label for="file">Theme File</label>
</div>
</div>
<div class="col-12 col-sm-6 pb-3">
<div class="form-check form-switch pb-2">
<input type="checkbox" name="clean" id="clean" class="form-check-input" value="true">
<label for="clean" class="form-check-label">Delete Existing Theme Files</label>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col text-center">
<button type="submit" class="btn btn-primary">Upload Theme</button>
</div>
</div>
</form>
</article>

View File

@@ -1,64 +1,102 @@
<h2 class="my-3">{{ page_title }}</h2> <div class="col-12">
<article> <h5 class="my-3">{{ page_title }}</h5>
<form action="{{ "admin/user/save" | relative_link }}" method="post"> <form hx-post="{{ "admin/settings/user/save" | relative_link }}" method="post" class="container"
hx-target="#userList" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="container"> <input type="hidden" name="Id" value="{{ model.id }}">
<div class="row mb-3"> <div class="row">
<div class="col-12 col-md-6 col-lg-4 pb-3"> <div class="col-12 col-md-5 col-lg-3 col-xxl-2 offset-xxl-1 mb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="firstName" id="firstName" class="form-control" autofocus required <select name="AccessLevel" id="accessLevel" class="form-control" required autofocus>
placeholder="First" value="{{ model.first_name }}"> {%- for level in access_levels %}
<label for="firstName">First Name</label> <option value="{{ level[0] }}"{% if model.access_level == level[0] %} selected{% endif %}>
</div> {{ level[1] }}
</div> </option>
<div class="col-12 col-md-6 col-lg-4 pb-3"> {%- endfor %}
<div class="form-floating"> </select>
<input type="text" name="lastName" id="lastName" class="form-control" required <label for="accessLevel">Access Level</label>
placeholder="Last" value="{{ model.last_name }}">
<label for="lastName">Last Name</label>
</div>
</div>
<div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="preferredName" id="preferredName" class="form-control" required
placeholder="Preferred" value="{{ model.preferred_name }}">
<label for="preferredName">Preferred Name</label>
</div>
</div> </div>
</div> </div>
<div class="row mb-3"> <div class="col-12 col-md-7 col-lg-4 col-xxl-3 mb-3">
<div class="col"> <div class="form-floating">
<fieldset class="container"> <input type="email" name="Email" id="email" class="form-control" placeholder="E-mail" required
<legend>Change Password</legend> value="{{ model.email | escape }}">
<div class="row"> <label for="email">E-mail Address</label>
<div class="col">
<p class="form-text">Optional; leave blank to keep your current password</p>
</div>
</div>
<div class="row">
<div class="col-12 col-md-6 pb-3">
<div class="form-floating">
<input type="password" name="newPassword" id="newPassword" class="form-control"
placeholder="Password">
<label for="newPassword">New Password</label>
</div>
</div>
<div class="col-12 col-md-6 pb-3">
<div class="form-floating">
<input type="password" name="newPasswordConfirm" id="newPasswordConfirm" class="form-control"
placeholder="Confirm">
<label for="newPasswordConfirm">Confirm New Password</label>
</div>
</div>
</div>
</fieldset>
</div> </div>
</div> </div>
<div class="row"> <div class="col-12 col-lg-5 mb-3">
<div class="col text-center mb-3"> <div class="form-floating">
<button type="submit" class="btn btn-primary">Save Changes</button> <input type="text" name="Url" id="url" class="form-control" placeholder="URL"
value="{{ model.url | escape }}">
<label for="url">User&rsquo;s Personal URL</label>
</div> </div>
</div> </div>
</div> </div>
<div class="row mb-3">
<div class="col-12 col-md-6 col-lg-4 col-xl-3 offset-xl-1 pb-3">
<div class="form-floating">
<input type="text" name="FirstName" id="firstName" class="form-control" placeholder="First" required
value="{{ model.first_name | escape }}">
<label for="firstName">First Name</label>
</div>
</div>
<div class="col-12 col-md-6 col-lg-4 col-xl-3 pb-3">
<div class="form-floating">
<input type="text" name="LastName" id="lastName" class="form-control" placeholder="Last" required
value="{{ model.last_name | escape }}">
<label for="lastName">Last Name</label>
</div>
</div>
<div class="col-12 col-md-6 offset-md-3 col-lg-4 offset-lg-0 col-xl-3 offset-xl-1 pb-3">
<div class="form-floating">
<input type="text" name="PreferredName" id="preferredName" class="form-control"
placeholder="Preferred" required value="{{ model.preferred_name | escape }}">
<label for="preferredName">Preferred Name</label>
</div>
</div>
</div>
<div class="row mb-3">
<div class="col-12 col-xl-10 offset-xl-1">
<fieldset class="p-2">
<legend class="ps-1">{% unless model.is_new %}Change {% endunless %}Password</legend>
{% unless model.is_new %}
<div class="row">
<div class="col">
<p class="form-text">Optional; leave blank not change the user&rsquo;s password</p>
</div>
</div>
{% endunless %}
<div class="row">
<div class="col-12 col-md-6 pb-3">
<div class="form-floating">
<input type="password" name="Password" id="password" class="form-control"
placeholder="Password"{% if model.is_new %} required{% endif %}>
<label for="password">{% unless model.is_new %}New {% endunless %}Password</label>
</div>
</div>
<div class="col-12 col-md-6 pb-3">
<div class="form-floating">
<input type="password" name="PasswordConfirm" id="passwordConfirm" class="form-control"
placeholder="Confirm"{% if model.is_new %} required{% endif %}>
<label for="passwordConfirm">Confirm{% unless model.is_new %} New{% endunless %} Password</label>
</div>
</div>
</div>
</fieldset>
</div>
</div>
<div class="row mb-3">
<div class="col text-center">
<button type="submit" class="btn btn-sm btn-primary">Save Changes</button>
{% if model.is_new %}
<button type="button" class="btn btn-sm btn-secondary ms-3"
onclick="document.getElementById('user_new').innerHTML = ''">
Cancel
</button>
{% else %}
<a href="{{ "admin/settings/users" | relative_link }}" class="btn btn-sm btn-secondary ms-3">Cancel</a>
{% endif %}
</div>
</div>
</form> </form>
</article> </div>

View File

@@ -0,0 +1,61 @@
<div id="userList">
<div class="container g-0">
<div class="row mwl-table-detail" id="user_new"></div>
</div>
<form method="post" id="userList" class="container g-0" hx-target="this" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
{% include_template "_user-list-columns" %}
{%- assign badge = "ms-2 badge bg" -%}
{% for user in users -%}
<div class="row mwl-table-detail" id="user_{{ user.id }}">
<div class="{{ user_col }} no-wrap">
{{ user.preferred_name }}
{%- if user.access_level == "Administrator" %}
<span class="{{ badge }}-success">ADMINISTRATOR</span>
{%- elsif user.access_level == "WebLogAdmin" %}
<span class="{{ badge }}-primary">WEB LOG ADMIN</span>
{%- elsif user.access_level == "Editor" %}
<span class="{{ badge }}-secondary">EDITOR</span>
{%- elsif user.access_level == "Author" %}
<span class="{{ badge }}-dark">AUTHOR</span>
{%- endif %}<br>
{%- unless is_administrator == false and user.access_level == "Administrator" %}
<small>
{%- assign user_url_base = "admin/settings/user/" | append: user.id -%}
<a href="{{ user_url_base | append: "/edit" | relative_link }}" hx-target="#user_{{ user.id }}"
hx-swap="innerHTML show:#user_{{ user.id }}:top">
Edit
</a>
{% unless user_id == user.id %}
<span class="text-muted"> &bull; </span>
{%- assign user_del_link = user_url_base | append: "/delete" | relative_link -%}
<a href="{{ user_del_link }}" hx-post="{{ user_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the user &ldquo;{{ user.preferred_name }}&rdquo;? This action cannot be undone. (This action will not succeed if the user has authored any posts or pages.)">
Delete
</a>
{% endunless %}
</small>
{%- endunless %}
</div>
<div class="{{ email_col }}">
{{ user.first_name }} {{ user.last_name }}<br>
<small class="text-muted">
{{ user.email }}
{%- unless user.url == "" %}<br>{{ user.url }}{% endunless %}
</small>
</div>
<div class="{{ cre8_col }}">
{{ user.created_on | date: "MMMM d, yyyy" }}
</div>
<div class="{{ last_col }}">
{% if user.last_seen_on %}
{{ user.last_seen_on | date: "MMMM d, yyyy" }} at
{{ user.last_seen_on | date: "h:mmtt" | downcase }}
{% else %}
--
{% endif %}
</div>
</div>
{%- endfor %}
</form>
</div>

View File

@@ -1,2 +1,2 @@
myWebLog Admin myWebLog Admin
2.0.0-beta03 2.0.0-rc2

View File

@@ -29,7 +29,6 @@ header nav {
footer { footer {
background-color: #808080; background-color: #808080;
border-top: solid 1px black; border-top: solid 1px black;
color: white;
} }
.messages { .messages {
max-width: 60rem; max-width: 60rem;
@@ -85,3 +84,34 @@ a.text-danger:link:hover, a.text-danger:visited:hover {
background-color: var(--light-accent); background-color: var(--light-accent);
color: var(--dark-gray); color: var(--dark-gray);
} }
.mwl-revision-preview {
max-height: 90vh;
overflow: auto;
border: solid 1px black;
border-radius: .5rem;
padding: .5rem;
}
.load-overlay {
display: none;
position: fixed;
top: 55px;
left: 0;
z-index: 100;
width: 100%;
height: 100%;
background-color: rgba(0, 0, 0, .1);
transition: ease-in-out .5s;
}
.load-overlay h1 {
background-color: rgba(204, 204, 0, .95);
height: fit-content;
border: solid 6px darkgreen;
border-radius: 2rem;
}
.load-overlay.htmx-request {
display: flex;
flex-flow: row;
}
#toastHost {
z-index: 5;
}

View File

@@ -56,7 +56,7 @@ this.Admin = {
const nameField = document.createElement("input") const nameField = document.createElement("input")
nameField.type = "text" nameField.type = "text"
nameField.name = "metaNames" nameField.name = "MetaNames"
nameField.id = `metaNames_${this.nextMetaIndex}` nameField.id = `metaNames_${this.nextMetaIndex}`
nameField.className = "form-control" nameField.className = "form-control"
nameField.placeholder = "Name" nameField.placeholder = "Name"
@@ -94,7 +94,7 @@ this.Admin = {
const valueField = document.createElement("input") const valueField = document.createElement("input")
valueField.type = "text" valueField.type = "text"
valueField.name = "metaValues" valueField.name = "MetaValues"
valueField.id = `metaValues_${this.nextMetaIndex}` valueField.id = `metaValues_${this.nextMetaIndex}`
valueField.className = "form-control" valueField.className = "form-control"
valueField.placeholder = "Value" valueField.placeholder = "Value"
@@ -182,7 +182,7 @@ this.Admin = {
// Link // Link
const linkField = document.createElement("input") const linkField = document.createElement("input")
linkField.type = "text" linkField.type = "text"
linkField.name = "prior" linkField.name = "Prior"
linkField.id = `prior_${this.nextPermalink}` linkField.id = `prior_${this.nextPermalink}`
linkField.className = "form-control" linkField.className = "form-control"
linkField.placeholder = "Link" linkField.placeholder = "Link"
@@ -293,33 +293,46 @@ this.Admin = {
const parts = msg.split("|||") const parts = msg.split("|||")
if (parts.length < 2) return if (parts.length < 2) return
const msgDiv = document.createElement("div") // Create the toast header
msgDiv.className = `alert alert-${parts[0]} alert-dismissible fade show` const toastType = document.createElement("strong")
msgDiv.setAttribute("role", "alert") toastType.className = "me-auto text-uppercase"
msgDiv.innerHTML = parts[1] toastType.innerText = parts[0] === "danger" ? "error" : parts[0]
const closeBtn = document.createElement("button") const closeBtn = document.createElement("button")
closeBtn.type = "button" closeBtn.type = "button"
closeBtn.className = "btn-close" closeBtn.className = "btn-close"
closeBtn.setAttribute("data-bs-dismiss", "alert") closeBtn.setAttribute("data-bs-dismiss", "toast")
closeBtn.setAttribute("aria-label", "Close") closeBtn.setAttribute("aria-label", "Close")
msgDiv.appendChild(closeBtn)
const toastHead = document.createElement("div")
toastHead.className = `toast-header bg-${parts[0]}${parts[0] === "warning" ? "" : " text-white"}`
toastHead.appendChild(toastType)
toastHead.appendChild(closeBtn)
// Create the toast body
const toastBody = document.createElement("div")
toastBody.className = `toast-body bg-${parts[0]} bg-opacity-25`
toastBody.innerHTML = parts[1]
if (parts.length === 3) { if (parts.length === 3) {
msgDiv.innerHTML += `<hr>${parts[2]}` toastBody.innerHTML += `<hr>${parts[2]}`
} }
document.getElementById("msgContainer").appendChild(msgDiv)
})
},
/** // Assemble the toast
* Set all "success" alerts to close after 4 seconds const toast = document.createElement("div")
*/ toast.className = "toast"
dismissSuccesses() { toast.setAttribute("role", "alert")
[...document.querySelectorAll(".alert-success")].forEach(alert => { toast.setAttribute("aria-live", "assertive")
setTimeout(() => { toast.setAttribute("aria-atomic", "true")
(bootstrap.Alert.getInstance(alert) ?? new bootstrap.Alert(alert)).close() toast.appendChild(toastHead)
}, 4000) toast.appendChild(toastBody)
document.getElementById("toasts").appendChild(toast)
let options = { delay: 4000 }
if (parts[0] !== "success") options.autohide = false
const theToast = new bootstrap.Toast(toast, options)
theToast.show()
}) })
} }
} }
@@ -329,6 +342,26 @@ htmx.on("htmx:afterOnLoad", function (evt) {
// Show messages if there were any in the response // Show messages if there were any in the response
if (hdrs.indexOf("x-message") >= 0) { if (hdrs.indexOf("x-message") >= 0) {
Admin.showMessage(evt.detail.xhr.getResponseHeader("x-message")) Admin.showMessage(evt.detail.xhr.getResponseHeader("x-message"))
Admin.dismissSuccesses() }
// Initialize any toasts that were pre-rendered from the server
[...document.querySelectorAll(".toast")].forEach(el => {
if (el.getAttribute("data-mwl-shown") === "true" && el.className.indexOf("hide") >= 0) {
document.removeChild(el)
} else {
const toast = new bootstrap.Toast(el,
el.getAttribute("data-bs-autohide") === "false"
? { autohide: false } : { delay: 6000, autohide: true })
toast.show()
el.setAttribute("data-mwl-shown", "true")
}
})
})
htmx.on("htmx:responseError", function (evt) {
const xhr = evt.detail.xhr
const hdrs = xhr.getAllResponseHeaders()
// Show an error message if there were none in the response
if (hdrs.indexOf("x-message") < 0) {
Admin.showMessage(`danger|||${xhr.status}: ${xhr.statusText}`)
} }
}) })

View File

@@ -1,56 +1,60 @@
{%- if is_category or is_tag %} {%- if is_category or is_tag %}
<h1 class="index-title">{{ page_title }}</h1> <h1 class="index-title">{{ page_title }}</h1>
{%- if is_category %} {%- if subtitle %}<h4 class="text-muted">{{ subtitle }}</h4>{% endif -%}
{%- assign cat = categories | where: "slug", slug | first -%} {% endif %}
{%- if cat.description %}<h4 class="text-muted">{{ cat.description.value }}</h4>{% endif -%} {%- assign post_count = model.posts | size -%}
{%- endif %} {%- if post_count > 0 %}
{%- endif %} <section class="container mt-3" aria-label="The posts for the page">
<section class="container mt-3" aria-label="The posts for the page"> {%- for post in model.posts %}
{% for post in model.posts %} <article>
<article> <h1>
<h1> <a href="{{ post | relative_link }}" title="Permanent link to &quot;{{ post.title | escape }}&quot;">
<a href="{{ post | relative_link }}" title="Permanent link to &quot;{{ post.title | escape }}&quot;"> {{ post.title }}
{{ post.title }} </a>
</a> </h1>
</h1> <p>
<p> Published on {{ post.published_on | date: "MMMM d, yyyy" }}
Published on {{ post.published_on | date: "MMMM d, yyyy" }} at {{ post.published_on | date: "h:mmtt" | downcase }}
at {{ post.published_on | date: "h:mmtt" | downcase }} by {{ model.authors | value: post.author_id }}
by {{ model.authors | value: post.author_id }} </p>
</p> {{ post.text }}
{{ post.text }} {%- assign category_count = post.category_ids | size -%}
{%- assign category_count = post.category_ids | size -%} {%- assign tag_count = post.tags | size -%}
{%- assign tag_count = post.tags | size -%} {% if category_count > 0 or tag_count > 0 %}
{% if category_count > 0 or tag_count > 0 %} <footer>
<footer> <p>
<p> {%- if category_count > 0 -%}
{%- if category_count > 0 -%} Categorized under:
Categorized under: {% for cat in post.category_ids -%}
{% for cat in post.category_ids -%} {%- assign this_cat = categories | where: "Id", cat | first -%}
{%- assign this_cat = categories | where: "id", cat | first -%} {{ this_cat.name }}{% unless forloop.last %}, {% endunless %}
{{ this_cat.name }}{% unless forloop.last %}, {% endunless %} {%- assign cat_names = this_cat.name | concat: cat_names -%}
{%- assign cat_names = this_cat.name | concat: cat_names -%} {%- endfor -%}
{%- endfor -%} {%- assign cat_names = "" -%}
{%- assign cat_names = "" -%} <br>
<br> {% endif -%}
{% endif -%} {%- if tag_count > 0 %}
{%- if tag_count > 0 %} Tagged: {{ post.tags | join: ", " }}
Tagged: {{ post.tags | join: ", " }} {% endif -%}
{% endif -%} </p>
</p> </footer>
</footer> {% endif %}
<hr>
</article>
{% endfor %}
</section>
<nav aria-label="pagination">
<ul class="pagination justify-content-evenly mt-2">
{% if model.newer_link -%}
<li class="page-item"><a class="page-link" href="{{ model.newer_link.value }}">&laquo; Newer Posts</a></li>
{% endif %} {% endif %}
<hr> {% if model.older_link -%}
</article> <li class="page-item"><a class="page-link" href="{{ model.older_link.value }}">Older Posts &raquo;</a></li>
{% endfor %} {%- endif -%}
</section> </ul>
<nav aria-label="pagination"> </nav>
<ul class="pagination justify-content-evenly mt-2"> {%- else %}
{% if model.newer_link -%} <article>
<li class="page-item"><a class="page-link" href="{{ model.newer_link.value }}">&laquo; Newer Posts</a></li> <p class="text-center mt-3">No posts found</p>
{% endif %} </article>
{% if model.older_link -%} {%- endif %}
<li class="page-item"><a class="page-link" href="{{ model.older_link.value }}">Older Posts &raquo;</a></li>
{%- endif -%}
</ul>
</nav>

View File

@@ -3,8 +3,8 @@
<head> <head>
<meta charset="utf-8"> <meta charset="utf-8">
<meta name="viewport" content="width=device-width"> <meta name="viewport" content="width=device-width">
<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css" <link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@5.1.3/dist/css/bootstrap.min.css"
integrity="sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" crossorigin="anonymous"> integrity="sha384-1BmE4kWBq78iYhFldvKuhfTAU6auU8tT94WrHftjDbrCEXSU1oBoqyl2QvZ6jIW3" crossorigin="anonymous">
<title>{{ page_title | strip_html }}{% if page_title %} &laquo; {% endif %}{{ web_log.name | strip_html }}</title> <title>{{ page_title | strip_html }}{% if page_title %} &laquo; {% endif %}{{ web_log.name | strip_html }}</title>
{% page_head -%} {% page_head -%}
</head> </head>
@@ -55,8 +55,8 @@
<img src="{{ "themes/admin/logo-dark.png" | relative_link }}" alt="myWebLog" width="120" height="34"> <img src="{{ "themes/admin/logo-dark.png" | relative_link }}" alt="myWebLog" width="120" height="34">
</div> </div>
</footer> </footer>
<script src="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/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-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM" integrity="sha384-ka7Sk0Gln4gmtz2MlQnikT1wXgYsOg+OMhuP+IlRH9sENBO0LRn5q+8nbTov4+1p"
crossorigin="anonymous"></script> crossorigin="anonymous"></script>
</body> </body>
</html> </html>

View File

@@ -8,7 +8,9 @@
**DRAFT** **DRAFT**
{% endif %} {% endif %}
by {{ model.authors | value: post.author_id }} by {{ model.authors | value: post.author_id }}
{% if logged_on %} &bull; <a hx-boost="false" href="{{ post | edit_post_link }}">Edit Post</a> {% endif %} {%- if is_editor or is_author and user_id == post.author_id %}
&bull; <a hx-boost="false" href="{{ post | edit_post_link }}">Edit Post</a>
{%- endif %}
</h4> </h4>
<div> <div>
<article class="container mt-3"> <article class="container mt-3">
@@ -18,7 +20,7 @@
<h4 class="item-meta text-muted"> <h4 class="item-meta text-muted">
Categorized under Categorized under
{% for cat_id in post.category_ids -%} {% for cat_id in post.category_ids -%}
{% assign cat = categories | where: "id", cat_id | first %} {% assign cat = categories | where: "Id", cat_id | first %}
<span class="text-nowrap"> <span class="text-nowrap">
<a href="{{ cat | category_link }}" title="Categorized under &ldquo;{{ cat.name | escape }}&rdquo;"> <a href="{{ cat | category_link }}" title="Categorized under &ldquo;{{ cat.name | escape }}&rdquo;">
{{ cat.name }} {{ cat.name }}

View File

@@ -1,2 +1,2 @@
myWebLog Default Theme myWebLog Default Theme
2.0.0-alpha36 2.0.0-rc2