25 Commits

Author SHA1 Message Date
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
355ade8c87 Add slug and upload dest to settings (#2) 2022-07-07 12:42:37 -04:00
1d096d696b Add types to admin functions
- Change how functions are registered
2022-07-06 10:30:30 -04:00
ce3816a8ae Use web log slug for backup file name (#16) 2022-07-04 19:06:32 -04:00
879710a0a3 Add funding (#7)/GUID (#4)/medium (#3) to podcast
- Add info log for non-default DB connections
2022-07-04 18:40:32 -04:00
c957279162 Add and delete uploaded files (#2) 2022-07-04 13:19:16 -04:00
9307ace24a WIP on saving uploads (#2) 2022-07-01 20:59:21 -04:00
feada6f11f Add copy links to upload list (#2) 2022-06-30 18:56:24 -04:00
0567dff54a WIP on upload admin (#2) 2022-06-28 22:18:56 -04:00
c29bbc04ac WIP on uploads (#2)
- Add data types and fields
- Implement in both RethinkDB and SQLite
- Add uploads to backup/restore
- Add empty upload folder to project
- Add indexes to SQLite tables (#15)
2022-06-28 17:34:18 -04:00
46bd785a1f Make program executable (#14)
- Bump versions for next release
2022-06-28 08:39:43 -04:00
63 changed files with 5531 additions and 3249 deletions

3
.gitignore vendored
View File

@@ -262,3 +262,6 @@ src/MyWebLog/wwwroot/img/bit-badger
.ionide
src/MyWebLog/appsettings.Production.json
# SQLite database files
src/MyWebLog/*.db*

View File

@@ -33,7 +33,6 @@ let version =
/// Zip a theme distributed with myWebLog
let zipTheme (name : string) (_ : TargetParameter) =
let path = $"src/{name}-theme"
Trace.log $"Path = {path}"
!! $"{path}/**/*"
|> Zip.filesAsSpecs path //$"src/{name}-theme"
|> Seq.filter (fun (_, name) -> not (name.EndsWith ".zip"))
@@ -79,14 +78,16 @@ Target.create "PackageLinux" (packageFor "linux-x64")
Target.create "RepackageLinux" (fun _ ->
let workDir = $"{releasePath}/linux"
let zipArchive = $"{releasePath}/myWebLog-{version}.linux-x64.zip"
Shell.mkdir workDir
Zip.unzip workDir zipArchive
Shell.cd workDir
[ "cfj"; $"../myWebLog-{version}.linux-x64.tar.bz2"; "." ]
|> CreateProcess.fromRawCommand "tar"
let sh command args =
CreateProcess.fromRawCommand command args
|> CreateProcess.redirectOutput
|> Proc.run
|> ignore
Shell.mkdir workDir
Zip.unzip workDir zipArchive
Shell.cd workDir
sh "chmod" [ "+x"; "app/MyWebLog" ]
sh "tar" [ "cfj"; $"../myWebLog-{version}.linux-x64.tar.bz2"; "." ]
Shell.cd "../.."
Shell.rm zipArchive
Shell.rm_rf workDir

171
rethink-case-fix.js Normal file
View File

@@ -0,0 +1,171 @@
// Category
r.db('myWebLog').table('Category').map({
Description: r.row('description'),
Id: r.row('id'),
Name: r.row('name'),
ParentId: r.row('parentId'),
Slug: r.row('slug'),
WebLogId: r.row('webLogId')
})
// Page
r.db('myWebLog').table('Page').map({
AuthorId: r.row('authorId'),
Id: r.row('id'),
Metadata: r.row('metadata').map(function (meta) {
return { Name: meta('name'), Value: meta('value') }
}),
Permalink: r.row('permalink'),
PriorPermalinks: r.row('priorPermalinks'),
PublishedOn: r.row('publishedOn'),
Revisions: r.row('revisions').map(function (rev) {
return {
AsOf: rev('asOf'),
Text: rev('text')
}
}),
IsInPageList: r.row('showInPageList'),
Template: r.row('template'),
Text: r.row('text'),
Title: r.row('title'),
UpdatedOn: r.row('updatedOn'),
WebLogId: r.row('webLogId')
})
// Post
r.db('myWebLog').table('Post').map({
AuthorId: r.row('authorId'),
CategoryIds: r.row('categoryIds'),
Episode: r.branch(r.row.hasFields('episode'), {
Duration: r.row('episode')('duration'),
Length: r.row('episode')('length'),
Media: r.row('episode')('media'),
MediaType: r.row('episode')('mediaType').default(null),
ImageUrl: r.row('episode')('imageUrl').default(null),
Subtitle: r.row('episode')('subtitle').default(null),
Explicit: r.row('episode')('explicit').default(null),
ChapterFile: r.row('episode')('chapterFile').default(null),
ChapterType: r.row('episode')('chapterType').default(null),
TranscriptUrl: r.row('episode')('transcriptUrl').default(null),
TranscriptType: r.row('episode')('transcriptType').default(null),
TranscriptLang: r.row('episode')('transcriptLang').default(null),
TranscriptCaptions: r.row('episode')('transcriptCaptions').default(null),
SeasonNumber: r.row('episode')('seasonNumber').default(null),
SeasonDescription: r.row('episode')('seasonDescription').default(null),
EpisodeNumber: r.row('episode')('episodeNumber').default(null),
EpisodeDescription: r.row('episode')('episodeDescription').default(null)
}, null),
Id: r.row('id'),
Metadata: r.row('metadata').map(function (meta) {
return { Name: meta('name'), Value: meta('value') }
}),
Permalink: r.row('permalink'),
PriorPermalinks: r.row('priorPermalinks'),
PublishedOn: r.row('publishedOn'),
Revisions: r.row('revisions').map(function (rev) {
return {
AsOf: rev('asOf'),
Text: rev('text')
}
}),
Status: r.row('status'),
Tags: r.row('tags'),
Template: r.row('template').default(null),
Text: r.row('text'),
Title: r.row('title'),
UpdatedOn: r.row('updatedOn'),
WebLogId: r.row('webLogId')
})
// TagMap
r.db('myWebLog').table('TagMap').map({
Id: r.row('id'),
Tag: r.row('tag'),
UrlValue: r.row('urlValue'),
WebLogId: r.row('webLogId')
})
// Theme
r.db('myWebLog').table('Theme').map({
Id: r.row('id'),
Name: r.row('name'),
Templates: r.row('templates').map(function (tmpl) {
return {
Name: tmpl('name'),
Text: tmpl('text')
}
}),
Version: r.row('version')
})
// ThemeAsset
r.db('myWebLog').table('ThemeAsset').map({
Data: r.row('data'),
Id: r.row('id'),
UpdatedOn: r.row('updatedOn')
})
// WebLog
r.db('myWebLog').table('WebLog').map(
{ AutoHtmx: r.row('autoHtmx'),
DefaultPage: r.row('defaultPage'),
Id: r.row('id'),
Name: r.row('name'),
PostsPerPage: r.row('postsPerPage'),
Rss: {
IsCategoryEnabled: r.row('rss')('categoryEnabled'),
Copyright: r.row('rss')('copyright'),
CustomFeeds: r.row('rss')('customFeeds').map(function (feed) {
return {
Id: feed('id'),
Path: feed('path'),
Podcast: {
DefaultMediaType: feed('podcast')('defaultMediaType'),
DisplayedAuthor: feed('podcast')('displayedAuthor'),
Email: feed('podcast')('email'),
Explicit: feed('podcast')('explicit'),
FundingText: feed('podcast')('fundingText'),
FundingUrl: feed('podcast')('fundingUrl'),
PodcastGuid: feed('podcast')('guid'),
AppleCategory: feed('podcast')('iTunesCategory'),
AppleSubcategory: feed('podcast')('iTunesSubcategory'),
ImageUrl: feed('podcast')('imageUrl'),
ItemsInFeed: feed('podcast')('itemsInFeed'),
MediaBaseUrl: feed('podcast')('mediaBaseUrl'),
Medium: feed('podcast')('medium'),
Subtitle: feed('podcast')('subtitle'),
Summary: feed('podcast')('summary'),
Title: feed('podcast')('title')
},
Source: feed('source')
}
}),
IsFeedEnabled: r.row('rss')('feedEnabled'),
FeedName: r.row('rss')('feedName'),
ItemsInFeed: r.row('rss')('itemsInFeed'),
IsTagEnabled: r.row('rss')('tagEnabled')
},
Slug: r.row('slug'),
Subtitle: r.row('subtitle'),
ThemeId: r.row('themePath'),
TimeZone: r.row('timeZone'),
Uploads: r.row('uploads'),
UrlBase: r.row('urlBase')
})
// WebLogUser
r.db('myWebLog').table('WebLogUser').map({
AccessLevel: r.row('authorizationLevel'),
FirstName: r.row('firstName'),
Id: r.row('id'),
LastName: r.row('lastName'),
PasswordHash: r.row('passwordHash'),
PreferredName: r.row('preferredName'),
Salt: r.row('salt'),
Url: r.row('url'),
Email: r.row('userName'),
WebLogId: r.row('webLogId'),
CreatedOn: r.branch(r.row.hasFields('createdOn'), r.row('createdOn'), r.expr(new Date(0))),
LastSeenOn: r.row('lastSeenOn').default(null)
})

View File

@@ -100,6 +100,13 @@ module Json =
override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) =
(string >> ThemeId) reader.Value
type UploadIdConverter () =
inherit JsonConverter<UploadId> ()
override _.WriteJson (writer : JsonWriter, value : UploadId, _ : JsonSerializer) =
writer.WriteValue (UploadId.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadId, _ : bool, _ : JsonSerializer) =
(string >> UploadId) reader.Value
type WebLogIdConverter () =
inherit JsonConverter<WebLogId> ()
override _.WriteJson (writer : JsonWriter, value : WebLogId, _ : JsonSerializer) =
@@ -133,6 +140,7 @@ module Json =
TagMapIdConverter ()
ThemeAssetIdConverter ()
ThemeIdConverter ()
UploadIdConverter ()
WebLogIdConverter ()
WebLogUserIdConverter ()
// Handles DUs with no associated data, as well as option fields

View File

@@ -9,244 +9,275 @@ open MyWebLog.ViewModels
type ICategoryData =
/// Add a category
abstract member add : Category -> Task<unit>
abstract member Add : Category -> Task<unit>
/// 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
abstract member countTopLevel : WebLogId -> Task<int>
abstract member CountTopLevel : WebLogId -> Task<int>
/// Delete a category (also removes it from posts)
abstract member delete : CategoryId -> WebLogId -> Task<bool>
abstract member Delete : CategoryId -> WebLogId -> Task<bool>
/// 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
abstract member findById : CategoryId -> WebLogId -> Task<Category option>
abstract member FindById : CategoryId -> WebLogId -> Task<Category option>
/// 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
abstract member restore : Category list -> Task<unit>
abstract member Restore : Category list -> Task<unit>
/// 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
type IPageData =
/// 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)
abstract member all : WebLogId -> Task<Page list>
abstract member All : WebLogId -> Task<Page list>
/// 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
abstract member countListed : WebLogId -> Task<int>
abstract member CountListed : WebLogId -> Task<int>
/// 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)
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)
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
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)
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)
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)
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)
abstract member findPageOfPages : WebLogId -> pageNbr : int -> Task<Page list>
abstract member FindPageOfPages : WebLogId -> pageNbr : int -> Task<Page list>
/// Restore pages from a backup
abstract member restore : Page list -> Task<unit>
abstract member Restore : Page list -> Task<unit>
/// Update a page
abstract member update : Page -> Task<unit>
abstract member Update : Page -> Task<unit>
/// 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
type IPostData =
/// Add a post
abstract member add : Post -> Task<unit>
abstract member Add : Post -> Task<unit>
/// Count posts by their status
abstract member countByStatus : PostStatus -> WebLogId -> Task<int>
abstract member CountByStatus : PostStatus -> WebLogId -> Task<int>
/// 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)
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
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)
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)
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)
abstract member findPageOfCategorizedPosts :
abstract member FindPageOfCategorizedPosts :
WebLogId -> CategoryId list -> pageNbr : int -> postsPerPage : int -> Task<Post list>
/// 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)
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)
abstract member findPageOfTaggedPosts :
abstract member FindPageOfTaggedPosts :
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)
abstract member findSurroundingPosts : WebLogId -> publishedOn : DateTime -> Task<Post option * Post option>
abstract member FindSurroundingPosts : WebLogId -> publishedOn : DateTime -> Task<Post option * Post option>
/// Restore posts from a backup
abstract member restore : Post list -> Task<unit>
abstract member Restore : Post list -> Task<unit>
/// Update a post
abstract member update : Post -> Task<unit>
abstract member Update : Post -> Task<unit>
/// 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
type ITagMapData =
/// 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
abstract member findById : TagMapId -> WebLogId -> Task<TagMap option>
abstract member FindById : TagMapId -> WebLogId -> Task<TagMap option>
/// 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
abstract member findByWebLog : WebLogId -> Task<TagMap list>
abstract member FindByWebLog : WebLogId -> Task<TagMap list>
/// 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
abstract member restore : TagMap list -> Task<unit>
abstract member Restore : TagMap list -> Task<unit>
/// Save a tag mapping (insert or update)
abstract member save : TagMap -> Task<unit>
abstract member Save : TagMap -> Task<unit>
/// Functions to manipulate themes
type IThemeData =
/// Retrieve all themes (except "admin")
abstract member all : unit -> Task<Theme list>
abstract member All : unit -> Task<Theme list>
/// 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)
abstract member findByIdWithoutText : ThemeId -> Task<Theme option>
abstract member FindByIdWithoutText : ThemeId -> Task<Theme option>
/// Save a theme (insert or update)
abstract member save : Theme -> Task<unit>
abstract member Save : Theme -> Task<unit>
/// Functions to manipulate theme assets
type IThemeAssetData =
/// 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
abstract member deleteByTheme : ThemeId -> Task<unit>
abstract member DeleteByTheme : ThemeId -> Task<unit>
/// 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)
abstract member findByTheme : ThemeId -> Task<ThemeAsset list>
abstract member FindByTheme : ThemeId -> Task<ThemeAsset list>
/// 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)
abstract member save : ThemeAsset -> Task<unit>
abstract member Save : ThemeAsset -> Task<unit>
/// Functions to manipulate uploaded files
type IUploadData =
/// Add an uploaded file
abstract member Add : Upload -> Task<unit>
/// Delete an uploaded file
abstract member Delete : UploadId -> WebLogId -> Task<Result<string, string>>
/// Find an uploaded file by its path for the given web log
abstract member FindByPath : string -> WebLogId -> Task<Upload option>
/// Find all uploaded files for a web log (excludes data)
abstract member FindByWebLog : WebLogId -> Task<Upload list>
/// Find all uploaded files for a web log
abstract member FindByWebLogWithData : WebLogId -> Task<Upload list>
/// Restore uploaded files from a backup
abstract member Restore : Upload list -> Task<unit>
/// Functions to manipulate web logs
type IWebLogData =
/// Add a web log
abstract member add : WebLog -> Task<unit>
abstract member Add : WebLog -> Task<unit>
/// 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
abstract member delete : WebLogId -> Task<unit>
abstract member Delete : WebLogId -> Task<unit>
/// 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
abstract member findById : WebLogId -> Task<WebLog option>
abstract member FindById : WebLogId -> Task<WebLog option>
/// 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)
abstract member updateSettings : WebLog -> Task<unit>
abstract member UpdateSettings : WebLog -> Task<unit>
/// Functions to manipulate web log users
type IWebLogUserData =
/// 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
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
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
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
abstract member findNames : WebLogId -> WebLogUserId list -> Task<MetaItem list>
abstract member FindNames : WebLogId -> WebLogUserId list -> Task<MetaItem list>
/// 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
abstract member update : WebLogUser -> Task<unit>
abstract member Update : WebLogUser -> Task<unit>
/// Data interface required for a myWebLog data implementation
@@ -270,6 +301,9 @@ type IData =
/// Theme asset data functions
abstract member ThemeAsset : IThemeAssetData
/// Uploaded file functions
abstract member Upload : IUploadData
/// Web log data functions
abstract member WebLog : IWebLogData
@@ -277,5 +311,5 @@ type IData =
abstract member WebLogUser : IWebLogUserData
/// Do any required start up data checks
abstract member startUp : unit -> Task<unit>
abstract member StartUp : unit -> Task<unit>

View File

@@ -11,12 +11,12 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.6" />
<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.7" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" />
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-05" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup>
@@ -31,6 +31,7 @@
<Compile Include="SQLite\SQLitePostData.fs" />
<Compile Include="SQLite\SQLiteTagMapData.fs" />
<Compile Include="SQLite\SQLiteThemeData.fs" />
<Compile Include="SQLite\SQLiteUploadData.fs" />
<Compile Include="SQLite\SQLiteWebLogData.fs" />
<Compile Include="SQLite\SQLiteWebLogUserData.fs" />
<Compile Include="SQLiteData.fs" />

File diff suppressed because it is too large Load Diff

View File

@@ -19,7 +19,7 @@ let diffLists<'T, 'U when 'U : equality> oldItems newItems (f : 'T -> 'U) =
/// Find meta items added and removed
let diffMetaItems (oldItems : MetaItem list) newItems =
diffLists oldItems newItems (fun item -> $"{item.name}|{item.value}")
diffLists oldItems newItems (fun item -> $"{item.Name}|{item.Value}")
/// Find the permalinks added and removed
let diffPermalinks oldLinks newLinks =
@@ -27,7 +27,7 @@ let diffPermalinks oldLinks newLinks =
/// Find the revisions added and removed
let diffRevisions oldRevs newRevs =
diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.asOf.Ticks}|{MarkupText.toString rev.text}")
diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.Ticks}|{MarkupText.toString rev.Text}")
/// Create a list of items from the given data reader
let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) =
@@ -39,8 +39,7 @@ let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (it : SqliteDataReader ->
if rdr.Read () then
let item = it rdr
if prop item = webLogId then Some item else None
else
None
else None
/// Execute a command that returns no data
let write (cmd : SqliteCommand) = backgroundTask {
@@ -101,134 +100,134 @@ module Map =
let tryTimeSpan col (rdr : SqliteDataReader) =
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
let toCategoryId = getString "id" >> CategoryId
/// Map an id field to a category ID
let toCategoryId rdr = getString "id" rdr |> CategoryId
/// Create a category from the current row in the given data reader
let toCategory (rdr : SqliteDataReader) : Category =
{ id = toCategoryId rdr
webLogId = WebLogId (getString "web_log_id" rdr)
name = getString "name" rdr
slug = getString "slug" rdr
description = tryString "description" rdr
parentId = tryString "parent_id" rdr |> Option.map CategoryId
let toCategory rdr : Category =
{ Id = toCategoryId rdr
WebLogId = getString "web_log_id" rdr |> WebLogId
Name = getString "name" rdr
Slug = getString "slug" rdr
Description = tryString "description" rdr
ParentId = tryString "parent_id" rdr |> Option.map CategoryId
}
/// Create a custom feed from the current row in the given data reader
let toCustomFeed (rdr : SqliteDataReader) : CustomFeed =
{ id = CustomFeedId (getString "id" rdr)
source = CustomFeedSource.parse (getString "source" rdr)
path = Permalink (getString "path" rdr)
podcast =
let toCustomFeed rdr : CustomFeed =
{ Id = getString "id" rdr |> CustomFeedId
Source = getString "source" rdr |> CustomFeedSource.parse
Path = getString "path" rdr |> Permalink
Podcast =
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
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 = getString "image_url" rdr |> Permalink
AppleCategory = getString "apple_category" rdr
AppleSubcategory = tryString "apple_subcategory" rdr
Explicit = getString "explicit" rdr |> ExplicitRating.parse
DefaultMediaType = tryString "default_media_type" rdr
MediaBaseUrl = tryString "media_base_url" rdr
PodcastGuid = tryGuid "podcast_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
let toMetaItem rdr : MetaItem =
{ Name = getString "name" rdr
Value = getString "value" rdr
}
/// 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
let toPage (rdr : SqliteDataReader) : Page =
let toPage rdr : Page =
{ Page.empty with
id = PageId (getString "id" rdr)
webLogId = WebLogId (getString "web_log_id" rdr)
authorId = WebLogUserId (getString "author_id" rdr)
title = getString "title" rdr
permalink = toPermalink rdr
publishedOn = getDateTime "published_on" rdr
updatedOn = getDateTime "updated_on" rdr
showInPageList = getBoolean "show_in_page_list" rdr
template = tryString "template" rdr
text = getString "page_text" rdr
Id = getString "id" rdr |> PageId
WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId
Title = getString "title" rdr
Permalink = toPermalink rdr
PublishedOn = getDateTime "published_on" rdr
UpdatedOn = getDateTime "updated_on" rdr
IsInPageList = getBoolean "is_in_page_list" rdr
Template = tryString "template" rdr
Text = getString "page_text" rdr
}
/// Create a post from the current row in the given data reader
let toPost (rdr : SqliteDataReader) : Post =
let toPost rdr : Post =
{ Post.empty with
id = PostId (getString "id" rdr)
webLogId = WebLogId (getString "web_log_id" rdr)
authorId = WebLogUserId (getString "author_id" rdr)
status = PostStatus.parse (getString "status" rdr)
title = getString "title" rdr
permalink = toPermalink rdr
publishedOn = tryDateTime "published_on" rdr
updatedOn = getDateTime "updated_on" rdr
template = tryString "template" rdr
text = getString "post_text" rdr
episode =
Id = getString "id" rdr |> PostId
WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId
Status = getString "status" rdr |> PostStatus.parse
Title = getString "title" rdr
Permalink = toPermalink rdr
PublishedOn = tryDateTime "published_on" rdr
UpdatedOn = getDateTime "updated_on" rdr
Template = tryString "template" rdr
Text = getString "post_text" rdr
Episode =
match tryString "media" rdr with
| Some media ->
Some {
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
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
let toRevision (rdr : SqliteDataReader) : Revision =
{ asOf = getDateTime "as_of" rdr
text = MarkupText.parse (getString "revision_text" rdr)
let toRevision rdr : Revision =
{ AsOf = getDateTime "as_of" rdr
Text = getString "revision_text" rdr |> MarkupText.parse
}
/// Create a tag mapping from the current row in the given data reader
let toTagMap (rdr : SqliteDataReader) : TagMap =
{ id = TagMapId (getString "id" rdr)
webLogId = WebLogId (getString "web_log_id" rdr)
tag = getString "tag" rdr
urlValue = getString "url_value" rdr
let toTagMap rdr : TagMap =
{ Id = getString "id" rdr |> TagMapId
WebLogId = getString "web_log_id" rdr |> WebLogId
Tag = getString "tag" rdr
UrlValue = getString "url_value" rdr
}
/// 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
id = ThemeId (getString "id" rdr)
name = getString "name" rdr
version = getString "version" rdr
Id = getString "id" rdr |> ThemeId
Name = getString "name" rdr
Version = getString "version" rdr
}
/// 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 =
if includeData then
use dataStream = new MemoryStream ()
@@ -237,51 +236,72 @@ module Map =
dataStream.ToArray ()
else
[||]
{ id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
updatedOn = getDateTime "updated_on" rdr
data = assetData
{ Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
UpdatedOn = getDateTime "updated_on" rdr
Data = assetData
}
/// Create a theme template from the current row in the given data reader
let toThemeTemplate (rdr : SqliteDataReader) : ThemeTemplate =
{ name = getString "name" rdr
text = getString "template" rdr
let toThemeTemplate rdr : ThemeTemplate =
{ Name = getString "name" rdr
Text = getString "template" rdr
}
/// Create an uploaded file from the current row in the given data reader
let toUpload includeData rdr : Upload =
let data =
if includeData then
use dataStream = new MemoryStream ()
use blobStream = getStream "data" rdr
blobStream.CopyTo dataStream
dataStream.ToArray ()
else
[||]
{ Id = getString "id" rdr |> UploadId
WebLogId = getString "web_log_id" rdr |> WebLogId
Path = getString "path" rdr |> Permalink
UpdatedOn = getDateTime "updated_on" rdr
Data = data
}
/// Create a web log from the current row in the given data reader
let toWebLog (rdr : SqliteDataReader) : WebLog =
{ id = WebLogId (getString "id" rdr)
name = getString "name" rdr
subtitle = tryString "subtitle" rdr
defaultPage = getString "default_page" rdr
postsPerPage = getInt "posts_per_page" rdr
themePath = getString "theme_id" rdr
urlBase = getString "url_base" rdr
timeZone = getString "time_zone" rdr
autoHtmx = getBoolean "auto_htmx" rdr
rss = {
feedEnabled = getBoolean "feed_enabled" rdr
feedName = getString "feed_name" rdr
itemsInFeed = tryInt "items_in_feed" rdr
categoryEnabled = getBoolean "category_enabled" rdr
tagEnabled = getBoolean "tag_enabled" rdr
copyright = tryString "copyright" rdr
customFeeds = []
let toWebLog rdr : WebLog =
{ Id = getString "id" rdr |> WebLogId
Name = getString "name" rdr
Slug = getString "slug" rdr
Subtitle = tryString "subtitle" rdr
DefaultPage = getString "default_page" rdr
PostsPerPage = getInt "posts_per_page" rdr
ThemeId = getString "theme_id" rdr |> ThemeId
UrlBase = getString "url_base" rdr
TimeZone = getString "time_zone" rdr
AutoHtmx = getBoolean "auto_htmx" rdr
Uploads = getString "uploads" rdr |> UploadDestination.parse
Rss = {
IsFeedEnabled = getBoolean "is_feed_enabled" rdr
FeedName = getString "feed_name" rdr
ItemsInFeed = tryInt "items_in_feed" rdr
IsCategoryEnabled = getBoolean "is_category_enabled" rdr
IsTagEnabled = getBoolean "is_tag_enabled" rdr
Copyright = tryString "copyright" rdr
CustomFeeds = []
}
}
/// Create a web log user from the current row in the given data reader
let toWebLogUser (rdr : SqliteDataReader) : WebLogUser =
{ id = WebLogUserId (getString "id" rdr)
webLogId = WebLogId (getString "web_log_id" rdr)
userName = getString "user_name" rdr
firstName = getString "first_name" rdr
lastName = getString "last_name" rdr
preferredName = getString "preferred_name" rdr
passwordHash = getString "password_hash" rdr
salt = getGuid "salt" rdr
url = tryString "url" rdr
authorizationLevel = AuthorizationLevel.parse (getString "authorization_level" rdr)
let toWebLogUser rdr : WebLogUser =
{ Id = getString "id" rdr |> WebLogUserId
WebLogId = getString "web_log_id" rdr |> WebLogId
Email = getString "email" rdr
FirstName = getString "first_name" rdr
LastName = getString "last_name" rdr
PreferredName = getString "preferred_name" rdr
PasswordHash = getString "password_hash" rdr
Salt = getGuid "salt" rdr
Url = tryString "url" rdr
AccessLevel = getString "access_level" rdr |> AccessLevel.parse
CreatedOn = getDateTime "created_on" rdr
LastSeenOn = tryDateTime "last_seen_on" rdr
}
/// Add a possibly-missing parameter, substituting null for None

View File

@@ -10,19 +10,19 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Add parameters for category INSERT or UPDATE statements
let addCategoryParameters (cmd : SqliteCommand) (cat : Category) =
[ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.webLogId)
cmd.Parameters.AddWithValue ("@name", cat.name)
cmd.Parameters.AddWithValue ("@slug", cat.slug)
cmd.Parameters.AddWithValue ("@description", maybe cat.description)
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.parentId |> Option.map CategoryId.toString))
[ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId)
cmd.Parameters.AddWithValue ("@name", cat.Name)
cmd.Parameters.AddWithValue ("@slug", cat.Slug)
cmd.Parameters.AddWithValue ("@description", maybe cat.Description)
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
] |> ignore
/// Add a category
let add cat = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""INSERT INTO category (
cmd.CommandText <- """
INSERT INTO category (
id, web_log_id, name, slug, description, parent_id
) VALUES (
@id, @webLogId, @name, @slug, @description, @parentId
@@ -60,7 +60,7 @@ type SQLiteCategoryData (conn : SqliteConnection) =
while rdr.Read () do
Map.toCategory rdr
}
|> Seq.sortBy (fun cat -> cat.name.ToLowerInvariant ())
|> Seq.sortBy (fun cat -> cat.Name.ToLowerInvariant ())
|> List.ofSeq
do! rdr.CloseAsync ()
let ordered = Utils.orderByHierarchy cats None None []
@@ -70,32 +70,32 @@ type SQLiteCategoryData (conn : SqliteConnection) =
// Parent category post counts include posts in subcategories
cmd.Parameters.Clear ()
addWebLogId cmd webLogId
cmd.CommandText <-
"""SELECT COUNT(DISTINCT p.id)
cmd.CommandText <- """
SELECT COUNT(DISTINCT p.id)
FROM post p
INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = 'Published'
AND pc.category_id IN ("""
ordered
|> Seq.filter (fun cat -> cat.parentNames |> Array.contains it.name)
|> Seq.map (fun cat -> cat.id)
|> Seq.append (Seq.singleton it.id)
|> 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
return it.id, postCount
return it.Id, postCount
})
|> Task.WhenAll
return
ordered
|> Seq.map (fun cat ->
{ cat with
postCount = counts
|> Array.tryFind (fun c -> fst c = cat.id)
PostCount = counts
|> Array.tryFind (fun c -> fst c = cat.Id)
|> Option.map snd
|> Option.defaultValue 0
})
@@ -107,7 +107,7 @@ type SQLiteCategoryData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT * FROM category WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) |> ignore
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
@@ -125,8 +125,8 @@ type SQLiteCategoryData (conn : SqliteConnection) =
| Some _ ->
use cmd = conn.CreateCommand ()
// Delete the category off all posts where it is assigned
cmd.CommandText <-
"""DELETE FROM post_category
cmd.CommandText <- """
DELETE FROM post_category
WHERE category_id = @id
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)"""
let catIdParameter = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
@@ -150,8 +150,8 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Update a category
let update cat = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE category
cmd.CommandText <- """
UPDATE category
SET name = @name,
slug = @slug,
description = @description,
@@ -163,12 +163,12 @@ type SQLiteCategoryData (conn : SqliteConnection) =
}
interface ICategoryData with
member _.add cat = add 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 = update cat
member _.Add cat = add 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 = update cat

View File

@@ -12,45 +12,45 @@ type SQLitePageData (conn : SqliteConnection) =
/// Add parameters for page INSERT or UPDATE statements
let addPageParameters (cmd : SqliteCommand) (page : Page) =
[ cmd.Parameters.AddWithValue ("@id", PageId.toString page.id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.webLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.authorId)
cmd.Parameters.AddWithValue ("@title", page.title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.permalink)
cmd.Parameters.AddWithValue ("@publishedOn", page.publishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", page.updatedOn)
cmd.Parameters.AddWithValue ("@showInPageList", page.showInPageList)
cmd.Parameters.AddWithValue ("@template", maybe page.template)
cmd.Parameters.AddWithValue ("@text", page.text)
[ cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId)
cmd.Parameters.AddWithValue ("@title", page.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", page.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", page.UpdatedOn)
cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
cmd.Parameters.AddWithValue ("@template", maybe page.Template)
cmd.Parameters.AddWithValue ("@text", page.Text)
] |> 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
cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return { page with metadata = toList Map.toMetaItem rdr }
return { page with Metadata = toList Map.toMetaItem rdr }
}
/// Append revisions and permalinks to a page
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
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"
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 ()
cmd.CommandText <- "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC"
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)
let pageWithoutTextOrMeta rdr =
{ Map.toPage rdr with text = "" }
{ Map.toPage rdr with Text = "" }
/// Update a page's metadata items
let updatePageMeta pageId oldItems newItems = backgroundTask {
@@ -64,8 +64,8 @@ type SQLitePageData (conn : SqliteConnection) =
cmd.Parameters.Add ("@value", SqliteType.Text)
] |> ignore
let runCmd (item : MetaItem) = backgroundTask {
cmd.Parameters["@name" ].Value <- item.name
cmd.Parameters["@value"].Value <- item.value
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"
@@ -116,9 +116,9 @@ type SQLitePageData (conn : SqliteConnection) =
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
cmd.Parameters.AddWithValue ("@asOf", rev.asOf)
cmd.Parameters.AddWithValue ("@asOf", rev.AsOf)
] |> 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
}
cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf"
@@ -139,19 +139,19 @@ type SQLitePageData (conn : SqliteConnection) =
let add page = backgroundTask {
use cmd = conn.CreateCommand ()
// The page itself
cmd.CommandText <-
"""INSERT INTO page (
id, web_log_id, author_id, title, permalink, published_on, updated_on, show_in_page_list,
template, page_text
cmd.CommandText <- """
INSERT INTO page (
id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template,
page_text
) VALUES (
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @showInPageList,
@template, @text
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template,
@text
)"""
addPageParameters cmd page
do! write cmd
do! updatePageMeta page.id [] page.metadata
do! updatePagePermalinks page.id [] page.priorPermalinks
do! updatePageRevisions page.id [] page.revisions
do! updatePageMeta page.Id [] page.Metadata
do! updatePagePermalinks page.Id [] page.PriorPermalinks
do! updatePageRevisions page.Id [] page.Revisions
}
/// Get all pages for a web log (without text, revisions, prior permalinks, or metadata)
@@ -174,13 +174,13 @@ type SQLitePageData (conn : SqliteConnection) =
/// Count all pages shown in the page list for the given web log
let countListed webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""SELECT COUNT(id)
cmd.CommandText <- """
SELECT COUNT(id)
FROM page
WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList"""
AND is_in_page_list = @isInPageList"""
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
return! count cmd
}
@@ -190,7 +190,7 @@ type SQLitePageData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT * FROM page WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
match Helpers.verifyWebLog<Page> webLogId (fun it -> it.webLogId) Map.toPage rdr with
match Helpers.verifyWebLog<Page> webLogId (fun it -> it.WebLogId) Map.toPage rdr with
| Some page ->
let! page = appendPageMeta page
return Some page
@@ -211,8 +211,8 @@ type SQLitePageData (conn : SqliteConnection) =
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
cmd.CommandText <-
"""DELETE FROM page_revision WHERE page_id = @id;
cmd.CommandText <- """
DELETE FROM page_revision 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"""
@@ -238,8 +238,8 @@ type SQLitePageData (conn : SqliteConnection) =
/// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""SELECT p.permalink
cmd.CommandText <- """
SELECT p.permalink
FROM page p
INNER JOIN page_permalink pp ON pp.page_id = p.id
WHERE p.web_log_id = @webLogId
@@ -274,14 +274,14 @@ type SQLitePageData (conn : SqliteConnection) =
/// Get all listed pages for the given web log (without revisions, prior permalinks, or text)
let findListed webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""SELECT *
cmd.CommandText <- """
SELECT *
FROM page
WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList
AND is_in_page_list = @isInPageList
ORDER BY LOWER(title)"""
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! pages =
toList pageWithoutTextOrMeta rdr
@@ -293,8 +293,8 @@ type SQLitePageData (conn : SqliteConnection) =
/// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata)
let findPageOfPages webLogId pageNbr = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""SELECT *
cmd.CommandText <- """
SELECT *
FROM page
WHERE web_log_id = @webLogId
ORDER BY LOWER(title)
@@ -315,26 +315,26 @@ type SQLitePageData (conn : SqliteConnection) =
/// Update a page
let update (page : Page) = backgroundTask {
match! findFullById page.id page.webLogId with
match! findFullById page.Id page.WebLogId with
| Some oldPage ->
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE page
cmd.CommandText <- """
UPDATE page
SET author_id = @authorId,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
show_in_page_list = @showInPageList,
is_in_page_list = @isInPageList,
template = @template,
page_text = @text
WHERE id = @pageId
AND web_log_id = @webLogId"""
addPageParameters cmd page
do! write cmd
do! updatePageMeta page.id oldPage.metadata page.metadata
do! updatePagePermalinks page.id oldPage.priorPermalinks page.priorPermalinks
do! updatePageRevisions page.id oldPage.revisions page.revisions
do! updatePageMeta page.Id oldPage.Metadata page.Metadata
do! updatePagePermalinks page.Id oldPage.PriorPermalinks page.PriorPermalinks
do! updatePageRevisions page.Id oldPage.Revisions page.Revisions
return ()
| None -> return ()
}
@@ -343,24 +343,24 @@ type SQLitePageData (conn : SqliteConnection) =
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
match! findFullById pageId webLogId with
| Some page ->
do! updatePagePermalinks pageId page.priorPermalinks permalinks
do! updatePagePermalinks pageId page.PriorPermalinks permalinks
return true
| None -> return false
}
interface IPageData with
member _.add page = add 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 = update page
member _.updatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks
member _.Add page = add 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 = update page
member _.UpdatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks

View File

@@ -13,77 +13,89 @@ type SQLitePostData (conn : SqliteConnection) =
/// Add parameters for post INSERT or UPDATE statements
let addPostParameters (cmd : SqliteCommand) (post : Post) =
[ cmd.Parameters.AddWithValue ("@id", PostId.toString post.id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.webLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.authorId)
cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.status)
cmd.Parameters.AddWithValue ("@title", post.title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.permalink)
cmd.Parameters.AddWithValue ("@publishedOn", maybe post.publishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", post.updatedOn)
cmd.Parameters.AddWithValue ("@template", maybe post.template)
cmd.Parameters.AddWithValue ("@text", post.text)
[ cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId)
cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status)
cmd.Parameters.AddWithValue ("@title", post.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", maybe post.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", post.UpdatedOn)
cmd.Parameters.AddWithValue ("@template", maybe post.Template)
cmd.Parameters.AddWithValue ("@text", post.Text)
] |> ignore
/// Add parameters for episode INSERT or UPDATE statements
let addEpisodeParameters (cmd : SqliteCommand) (ep : Episode) =
[ 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)
[ 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 ()
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"
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 ()
cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync ()
let post = { post with tags = toList (Map.getString "tag") rdr }
let post = { 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 }
return { post with Metadata = toList Map.toMetaItem rdr }
}
/// Append revisions and permalinks to a post
let appendPostRevisionsAndPermalinks (post : Post) = backgroundTask {
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"
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 ()
cmd.CommandText <- "SELECT as_of, revision_text FROM post_revision WHERE post_id = @postId ORDER BY as_of DESC"
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.*, e.* FROM post p LEFT JOIN post_episode e ON e.post_id = p.id"
/// 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) Map.toPost rdr
}
/// Return a post with no revisions, prior permalinks, or text
let postWithoutText rdr =
{ Map.toPost rdr with text = "" }
{ Map.toPost rdr with Text = "" }
/// Update a post's assigned categories
let updatePostCategories postId oldCats newCats = backgroundTask {
@@ -141,13 +153,13 @@ type SQLitePostData (conn : SqliteConnection) =
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
cmd.Parameters.AddWithValue ("@postId", PostId.toString post.Id) |> ignore
let! count = count cmd
if count = 1 then
match post.episode with
match post.Episode with
| Some ep ->
cmd.CommandText <-
"""UPDATE post_episode
cmd.CommandText <- """
UPDATE post_episode
SET media = @media,
length = @length,
duration = @duration,
@@ -172,17 +184,17 @@ type SQLitePostData (conn : SqliteConnection) =
cmd.CommandText <- "DELETE FROM post_episode WHERE post_id = @postId"
do! write cmd
else
match post.episode with
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
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
@postId, @media, @length, @duration, @mediaType, @imageUrl, @subtitle, @explicit, @chapterFile,
@chapterType, @transcriptUrl, @transcriptType, @transcriptLang, @transcriptCaptions,
@seasonNumber, @seasonDescription, @episodeNumber, @episodeDescription
)"""
addEpisodeParameters cmd ep
do! write cmd
@@ -201,8 +213,8 @@ type SQLitePostData (conn : SqliteConnection) =
cmd.Parameters.Add ("@value", SqliteType.Text)
] |> ignore
let runCmd (item : MetaItem) = backgroundTask {
cmd.Parameters["@name" ].Value <- item.name
cmd.Parameters["@value"].Value <- item.value
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"
@@ -253,9 +265,9 @@ type SQLitePostData (conn : SqliteConnection) =
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.AddWithValue ("@asOf", rev.asOf)
cmd.Parameters.AddWithValue ("@asOf", rev.AsOf)
] |> 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
}
cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf"
@@ -270,30 +282,25 @@ type SQLitePostData (conn : SqliteConnection) =
|> 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
/// Add a post
let add post = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""INSERT INTO post (
id, web_log_id, author_id, status, title, permalink, published_on, updated_on,
template, post_text
cmd.CommandText <- """
INSERT INTO post (
id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text
) VALUES (
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn,
@template, @text
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text
)"""
addPostParameters cmd post
do! write cmd
do! updatePostCategories post.id [] post.categoryIds
do! updatePostTags post.id [] post.tags
do! updatePostCategories post.Id [] post.CategoryIds
do! updatePostTags post.Id [] post.Tags
do! updatePostEpisode post
do! updatePostMeta post.id [] post.metadata
do! updatePostPermalinks post.id [] post.priorPermalinks
do! updatePostRevisions post.id [] post.revisions
do! updatePostMeta post.Id [] post.Metadata
do! updatePostPermalinks post.Id [] post.PriorPermalinks
do! updatePostRevisions post.Id [] post.Revisions
}
/// Count posts in a status for the given web log
@@ -305,6 +312,15 @@ type SQLitePostData (conn : SqliteConnection) =
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 = appendPostCategoryTagAndMeta post
return Some post
| None -> return None
}
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink permalink webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
@@ -321,17 +337,11 @@ type SQLitePostData (conn : SqliteConnection) =
/// Find a complete post by its ID for the given web log
let findFullById 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 ()
match Helpers.verifyWebLog<Post> webLogId (fun p -> p.webLogId) Map.toPost rdr with
match! findById postId webLogId with
| Some post ->
let! post = appendPostCategoryTagAndMeta post
let! post = appendPostRevisionsAndPermalinks post
return Some post
| None ->
return None
| None -> return None
}
/// Delete a post by its ID for the given web log
@@ -340,8 +350,8 @@ type SQLitePostData (conn : SqliteConnection) =
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
cmd.CommandText <-
"""DELETE FROM post_revision WHERE post_id = @id;
cmd.CommandText <- """
DELETE FROM post_revision WHERE post_id = @id;
DELETE FROM post_permalink WHERE post_id = @id;
DELETE FROM post_meta WHERE post_id = @id;
DELETE FROM post_episode WHERE post_id = @id;
@@ -356,8 +366,8 @@ type SQLitePostData (conn : SqliteConnection) =
/// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""SELECT p.permalink
cmd.CommandText <- """
SELECT p.permalink
FROM post p
INNER JOIN post_permalink pp ON pp.post_id = p.id
WHERE p.web_log_id = @webLogId
@@ -392,8 +402,8 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
$"""{selectPost}
cmd.CommandText <- $"""
{selectPost}
INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = @status
@@ -420,8 +430,8 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks)
let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
$"""{selectPost}
cmd.CommandText <- $"""
{selectPost}
WHERE p.web_log_id = @webLogId
ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
@@ -437,8 +447,8 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of published posts for the given web log (excludes revisions and prior permalinks)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
$"""{selectPost}
cmd.CommandText <- $"""
{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
ORDER BY p.published_on DESC
@@ -456,8 +466,8 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
$"""{selectPost}
cmd.CommandText <- $"""
{selectPost}
INNER JOIN post_tag pt ON pt.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = @status
@@ -479,8 +489,8 @@ type SQLitePostData (conn : SqliteConnection) =
/// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
$"""{selectPost}
cmd.CommandText <- $"""
{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND p.published_on < @publishedOn
@@ -499,8 +509,8 @@ type SQLitePostData (conn : SqliteConnection) =
return None
}
do! rdr.CloseAsync ()
cmd.CommandText <-
$"""{selectPost}
cmd.CommandText <- $"""
{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND p.published_on > @publishedOn
@@ -525,11 +535,11 @@ type SQLitePostData (conn : SqliteConnection) =
/// Update a post
let update (post : Post) = backgroundTask {
match! findFullById post.id post.webLogId with
match! findFullById post.Id post.WebLogId with
| Some oldPost ->
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE post
cmd.CommandText <- """
UPDATE post
SET author_id = @authorId,
status = @status,
title = @title,
@@ -542,12 +552,12 @@ type SQLitePostData (conn : SqliteConnection) =
AND web_log_id = @webLogId"""
addPostParameters cmd post
do! write cmd
do! updatePostCategories post.id oldPost.categoryIds post.categoryIds
do! updatePostTags post.id oldPost.tags post.tags
do! updatePostCategories post.Id oldPost.CategoryIds post.CategoryIds
do! updatePostTags post.Id oldPost.Tags post.Tags
do! updatePostEpisode post
do! updatePostMeta post.id oldPost.metadata post.metadata
do! updatePostPermalinks post.id oldPost.priorPermalinks post.priorPermalinks
do! updatePostRevisions post.id oldPost.revisions post.revisions
do! updatePostMeta post.Id oldPost.Metadata post.Metadata
do! updatePostPermalinks post.Id oldPost.PriorPermalinks post.PriorPermalinks
do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
| None -> return ()
}
@@ -555,27 +565,28 @@ type SQLitePostData (conn : SqliteConnection) =
let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
match! findFullById postId webLogId with
| Some post ->
do! updatePostPermalinks postId post.priorPermalinks permalinks
do! updatePostPermalinks postId post.PriorPermalinks permalinks
return true
| None -> return false
}
interface IPostData with
member _.add post = add post
member _.countByStatus status webLogId = countByStatus status webLogId
member _.delete postId webLogId = delete 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 =
member _.Add post = add 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 =
member _.FindPageOfPosts webLogId pageNbr postsPerPage = findPageOfPosts webLogId pageNbr postsPerPage
member _.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
member _.findSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn
member _.restore posts = restore posts
member _.update post = update post
member _.updatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks
member _.FindSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn
member _.Restore posts = restore posts
member _.Update post = update post
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.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore
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
@@ -50,8 +50,8 @@ type SQLiteTagMapData (conn : SqliteConnection) =
/// Find any tag mappings in a list of tags for the given web log
let findMappingForTags (tags : string list) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""SELECT *
cmd.CommandText <- """
SELECT *
FROM tag_map
WHERE web_log_id = @webLogId
AND tag IN ("""
@@ -69,25 +69,25 @@ type SQLiteTagMapData (conn : SqliteConnection) =
/// Save a tag mapping
let save (tagMap : TagMap) = backgroundTask {
use cmd = conn.CreateCommand ()
match! findById tagMap.id tagMap.webLogId with
match! findById tagMap.Id tagMap.WebLogId with
| Some _ ->
cmd.CommandText <-
"""UPDATE tag_map
cmd.CommandText <- """
UPDATE tag_map
SET tag = @tag,
url_value = @urlValue
WHERE id = @id
AND web_log_id = @webLogId"""
| None ->
cmd.CommandText <-
"""INSERT INTO tag_map (
cmd.CommandText <- """
INSERT INTO tag_map (
id, web_log_id, tag, url_value
) VALUES (
@id, @webLogId, @tag, @urlValue
)"""
addWebLogId cmd tagMap.webLogId
[ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.id)
cmd.Parameters.AddWithValue ("@tag", tagMap.tag)
cmd.Parameters.AddWithValue ("@urlValue", tagMap.urlValue)
addWebLogId cmd tagMap.WebLogId
[ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id)
cmd.Parameters.AddWithValue ("@tag", tagMap.Tag)
cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue)
] |> ignore
do! write cmd
}
@@ -99,10 +99,10 @@ type SQLiteTagMapData (conn : SqliteConnection) =
}
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 this.restore tagMaps = restore tagMaps
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

@@ -28,7 +28,7 @@ type SQLiteThemeData (conn : SqliteConnection) =
templateCmd.CommandText <- "SELECT * FROM theme_template WHERE theme_id = @id"
templateCmd.Parameters.Add cmd.Parameters["@id"] |> ignore
use! templateRdr = templateCmd.ExecuteReaderAsync ()
return Some { theme with templates = toList Map.toThemeTemplate templateRdr }
return Some { theme with Templates = toList Map.toThemeTemplate templateRdr }
else
return None
}
@@ -38,7 +38,7 @@ type SQLiteThemeData (conn : SqliteConnection) =
match! findById themeId with
| Some theme ->
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
}
@@ -46,36 +46,36 @@ type SQLiteThemeData (conn : SqliteConnection) =
/// Save a theme
let save (theme : Theme) = backgroundTask {
use cmd = conn.CreateCommand ()
let! oldTheme = findById theme.id
let! oldTheme = findById theme.Id
cmd.CommandText <-
match oldTheme with
| Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id"
| None -> "INSERT INTO theme VALUES (@id, @name, @version)"
[ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.id)
cmd.Parameters.AddWithValue ("@name", theme.name)
cmd.Parameters.AddWithValue ("@version", theme.version)
[ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.Id)
cmd.Parameters.AddWithValue ("@name", theme.Name)
cmd.Parameters.AddWithValue ("@version", theme.Version)
] |> ignore
do! write cmd
let toDelete, toAdd =
diffLists (oldTheme |> Option.map (fun t -> t.templates) |> Option.defaultValue [])
theme.templates (fun t -> t.name)
diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue [])
theme.Templates (fun t -> t.Name)
let toUpdate =
theme.templates
theme.Templates
|> List.filter (fun t ->
not (toDelete |> List.exists (fun d -> d.name = t.name))
&& not (toAdd |> List.exists (fun a -> a.name = t.name)))
not (toDelete |> List.exists (fun d -> d.Name = t.Name))
&& not (toAdd |> List.exists (fun a -> a.Name = t.Name)))
cmd.CommandText <-
"UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name"
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 ("@template", SqliteType.Text)
] |> ignore
toUpdate
|> List.map (fun template -> backgroundTask {
cmd.Parameters["@name" ].Value <- template.name
cmd.Parameters["@template"].Value <- template.text
cmd.Parameters["@name" ].Value <- template.Name
cmd.Parameters["@template"].Value <- template.Text
do! write cmd
})
|> Task.WhenAll
@@ -83,8 +83,8 @@ type SQLiteThemeData (conn : SqliteConnection) =
cmd.CommandText <- "INSERT INTO theme_template VALUES (@themeId, @name, @template)"
toAdd
|> List.map (fun template -> backgroundTask {
cmd.Parameters["@name" ].Value <- template.name
cmd.Parameters["@template"].Value <- template.text
cmd.Parameters["@name" ].Value <- template.Name
cmd.Parameters["@template"].Value <- template.Text
do! write cmd
})
|> Task.WhenAll
@@ -93,7 +93,7 @@ type SQLiteThemeData (conn : SqliteConnection) =
cmd.Parameters.Remove cmd.Parameters["@template"]
toDelete
|> List.map (fun template -> backgroundTask {
cmd.Parameters["@name"].Value <- template.name
cmd.Parameters["@name"].Value <- template.Name
do! write cmd
})
|> Task.WhenAll
@@ -101,10 +101,10 @@ type SQLiteThemeData (conn : SqliteConnection) =
}
interface IThemeData with
member _.all () = all ()
member _.findById themeId = findById themeId
member _.findByIdWithoutText themeId = findByIdWithoutText themeId
member _.save theme = save theme
member _.All () = all ()
member _.FindById themeId = findById themeId
member _.FindByIdWithoutText themeId = findByIdWithoutText themeId
member _.Save theme = save theme
open System.IO
@@ -163,7 +163,7 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
use sideCmd = conn.CreateCommand ()
sideCmd.CommandText <-
"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 ("@path", path)
] |> ignore
@@ -185,23 +185,23 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
)"""
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
cmd.Parameters.AddWithValue ("@path", path)
cmd.Parameters.AddWithValue ("@updatedOn", asset.updatedOn)
cmd.Parameters.AddWithValue ("@dataLength", asset.data.Length)
cmd.Parameters.AddWithValue ("@updatedOn", asset.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length)
] |> ignore
do! write cmd
sideCmd.CommandText <- "SELECT ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
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)
do! dataStream.CopyToAsync blobStream
}
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
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,101 @@
namespace MyWebLog.Data.SQLite
open System.IO
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
/// SQLite myWebLog web log data implementation
type SQLiteUploadData (conn : SqliteConnection) =
/// Add parameters for uploaded file INSERT and UPDATE statements
let addUploadParameters (cmd : SqliteCommand) (upload : Upload) =
[ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId)
cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.Path)
cmd.Parameters.AddWithValue ("@updatedOn", upload.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length)
] |> ignore
/// Save an uploaded file
let add upload = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
INSERT INTO upload (
id, web_log_id, path, updated_on, data
) VALUES (
@id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength)
)"""
addUploadParameters cmd upload
do! write cmd
cmd.CommandText <- "SELECT ROWID FROM upload WHERE id = @id"
let! rowId = cmd.ExecuteScalarAsync ()
use dataStream = new MemoryStream (upload.Data)
use blobStream = new SqliteBlob (conn, "upload", "data", rowId :?> int64)
do! dataStream.CopyToAsync blobStream
}
/// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
SELECT id, web_log_id, path, updated_on
FROM upload
WHERE id = @id
AND web_log_id = @webLogId"""
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@id", UploadId.toString uploadId) |> ignore
let! rdr = cmd.ExecuteReaderAsync ()
if (rdr.Read ()) then
let upload = Map.toUpload false rdr
do! rdr.CloseAsync ()
cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
do! write cmd
return Ok (Permalink.toString upload.Path)
else
return Error $"""Upload ID {cmd.Parameters["@id"]} not found"""
}
/// Find an uploaded file by its path for the given web log
let findByPath (path : string) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT *, ROWID FROM upload WHERE web_log_id = @webLogId AND path = @path"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@path", path) |> ignore
let! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toUpload true rdr) else None
}
/// Find all uploaded files for the given web log (excludes data)
let findByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT id, web_log_id, path, updated_on FROM upload WHERE web_log_id = @webLogId"
addWebLogId cmd webLogId
let! rdr = cmd.ExecuteReaderAsync ()
return toList (Map.toUpload false) rdr
}
/// Find all uploaded files for the given web log
let findByWebLogWithData webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT *, ROWID FROM upload WHERE web_log_id = @webLogId"
addWebLogId cmd webLogId
let! rdr = cmd.ExecuteReaderAsync ()
return toList (Map.toUpload true) rdr
}
/// Restore uploads from a backup
let restore uploads = backgroundTask {
for upload in uploads do do! add upload
}
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

@@ -15,66 +15,68 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Add parameters for web log INSERT or web log/RSS options UPDATE statements
let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@feedEnabled", webLog.rss.feedEnabled)
cmd.Parameters.AddWithValue ("@feedName", webLog.rss.feedName)
cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.rss.itemsInFeed)
cmd.Parameters.AddWithValue ("@categoryEnabled", webLog.rss.categoryEnabled)
cmd.Parameters.AddWithValue ("@tagEnabled", webLog.rss.tagEnabled)
cmd.Parameters.AddWithValue ("@copyright", maybe webLog.rss.copyright)
[ cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled)
cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName)
cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed)
cmd.Parameters.AddWithValue ("@isCategoryEnabled", webLog.Rss.IsCategoryEnabled)
cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled)
cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright)
] |> ignore
/// Add parameters for web log INSERT or UPDATE statements
let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.id)
cmd.Parameters.AddWithValue ("@name", webLog.name)
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.subtitle)
cmd.Parameters.AddWithValue ("@defaultPage", webLog.defaultPage)
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.postsPerPage)
cmd.Parameters.AddWithValue ("@themeId", webLog.themePath)
cmd.Parameters.AddWithValue ("@urlBase", webLog.urlBase)
cmd.Parameters.AddWithValue ("@timeZone", webLog.timeZone)
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.autoHtmx)
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id)
cmd.Parameters.AddWithValue ("@name", webLog.Name)
cmd.Parameters.AddWithValue ("@slug", webLog.Slug)
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle)
cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage)
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage)
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId)
cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase)
cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone)
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx)
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads)
] |> ignore
addWebLogRssParameters cmd webLog
/// Add parameters for custom feed INSERT or UPDATE statements
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 ("@source", CustomFeedSource.toString feed.source)
cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.path)
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source)
cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path)
] |> ignore
/// Add parameters for podcast INSERT or UPDATE statements
let addPodcastParameters (cmd : SqliteCommand) feedId (podcast : PodcastOptions) =
[ cmd.Parameters.AddWithValue ("@feedId", CustomFeedId.toString feedId)
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))
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 ("@appleCategory", podcast.AppleCategory)
cmd.Parameters.AddWithValue ("@appleSubcategory", maybe podcast.AppleSubcategory)
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 ("@podcastGuid", maybe podcast.PodcastGuid)
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
let getCustomFeeds (webLog : WebLog) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""SELECT f.*, p.*
cmd.CommandText <- """
SELECT f.*, p.*
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
addWebLogId cmd webLog.Id
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toCustomFeed rdr
}
@@ -82,21 +84,21 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// 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 } }
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
cmd.CommandText <- """
INSERT INTO web_log_feed_podcast (
feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url,
apple_category, apple_subcategory, explicit, default_media_type, media_base_url, podcast_guid,
funding_url, funding_text, medium
) VALUES (
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email,
@imageUrl, @iTunesCategory, @iTunesSubcategory, @explicit, @defaultMediaType,
@mediaBaseUrl, @guid, @fundingUrl, @fundingText, @medium
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl,
@appleCategory, @appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @podcastGuid,
@fundingUrl, @fundingText, @medium
)"""
addPodcastParameters cmd feedId podcast
do! write cmd
@@ -105,20 +107,20 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Update the custom feeds for a web log
let updateCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog
let toDelete, toAdd = diffLists feeds webLog.rss.customFeeds (fun it -> $"{CustomFeedId.toString it.id}")
let toId (feed : CustomFeed) = feed.id
let toDelete, toAdd = diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
let toId (feed : CustomFeed) = feed.Id
let toUpdate =
webLog.rss.customFeeds
webLog.Rss.CustomFeeds
|> 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 ()
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
toDelete
|> List.map (fun it -> backgroundTask {
cmd.CommandText <-
"""DELETE FROM web_log_feed_podcast WHERE feed_id = @id;
cmd.CommandText <- """
DELETE FROM web_log_feed_podcast WHERE feed_id = @id;
DELETE FROM web_log_feed WHERE id = @id"""
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.id
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id
do! write cmd
})
|> Task.WhenAll
@@ -126,38 +128,38 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.Parameters.Clear ()
toAdd
|> List.map (fun it -> backgroundTask {
cmd.CommandText <-
"""INSERT INTO web_log_feed (
cmd.CommandText <- """
INSERT INTO web_log_feed (
id, web_log_id, source, path
) VALUES (
@id, @webLogId, @source, @path
)"""
cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.id it
addCustomFeedParameters cmd webLog.Id it
do! write cmd
match it.podcast with
| Some podcast -> do! addPodcast it.id podcast
match it.Podcast with
| Some podcast -> do! addPodcast it.Id podcast
| None -> ()
})
|> Task.WhenAll
|> ignore
toUpdate
|> List.map (fun it -> backgroundTask {
cmd.CommandText <-
"""UPDATE web_log_feed
cmd.CommandText <- """
UPDATE web_log_feed
SET source = @source,
path = @path
WHERE id = @id
AND web_log_id = @webLogId"""
cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.id it
addCustomFeedParameters cmd webLog.Id it
do! write cmd
let hadPodcast = Option.isSome (feeds |> List.find (fun f -> f.id = it.id)).podcast
match it.podcast with
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
cmd.CommandText <- """
UPDATE web_log_feed_podcast
SET title = @title,
subtitle = @subtitle,
items_in_feed = @itemsInFeed,
@@ -165,26 +167,26 @@ type SQLiteWebLogData (conn : SqliteConnection) =
displayed_author = @displayedAuthor,
email = @email,
image_url = @imageUrl,
itunes_category = @iTunesCategory,
itunes_subcategory = @iTunesSubcategory,
apple_category = @appleCategory,
apple_subcategory = @appleSubcategory,
explicit = @explicit,
default_media_type = @defaultMediaType,
media_base_url = @mediaBaseUrl,
guid = @guid,
podcast_guid = @podcastGuid,
funding_url = @fundingUrl,
funding_text = @fundingText,
medium = @medium
WHERE feed_id = @feedId"""
cmd.Parameters.Clear ()
addPodcastParameters cmd it.id podcast
addPodcastParameters cmd it.Id podcast
do! write cmd
else
do! addPodcast it.id podcast
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
cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString it.Id) |> ignore
do! write cmd
else
()
@@ -198,15 +200,13 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Add a web log
let add webLog = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""INSERT INTO web_log (
id, name, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone,
auto_htmx, feed_enabled, feed_name, items_in_feed, category_enabled, tag_enabled,
copyright
cmd.CommandText <- """
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, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone,
@autoHtmx, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled,
@copyright
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
@uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
)"""
addWebLogParameters cmd webLog
do! write cmd
@@ -232,8 +232,8 @@ type SQLiteWebLogData (conn : SqliteConnection) =
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
let postSubQuery = subQuery "post"
let pageSubQuery = subQuery "page"
cmd.CommandText <-
$"""DELETE FROM post_comment WHERE post_id IN {postSubQuery};
cmd.CommandText <- $"""
DELETE FROM post_comment 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_episode WHERE post_id IN {postSubQuery};
@@ -247,6 +247,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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_podcast WHERE feed_id IN {subQuery "web_log_feed"};
DELETE FROM web_log_feed WHERE web_log_id = @webLogId;
@@ -283,9 +284,10 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Update settings for a web log
let updateSettings webLog = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE web_log
cmd.CommandText <- """
UPDATE web_log
SET name = @name,
slug = @slug,
subtitle = @subtitle,
default_page = @defaultPage,
posts_per_page = @postsPerPage,
@@ -293,11 +295,12 @@ type SQLiteWebLogData (conn : SqliteConnection) =
url_base = @urlBase,
time_zone = @timeZone,
auto_htmx = @autoHtmx,
feed_enabled = @feedEnabled,
uploads = @uploads,
is_feed_enabled = @isFeedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
category_enabled = @categoryEnabled,
tag_enabled = @tagEnabled,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright
WHERE id = @id"""
addWebLogParameters cmd webLog
@@ -307,13 +310,13 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Update RSS options for a web log
let updateRssOptions webLog = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE web_log
SET feed_enabled = @feedEnabled,
cmd.CommandText <- """
UPDATE web_log
SET is_feed_enabled = @isFeedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
category_enabled = @categoryEnabled,
tag_enabled = @tagEnabled,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright
WHERE id = @id"""
addWebLogRssParameters cmd webLog
@@ -322,10 +325,10 @@ type SQLiteWebLogData (conn : SqliteConnection) =
}
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
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

@@ -1,5 +1,6 @@
namespace MyWebLog.Data.SQLite
open System
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
@@ -11,16 +12,18 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Add parameters for web log user INSERT or UPDATE statements
let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) =
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.webLogId)
cmd.Parameters.AddWithValue ("@userName", user.userName)
cmd.Parameters.AddWithValue ("@firstName", user.firstName)
cmd.Parameters.AddWithValue ("@lastName", user.lastName)
cmd.Parameters.AddWithValue ("@preferredName", user.preferredName)
cmd.Parameters.AddWithValue ("@passwordHash", user.passwordHash)
cmd.Parameters.AddWithValue ("@salt", user.salt)
cmd.Parameters.AddWithValue ("@url", maybe user.url)
cmd.Parameters.AddWithValue ("@authorizationLevel", AuthorizationLevel.toString user.authorizationLevel)
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.WebLogId)
cmd.Parameters.AddWithValue ("@email", user.Email)
cmd.Parameters.AddWithValue ("@firstName", user.FirstName)
cmd.Parameters.AddWithValue ("@lastName", user.LastName)
cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName)
cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash)
cmd.Parameters.AddWithValue ("@salt", user.Salt)
cmd.Parameters.AddWithValue ("@url", maybe user.Url)
cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel)
cmd.Parameters.AddWithValue ("@createdOn", user.CreatedOn)
cmd.Parameters.AddWithValue ("@lastSeenOn", maybe user.LastSeenOn)
] |> ignore
// IMPLEMENTATION FUNCTIONS
@@ -28,42 +31,60 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Add a user
let add user = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""INSERT INTO web_log_user (
id, web_log_id, user_name, first_name, last_name, preferred_name, password_hash, salt,
url, authorization_level
cmd.CommandText <- """
INSERT INTO web_log_user (
id, web_log_id, email, first_name, last_name, preferred_name, password_hash, salt, url, access_level,
created_on, last_seen_on
) VALUES (
@id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash, @salt,
@url, @authorizationLevel
@id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel,
@createdOn, @lastSeenOn
)"""
addWebLogUserParameters cmd user
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
let findById userId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore
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
let findByWebLog webLogId = backgroundTask {
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
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toWebLogUser rdr
@@ -83,7 +104,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
use! rdr = cmd.ExecuteReaderAsync ()
return
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
@@ -92,19 +113,37 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
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", DateTime.UtcNow)
] |> ignore
let! _ = cmd.ExecuteNonQueryAsync ()
()
}
/// Update a user
let update user = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE web_log_user
SET user_name = @userName,
cmd.CommandText <- """
UPDATE web_log_user
SET email = @email,
first_name = @firstName,
last_name = @lastName,
preferred_name = @preferredName,
password_hash = @passwordHash,
salt = @salt,
url = @url,
authorization_level = @authorizationLevel
access_level = @accessLevel,
created_on = @createdOn,
last_seen_on = @lastSeenOn
WHERE id = @id
AND web_log_id = @webLogId"""
addWebLogUserParameters cmd user
@@ -112,10 +151,12 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
}
interface IWebLogUserData with
member _.add user = add user
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 this.restore users = restore users
member _.update user = update user
member _.Add user = add 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 = update user

View File

@@ -36,10 +36,11 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
member _.TagMap = SQLiteTagMapData conn
member _.Theme = SQLiteThemeData conn
member _.ThemeAsset = SQLiteThemeAssetData conn
member _.Upload = SQLiteUploadData conn
member _.WebLog = SQLiteWebLogData conn
member _.WebLogUser = SQLiteWebLogUserData conn
member _.startUp () = backgroundTask {
member _.StartUp () = backgroundTask {
use cmd = conn.CreateCommand ()
@@ -48,8 +49,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating theme table..."
cmd.CommandText <-
"""CREATE TABLE theme (
cmd.CommandText <- """
CREATE TABLE theme (
id TEXT PRIMARY KEY,
name TEXT NOT NULL,
version TEXT NOT NULL)"""
@@ -58,8 +59,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating theme_template table..."
cmd.CommandText <-
"""CREATE TABLE theme_template (
cmd.CommandText <- """
CREATE TABLE theme_template (
theme_id TEXT NOT NULL REFERENCES theme (id),
name TEXT NOT NULL,
template TEXT NOT NULL,
@@ -69,8 +70,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating theme_asset table..."
cmd.CommandText <-
"""CREATE TABLE theme_asset (
cmd.CommandText <- """
CREATE TABLE theme_asset (
theme_id TEXT NOT NULL REFERENCES theme (id),
path TEXT NOT NULL,
updated_on TEXT NOT NULL,
@@ -83,10 +84,11 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating web_log table..."
cmd.CommandText <-
"""CREATE TABLE web_log (
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,
@@ -94,30 +96,33 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
url_base TEXT NOT NULL,
time_zone TEXT NOT NULL,
auto_htmx INTEGER NOT NULL DEFAULT 0,
feed_enabled 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,
category_enabled INTEGER NOT NULL DEFAULT 0,
tag_enabled INTEGER NOT NULL DEFAULT 0,
copyright TEXT)"""
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)"""
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 (
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)"""
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 (
cmd.CommandText <- """
CREATE TABLE web_log_feed_podcast (
feed_id TEXT PRIMARY KEY REFERENCES web_log_feed (id),
title TEXT NOT NULL,
subtitle TEXT,
@@ -126,12 +131,12 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
displayed_author TEXT NOT NULL,
email TEXT NOT NULL,
image_url TEXT NOT NULL,
itunes_category TEXT NOT NULL,
itunes_subcategory TEXT,
apple_category TEXT NOT NULL,
apple_subcategory TEXT,
explicit TEXT NOT NULL,
default_media_type TEXT,
media_base_url TEXT,
guid TEXT,
podcast_guid TEXT,
funding_url TEXT,
funding_text TEXT,
medium TEXT)"""
@@ -142,14 +147,15 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating category table..."
cmd.CommandText <-
"""CREATE TABLE category (
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)"""
parent_id TEXT);
CREATE INDEX category_web_log_idx ON category (web_log_id)"""
do! write cmd
// Web log user table
@@ -157,18 +163,22 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating web_log_user table..."
cmd.CommandText <-
"""CREATE TABLE web_log_user (
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,
email 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)"""
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)"""
do! write cmd
// Page tables
@@ -176,8 +186,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating page table..."
cmd.CommandText <-
"""CREATE TABLE page (
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),
@@ -185,16 +195,19 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
permalink TEXT NOT NULL,
published_on TEXT NOT NULL,
updated_on TEXT NOT NULL,
show_in_page_list INTEGER NOT NULL DEFAULT 0,
is_in_page_list INTEGER NOT NULL DEFAULT 0,
template TEXT,
page_text TEXT NOT NULL)"""
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 (
cmd.CommandText <- """
CREATE TABLE page_meta (
page_id TEXT NOT NULL REFERENCES page (id),
name TEXT NOT NULL,
value TEXT NOT NULL,
@@ -204,8 +217,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating page_permalink table..."
cmd.CommandText <-
"""CREATE TABLE page_permalink (
cmd.CommandText <- """
CREATE TABLE page_permalink (
page_id TEXT NOT NULL REFERENCES page (id),
permalink TEXT NOT NULL,
PRIMARY KEY (page_id, permalink))"""
@@ -214,8 +227,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating page_revision table..."
cmd.CommandText <-
"""CREATE TABLE page_revision (
cmd.CommandText <- """
CREATE TABLE page_revision (
page_id TEXT NOT NULL REFERENCES page (id),
as_of TEXT NOT NULL,
revision_text TEXT NOT NULL,
@@ -227,8 +240,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post table..."
cmd.CommandText <-
"""CREATE TABLE post (
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),
@@ -238,24 +251,29 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
published_on TEXT,
updated_on TEXT NOT NULL,
template TEXT,
post_text TEXT NOT NULL)"""
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 (
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))"""
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 (
cmd.CommandText <- """
CREATE TABLE post_episode (
post_id TEXT PRIMARY KEY REFERENCES post(id),
media TEXT NOT NULL,
length INTEGER NOT NULL,
@@ -279,8 +297,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post_tag table..."
cmd.CommandText <-
"""CREATE TABLE post_tag (
cmd.CommandText <- """
CREATE TABLE post_tag (
post_id TEXT NOT NULL REFERENCES post (id),
tag TEXT NOT NULL,
PRIMARY KEY (post_id, tag))"""
@@ -289,8 +307,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post_meta table..."
cmd.CommandText <-
"""CREATE TABLE post_meta (
cmd.CommandText <- """
CREATE TABLE post_meta (
post_id TEXT NOT NULL REFERENCES post (id),
name TEXT NOT NULL,
value TEXT NOT NULL,
@@ -300,8 +318,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post_permalink table..."
cmd.CommandText <-
"""CREATE TABLE post_permalink (
cmd.CommandText <- """
CREATE TABLE post_permalink (
post_id TEXT NOT NULL REFERENCES post (id),
permalink TEXT NOT NULL,
PRIMARY KEY (post_id, permalink))"""
@@ -310,8 +328,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post_revision table..."
cmd.CommandText <-
"""CREATE TABLE post_revision (
cmd.CommandText <- """
CREATE TABLE post_revision (
post_id TEXT NOT NULL REFERENCES post (id),
as_of TEXT NOT NULL,
revision_text TEXT NOT NULL,
@@ -321,8 +339,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post_comment table..."
cmd.CommandText <-
"""CREATE TABLE post_comment (
cmd.CommandText <- """
CREATE TABLE post_comment (
id TEXT PRIMARY KEY,
post_id TEXT NOT NULL REFERENCES post(id),
in_reply_to_id TEXT,
@@ -331,7 +349,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
url TEXT,
status TEXT NOT NULL,
posted_on TEXT NOT NULL,
comment_text 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
@@ -339,11 +358,28 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating tag_map table..."
cmd.CommandText <-
"""CREATE TABLE tag_map (
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)"""
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

@@ -7,16 +7,16 @@ open MyWebLog.ViewModels
/// Create a category hierarchy from the given list of categories
let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq {
for cat in cats |> List.filter (fun c -> c.parentId = parentId) do
let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.slug
{ id = CategoryId.toString cat.id
slug = fullSlug
name = cat.name
description = cat.description
parentNames = Array.ofList parentNames
for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do
let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug
{ Id = CategoryId.toString cat.Id
Slug = fullSlug
Name = cat.Name
Description = cat.Description
ParentNames = Array.ofList parentNames
// 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)
}

View File

@@ -7,22 +7,22 @@ open MyWebLog
[<CLIMutable; NoComparison; NoEquality>]
type Category =
{ /// The ID of the category
id : CategoryId
Id : CategoryId
/// The ID of the web log to which the category belongs
webLogId : WebLogId
WebLogId : WebLogId
/// The displayed name
name : string
Name : string
/// The slug (used in category URLs)
slug : string
Slug : string
/// A longer description of the category
description : string option
Description : string option
/// The parent ID of this category (if a subcategory)
parentId : CategoryId option
ParentId : CategoryId option
}
/// Functions to support categories
@@ -30,12 +30,12 @@ module Category =
/// An empty category
let empty =
{ id = CategoryId.empty
webLogId = WebLogId.empty
name = ""
slug = ""
description = None
parentId = None
{ Id = CategoryId.empty
WebLogId = WebLogId.empty
Name = ""
Slug = ""
Description = None
ParentId = None
}
@@ -43,31 +43,31 @@ module Category =
[<CLIMutable; NoComparison; NoEquality>]
type Comment =
{ /// The ID of the comment
id : CommentId
Id : CommentId
/// 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
inReplyToId : CommentId option
InReplyToId : CommentId option
/// The name of the commentor
name : string
Name : string
/// The e-mail address of the commentor
email : string
Email : string
/// The URL of the commentor's personal website
url : string option
Url : string option
/// The status of the comment
status : CommentStatus
Status : CommentStatus
/// When the comment was posted
postedOn : DateTime
PostedOn : DateTime
/// The text of the comment
text : string
Text : string
}
/// Functions to support comments
@@ -75,15 +75,15 @@ module Comment =
/// An empty comment
let empty =
{ id = CommentId.empty
postId = PostId.empty
inReplyToId = None
name = ""
email = ""
url = None
status = Pending
postedOn = DateTime.UtcNow
text = ""
{ Id = CommentId.empty
PostId = PostId.empty
InReplyToId = None
Name = ""
Email = ""
Url = None
Status = Pending
PostedOn = DateTime.UtcNow
Text = ""
}
@@ -91,43 +91,43 @@ module Comment =
[<CLIMutable; NoComparison; NoEquality>]
type Page =
{ /// The ID of this page
id : PageId
Id : PageId
/// The ID of the web log to which this page belongs
webLogId : WebLogId
WebLogId : WebLogId
/// The ID of the author of this page
authorId : WebLogUserId
AuthorId : WebLogUserId
/// The title of the page
title : string
Title : string
/// The link at which this page is displayed
permalink : Permalink
Permalink : Permalink
/// When this page was published
publishedOn : DateTime
PublishedOn : DateTime
/// When this page was last updated
updatedOn : DateTime
UpdatedOn : DateTime
/// Whether this page shows as part of the web log's navigation
showInPageList : bool
IsInPageList : bool
/// The template to use when rendering this page
template : string option
Template : string option
/// The current text of the page
text : string
Text : string
/// Metadata for this page
metadata : MetaItem list
Metadata : MetaItem list
/// 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 : Revision list
Revisions : Revision list
}
/// Functions to support pages
@@ -135,19 +135,19 @@ module Page =
/// An empty page
let empty =
{ id = PageId.empty
webLogId = WebLogId.empty
authorId = WebLogUserId.empty
title = ""
permalink = Permalink.empty
publishedOn = DateTime.MinValue
updatedOn = DateTime.MinValue
showInPageList = false
template = None
text = ""
metadata = []
priorPermalinks = []
revisions = []
{ Id = PageId.empty
WebLogId = WebLogId.empty
AuthorId = WebLogUserId.empty
Title = ""
Permalink = Permalink.empty
PublishedOn = DateTime.MinValue
UpdatedOn = DateTime.MinValue
IsInPageList = false
Template = None
Text = ""
Metadata = []
PriorPermalinks = []
Revisions = []
}
@@ -155,52 +155,52 @@ module Page =
[<CLIMutable; NoComparison; NoEquality>]
type Post =
{ /// The ID of this post
id : PostId
Id : PostId
/// The ID of the web log to which this post belongs
webLogId : WebLogId
WebLogId : WebLogId
/// The ID of the author of this post
authorId : WebLogUserId
AuthorId : WebLogUserId
/// The status
status : PostStatus
Status : PostStatus
/// The title
title : string
Title : string
/// The link at which the post resides
permalink : Permalink
Permalink : Permalink
/// The instant on which the post was originally published
publishedOn : DateTime option
PublishedOn : DateTime option
/// The instant on which the post was last updated
updatedOn : DateTime
UpdatedOn : DateTime
/// 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
text : string
Text : string
/// The Ids of the categories to which this is assigned
categoryIds : CategoryId list
CategoryIds : CategoryId list
/// The tags for the post
tags : string list
Tags : string list
/// Podcast episode information for this post
episode : Episode option
Episode : Episode option
/// Metadata for the post
metadata : MetaItem list
Metadata : MetaItem list
/// 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
revisions : Revision list
Revisions : Revision list
}
/// Functions to support posts
@@ -208,38 +208,38 @@ module Post =
/// An empty post
let empty =
{ id = PostId.empty
webLogId = WebLogId.empty
authorId = WebLogUserId.empty
status = Draft
title = ""
permalink = Permalink.empty
publishedOn = None
updatedOn = DateTime.MinValue
text = ""
template = None
categoryIds = []
tags = []
episode = None
metadata = []
priorPermalinks = []
revisions = []
{ Id = PostId.empty
WebLogId = WebLogId.empty
AuthorId = WebLogUserId.empty
Status = Draft
Title = ""
Permalink = Permalink.empty
PublishedOn = None
UpdatedOn = DateTime.MinValue
Text = ""
Template = None
CategoryIds = []
Tags = []
Episode = None
Metadata = []
PriorPermalinks = []
Revisions = []
}
/// A mapping between a tag and its URL value, used to translate restricted characters (ex. "#1" -> "number-1")
type TagMap =
{ /// The ID of this tag mapping
id : TagMapId
Id : TagMapId
/// 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
tag : string
Tag : string
/// The value by which the tag should be linked
urlValue : string
UrlValue : string
}
/// Functions to support tag mappings
@@ -247,26 +247,26 @@ module TagMap =
/// An empty tag mapping
let empty =
{ id = TagMapId.empty
webLogId = WebLogId.empty
tag = ""
urlValue = ""
{ Id = TagMapId.empty
WebLogId = WebLogId.empty
Tag = ""
UrlValue = ""
}
/// A theme
type Theme =
{ /// The ID / path of the theme
id : ThemeId
Id : ThemeId
/// A long name of the theme
name : string
Name : string
/// The version of the theme
version : string
Version : string
/// The templates for this theme
templates: ThemeTemplate list
Templates: ThemeTemplate list
}
/// Functions to support themes
@@ -274,10 +274,10 @@ module Theme =
/// An empty theme
let empty =
{ id = ThemeId ""
name = ""
version = ""
templates = []
{ Id = ThemeId ""
Name = ""
Version = ""
Templates = []
}
@@ -285,13 +285,54 @@ module Theme =
type ThemeAsset =
{
/// 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)
updatedOn : DateTime
UpdatedOn : DateTime
/// 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 = DateTime.MinValue
Data = [||]
}
/// An uploaded file
type Upload =
{ /// The ID of the upload
Id : UploadId
/// The ID of the web log to which this upload belongs
WebLogId : WebLogId
/// The link at which this upload is served
Path : Permalink
/// The updated date/time for this upload
UpdatedOn : DateTime
/// The data for the upload
Data : byte[]
}
/// Functions to support uploaded files
module Upload =
/// An empty upload
let empty =
{ Id = UploadId.empty
WebLogId = WebLogId.empty
Path = Permalink.empty
UpdatedOn = DateTime.MinValue
Data = [||]
}
@@ -299,34 +340,40 @@ type ThemeAsset =
[<CLIMutable; NoComparison; NoEquality>]
type WebLog =
{ /// The ID of the web log
id : WebLogId
Id : WebLogId
/// The name of the web log
name : string
Name : string
/// The slug of the web log
Slug : string
/// A subtitle for the web log
subtitle : string option
Subtitle : string option
/// The default page ("posts" or a page Id)
defaultPage : string
DefaultPage : string
/// The number of posts to display on pages of posts
postsPerPage : int
PostsPerPage : int
/// The path of the theme (within /themes)
themePath : string
/// The ID of the theme (also the path within /themes)
ThemeId : ThemeId
/// The URL base
urlBase : string
UrlBase : string
/// The time zone in which dates/times should be displayed
timeZone : string
TimeZone : string
/// The RSS options for this web log
rss : RssOptions
Rss : RssOptions
/// Whether to automatically load htmx
autoHtmx : bool
AutoHtmx : bool
/// Where uploads are placed
Uploads : UploadDestination
}
/// Functions to support web logs
@@ -334,27 +381,29 @@ module WebLog =
/// An empty web log
let empty =
{ id = WebLogId.empty
name = ""
subtitle = None
defaultPage = ""
postsPerPage = 10
themePath = "default"
urlBase = ""
timeZone = ""
rss = RssOptions.empty
autoHtmx = false
{ Id = WebLogId.empty
Name = ""
Slug = ""
Subtitle = None
DefaultPage = ""
PostsPerPage = 10
ThemeId = ThemeId "default"
UrlBase = ""
TimeZone = ""
Rss = RssOptions.empty
AutoHtmx = false
Uploads = Database
}
/// Get the host (including scheme) and extra path from the URL base
let hostAndPath webLog =
let scheme = webLog.urlBase.Split "://"
let scheme = webLog.UrlBase.Split "://"
let host = scheme[1].Split "/"
$"{scheme[0]}://{host[0]}", if host.Length > 1 then $"""/{String.Join ("/", host |> Array.skip 1)}""" else ""
/// Generate an absolute URL for the given link
let absoluteUrl webLog permalink =
$"{webLog.urlBase}/{Permalink.toString permalink}"
$"{webLog.UrlBase}/{Permalink.toString permalink}"
/// Generate a relative URL for the given link
let relativeUrl webLog permalink =
@@ -364,46 +413,47 @@ module WebLog =
/// Convert a UTC date/time to the web log's local date/time
let localTime webLog (date : DateTime) =
TimeZoneInfo.ConvertTimeFromUtc
(DateTime (date.Ticks, DateTimeKind.Utc), TimeZoneInfo.FindSystemTimeZoneById webLog.timeZone)
/// 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)
(DateTime (date.Ticks, DateTimeKind.Utc), TimeZoneInfo.FindSystemTimeZoneById webLog.TimeZone)
/// A user of the web log
[<CLIMutable; NoComparison; NoEquality>]
type WebLogUser =
{ /// The ID of the user
id : WebLogUserId
Id : WebLogUserId
/// The ID of the web log to which this user belongs
webLogId : WebLogId
WebLogId : WebLogId
/// The user name (e-mail address)
userName : string
Email : string
/// The user's first name
firstName : string
FirstName : string
/// The user's last name
lastName : string
LastName : string
/// The user's preferred name
preferredName : string
PreferredName : string
/// The hash of the user's password
passwordHash : string
PasswordHash : string
/// Salt used to calculate the user's password hash
salt : Guid
Salt : Guid
/// The URL of the user's personal site
url : string option
Url : string option
/// The user's authorization level
authorizationLevel : AuthorizationLevel
/// The user's access level
AccessLevel : AccessLevel
/// When the user was created
CreatedOn : DateTime
/// When the user last logged on
LastSeenOn : DateTime option
}
/// Functions to support web log users
@@ -411,21 +461,27 @@ module WebLogUser =
/// An empty web log user
let empty =
{ id = WebLogUserId.empty
webLogId = WebLogId.empty
userName = ""
firstName = ""
lastName = ""
preferredName = ""
passwordHash = ""
salt = Guid.Empty
url = None
authorizationLevel = User
{ Id = WebLogUserId.empty
WebLogId = WebLogId.empty
Email = ""
FirstName = ""
LastName = ""
PreferredName = ""
PasswordHash = ""
Salt = Guid.Empty
Url = None
AccessLevel = Author
CreatedOn = DateTime.UnixEpoch
LastSeenOn = None
}
/// Get the user's displayed name
let displayName user =
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 (+)
name.Trim ()
/// Does a user have the required access level?
let hasAccess level user =
AccessLevel.hasAccess level user.AccessLevel

View File

@@ -12,6 +12,51 @@ module private Helpers =
Convert.ToBase64String(Guid.NewGuid().ToByteArray ()).Replace('/', '_').Replace('+', '-').Substring (0, 22)
/// 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
type CategoryId = CategoryId of string
@@ -95,79 +140,79 @@ module ExplicitRating =
/// A podcast episode
type Episode =
{ /// The URL to the media file for the episode (may be permalink)
media : string
Media : string
/// The length of the media file, in bytes
length : int64
Length : int64
/// The duration of the episode
duration : TimeSpan option
Duration : TimeSpan option
/// 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)
imageUrl : string option
ImageUrl : string option
/// A subtitle for this episode
subtitle : string option
Subtitle : string option
/// This episode's explicit rating (overrides podcast rating if present)
explicit : ExplicitRating option
Explicit : ExplicitRating option
/// A link to a chapter file
chapterFile : string option
ChapterFile : string option
/// The MIME type for the chapter file
chapterType : string option
ChapterType : string option
/// The URL for the transcript of the episode (may be permalink)
transcriptUrl : string option
TranscriptUrl : string option
/// The MIME type of the transcript
transcriptType : string option
TranscriptType : string option
/// 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
transcriptCaptions : bool option
TranscriptCaptions : bool option
/// The season number (for serialized podcasts)
seasonNumber : int option
SeasonNumber : int option
/// A description of the season
seasonDescription : string option
SeasonDescription : string option
/// The episode number
episodeNumber : double option
EpisodeNumber : double option
/// A description of the episode
episodeDescription : string option
EpisodeDescription : string option
}
/// Functions to support episodes
module Episode =
/// An empty episode
let empty = {
media = ""
length = 0L
duration = None
mediaType = None
imageUrl = None
subtitle = None
explicit = None
chapterFile = None
chapterType = None
transcriptUrl = None
transcriptType = None
transcriptLang = None
transcriptCaptions = None
seasonNumber = None
seasonDescription = None
episodeNumber = None
episodeDescription = None
let empty =
{ Media = ""
Length = 0L
Duration = None
MediaType = None
ImageUrl = None
Subtitle = None
Explicit = None
ChapterFile = None
ChapterType = None
TranscriptUrl = None
TranscriptType = None
TranscriptLang = None
TranscriptCaptions = None
SeasonNumber = None
SeasonDescription = None
EpisodeNumber = None
EpisodeDescription = None
}
@@ -211,10 +256,10 @@ module MarkupText =
[<CLIMutable; NoComparison; NoEquality>]
type MetaItem =
{ /// The name of the metadata value
name : string
Name : string
/// The metadata value
value : string
Value : string
}
/// Functions to support metadata items
@@ -222,17 +267,17 @@ module MetaItem =
/// An empty metadata item
let empty =
{ name = ""; value = "" }
{ Name = ""; Value = "" }
/// A revision of a page or post
[<CLIMutable; NoComparison; NoEquality>]
type Revision =
{ /// When this revision was saved
asOf : DateTime
AsOf : DateTime
/// The text of the revision
text : MarkupText
Text : MarkupText
}
/// Functions to support revisions
@@ -240,8 +285,8 @@ module Revision =
/// An empty revision
let empty =
{ asOf = DateTime.UtcNow
text = Html ""
{ AsOf = DateTime.UtcNow
Text = Html ""
}
@@ -391,68 +436,68 @@ module CustomFeedSource =
/// Options for a feed that describes a podcast
type PodcastOptions =
{ /// The title of the podcast
title : string
Title : string
/// A subtitle for the podcast
subtitle : string option
Subtitle : string option
/// The number of items in the podcast feed
itemsInFeed : int
ItemsInFeed : int
/// A summary of the podcast (iTunes field)
summary : string
Summary : string
/// 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
email : string
Email : string
/// The link to the image for the podcast
imageUrl : Permalink
ImageUrl : Permalink
/// The category from iTunes under which this podcast is categorized
iTunesCategory : string
/// The category from Apple Podcasts (iTunes) under which this podcast is categorized
AppleCategory : string
/// A further refinement of the categorization of this podcast (iTunes field / values)
iTunesSubcategory : string option
/// A further refinement of the categorization of this podcast (Apple Podcasts/iTunes field / values)
AppleSubcategory : string option
/// The explictness rating (iTunes field)
explicit : ExplicitRating
Explicit : ExplicitRating
/// 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)
mediaBaseUrl : string option
MediaBaseUrl : string option
/// 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)
fundingUrl : string option
FundingUrl : string option
/// 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)
medium : PodcastMedium option
Medium : PodcastMedium option
}
/// A custom feed
type CustomFeed =
{ /// The ID of the custom feed
id : CustomFeedId
Id : CustomFeedId
/// The source for the custom feed
source : CustomFeedSource
Source : CustomFeedSource
/// The path for the custom feed
path : Permalink
Path : Permalink
/// Podcast options, if the feed defines a podcast
podcast : PodcastOptions option
Podcast : PodcastOptions option
}
/// Functions to support custom feeds
@@ -460,10 +505,10 @@ module CustomFeed =
/// An empty custom feed
let empty =
{ id = CustomFeedId ""
source = Category (CategoryId "")
path = Permalink ""
podcast = None
{ Id = CustomFeedId ""
Source = Category (CategoryId "")
Path = Permalink ""
Podcast = None
}
@@ -471,25 +516,25 @@ module CustomFeed =
[<CLIMutable; NoComparison; NoEquality>]
type RssOptions =
{ /// Whether the site feed of posts is enabled
feedEnabled : bool
IsFeedEnabled : bool
/// The name of the file generated for the site feed
feedName : string
FeedName : string
/// Override the "posts per page" setting for the site feed
itemsInFeed : int option
ItemsInFeed : int option
/// Whether feeds are enabled for all categories
categoryEnabled : bool
IsCategoryEnabled : bool
/// Whether feeds are enabled for all tags
tagEnabled : bool
IsTagEnabled : bool
/// A copyright string to be placed in all feeds
copyright : string option
Copyright : string option
/// Custom feeds for this web log
customFeeds: CustomFeed list
CustomFeeds: CustomFeed list
}
/// Functions to support RSS options
@@ -497,13 +542,13 @@ module RssOptions =
/// An empty set of RSS options
let empty =
{ feedEnabled = true
feedName = "feed.xml"
itemsInFeed = None
categoryEnabled = true
tagEnabled = true
copyright = None
customFeeds = []
{ IsFeedEnabled = true
FeedName = "feed.xml"
ItemsInFeed = None
IsCategoryEnabled = true
IsTagEnabled = true
Copyright = None
CustomFeeds = []
}
@@ -549,12 +594,56 @@ module ThemeAssetId =
/// A template for a theme
type ThemeTemplate =
{ /// The name of the template
name : string
Name : string
/// 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
type UploadDestination =
| Database
| Disk
/// Functions to support upload destinations
module UploadDestination =
/// Convert an upload destination to its string representation
let toString = function Database -> "Database" | Disk -> "Disk"
/// Parse an upload destination from its string representation
let parse value =
match value with
| "Database" -> Database
| "Disk" -> Disk
| it -> invalidOp $"{it} is not a valid upload destination"
/// An identifier for an upload
type UploadId = UploadId of string
/// Functions to support upload IDs
module UploadId =
/// An empty upload ID
let empty = UploadId ""
/// Convert an upload ID to a string
let toString = function UploadId ui -> ui
/// Create a new upload ID
let create () = UploadId (newId ())
/// An identifier for a web log
type WebLogId = WebLogId of string
@@ -572,26 +661,6 @@ module WebLogId =
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
type WebLogUserId = WebLogUserId of string

File diff suppressed because it is too large Load Diff

View File

@@ -7,15 +7,55 @@ open MyWebLog.Data
[<AutoOpen>]
module Extensions =
open System.Security.Claims
open Microsoft.AspNetCore.Antiforgery
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection
/// Hold variable for the configured generator string
let mutable private generatorString : string option = None
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
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
@@ -32,17 +72,17 @@ module WebLogCache =
/// Try to get the web log for the current request (longest matching URL base wins)
let tryGet (path : string) =
_cache
|> List.filter (fun wl -> path.StartsWith wl.urlBase)
|> List.sortByDescending (fun wl -> wl.urlBase.Length)
|> List.filter (fun wl -> path.StartsWith wl.UrlBase)
|> List.sortByDescending (fun wl -> wl.UrlBase.Length)
|> List.tryHead
/// Cache the web log for a particular host
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))
/// Fill the web log cache from the database
let fill (data : IData) = backgroundTask {
let! webLogs = data.WebLog.all ()
let! webLogs = data.WebLog.All ()
_cache <- webLogs
}
@@ -56,18 +96,18 @@ module PageListCache =
let private _cache = ConcurrentDictionary<string, DisplayPage[]> ()
/// 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.UrlBase
/// 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.UrlBase]
/// Update the pages for the current web log
let update (ctx : HttpContext) = backgroundTask {
let webLog = ctx.WebLog
let! pages = ctx.Data.Page.findListed webLog.id
_cache[webLog.urlBase] <-
let! pages = ctx.Data.Page.FindListed webLog.Id
_cache[webLog.UrlBase] <-
pages
|> List.map (fun pg -> DisplayPage.fromPage webLog { pg with text = "" })
|> List.map (fun pg -> DisplayPage.fromPage webLog { pg with Text = "" })
|> Array.ofList
}
@@ -81,15 +121,15 @@ module CategoryCache =
let private _cache = ConcurrentDictionary<string, DisplayCategory[]> ()
/// 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.UrlBase
/// 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.UrlBase]
/// Update the cache with fresh data
let update (ctx : HttpContext) = backgroundTask {
let! cats = ctx.Data.Category.findAllForView ctx.WebLog.id
_cache[ctx.WebLog.urlBase] <- cats
let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.Id
_cache[ctx.WebLog.UrlBase] <- cats
}
@@ -112,12 +152,12 @@ module TemplateCache =
match _cache.ContainsKey templatePath with
| true -> ()
| false ->
match! data.Theme.findById (ThemeId themeId) with
match! data.Theme.FindById (ThemeId themeId) with
| Some theme ->
let mutable text = (theme.templates |> List.find (fun t -> t.name = templateName)).text
let mutable text = (theme.Templates |> List.find (fun t -> t.Name = templateName)).Text
while hasInclude.IsMatch text do
let child = hasInclude.Match text
let childText = (theme.templates |> List.find (fun t -> t.name = child.Groups[1].Value)).text
let childText = (theme.Templates |> List.find (fun t -> t.Name = child.Groups[1].Value)).Text
text <- text.Replace (child.Value, childText)
_cache[templatePath] <- Template.Parse (text, SyntaxCompatibility.DotLiquid22)
| None -> ()
@@ -143,15 +183,15 @@ module ThemeAssetCache =
/// Refresh the list of assets for the given theme
let refreshTheme themeId (data : IData) = backgroundTask {
let! assets = data.ThemeAsset.findByTheme themeId
_cache[themeId] <- assets |> List.map (fun a -> match a.id with ThemeAssetId (_, path) -> path)
let! assets = data.ThemeAsset.FindByTheme themeId
_cache[themeId] <- assets |> List.map (fun a -> match a.Id with ThemeAssetId (_, path) -> path)
}
/// Fill the theme asset cache
let fill (data : IData) = backgroundTask {
let! assets = data.ThemeAsset.all ()
let! assets = data.ThemeAsset.All ()
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] <- []
_cache[themeId] <- path :: _cache[themeId]
}

View File

@@ -8,24 +8,28 @@ open DotLiquid
open Giraffe.ViewEngine
open MyWebLog.ViewModels
/// Extensions on the DotLiquid Context object
type Context with
/// Get the current web log from the DotLiquid context
let webLog (ctx : Context) =
ctx.Environments[0].["web_log"] :?> WebLog
member this.WebLog =
this.Environments[0].["web_log"] :?> WebLog
/// Does an asset exist for the current theme?
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
let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> string) =
match item with
| :? String as link -> Some link
| :? DisplayPage as page -> Some page.permalink
| :? PostListItem as post -> Some post.permalink
| :? DropProxy as proxy -> Option.ofObj proxy["permalink"] |> Option.map string
| :? DisplayPage as page -> Some page.Permalink
| :? PostListItem as post -> Some post.Permalink
| :? DropProxy as proxy -> Option.ofObj proxy["Permalink"] |> Option.map string
| _ -> None
|> function
| Some link -> linkFunc (webLog ctx) (Permalink link)
| Some link -> linkFunc ctx.WebLog (Permalink link)
| None -> $"alert('unknown item type {item.GetType().Name}')"
@@ -39,11 +43,11 @@ type AbsoluteLinkFilter () =
type CategoryLinkFilter () =
static member CategoryLink (ctx : Context, catObj : obj) =
match catObj with
| :? DisplayCategory as cat -> Some cat.slug
| :? DropProxy as proxy -> Option.ofObj proxy["slug"] |> Option.map string
| :? DisplayCategory as cat -> Some cat.Slug
| :? DropProxy as proxy -> Option.ofObj proxy["Slug"] |> Option.map string
| _ -> None
|> 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}')"
@@ -51,12 +55,12 @@ type CategoryLinkFilter () =
type EditPageLinkFilter () =
static member EditPageLink (ctx : Context, pageObj : obj) =
match pageObj with
| :? DisplayPage as page -> Some page.id
| :? DropProxy as proxy -> Option.ofObj proxy["id"] |> Option.map string
| :? DisplayPage as page -> Some page.Id
| :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId
| _ -> None
|> 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}')"
@@ -64,38 +68,36 @@ type EditPageLinkFilter () =
type EditPostLinkFilter () =
static member EditPostLink (ctx : Context, postObj : obj) =
match postObj with
| :? PostListItem as post -> Some post.id
| :? DropProxy as proxy -> Option.ofObj proxy["id"] |> Option.map string
| :? PostListItem as post -> Some post.Id
| :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId
| _ -> None
|> 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}')"
/// A filter to generate nav links, highlighting the active link (exact match)
type NavLinkFilter () =
static member NavLink (ctx : Context, url : string, text : string) =
let webLog = webLog ctx
let _, path = WebLog.hostAndPath webLog
let _, path = WebLog.hostAndPath ctx.WebLog
let path = if path = "" then path else $"{path.Substring 1}/"
seq {
"<li class=\"nav-item\"><a class=\"nav-link"
if (string ctx.Environments[0].["current_page"]).StartsWith $"{path}{url}" then " active"
"\" href=\""
WebLog.relativeUrl webLog (Permalink url)
WebLog.relativeUrl ctx.WebLog (Permalink url)
"\">"
text
"</a></li>"
}
|> Seq.fold (+) ""
|> String.concat ""
/// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
type ThemeAssetFilter () =
static member ThemeAsset (ctx : Context, asset : string) =
let webLog = webLog ctx
WebLog.relativeUrl webLog (Permalink $"themes/{webLog.themePath}/{asset}")
WebLog.relativeUrl ctx.WebLog (Permalink $"themes/{ThemeId.toString ctx.WebLog.ThemeId}/{asset}")
/// Create various items in the page header based on the state of the page being generated
@@ -103,11 +105,11 @@ type PageHeadTag () =
inherit Tag ()
override this.Render (context : Context, result : TextWriter) =
let webLog = webLog context
let webLog = context.WebLog
// spacer
let s = " "
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"]}">"""
@@ -123,26 +125,26 @@ type PageHeadTag () =
let relUrl = WebLog.relativeUrl webLog (Permalink url)
$"""{s}<link rel="alternate" type="application/rss+xml" title="{escTitle}" href="{relUrl}">"""
if webLog.rss.feedEnabled && getBool "is_home" then
result.WriteLine (feedLink webLog.name webLog.rss.feedName)
if webLog.Rss.IsFeedEnabled && getBool "is_home" then
result.WriteLine (feedLink webLog.Name webLog.Rss.FeedName)
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
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
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
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}">"""
if getBool "is_page" then
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}">"""
@@ -151,11 +153,11 @@ type PageFootTag () =
inherit Tag ()
override this.Render (context : Context, result : TextWriter) =
let webLog = webLog context
let webLog = context.WebLog
// spacer
let s = " "
if webLog.autoHtmx then
if webLog.AutoHtmx then
result.WriteLine $"{s}{RenderView.AsString.htmlNode Htmx.Script.minified}"
if assetExists "script.js" webLog then
@@ -172,11 +174,11 @@ type RelativeLinkFilter () =
type TagLinkFilter () =
static member TagLink (ctx : Context, tag : string) =
ctx.Environments[0].["tag_mappings"] :?> TagMap list
|> List.tryFind (fun it -> it.tag = tag)
|> List.tryFind (fun it -> it.Tag = tag)
|> function
| Some tagMap -> tagMap.urlValue
| Some tagMap -> tagMap.UrlValue
| 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
@@ -184,11 +186,10 @@ type UserLinksTag () =
inherit Tag ()
override this.Render (context : Context, result : TextWriter) =
let webLog = webLog context
let link it = WebLog.relativeUrl webLog (Permalink it)
let link it = WebLog.relativeUrl context.WebLog (Permalink it)
seq {
"""<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 ->
$"""<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>"""
@@ -202,8 +203,8 @@ type UserLinksTag () =
// (shorter than `{% assign item = list | where: "name", [name] | first %}{{ item.value }}`)
type ValueFilter () =
static member Value (_ : Context, items : MetaItem list, name : string) =
match items |> List.tryFind (fun it -> it.name = name) with
| Some item -> item.value
match items |> List.tryFind (fun it -> it.Name = name) with
| Some item -> item.Value
| None -> $"-- {name} not found --"
@@ -223,16 +224,17 @@ let register () =
Template.RegisterTag<UserLinksTag> "user_links"
[ // Domain types
typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>; typeof<MetaItem>; typeof<Page>; typeof<RssOptions>
typeof<TagMap>; typeof<WebLog>
typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>; typeof<MetaItem>; typeof<Page>
typeof<RssOptions>; typeof<TagMap>; typeof<UploadDestination>; typeof<WebLog>
// View models
typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayCustomFeed>; typeof<DisplayPage>
typeof<EditCategoryModel>; typeof<EditCustomFeedModel>; typeof<EditPageModel>; typeof<EditPostModel>
typeof<DisplayRevision>; typeof<DisplayUpload>; typeof<DisplayUser>; typeof<EditCategoryModel>
typeof<EditCustomFeedModel>; typeof<EditMyInfoModel>; typeof<EditPageModel>; typeof<EditPostModel>
typeof<EditRssModel>; typeof<EditTagMapModel>; typeof<EditUserModel>; typeof<LogOnModel>
typeof<ManagePermalinksModel>; typeof<PostDisplay>; typeof<PostListItem>; typeof<SettingsModel>
typeof<UserMessage>
typeof<ManagePermalinksModel>; typeof<ManageRevisionsModel>; typeof<PostDisplay>; typeof<PostListItem>
typeof<SettingsModel>; typeof<UserMessage>
// Framework types
typeof<AntiforgeryTokenSet>; typeof<int option>; typeof<KeyValuePair>; 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, [| "*" |]))

View File

@@ -2,355 +2,190 @@
module MyWebLog.Handlers.Admin
open System.Threading.Tasks
open DotLiquid
open Giraffe
open MyWebLog
open MyWebLog.ViewModels
// GET /admin
let dashboard : HttpHandler = fun next ctx -> task {
let webLogId = ctx.WebLog.id
let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let getCount (f : WebLogId -> Task<int>) = f ctx.WebLog.Id
let data = ctx.Data
let getCount (f : WebLogId -> Task<int>) = f webLogId
let! posts = data.Post.countByStatus Published |> getCount
let! drafts = data.Post.countByStatus Draft |> getCount
let! pages = data.Page.countAll |> getCount
let! listed = data.Page.countListed |> getCount
let! cats = data.Category.countAll |> getCount
let! topCats = data.Category.countTopLevel |> getCount
let posts = getCount (data.Post.CountByStatus Published)
let drafts = getCount (data.Post.CountByStatus Draft)
let pages = getCount data.Page.CountAll
let listed = getCount data.Page.CountListed
let cats = getCount data.Category.CountAll
let topCats = getCount data.Category.CountTopLevel
let! _ = Task.WhenAll (posts, drafts, pages, listed, cats, topCats)
return!
Hash.FromAnonymousObject {|
page_title = "Dashboard"
model =
{ posts = posts
drafts = drafts
pages = pages
listedPages = listed
categories = cats
topLevelCategories = topCats
hashForPage "Dashboard"
|> addToHash ViewContext.Model {
Posts = posts.Result
Drafts = drafts.Result
Pages = pages.Result
ListedPages = listed.Result
Categories = cats.Result
TopLevelCategories = topCats.Result
}
|}
|> viewForTheme "admin" "dashboard" next ctx
|> adminView "dashboard" next ctx
}
// -- CATEGORIES --
// GET /admin/categories
let listCategories : HttpHandler = fun next ctx -> task {
let listCategories : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! catListTemplate = TemplateCache.get "admin" "category-list-body" ctx.Data
let hash = Hash.FromAnonymousObject {|
web_log = ctx.WebLog
categories = CategoryCache.get ctx
page_title = "Categories"
csrf = csrfToken ctx
|}
hash.Add ("category_list", catListTemplate.Render hash)
return! viewForTheme "admin" "category-list" next ctx hash
let! hash =
hashForPage "Categories"
|> withAntiCsrf ctx
|> addViewContext ctx
return!
addToHash "category_list" (catListTemplate.Render hash) hash
|> adminView "category-list" next ctx
}
// GET /admin/categories/bare
let listCategoriesBare : HttpHandler = fun next ctx -> task {
return!
Hash.FromAnonymousObject {|
categories = CategoryCache.get ctx
csrf = csrfToken ctx
|}
|> bareForTheme "admin" "category-list-body" next ctx
}
let listCategoriesBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
hashForPage "Categories"
|> withAntiCsrf ctx
|> adminBareView "category-list-body" next ctx
// GET /admin/category/{id}/edit
let editCategory catId : HttpHandler = fun next ctx -> task {
let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! result = task {
match catId with
| "new" -> return Some ("Add a New Category", { Category.empty with id = CategoryId "new" })
| "new" -> return Some ("Add a New Category", { Category.empty with Id = CategoryId "new" })
| _ ->
match! ctx.Data.Category.findById (CategoryId catId) ctx.WebLog.id with
match! ctx.Data.Category.FindById (CategoryId catId) ctx.WebLog.Id with
| Some cat -> return Some ("Edit Category", cat)
| None -> return None
}
match result with
| Some (title, cat) ->
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = EditCategoryModel.fromCategory cat
page_title = title
categories = CategoryCache.get ctx
|}
|> bareForTheme "admin" "category-edit" next ctx
hashForPage title
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditCategoryModel.fromCategory cat)
|> adminBareView "category-edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/category/save
let saveCategory : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let saveCategory : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditCategoryModel> ()
let! category = task {
match model.categoryId with
| "new" -> return Some { Category.empty with id = CategoryId.create (); webLogId = webLog.id }
| catId -> return! data.Category.findById (CategoryId catId) webLog.id
}
match category with
let category =
if model.IsNew then someTask { Category.empty with Id = CategoryId.create (); WebLogId = ctx.WebLog.Id }
else data.Category.FindById (CategoryId model.CategoryId) ctx.WebLog.Id
match! category with
| Some cat ->
let cat =
let updatedCat =
{ cat with
name = model.name
slug = model.slug
description = if model.description = "" then None else Some model.description
parentId = if model.parentId = "" then None else Some (CategoryId model.parentId)
Name = model.Name
Slug = model.Slug
Description = if model.Description = "" then None else Some model.Description
ParentId = if model.ParentId = "" then None else Some (CategoryId model.ParentId)
}
do! (match model.categoryId with "new" -> data.Category.add | _ -> data.Category.update) cat
do! (if model.IsNew then data.Category.Add else data.Category.Update) updatedCat
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Category saved successfully" }
do! addMessage ctx { UserMessage.success with Message = "Category saved successfully" }
return! listCategoriesBare next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/category/{id}/delete
let deleteCategory catId : HttpHandler = fun next ctx -> task {
match! ctx.Data.Category.delete (CategoryId catId) ctx.WebLog.id with
let deleteCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Category.Delete (CategoryId catId) ctx.WebLog.Id with
| true ->
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Category deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with message = "Category not found; cannot delete" }
do! addMessage ctx { UserMessage.success with Message = "Category deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with Message = "Category not found; cannot delete" }
return! listCategoriesBare next ctx
}
// -- PAGES --
// GET /admin/pages
// GET /admin/pages/page/{pageNbr}
let listPages pageNbr : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let! pages = ctx.Data.Page.findPageOfPages webLog.id pageNbr
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
pages = pages |> List.map (DisplayPage.fromPageMinimal webLog)
page_title = "Pages"
page_nbr = pageNbr
prev_page = if pageNbr = 2 then "" else $"/page/{pageNbr - 1}"
next_page = $"/page/{pageNbr + 1}"
|}
|> viewForTheme "admin" "page-list" next ctx
}
// GET /admin/page/{id}/edit
let editPage pgId : HttpHandler = fun next ctx -> task {
let! result = task {
match pgId with
| "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new" })
| _ ->
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) ->
let model = EditPageModel.fromPage page
let! templates = templatesForTheme ctx "page"
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = model
metadata = Array.zip model.metaNames model.metaValues
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
page_title = title
templates = templates
|}
|> viewForTheme "admin" "page-edit" next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/page/{id}/permalinks
let editPagePermalinks pgId : HttpHandler = fun next ctx -> task {
match! ctx.Data.Page.findFullById (PageId pgId) ctx.WebLog.id with
| Some pg ->
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = ManagePermalinksModel.fromPage pg
page_title = $"Manage Prior Permalinks"
|}
|> viewForTheme "admin" "permalinks" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/page/permalinks
let savePagePermalinks : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let links = model.prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Page.updatePriorPermalinks (PageId model.id) webLog.id links with
| true ->
do! addMessage ctx { UserMessage.success with message = "Page permalinks saved successfully" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/page/{model.id}/permalinks")) next ctx
| false -> return! Error.notFound next ctx
}
// POST /admin/page/{id}/delete
let deletePage pgId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
match! ctx.Data.Page.delete (PageId pgId) 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 (WebLog.relativeUrl webLog (Permalink "admin/pages")) next ctx
}
open System
#nowarn "3511"
// POST /admin/page/save
let savePage : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> ()
let webLog = ctx.WebLog
let data = ctx.Data
let now = DateTime.UtcNow
let! pg = task {
match model.pageId with
| "new" ->
return Some
{ Page.empty with
id = PageId.create ()
webLogId = webLog.id
authorId = userId ctx
publishedOn = now
}
| pgId -> return! data.Page.findFullById (PageId pgId) webLog.id
}
match pg with
| Some page ->
let updateList = page.showInPageList <> model.isShownInPageList
let revision = { asOf = now; text = MarkupText.parse $"{model.source}: {model.text}" }
// Detect a permalink change, and add the prior one to the prior list
let page =
match Permalink.toString page.permalink with
| "" -> page
| link when link = model.permalink -> page
| _ -> { page with priorPermalinks = page.permalink :: page.priorPermalinks }
let page =
{ page with
title = model.title
permalink = Permalink model.permalink
updatedOn = now
showInPageList = model.isShownInPageList
template = match model.template with "" -> None | tmpl -> Some tmpl
text = MarkupText.toHtml revision.text
metadata = Seq.zip model.metaNames model.metaValues
|> Seq.filter (fun it -> fst it > "")
|> Seq.map (fun it -> { name = fst it; value = snd it })
|> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}")
|> List.ofSeq
revisions = match page.revisions |> List.tryHead with
| Some r when r.text = revision.text -> page.revisions
| _ -> revision :: page.revisions
}
do! (if model.pageId = "new" then data.Page.add else data.Page.update) page
if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Page saved successfully" }
return!
redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/page/{PageId.toString page.id}/edit")) next ctx
| None -> return! Error.notFound next ctx
}
open Microsoft.AspNetCore.Http
// -- TAG MAPPINGS --
open Microsoft.AspNetCore.Http
/// Get the hash necessary to render the tag mapping list
let private tagMappingHash (ctx : HttpContext) = task {
let! mappings = ctx.Data.TagMap.findByWebLog ctx.WebLog.id
return Hash.FromAnonymousObject {|
web_log = ctx.WebLog
csrf = csrfToken ctx
mappings = mappings
mapping_ids = mappings |> List.map (fun it -> { name = it.tag; value = TagMapId.toString it.id })
|}
let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
return!
hashForPage "Tag Mappings"
|> withAntiCsrf ctx
|> addToHash "mappings" mappings
|> addToHash "mapping_ids" (mappings |> List.map (fun it -> { Name = it.Tag; Value = TagMapId.toString it.Id }))
|> addViewContext ctx
}
// GET /admin/settings/tag-mappings
let tagMappings : HttpHandler = fun next ctx -> task {
let tagMappings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash = tagMappingHash ctx
let! listTemplate = TemplateCache.get "admin" "tag-mapping-list-body" ctx.Data
hash.Add ("tag_mapping_list", listTemplate.Render hash)
hash.Add ("page_title", "Tag Mappings")
return! viewForTheme "admin" "tag-mapping-list" next ctx hash
return!
addToHash "tag_mapping_list" (listTemplate.Render hash) hash
|> adminView "tag-mapping-list" next ctx
}
// GET /admin/settings/tag-mappings/bare
let tagMappingsBare : HttpHandler = fun next ctx -> task {
let tagMappingsBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash = tagMappingHash ctx
return! bareForTheme "admin" "tag-mapping-list-body" next ctx hash
return! adminBareView "tag-mapping-list-body" next ctx hash
}
// GET /admin/settings/tag-mapping/{id}/edit
let editMapping tagMapId : HttpHandler = fun next ctx -> task {
let editMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let isNew = tagMapId = "new"
let tagMap =
if isNew then
Task.FromResult (Some { TagMap.empty with id = TagMapId "new" })
else
ctx.Data.TagMap.findById (TagMapId tagMapId) ctx.WebLog.id
if isNew then someTask { TagMap.empty with Id = TagMapId "new" }
else ctx.Data.TagMap.FindById (TagMapId tagMapId) ctx.WebLog.Id
match! tagMap with
| Some tm ->
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = EditTagMapModel.fromMapping tm
page_title = if isNew then "Add Tag Mapping" else $"Mapping for {tm.tag} Tag"
|}
|> bareForTheme "admin" "tag-mapping-edit" next ctx
hashForPage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag")
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditTagMapModel.fromMapping tm)
|> adminBareView "tag-mapping-edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/settings/tag-mapping/save
let saveMapping : HttpHandler = fun next ctx -> task {
let saveMapping : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel> ()
let tagMap =
if model.id = "new" then
Task.FromResult (Some { TagMap.empty with id = TagMapId.create (); webLogId = ctx.WebLog.id })
else
data.TagMap.findById (TagMapId model.id) ctx.WebLog.id
if model.IsNew then someTask { TagMap.empty with Id = TagMapId.create (); WebLogId = ctx.WebLog.Id }
else data.TagMap.FindById (TagMapId model.Id) ctx.WebLog.Id
match! tagMap with
| Some tm ->
do! data.TagMap.save { tm with tag = model.tag.ToLower (); urlValue = model.urlValue.ToLower () }
do! addMessage ctx { UserMessage.success with message = "Tag mapping saved successfully" }
do! data.TagMap.Save { tm with Tag = model.Tag.ToLower (); UrlValue = model.UrlValue.ToLower () }
do! addMessage ctx { UserMessage.success with Message = "Tag mapping saved successfully" }
return! tagMappingsBare next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/settings/tag-mapping/{id}/delete
let deleteMapping tagMapId : HttpHandler = fun next ctx -> task {
match! ctx.Data.TagMap.delete (TagMapId tagMapId) ctx.WebLog.id with
| true -> do! addMessage ctx { UserMessage.success with message = "Tag mapping deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with message = "Tag mapping not found; nothing deleted" }
let deleteMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.TagMap.Delete (TagMapId tagMapId) ctx.WebLog.Id with
| true -> do! addMessage ctx { UserMessage.success with Message = "Tag mapping deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with Message = "Tag mapping not found; nothing deleted" }
return! tagMappingsBare next ctx
}
// -- THEMES --
open System
open System.IO
open System.IO.Compression
open System.Text.RegularExpressions
open MyWebLog.Data
// GET /admin/theme/update
let themeUpdatePage : HttpHandler = fun next ctx -> task {
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
page_title = "Upload Theme"
|}
|> viewForTheme "admin" "upload-theme" next ctx
}
let themeUpdatePage : HttpHandler = requireAccess Administrator >=> fun next ctx ->
hashForPage "Upload Theme"
|> withAntiCsrf ctx
|> adminView "upload-theme" next ctx
/// Update the name and version for a theme based on the version.txt file, if present
let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = backgroundTask {
@@ -360,20 +195,18 @@ let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = background
use versionFile = new StreamReader(versionItem.Open ())
let! versionText = versionFile.ReadToEndAsync ()
let parts = versionText.Trim().Replace("\r", "").Split "\n"
let displayName = if parts[0] > "" then parts[0] else ThemeId.toString theme.id
let displayName = if parts[0] > "" then parts[0] else ThemeId.toString theme.Id
let version = if parts.Length > 1 && parts[1] > "" then parts[1] else now ()
return { theme with name = displayName; version = version }
| None ->
return { theme with name = ThemeId.toString theme.id; version = now () }
return { theme with Name = displayName; Version = version }
| None -> return { theme with Name = ThemeId.toString theme.Id; Version = now () }
}
/// Delete all theme assets, and remove templates from theme
let private checkForCleanLoad (theme : Theme) cleanLoad (data : IData) = backgroundTask {
if cleanLoad then
do! data.ThemeAsset.deleteByTheme theme.id
return { theme with templates = [] }
else
return theme
do! data.ThemeAsset.DeleteByTheme theme.Id
return { theme with Templates = [] }
else return theme
}
/// Update the theme with all templates from the ZIP archive
@@ -384,13 +217,13 @@ let private updateTemplates (theme : Theme) (zip : ZipArchive) = backgroundTask
|> Seq.map (fun templateItem -> backgroundTask {
use templateFile = new StreamReader (templateItem.Open ())
let! template = templateFile.ReadToEndAsync ()
return { name = templateItem.Name.Replace (".liquid", ""); text = template }
return { Name = templateItem.Name.Replace (".liquid", ""); Text = template }
})
let! templates = Task.WhenAll tasks
return
templates
|> Array.fold (fun t template ->
{ t with templates = template :: (t.templates |> List.filter (fun it -> it.name <> template.name)) })
{ t with Templates = template :: (t.Templates |> List.filter (fun it -> it.Name <> template.Name)) })
theme
}
@@ -401,10 +234,10 @@ let private updateAssets themeId (zip : ZipArchive) (data : IData) = backgroundT
if assetName <> "" && not (assetName.EndsWith "/") then
use stream = new MemoryStream ()
do! asset.Open().CopyToAsync stream
do! data.ThemeAsset.save
{ id = ThemeAssetId (themeId, assetName)
updatedOn = asset.LastWriteTime.DateTime
data = stream.ToArray ()
do! data.ThemeAsset.Save
{ Id = ThemeAssetId (themeId, assetName)
UpdatedOn = asset.LastWriteTime.DateTime
Data = stream.ToArray ()
}
}
@@ -418,19 +251,19 @@ let loadThemeFromZip themeName file clean (data : IData) = backgroundTask {
use zip = new ZipArchive (file, ZipArchiveMode.Read)
let themeId = ThemeId themeName
let! theme = backgroundTask {
match! data.Theme.findById themeId with
match! data.Theme.FindById themeId with
| Some t -> return t
| None -> return { Theme.empty with id = themeId }
| None -> return { Theme.empty with Id = themeId }
}
let! theme = updateNameAndVersion theme zip
let! theme = checkForCleanLoad theme clean data
let! theme = updateTemplates theme zip
do! data.Theme.save theme
do! data.Theme.Save theme
do! updateAssets themeId zip data
}
// POST /admin/theme/update
let updateTheme : HttpHandler = fun next ctx -> task {
let updateTheme : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let themeFile = Seq.head ctx.Request.Form.Files
match getThemeName themeFile.FileName with
@@ -441,16 +274,15 @@ let updateTheme : HttpHandler = fun next ctx -> task {
do! loadThemeFromZip themeName stream true data
do! ThemeAssetCache.refreshTheme (ThemeId themeName) data
TemplateCache.invalidateTheme themeName
do! addMessage ctx { UserMessage.success with message = "Theme updated successfully" }
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/dashboard")) next ctx
do! addMessage ctx { UserMessage.success with Message = "Theme updated successfully" }
return! redirectToGet "admin/dashboard" next ctx
| Ok _ ->
do! addMessage ctx { UserMessage.error with message = "You may not replace the admin theme" }
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/theme/update")) next ctx
do! addMessage ctx { UserMessage.error with Message = "You may not replace the admin theme" }
return! redirectToGet "admin/theme/update" next ctx
| Error message ->
do! addMessage ctx { UserMessage.error with message = message }
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/theme/update")) next ctx
else
return! RequestErrors.BAD_REQUEST "Bad request" next ctx
do! addMessage ctx { UserMessage.error with Message = message }
return! redirectToGet "admin/theme/update" next ctx
else return! RequestErrors.BAD_REQUEST "Bad request" next ctx
}
// -- WEB LOG SETTINGS --
@@ -458,48 +290,54 @@ let updateTheme : HttpHandler = fun next ctx -> task {
open System.Collections.Generic
// GET /admin/settings
let settings : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! allPages = data.Page.all webLog.id
let! themes = data.Theme.all ()
let! allPages = data.Page.All ctx.WebLog.Id
let! themes = data.Theme.All ()
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = SettingsModel.fromWebLog webLog
pages =
hashForPage "Web Log Settings"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (SettingsModel.fromWebLog ctx.WebLog)
|> addToHash "pages" (
seq {
KeyValuePair.Create ("posts", "- First Page of Posts -")
yield! allPages
|> List.sortBy (fun p -> p.title.ToLower ())
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.id, p.title))
|> List.sortBy (fun p -> p.Title.ToLower ())
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.Id, p.Title))
}
|> Array.ofSeq
themes = themes
|> Array.ofSeq)
|> addToHash "themes" (
themes
|> Seq.ofList
|> Seq.map (fun it ->
KeyValuePair.Create (ThemeId.toString it.id, $"{it.name} (v{it.version})"))
|> Array.ofSeq
web_log = webLog
page_title = "Web Log Settings"
|}
|> viewForTheme "admin" "settings" next ctx
|> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.Id, $"{it.Name} (v{it.Version})"))
|> Array.ofSeq)
|> addToHash "upload_values" [|
KeyValuePair.Create (UploadDestination.toString Database, "Database")
KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
|]
|> adminView "settings" next ctx
}
// POST /admin/settings
let saveSettings : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<SettingsModel> ()
match! data.WebLog.findById webLog.id with
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
let oldSlug = webLog.Slug
let webLog = model.update webLog
do! data.WebLog.updateSettings webLog
do! data.WebLog.UpdateSettings webLog
// Update cache
WebLogCache.set webLog
do! addMessage ctx { UserMessage.success with message = "Web log settings saved successfully" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings")) next ctx
if oldSlug <> webLog.Slug then
// Rename disk directory if it exists
let uploadRoot = Path.Combine ("wwwroot", "upload")
let oldDir = Path.Combine (uploadRoot, oldSlug)
if Directory.Exists oldDir then Directory.Move (oldDir, Path.Combine (uploadRoot, webLog.Slug))
do! addMessage ctx { UserMessage.success with Message = "Web log settings saved successfully" }
return! redirectToGet "admin/settings" next ctx
| None -> return! Error.notFound next ctx
}

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

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

View File

@@ -12,12 +12,117 @@ type ISession with
this.SetString (key, JsonSerializer.Serialize item)
/// Get an item from the session
member this.Get<'T> key =
member this.TryGet<'T> key =
match this.GetString key with
| null -> None
| 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
let private sessionLoadedKey = "session-loaded"
@@ -38,46 +143,42 @@ open MyWebLog.ViewModels
/// Add a message to the user's session
let addMessage (ctx : HttpContext) message = task {
do! loadSession ctx
let msg = match ctx.Session.Get<UserMessage list> "messages" with Some it -> it | None -> []
ctx.Session.Set ("messages", message :: msg)
let msg = match ctx.Session.TryGet<UserMessage list> ViewContext.Messages with Some it -> it | None -> []
ctx.Session.Set (ViewContext.Messages, message :: msg)
}
/// Get any messages from the user's session, removing them in the process
let messages (ctx : HttpContext) = task {
do! loadSession ctx
match ctx.Session.Get<UserMessage list> "messages" with
match ctx.Session.TryGet<UserMessage list> ViewContext.Messages with
| Some msg ->
ctx.Session.Remove "messages"
ctx.Session.Remove ViewContext.Messages
return msg |> (List.rev >> Array.ofList)
| 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 DotLiquid
/// Either get the web log from the hash, or get it from the cache and add it to the hash
let private deriveWebLogFromHash (hash : Hash) (ctx : HttpContext) =
if hash.ContainsKey "web_log" then () else hash.Add ("web_log", ctx.WebLog)
hash["web_log"] :?> WebLog
/// Shorthand for creating a DotLiquid hash from an anonymous object
let makeHash (values : obj) =
Hash.FromAnonymousObject values
/// 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.Htmx
open Giraffe.ViewEngine
@@ -86,115 +187,189 @@ open Giraffe.ViewEngine
let private htmxScript = RenderView.AsString.htmlNode Htmx.Script.minified
/// Populate the DotLiquid hash with standard information
let private populateHash hash ctx = 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 addViewContext ctx (hash : Hash) = task {
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
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)
}
/// Render a view for the specified theme, using the specified template, layout, and hash
let viewForTheme theme template next ctx = fun (hash : Hash) -> task {
do! populateHash hash ctx
/// Is the request from htmx?
let isHtmx (ctx : HttpContext) =
ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
/// Render a view for the specified theme, using the specified template, layout, and hash
let viewForTheme themeId template next ctx (hash : Hash) = task {
let! hash = addViewContext ctx hash
let (ThemeId theme) = themeId
// 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
// Render view content...
let! contentTemplate = TemplateCache.get theme template ctx.Data
hash.Add ("content", contentTemplate.Render hash)
let _ = addToHash ViewContext.Content (contentTemplate.Render hash) hash
// ...then render that content with its layout
let isHtmx = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
let! layoutTemplate = TemplateCache.get theme (if isHtmx then "layout-partial" else "layout") ctx.Data
let! layoutTemplate = TemplateCache.get theme (if isHtmx ctx then "layout-partial" else "layout") ctx.Data
return! htmlString (layoutTemplate.Render hash) next ctx
}
/// Render a bare view for the specified theme, using the specified template and hash
let bareForTheme theme template next ctx = fun (hash : Hash) -> task {
do! populateHash hash ctx
// Bare templates are rendered with layout-bare
let! contentTemplate = TemplateCache.get theme template ctx.Data
hash.Add ("content", contentTemplate.Render hash)
let! layoutTemplate = TemplateCache.get theme "layout-bare" ctx.Data
// add messages as HTTP headers
let messages = hash["messages"] :?> UserMessage[]
let actions = seq {
/// 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}"
match m.Detail with
| Some detail -> $"{m.Level}|||{m.Message}|||{detail}"
| None -> $"{m.Level}|||{m.Message}"
|> setHttpHeader "X-Message")
withHxNoPush
htmlString (layoutTemplate.Render hash)
withHxNoPushUrl
}
|> Seq.reduce (>=>)
return! (actions |> Seq.reduce (>=>)) next ctx
/// Render a bare view for the specified theme, using the specified template and hash
let bareForTheme themeId template next ctx (hash : Hash) = task {
let! hash = addViewContext ctx hash
let (ThemeId theme) = themeId
if not (hash.ContainsKey ViewContext.Content) then
let! contentTemplate = TemplateCache.get theme template ctx.Data
addToHash ViewContext.Content (contentTemplate.Render hash) hash |> ignore
// Bare templates are rendered with layout-bare
let! layoutTemplate = TemplateCache.get theme "layout-bare" ctx.Data
return!
(messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage[])
>=> htmlString (layoutTemplate.Render hash))
next ctx
}
/// Return a view for the web log's default theme
let themedView template next ctx = fun (hash : Hash) -> task {
return! viewForTheme (deriveWebLogFromHash hash ctx).themePath template next ctx hash
let themedView template next ctx hash = task {
let! hash = addViewContext ctx hash
return! viewForTheme (hash[ViewContext.WebLog] :?> WebLog).ThemeId template next ctx hash
}
/// Display a view for the admin theme
let adminView template =
viewForTheme (ThemeId "admin") template
/// Display a bare view for the admin theme
let adminBareView template =
bareForTheme (ThemeId "admin") template
/// Redirect after doing some action; commits session and issues a temporary redirect
let redirectToGet url : HttpHandler = fun next ctx -> task {
let redirectToGet url : HttpHandler = fun _ ctx -> task {
do! commitSession ctx
return! redirectTo false url next ctx
return! redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink url)) earlyReturn ctx
}
open System.Security.Claims
/// Get the user ID for the current request
let userId (ctx : HttpContext) =
WebLogUserId (ctx.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value
open Microsoft.AspNetCore.Antiforgery
/// 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
/// Validate the anti cross-site request forgery token in the current request
let validateCsrf : HttpHandler = fun next ctx -> task {
match! (antiForgery ctx).IsRequestValidAsync ctx with
match! ctx.AntiForgery.IsRequestValidAsync ctx with
| true -> return! next ctx
| false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" next ctx
| false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" 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" }
|]
(messagesToHeaders messages >=> setStatusCode 404) earlyReturn ctx
else
(setStatusCode 404 >=> text "Not found") earlyReturn ctx)
/// Require a user to be logged on
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 MyWebLog.Data
/// Get the templates available for the current web log's theme (in a key/value pair list)
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 ->
return seq {
KeyValuePair.Create ("", $"- Default (single-{typ}) -")
yield!
theme.templates
theme.Templates
|> Seq.ofList
|> Seq.filter (fun it -> it.name.EndsWith $"-{typ}" && it.name <> $"single-{typ}")
|> Seq.map (fun it -> KeyValuePair.Create (it.name, it.name))
|> Seq.filter (fun it -> it.Name.EndsWith $"-{typ}" && it.Name <> $"single-{typ}")
|> Seq.map (fun it -> KeyValuePair.Create (it.Name, it.Name))
}
|> Array.ofSeq
| None -> return [| KeyValuePair.Create ("", $"- Default (single-{typ}) -") |]
@@ -203,29 +378,37 @@ let templatesForTheme (ctx : HttpContext) (typ : string) = backgroundTask {
/// Get all authors for a list of posts as metadata items
let getAuthors (webLog : WebLog) (posts : Post list) (data : IData) =
posts
|> List.map (fun p -> p.authorId)
|> List.map (fun p -> p.AuthorId)
|> List.distinct
|> data.WebLogUser.findNames webLog.id
|> data.WebLogUser.FindNames webLog.Id
/// Get all tag mappings for a list of posts as metadata items
let getTagMappings (webLog : WebLog) (posts : Post list) (data : IData) =
posts
|> List.map (fun p -> p.tags)
|> List.map (fun p -> p.Tags)
|> List.concat
|> 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)
let getCategoryIds slug 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
allCats
|> Seq.ofArray
|> Seq.filter (fun c -> c.id = cat.id || Array.contains cat.name c.parentNames)
|> Seq.map (fun c -> CategoryId c.id)
|> Seq.filter (fun c -> c.Id = cat.Id || Array.contains cat.Name c.ParentNames)
|> Seq.map (fun c -> CategoryId c.Id)
|> List.ofSeq
open System
open System.Globalization
/// Parse a date/time to UTC
let parseToUtc (date : string) =
DateTime.Parse (date, null, DateTimeStyles.AdjustToUniversal)
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Logging
/// Log level for debugging

View File

@@ -0,0 +1,190 @@
/// 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 ->
return! {|
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.Text}</div>"""
|}
|> makeHash |> adminBareView "" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
open System
// 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 = DateTime.UtcNow }
:: (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 = DateTime.UtcNow
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 slugPath = slugAndPage |> Seq.skip 1 |> Seq.head
let slugs, isFeed =
let feedName = $"/{webLog.rss.feedName}"
let feedName = $"/{webLog.Rss.FeedName}"
let notBlank = Array.filter (fun it -> it <> "")
if ( (webLog.rss.categoryEnabled && fullPath.StartsWith "/category/")
|| (webLog.rss.tagEnabled && fullPath.StartsWith "/tag/" ))
if ( (webLog.Rss.IsCategoryEnabled && fullPath.StartsWith "/category/")
|| (webLog.Rss.IsTagEnabled && fullPath.StartsWith "/tag/" ))
&& slugPath.EndsWith feedName then
notBlank (slugPath.Replace(feedName, "").Split "/"), true
else
notBlank (slugPath.Split "/"), false
else notBlank (slugPath.Split "/"), false
let pageIdx = Array.IndexOf (slugs, "page")
let pageNbr =
match pageIdx with
@@ -36,12 +35,11 @@ type ListType =
| TagList
open System.Threading.Tasks
open DotLiquid
open MyWebLog.Data
open MyWebLog.ViewModels
/// 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! tagMappings = getTagMappings webLog posts data
let relUrl it = Some <| WebLog.relativeUrl webLog (Permalink it)
@@ -55,14 +53,14 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (da
match listType with
| SinglePost ->
let post = List.head posts
let dateTime = defaultArg post.publishedOn post.updatedOn
data.Post.findSurroundingPosts webLog.id dateTime
let dateTime = defaultArg post.PublishedOn post.UpdatedOn
data.Post.FindSurroundingPosts webLog.Id dateTime
| _ -> Task.FromResult (None, None)
let newerLink =
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
| PostList, 2 when webLog.defaultPage = "posts" -> Some ""
| PostList, 2 when webLog.DefaultPage = "posts" -> Some ""
| PostList, _ -> relUrl $"page/{pageNbr - 1}"
| CategoryList, 2 -> relUrl $"category/{url}/"
| CategoryList, _ -> relUrl $"category/{url}/page/{pageNbr - 1}"
@@ -72,45 +70,47 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (da
| AdminList, _ -> relUrl $"admin/posts/page/{pageNbr - 1}"
let olderLink =
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
| PostList, true -> relUrl $"page/{pageNbr + 1}"
| CategoryList, true -> relUrl $"category/{url}/page/{pageNbr + 1}"
| TagList, true -> relUrl $"tag/{url}/page/{pageNbr + 1}"
| AdminList, true -> relUrl $"admin/posts/page/{pageNbr + 1}"
let model =
{ posts = postItems
authors = authors
subtitle = None
newerLink = newerLink
newerName = newerPost |> Option.map (fun p -> p.title)
olderLink = olderLink
olderName = olderPost |> Option.map (fun p -> p.title)
{ Posts = postItems
Authors = authors
Subtitle = None
NewerLink = newerLink
NewerName = newerPost |> Option.map (fun p -> p.Title)
OlderLink = olderLink
OlderName = olderPost |> Option.map (fun p -> p.Title)
}
return Hash.FromAnonymousObject {|
model = model
categories = CategoryCache.get ctx
tag_mappings = tagMappings
is_post = match listType with SinglePost -> true | _ -> false
|}
return
makeHash {||}
|> addToHash ViewContext.Model model
|> addToHash "tag_mappings" tagMappings
|> addToHash ViewContext.IsPost (match listType with SinglePost -> true | _ -> false)
}
open Giraffe
// GET /page/{pageNbr}
let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let count = ctx.WebLog.PostsPerPage
let data = ctx.Data
let! posts = data.Post.findPageOfPublishedPosts webLog.id pageNbr webLog.postsPerPage
let! hash = preparePostList webLog posts PostList "" pageNbr webLog.postsPerPage ctx data
let! posts = data.Post.FindPageOfPublishedPosts ctx.WebLog.Id pageNbr count
let! hash = preparePostList ctx.WebLog posts PostList "" pageNbr count data
let title =
match pageNbr, webLog.defaultPage with
match pageNbr, ctx.WebLog.DefaultPage with
| 1, "posts" -> None
| _, "posts" -> Some $"Page {pageNbr}"
| _, _ -> Some $"Page {pageNbr} &laquo; Posts"
match title with Some ttl -> hash.Add ("page_title", ttl) | None -> ()
if pageNbr = 1 && webLog.defaultPage = "posts" then hash.Add ("is_home", true)
return! themedView "index" next ctx hash
return!
match title with Some ttl -> addToHash ViewContext.PageTitle ttl hash | None -> 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}/
@@ -124,23 +124,24 @@ let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task {
let data = ctx.Data
match parseSlugAndPage webLog slugAndPage with
| 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 ->
return! Feed.generate (Feed.CategoryFeed ((CategoryId cat.id), $"category/{slug}/{webLog.rss.feedName}"))
(defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx
return! Feed.generate (Feed.CategoryFeed ((CategoryId cat.Id), $"category/{slug}/{webLog.Rss.FeedName}"))
(defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage) next ctx
| Some cat ->
// 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
| 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>"""
hash.Add ("page_title", $"{cat.name}: Category Archive{pgTitle}")
hash.Add ("subtitle", defaultArg cat.description "")
hash.Add ("is_category", true)
hash.Add ("is_category_home", (pageNbr = 1))
hash.Add ("slug", slug)
return! themedView "index" next ctx hash
return!
addToHash ViewContext.PageTitle $"{cat.Name}: Category Archive{pgTitle}" hash
|> addToHash "subtitle" (defaultArg cat.Description "")
|> addToHash ViewContext.IsCategory true
|> addToHash ViewContext.IsCategoryHome (pageNbr = 1)
|> addToHash ViewContext.Slug slug
|> themedView "index" next ctx
| _ -> 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 ->
let urlTag = HttpUtility.UrlDecode rawTag
let! tag = backgroundTask {
match! data.TagMap.findByUrlValue urlTag webLog.id with
| Some m -> return m.tag
match! data.TagMap.FindByUrlValue urlTag webLog.Id with
| Some m -> return m.Tag
| None -> return urlTag
}
if isFeed then
return! Feed.generate (Feed.TagFeed (tag, $"tag/{rawTag}/{webLog.rss.feedName}"))
(defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx
return! Feed.generate (Feed.TagFeed (tag, $"tag/{rawTag}/{webLog.Rss.FeedName}"))
(defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage) next ctx
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 ->
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>"""
hash.Add ("page_title", $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}")
hash.Add ("is_tag", true)
hash.Add ("is_tag_home", (pageNbr = 1))
hash.Add ("slug", rawTag)
return! themedView "index" next ctx hash
return!
addToHash ViewContext.PageTitle $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}" hash
|> addToHash ViewContext.IsTag true
|> addToHash ViewContext.IsTagHome (pageNbr = 1)
|> addToHash ViewContext.Slug rawTag
|> themedView "index" next ctx
// Other systems use hyphens for spaces; redirect if this is an old tag link
| _ ->
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 ->
let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}"
return!
@@ -191,158 +193,219 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
// GET /
let home : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
match webLog.defaultPage with
match webLog.DefaultPage with
| "posts" -> return! pageOfPosts 1 next ctx
| pageId ->
match! ctx.Data.Page.findById (PageId pageId) webLog.id with
match! ctx.Data.Page.FindById (PageId pageId) webLog.Id with
| Some page ->
return!
Hash.FromAnonymousObject {|
page = DisplayPage.fromPage webLog page
categories = CategoryCache.get ctx
page_title = page.title
is_home = true
|}
|> themedView (defaultArg page.template "single-page") next ctx
hashForPage page.Title
|> addToHash "page" (DisplayPage.fromPage webLog page)
|> addToHash ViewContext.IsHome true
|> themedView (defaultArg page.Template "single-page") next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/posts
// GET /admin/posts/page/{pageNbr}
let all pageNbr : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
let! posts = data.Post.findPageOfPosts webLog.id pageNbr 25
let! hash = preparePostList webLog posts AdminList "" pageNbr 25 ctx data
hash.Add ("page_title", "Posts")
hash.Add ("csrf", csrfToken ctx)
return! viewForTheme "admin" "post-list" next ctx hash
let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25
let! hash = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data
return!
addToHash ViewContext.PageTitle "Posts" hash
|> withAntiCsrf ctx
|> adminView "post-list" next ctx
}
// GET /admin/post/{id}/edit
let edit postId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
let! result = task {
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)
| None -> return None
}
match result with
| Some (title, post) ->
let! cats = data.Category.findAllForView webLog.id
| Some (title, post) when canEdit post.AuthorId ctx ->
let! templates = templatesForTheme ctx "post"
let model = EditPostModel.fromPost webLog post
let model = EditPostModel.fromPost ctx.WebLog post
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = model
metadata = Array.zip model.metaNames model.metaValues
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
page_title = title
templates = templates
categories = cats
explicit_values = [|
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
|> addToHash "explicit_values" [|
KeyValuePair.Create ("", "&ndash; Default &ndash;")
KeyValuePair.Create (ExplicitRating.toString Yes, "Yes")
KeyValuePair.Create (ExplicitRating.toString No, "No")
KeyValuePair.Create (ExplicitRating.toString Clean, "Clean")
|]
|}
|> viewForTheme "admin" "post-edit" next ctx
|> adminView "post-edit" next ctx
| Some _ -> return! Error.notAuthorized 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
let editPermalinks postId : HttpHandler = fun next ctx -> task {
match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with
| Some post ->
let editPermalinks 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 ->
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = ManagePermalinksModel.fromPost post
page_title = $"Manage Prior Permalinks"
|}
|> viewForTheme "admin" "permalinks" next ctx
hashForPage "Manage Prior Permalinks"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManagePermalinksModel.fromPost post)
|> adminView "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/post/permalinks
let savePermalinks : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let links = model.prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Post.updatePriorPermalinks (PostId model.id) webLog.id links with
let postId = PostId model.Id
match! ctx.Data.Post.FindById postId ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
let links = model.Prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Post.UpdatePriorPermalinks postId ctx.WebLog.Id links with
| true ->
do! addMessage ctx { UserMessage.success with message = "Post permalinks saved successfully" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{model.id}/permalinks")) next ctx
do! addMessage ctx { UserMessage.success with Message = "Post permalinks saved successfully" }
return! redirectToGet $"admin/post/{model.Id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/delete
let delete postId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
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" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/posts")) next ctx
}
#nowarn "3511"
// POST /admin/post/save
let save : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel> ()
let webLog = ctx.WebLog
let data = ctx.Data
let now = DateTime.UtcNow
let! pst = task {
match model.postId with
| "new" ->
return Some
{ Post.empty with
id = PostId.create ()
webLogId = webLog.id
authorId = userId ctx
}
| postId -> return! data.Post.findFullById (PostId postId) webLog.id
}
match pst with
| Some post ->
let revision = { asOf = now; text = MarkupText.parse $"{model.source}: {model.text}" }
// Detect a permalink change, and add the prior one to the prior list
let post =
match Permalink.toString post.permalink with
| "" -> post
| link when link = model.permalink -> post
| _ -> { post with priorPermalinks = post.permalink :: post.priorPermalinks }
let post = model.updatePost post revision now
let post =
match model.setPublished with
| true ->
let dt = WebLog.utcTime webLog model.pubOverride.Value
match model.setUpdated with
| true ->
{ post with
publishedOn = Some dt
updatedOn = dt
revisions = [ { (List.head post.revisions) with asOf = dt } ]
}
| false -> { post with publishedOn = Some dt }
| false -> post
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
if model.doPublish
|| not (pst.Value.categoryIds
|> List.append post.categoryIds
|> List.distinct
|> List.length = List.length pst.Value.categoryIds) then
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Post saved successfully" }
return!
redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{PostId.toString post.id}/edit")) next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/post/{id}/revisions
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 ->
return!
hashForPage "Manage Post Revisions"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManageRevisionsModel.fromPost ctx.WebLog post)
|> adminView "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/post/{id}/revisions/purge
let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
do! data.Post.Update { post with Revisions = [ List.head post.Revisions ] }
do! addMessage ctx { UserMessage.success with Message = "Prior revisions purged successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
open Microsoft.AspNetCore.Http
/// Find the post and the requested revision
let private findPostRevision postId revDate (ctx : HttpContext) = task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post ->
let asOf = parseToUtc revDate
return Some post, post.Revisions |> List.tryFind (fun r -> r.AsOf = asOf)
| None -> return None, None
}
// GET /admin/post/{id}/revision/{revision-date}/preview
let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
return! {|
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.Text}</div>"""
|}
|> makeHash |> adminBareView "" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/revision/{revision-date}/restore
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 = DateTime.UtcNow }
:: (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 now = DateTime.UtcNow
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 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
}

View File

@@ -8,7 +8,6 @@ open MyWebLog
/// Module to resolve routes that do not match any other known route (web blog content)
module CatchAll =
open DotLiquid
open MyWebLog.ViewModels
/// Sequence where the first returned value is the proper handler for the link
@@ -27,121 +26,86 @@ module CatchAll =
if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.empty)
let permalink = Permalink (textLink.Substring 1)
// Current post
match data.Post.findByPermalink permalink webLog.id |> await with
match data.Post.FindByPermalink permalink webLog.Id |> await with
| Some post ->
debug (fun () -> $"Found post by permalink")
let model = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 ctx data |> await
model.Add ("page_title", post.title)
yield fun next ctx -> themedView (defaultArg post.template "single-post") next ctx model
debug (fun () -> "Found post by permalink")
let hash = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 data |> await
yield fun next ctx ->
addToHash ViewContext.PageTitle post.Title hash
|> themedView (defaultArg post.Template "single-post") next ctx
| None -> ()
// Current page
match data.Page.findByPermalink permalink webLog.id |> await with
match data.Page.FindByPermalink permalink webLog.Id |> await with
| Some page ->
debug (fun () -> $"Found page by permalink")
debug (fun () -> "Found page by permalink")
yield fun next ctx ->
Hash.FromAnonymousObject {|
page = DisplayPage.fromPage webLog page
categories = CategoryCache.get ctx
page_title = page.title
is_page = true
|}
|> themedView (defaultArg page.template "single-page") next ctx
hashForPage page.Title
|> addToHash "page" (DisplayPage.fromPage webLog page)
|> addToHash ViewContext.IsPage true
|> themedView (defaultArg page.Template "single-page") next ctx
| None -> ()
// RSS feed
match Feed.deriveFeedType ctx textLink with
| Some (feedType, postCount) ->
debug (fun () -> $"Found RSS feed")
debug (fun () -> "Found RSS feed")
yield Feed.generate feedType postCount
| None -> ()
// Post differing only by trailing slash
let altLink =
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 ->
debug (fun () -> $"Found post by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog post.permalink)
debug (fun () -> "Found post by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog post.Permalink)
| None -> ()
// 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 ->
debug (fun () -> $"Found page by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog page.permalink)
debug (fun () -> "Found page by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog page.Permalink)
| None -> ()
// Prior post
match data.Post.findCurrentPermalink [ permalink; altLink ] webLog.id |> await with
match data.Post.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with
| Some link ->
debug (fun () -> $"Found post by prior permalink")
debug (fun () -> "Found post by prior permalink")
yield redirectTo true (WebLog.relativeUrl webLog link)
| None -> ()
// Prior page
match data.Page.findCurrentPermalink [ permalink; altLink ] webLog.id |> await with
match data.Page.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with
| Some link ->
debug (fun () -> $"Found page by prior permalink")
debug (fun () -> "Found page by prior permalink")
yield redirectTo true (WebLog.relativeUrl webLog link)
| None -> ()
debug (fun () -> $"No content found")
debug (fun () -> "No content found")
}
// GET {all-of-the-above}
let route : HttpHandler = fun next ctx -> task {
match deriveAction ctx |> Seq.tryHead with
| Some handler -> return! handler next ctx
| None -> return! Error.notFound next ctx
}
let route : HttpHandler = fun next ctx ->
match deriveAction ctx |> Seq.tryHead with Some handler -> handler next ctx | None -> Error.notFound next ctx
/// Serve theme assets
module Asset =
open System
open Microsoft.AspNetCore.Http.Headers
open Microsoft.AspNetCore.StaticFiles
open Microsoft.Net.Http.Headers
/// Determine if the asset has been modified since the date/time specified by the If-Modified-Since header
let private checkModified asset (ctx : HttpContext) : HttpHandler option =
match ctx.Request.Headers.IfModifiedSince with
| it when it.Count < 1 -> None
| it ->
if asset.updatedOn > DateTime.Parse it[0] then
None
else
Some (setStatusCode 304 >=> setBodyFromString "Not Modified")
/// An instance of ASP.NET Core's file extension to MIME type converter
let private mimeMap = FileExtensionContentTypeProvider ()
// GET /theme/{theme}/{**path}
let serveAsset (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
match! ctx.Data.ThemeAsset.findById (ThemeAssetId.ofString path) with
match! ctx.Data.ThemeAsset.FindById (ThemeAssetId.ofString path) with
| Some asset ->
match checkModified asset ctx with
match Upload.checkModified asset.UpdatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx
| None ->
let mimeType =
match mimeMap.TryGetContentType path with
| true, typ -> typ
| false, _ -> "application/octet-stream"
let headers = ResponseHeaders ctx.Response.Headers
headers.LastModified <- Some (DateTimeOffset asset.updatedOn) |> Option.toNullable
headers.ContentType <- MediaTypeHeaderValue mimeType
headers.CacheControl <-
let hdr = CacheControlHeaderValue()
hdr.MaxAge <- Some (TimeSpan.FromDays 30) |> Option.toNullable
hdr
return! setBody asset.data next ctx
| None -> return! Upload.sendFile asset.UpdatedOn path asset.Data next ctx
| None -> return! Error.notFound next ctx
}
/// The primary myWebLog router
let router : HttpHandler = choose [
GET >=> choose [
GET_HEAD >=> choose [
route "/" >=> Post.home
]
subRoute "/admin" (requireUser >=> choose [
GET >=> choose [
GET_HEAD >=> choose [
subRoute "/categor" (choose [
route "ies" >=> Admin.listCategories
route "ies/bare" >=> Admin.listCategoriesBare
@@ -149,16 +113,20 @@ let router : HttpHandler = choose [
])
route "/dashboard" >=> Admin.dashboard
subRoute "/page" (choose [
route "s" >=> Admin.listPages 1
routef "s/page/%i" Admin.listPages
routef "/%s/edit" Admin.editPage
routef "/%s/permalinks" Admin.editPagePermalinks
route "s" >=> Page.all 1
routef "s/page/%i" Page.all
routef "/%s/edit" Page.edit
routef "/%s/permalinks" Page.editPermalinks
routef "/%s/revision/%s/preview" Page.previewRevision
routef "/%s/revisions" Page.editRevisions
])
subRoute "/post" (choose [
route "s" >=> Post.all 1
routef "s/page/%i" Post.all
routef "/%s/edit" Post.edit
routef "/%s/permalinks" Post.editPermalinks
routef "/%s/revision/%s/preview" Post.previewRevision
routef "/%s/revisions" Post.editRevisions
])
subRoute "/settings" (choose [
route "" >=> Admin.settings
@@ -173,7 +141,16 @@ let router : HttpHandler = choose [
])
])
route "/theme/update" >=> Admin.themeUpdatePage
route "/user/edit" >=> User.edit
subRoute "/upload" (choose [
route "s" >=> Upload.list
route "/new" >=> Upload.showNew
])
subRoute "/user" (choose [
route "s" >=> User.all
route "s/bare" >=> User.bare
route "/my-info" >=> User.myInfo
routef "/%s/edit" User.edit
])
]
POST >=> validateCsrf >=> choose [
subRoute "/category" (choose [
@@ -181,14 +158,20 @@ let router : HttpHandler = choose [
routef "/%s/delete" Admin.deleteCategory
])
subRoute "/page" (choose [
route "/save" >=> Admin.savePage
route "/permalinks" >=> Admin.savePagePermalinks
routef "/%s/delete" Admin.deletePage
route "/save" >=> Page.save
route "/permalinks" >=> Page.savePermalinks
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 [
route "/save" >=> Post.save
route "/permalinks" >=> Post.savePermalinks
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 [
route "" >=> Admin.saveSettings
@@ -203,14 +186,24 @@ let router : HttpHandler = choose [
])
])
route "/theme/update" >=> Admin.updateTheme
route "/user/save" >=> User.save
subRoute "/upload" (choose [
route "/save" >=> Upload.save
routexp "/delete/(.*)" Upload.deleteFromDisk
routef "/%s/delete" Upload.deleteFromDb
])
subRoute "/user" (choose [
route "/my-info" >=> User.saveMyInfo
route "/save" >=> User.save
routef "/%s/delete" User.delete
])
]
])
GET_HEAD >=> routexp "/category/(.*)" Post.pageOfCategorizedPosts
GET_HEAD >=> routef "/page/%i" Post.pageOfPosts
GET_HEAD >=> routef "/page/%i/" Post.redirectToPageOfPosts
GET_HEAD >=> routexp "/tag/(.*)" Post.pageOfTaggedPosts
GET_HEAD >=> routexp "/themes/(.*)" Asset.serveAsset
GET_HEAD >=> routexp "/themes/(.*)" Asset.serve
GET_HEAD >=> routexp "/upload/(.*)" Upload.serve
subRoute "/user" (choose [
GET_HEAD >=> choose [
route "/log-on" >=> User.logOn None
@@ -229,10 +222,10 @@ let routerWithPath extraPath : HttpHandler =
subRoute extraPath router
/// 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
return! (if extraPath = "" then router else routerWithPath extraPath) next ctx
}
(if extraPath = "" then router else routerWithPath extraPath) next ctx
open Giraffe.EndpointRouting

View File

@@ -0,0 +1,205 @@
/// Handlers to manipulate uploaded files
module MyWebLog.Handlers.Upload
open System
open System.IO
open Microsoft.Net.Http.Headers
/// Helper functions for this module
[<AutoOpen>]
module private Helpers =
open Microsoft.AspNetCore.StaticFiles
/// A MIME type mapper instance to use when serving files from the database
let mimeMap = FileExtensionContentTypeProvider ()
/// A cache control header that instructs the browser to cache the result for no more than 30 days
let cacheForThirtyDays =
let hdr = CacheControlHeaderValue()
hdr.MaxAge <- Some (TimeSpan.FromDays 30) |> Option.toNullable
hdr
/// Shorthand for the directory separator
let slash = Path.DirectorySeparatorChar
/// The base directory where uploads are stored, relative to the executable
let uploadDir = Path.Combine ("wwwroot", "upload")
// ~~ SERVING UPLOADS ~~
open Giraffe
open Microsoft.AspNetCore.Http
/// 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 =
match ctx.Request.Headers.IfModifiedSince with
| it when it.Count < 1 -> None
| it when since > DateTime.Parse it[0] -> None
| _ -> Some (setStatusCode 304 >=> setBodyFromString "Not Modified")
open Microsoft.AspNetCore.Http.Headers
/// Derive a MIME type based on the extension of the file
let deriveMimeType path =
match mimeMap.TryGetContentType path with true, typ -> typ | false, _ -> "application/octet-stream"
/// Send a file, caching the response for 30 days
let sendFile updatedOn path (data : byte[]) : HttpHandler = fun next ctx ->
let headers = ResponseHeaders ctx.Response.Headers
headers.ContentType <- (deriveMimeType >> MediaTypeHeaderValue) path
headers.CacheControl <- cacheForThirtyDays
let stream = new MemoryStream (data)
streamData true stream None (Some (DateTimeOffset updatedOn)) next ctx
open MyWebLog
// GET /upload/{web-log-slug}/{**path}
let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let parts = (urlParts |> Seq.skip 1 |> Seq.head).Split '/'
let slug = Array.head parts
if slug = webLog.Slug then
// Static file middleware will not work in subdirectories; check for an actual file first
let fileName = Path.Combine ("wwwroot", (Seq.head urlParts)[1..])
if File.Exists fileName then
return! streamFile true fileName None None next ctx
else
let path = String.Join ('/', Array.skip 1 parts)
match! ctx.Data.Upload.FindByPath path webLog.Id with
| Some upload ->
match checkModified upload.UpdatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx
| None -> return! sendFile upload.UpdatedOn path upload.Data next ctx
| None -> return! Error.notFound next ctx
else
return! Error.notFound next ctx
}
// ~~ ADMINISTRATION ~~
open System.Text.RegularExpressions
open MyWebLog.ViewModels
/// Turn a string into a lowercase URL-safe slug
let makeSlug it = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 ]").Replace (it, ""), "-")).ToLowerInvariant ()
// GET /admin/uploads
let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let webLog = ctx.WebLog
let! dbUploads = ctx.Data.Upload.FindByWebLog webLog.Id
let diskUploads =
let path = Path.Combine (uploadDir, webLog.Slug)
try
Directory.EnumerateFiles (path, "*", SearchOption.AllDirectories)
|> Seq.map (fun file ->
let name = Path.GetFileName file
let create =
match File.GetCreationTime (Path.Combine (path, file)) with
| dt when dt > DateTime.UnixEpoch -> Some dt
| _ -> None
{ DisplayUpload.Id = ""
Name = name
Path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace (slash, '/')
UpdatedOn = create
Source = UploadDestination.toString Disk
})
|> List.ofSeq
with
| :? DirectoryNotFoundException -> [] // This is fine
| ex ->
warn "Upload" ctx $"Encountered {ex.GetType().Name} listing uploads for {path}:\n{ex.Message}"
[]
let allFiles =
dbUploads
|> List.map (DisplayUpload.fromUpload webLog Database)
|> List.append diskUploads
|> List.sortByDescending (fun file -> file.UpdatedOn, file.Path)
return!
hashForPage "Uploaded Files"
|> withAntiCsrf ctx
|> addToHash "files" allFiles
|> adminView "upload-list" next ctx
}
// GET /admin/upload/new
let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
hashForPage "Upload a File"
|> withAntiCsrf ctx
|> addToHash "destination" (UploadDestination.toString ctx.WebLog.Uploads)
|> adminView "upload-new" next ctx
/// Redirect to the upload list
let showUploads : HttpHandler =
redirectToGet "admin/uploads"
// POST /admin/upload/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let upload = Seq.head ctx.Request.Form.Files
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
Path.GetExtension(upload.FileName).ToLowerInvariant ())
let localNow = WebLog.localTime ctx.WebLog DateTime.Now
let year = localNow.ToString "yyyy"
let month = localNow.ToString "MM"
let! form = ctx.BindFormAsync<UploadFileModel> ()
match UploadDestination.parse form.Destination with
| Database ->
use stream = new MemoryStream ()
do! upload.CopyToAsync stream
let file =
{ Id = UploadId.create ()
WebLogId = ctx.WebLog.Id
Path = Permalink $"{year}/{month}/{fileName}"
UpdatedOn = DateTime.UtcNow
Data = stream.ToArray ()
}
do! ctx.Data.Upload.Add file
| Disk ->
let fullPath = Path.Combine (uploadDir, ctx.WebLog.Slug, year, month)
let _ = Directory.CreateDirectory fullPath
use stream = new FileStream (Path.Combine (fullPath, fileName), FileMode.Create)
do! upload.CopyToAsync stream
do! addMessage ctx { UserMessage.success with Message = $"File uploaded to {form.Destination} successfully" }
return! showUploads next ctx
else
return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx
}
// POST /admin/upload/{id}/delete
let deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.Id with
| Ok fileName ->
do! addMessage ctx { UserMessage.success with Message = $"{fileName} deleted successfully" }
return! showUploads next ctx
| Error _ -> return! Error.notFound next ctx
}
/// Remove a directory tree if it is empty
let removeEmptyDirectories (webLog : WebLog) (filePath : string) =
let mutable path = Path.GetDirectoryName filePath
let mutable finished = false
while (not finished) && path > "" do
let fullPath = Path.Combine (uploadDir, webLog.Slug, path)
if Directory.EnumerateFileSystemEntries fullPath |> Seq.isEmpty then
Directory.Delete fullPath
path <- String.Join(slash, path.Split slash |> Array.rev |> Array.skip 1 |> Array.rev)
else finished <- true
// POST /admin/upload/delete/{**path}
let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let filePath = urlParts |> Seq.skip 1 |> Seq.head
let path = Path.Combine (uploadDir, ctx.WebLog.Slug, filePath)
if File.Exists path then
File.Delete path
removeEmptyDirectories ctx.WebLog filePath
do! addMessage ctx { UserMessage.success with Message = $"{filePath} deleted successfully" }
return! showUploads next ctx
else return! Error.notFound next ctx
}

View File

@@ -5,114 +5,235 @@ open System
open System.Security.Cryptography
open System.Text
// ~~ LOG ON / LOG OFF ~~
/// Hash a password for a given user
let hashedPassword (plainText : string) (email : string) (salt : Guid) =
let allSalt = Array.concat [ salt.ToByteArray (); Encoding.UTF8.GetBytes email ]
use alg = new Rfc2898DeriveBytes (plainText, allSalt, 2_048)
Convert.ToBase64String (alg.GetBytes 64)
open DotLiquid
open Giraffe
open MyWebLog
open MyWebLog.ViewModels
// GET /user/log-on
let logOn returnUrl : HttpHandler = fun next ctx -> task {
let logOn returnUrl : HttpHandler = fun next ctx ->
let returnTo =
match returnUrl with
| Some _ -> returnUrl
| None ->
match ctx.Request.Query.ContainsKey "returnUrl" with
| true -> Some ctx.Request.Query["returnUrl"].[0]
| false -> None
return!
Hash.FromAnonymousObject {|
model = { LogOnModel.empty with returnTo = returnTo }
page_title = "Log On"
csrf = csrfToken ctx
|}
|> viewForTheme "admin" "log-on" next ctx
}
| None -> if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None
hashForPage "Log On"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model { LogOnModel.empty with ReturnTo = returnTo }
|> adminView "log-on" next ctx
open System.Security.Claims
open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies
open MyWebLog
// POST /user/log-on
let doLogOn : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel> ()
let webLog = ctx.WebLog
match! ctx.Data.WebLogUser.findByEmail model.emailAddress webLog.id with
| Some user when user.passwordHash = hashedPassword model.password user.userName user.salt ->
let data = ctx.Data
match! data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id with
| Some user when user.PasswordHash = hashedPassword model.Password user.Email user.Salt ->
let claims = seq {
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.id)
Claim (ClaimTypes.Name, $"{user.firstName} {user.lastName}")
Claim (ClaimTypes.GivenName, user.preferredName)
Claim (ClaimTypes.Role, user.authorizationLevel.ToString ())
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id)
Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
Claim (ClaimTypes.GivenName, user.PreferredName)
Claim (ClaimTypes.Role, AccessLevel.toString user.AccessLevel)
}
let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity,
AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow))
do! data.WebLogUser.SetLastSeen user.Id user.WebLogId
do! addMessage ctx
{ UserMessage.success with message = $"Logged on successfully | Welcome to {webLog.name}!" }
return! redirectToGet (defaultArg model.returnTo (WebLog.relativeUrl webLog (Permalink "admin/dashboard")))
next ctx
{ UserMessage.success with Message = $"Logged on successfully | Welcome to {ctx.WebLog.Name}!" }
return!
match model.ReturnTo with
| Some url -> redirectTo false url next ctx
| None -> redirectToGet "admin/dashboard" next ctx
| _ ->
do! addMessage ctx { UserMessage.error with message = "Log on attempt unsuccessful" }
return! logOn model.returnTo next ctx
do! addMessage ctx { UserMessage.error with Message = "Log on attempt unsuccessful" }
return! logOn model.ReturnTo next ctx
}
// GET /user/log-off
let logOff : HttpHandler = fun next ctx -> task {
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
do! addMessage ctx { UserMessage.info with message = "Log off successful" }
return! redirectToGet (WebLog.relativeUrl ctx.WebLog Permalink.empty) next ctx
do! addMessage ctx { UserMessage.info with Message = "Log off successful" }
return! redirectToGet "" next ctx
}
/// Display the user edit page, with information possibly filled in
let private showEdit (hash : Hash) : HttpHandler = fun next ctx -> task {
hash.Add ("page_title", "Edit Your Information")
hash.Add ("csrf", csrfToken ctx)
return! viewForTheme "admin" "user-edit" next ctx hash
// ~~ ADMINISTRATION ~~
open System.Collections.Generic
open Giraffe.Htmx
open Microsoft.AspNetCore.Http
/// Create the hash needed to display the user list
let private userListHash (ctx : HttpContext) = 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)
|> addViewContext ctx
}
// GET /admin/user/edit
let edit : HttpHandler = fun next ctx -> task {
match! ctx.Data.WebLogUser.findById (userId ctx) ctx.WebLog.id with
| Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) next ctx
/// Got no time for URL/form manipulators...
let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?"
// GET /admin/users
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash = userListHash ctx
let! tmpl = TemplateCache.get "admin" "user-list-body" ctx.Data
return!
addToHash "user_list" (tmpl.Render hash) hash
|> adminView "user-list" next ctx
}
// GET /admin/users/bare
let bare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash = userListHash ctx
return! adminBareView "user-list-body" next ctx hash
}
/// Show the edit user page
let private showEdit (model : EditUserModel) : HttpHandler = fun next ctx ->
hashForPage (if model.IsNew then "Add a New User" else "Edit User")
|> 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/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
}
// POST /admin/user/save
let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel> ()
if model.newPassword = model.newPasswordConfirm then
let data = ctx.Data
match! data.WebLogUser.findById (userId ctx) ctx.WebLog.id with
let tryUser =
if model.IsNew then
{ WebLogUser.empty with
Id = WebLogUserId.create ()
WebLogId = ctx.WebLog.Id
CreatedOn = DateTime.UtcNow
} |> 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 updatedUser =
if model.Password = "" then updatedUser
else
let salt = Guid.NewGuid ()
{ updatedUser with PasswordHash = hashedPassword model.Password model.Email salt; Salt = salt }
do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) updatedUser
do! addMessage ctx
{ UserMessage.success with
Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully"""
}
return! bare 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
}
// POST /admin/user/{id}/delete
let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLogUser.FindById (WebLogUserId userId) ctx.WebLog.Id with
| Some user ->
if user.AccessLevel = Administrator && not (ctx.HasAccessLevel Administrator) then
return! goAway next ctx
else
match! data.WebLogUser.Delete user.Id user.WebLogId with
| Ok _ ->
do! addMessage ctx
{ UserMessage.success with
Message = $"User {WebLogUser.displayName user} deleted successfully"
}
return! bare next ctx
| Error msg ->
do! addMessage ctx
{ UserMessage.error with
Message = $"User {WebLogUser.displayName user} was not deleted"
Detail = Some msg
}
return! bare next ctx
| None -> return! Error.notFound next ctx
}
/// Display the user "my info" page, with information possibly filled in
let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandler = fun next ctx ->
hashForPage "Edit Your Information"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> 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 DateTime.UnixEpoch))
|> adminView "my-info" next ctx
// GET /admin/user/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/user/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, salt =
if model.newPassword = "" then
user.passwordHash, user.salt
if model.NewPassword = "" then
user.PasswordHash, user.Salt
else
let newSalt = Guid.NewGuid ()
hashedPassword model.newPassword user.userName newSalt, newSalt
hashedPassword model.NewPassword user.Email newSalt, newSalt
let user =
{ user with
firstName = model.firstName
lastName = model.lastName
preferredName = model.preferredName
passwordHash = pw
salt = salt
FirstName = model.FirstName
LastName = model.LastName
PreferredName = model.PreferredName
PasswordHash = pw
Salt = salt
}
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 (WebLog.relativeUrl ctx.WebLog (Permalink "admin/user/edit")) next ctx
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/user/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
else
do! addMessage ctx { UserMessage.error with message = "Passwords did not match; no updates made" }
return! showEdit (Hash.FromAnonymousObject {|
model = { model with newPassword = ""; newPasswordConfirm = "" }
|}) next ctx
}

View File

@@ -23,65 +23,80 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
let webLogId = WebLogId.create ()
let userId = WebLogUserId.create ()
let homePageId = PageId.create ()
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
id = webLogId
name = args[2]
urlBase = args[1]
defaultPage = PageId.toString homePageId
timeZone = timeZone
Id = webLogId
Name = args[2]
Slug = slug
UrlBase = args[1]
DefaultPage = PageId.toString homePageId
TimeZone = timeZone
}
// Create the admin user
let salt = Guid.NewGuid ()
let now = DateTime.UtcNow
do! data.WebLogUser.add
do! data.WebLogUser.Add
{ WebLogUser.empty with
id = userId
webLogId = webLogId
userName = args[3]
firstName = "Admin"
lastName = "User"
preferredName = "Admin"
passwordHash = Handlers.User.hashedPassword args[4] args[3] salt
salt = salt
authorizationLevel = Administrator
Id = userId
WebLogId = webLogId
Email = args[3]
FirstName = "Admin"
LastName = "User"
PreferredName = "Admin"
PasswordHash = Handlers.User.hashedPassword args[4] args[3] salt
Salt = salt
AccessLevel = accessLevel
CreatedOn = now
}
// Create the default home page
do! data.Page.add
do! data.Page.Add
{ Page.empty with
id = homePageId
webLogId = webLogId
authorId = userId
title = "Welcome to myWebLog!"
permalink = Permalink "welcome-to-myweblog.html"
publishedOn = DateTime.UtcNow
updatedOn = DateTime.UtcNow
text = "<p>This is your default home page.</p>"
revisions = [
{ asOf = DateTime.UtcNow
text = Html "<p>This is your default home page.</p>"
Id = homePageId
WebLogId = webLogId
AuthorId = userId
Title = "Welcome to myWebLog!"
Permalink = Permalink "welcome-to-myweblog.html"
PublishedOn = now
UpdatedOn = now
Text = "<p>This is your default home page.</p>"
Revisions = [
{ AsOf = now
Text = Html "<p>This is your default home page.</p>"
}
]
}
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
let createWebLog args sp = task {
match args |> Array.length with
| 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]"
let importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
let private importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
let data = sp.GetRequiredService<IData> ()
match! data.WebLog.findByHost urlBase with
match! data.WebLog.FindByHost urlBase with
| Some webLog ->
let mapping =
@@ -92,13 +107,13 @@ let importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
Permalink parts[0], Permalink parts[1])
for old, current in mapping do
match! data.Post.findByPermalink current webLog.id with
match! data.Post.FindByPermalink current webLog.Id with
| Some post ->
let! withLinks = data.Post.findFullById post.id post.webLogId
let! _ = data.Post.updatePriorPermalinks post.id post.webLogId
(old :: withLinks.Value.priorPermalinks)
let! withLinks = data.Post.FindFullById post.Id post.WebLogId
let! _ = data.Post.UpdatePriorPermalinks post.Id post.WebLogId
(old :: withLinks.Value.PriorPermalinks)
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!"
| None -> eprintfn $"No web log found at {urlBase}"
}
@@ -107,7 +122,7 @@ let importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
let importLinks args sp = task {
match args |> Array.length with
| 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
@@ -131,8 +146,8 @@ let loadTheme (args : string[]) (sp : IServiceProvider) = task {
printfn $"Theme {themeName} loaded successfully"
| Error message -> eprintfn $"{message}"
else
printfn "Usage: MyWebLog load-theme [theme-zip-file-name] [*clean-load]"
printfn " * optional, defaults to true"
eprintfn "Usage: MyWebLog load-theme [theme-zip-file-name] [*clean-load]"
eprintfn " * optional, defaults to true"
}
/// Back up a web log's data
@@ -145,55 +160,93 @@ module Backup =
/// A theme asset, with the data base-64 encoded
type EncodedAsset =
{ /// The ID of the theme asset
id : ThemeAssetId
Id : ThemeAssetId
/// The updated date for this asset
updatedOn : DateTime
UpdatedOn : DateTime
/// The data for this asset, base-64 encoded
data : string
Data : string
}
/// Create an encoded theme asset from the original theme asset
static member fromAsset (asset : ThemeAsset) =
{ id = asset.id
updatedOn = asset.updatedOn
data = Convert.ToBase64String asset.data
{ Id = asset.Id
UpdatedOn = asset.UpdatedOn
Data = Convert.ToBase64String asset.Data
}
/// Create a theme asset from an encoded theme asset
static member fromAsset (asset : EncodedAsset) : ThemeAsset =
{ id = asset.id
updatedOn = asset.updatedOn
data = Convert.FromBase64String asset.data
static member toAsset (encoded : EncodedAsset) : ThemeAsset =
{ Id = encoded.Id
UpdatedOn = encoded.UpdatedOn
Data = Convert.FromBase64String encoded.Data
}
/// An uploaded file, with the data base-64 encoded
type EncodedUpload =
{ /// The ID of the upload
Id : UploadId
/// The ID of the web log to which the upload belongs
WebLogId : WebLogId
/// The path at which this upload is served
Path : Permalink
/// The date/time this upload was last updated (file time)
UpdatedOn : DateTime
/// The data for the upload, base-64 encoded
Data : string
}
/// Create an encoded uploaded file from the original uploaded file
static member fromUpload (upload : Upload) : EncodedUpload =
{ Id = upload.Id
WebLogId = upload.WebLogId
Path = upload.Path
UpdatedOn = upload.UpdatedOn
Data = Convert.ToBase64String upload.Data
}
/// Create an uploaded file from an encoded uploaded file
static member toUpload (encoded : EncodedUpload) : Upload =
{ Id = encoded.Id
WebLogId = encoded.WebLogId
Path = encoded.Path
UpdatedOn = encoded.UpdatedOn
Data = Convert.FromBase64String encoded.Data
}
/// A unified archive for a web log
type Archive =
{ /// The web log to which this archive belongs
webLog : WebLog
WebLog : WebLog
/// 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
theme : Theme
Theme : Theme
/// 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
categories : Category list
Categories : Category list
/// 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)
pages : Page list
Pages : Page list
/// 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
Uploads : EncodedUpload list
}
/// Create a JSON serializer (uses RethinkDB data implementation's JSON converters)
@@ -206,58 +259,62 @@ module Backup =
/// Display statistics for a backup archive
let private displayStats (msg : string) (webLog : WebLog) archive =
let userCount = List.length archive.users
let assetCount = List.length archive.assets
let categoryCount = List.length archive.categories
let tagMapCount = List.length archive.tagMappings
let pageCount = List.length archive.pages
let postCount = List.length archive.posts
let userCount = List.length archive.Users
let assetCount = List.length archive.Assets
let categoryCount = List.length archive.Categories
let tagMapCount = List.length archive.TagMappings
let pageCount = List.length archive.Pages
let postCount = List.length archive.Posts
let uploadCount = List.length archive.Uploads
// Create a pluralized output based on the count
let plural count ifOne ifMany =
if count = 1 then ifOne else ifMany
printfn ""
printfn $"""{msg.Replace ("{{NAME}}", webLog.name)}"""
printfn $""" - The theme "{archive.theme.name}" with {assetCount} asset{plural assetCount "" "s"}"""
printfn $"""{msg.Replace ("<>NAME<>", webLog.Name)}"""
printfn $""" - The theme "{archive.Theme.Name}" with {assetCount} asset{plural assetCount "" "s"}"""
printfn $""" - {userCount} user{plural userCount "" "s"}"""
printfn $""" - {categoryCount} categor{plural categoryCount "y" "ies"}"""
printfn $""" - {tagMapCount} tag mapping{plural tagMapCount "" "s"}"""
printfn $""" - {pageCount} page{plural pageCount "" "s"}"""
printfn $""" - {postCount} post{plural postCount "" "s"}"""
printfn $""" - {uploadCount} uploaded file{plural uploadCount "" "s"}"""
/// Create a backup archive
let private createBackup webLog (fileName : string) prettyOutput (data : IData) = task {
// Create the data structure
let themeId = ThemeId webLog.themePath
printfn "- Exporting theme..."
let! theme = data.Theme.findById themeId
let! assets = data.ThemeAsset.findByThemeWithData themeId
let! theme = data.Theme.FindById webLog.ThemeId
let! assets = data.ThemeAsset.FindByThemeWithData webLog.ThemeId
printfn "- Exporting users..."
let! users = data.WebLogUser.findByWebLog webLog.id
let! users = data.WebLogUser.FindByWebLog webLog.Id
printfn "- Exporting categories and tag mappings..."
let! categories = data.Category.findByWebLog webLog.id
let! tagMaps = data.TagMap.findByWebLog webLog.id
let! categories = data.Category.FindByWebLog webLog.Id
let! tagMaps = data.TagMap.FindByWebLog webLog.Id
printfn "- Exporting pages..."
let! pages = data.Page.findFullByWebLog webLog.id
let! pages = data.Page.FindFullByWebLog webLog.Id
printfn "- Exporting posts..."
let! posts = data.Post.findFullByWebLog webLog.id
let! posts = data.Post.FindFullByWebLog webLog.Id
printfn "- Exporting uploads..."
let! uploads = data.Upload.FindByWebLogWithData webLog.Id
printfn "- Writing archive..."
let archive = {
webLog = webLog
users = users
theme = Option.get theme
assets = assets |> List.map EncodedAsset.fromAsset
categories = categories
tagMappings = tagMaps
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 })
let archive =
{ WebLog = webLog
Users = users
Theme = Option.get theme
Assets = assets |> List.map EncodedAsset.fromAsset
Categories = categories
TagMappings = tagMaps
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 })
Uploads = uploads |> List.map EncodedUpload.fromUpload
}
// Write the structure to the backup file
@@ -267,82 +324,88 @@ module Backup =
serializer.Serialize (writer, archive)
writer.Close ()
displayStats "{{NAME}} backup contains:" webLog archive
displayStats $"{fileName} (for <>NAME<>) contains:" webLog archive
}
let private doRestore archive newUrlBase (data : IData) = task {
let! restore = task {
match! data.WebLog.findById archive.webLog.id with
| Some webLog when defaultArg newUrlBase webLog.urlBase = webLog.urlBase ->
do! data.WebLog.delete webLog.id
return { archive with webLog = { archive.webLog with urlBase = defaultArg newUrlBase webLog.urlBase } }
match! data.WebLog.FindById archive.WebLog.Id with
| Some webLog when defaultArg newUrlBase webLog.UrlBase = webLog.UrlBase ->
do! data.WebLog.Delete webLog.Id
return { archive with WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase webLog.UrlBase } }
| Some _ ->
// Err'body gets new IDs...
let newWebLogId = WebLogId.create ()
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 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 newUserIds = archive.users |> List.map (fun user -> user.id, WebLogUserId.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 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 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
return
{ archive with
webLog = { archive.webLog with id = newWebLogId; urlBase = Option.get newUrlBase }
users = archive.users
|> List.map (fun u -> { u with id = newUserIds[u.id]; webLogId = newWebLogId })
categories = archive.categories
|> List.map (fun c -> { c with id = newCatIds[c.id]; webLogId = newWebLogId })
tagMappings = archive.tagMappings
|> List.map (fun tm -> { tm with id = newMapIds[tm.id]; webLogId = newWebLogId })
pages = archive.pages
WebLog = { archive.WebLog with Id = newWebLogId; UrlBase = Option.get newUrlBase }
Users = archive.Users
|> List.map (fun u -> { u with Id = newUserIds[u.Id]; WebLogId = newWebLogId })
Categories = archive.Categories
|> List.map (fun c -> { c with Id = newCatIds[c.Id]; WebLogId = newWebLogId })
TagMappings = archive.TagMappings
|> List.map (fun tm -> { tm with Id = newMapIds[tm.Id]; WebLogId = newWebLogId })
Pages = archive.Pages
|> List.map (fun page ->
{ page with
id = newPageIds[page.id]
webLogId = newWebLogId
authorId = newUserIds[page.authorId]
Id = newPageIds[page.Id]
WebLogId = newWebLogId
AuthorId = newUserIds[page.AuthorId]
})
posts = archive.posts
Posts = archive.Posts
|> List.map (fun post ->
{ post with
id = newPostIds[post.id]
webLogId = newWebLogId
authorId = newUserIds[post.authorId]
categoryIds = post.categoryIds |> List.map (fun c -> newCatIds[c])
Id = newPostIds[post.Id]
WebLogId = newWebLogId
AuthorId = newUserIds[post.AuthorId]
CategoryIds = post.CategoryIds |> List.map (fun c -> newCatIds[c])
})
Uploads = archive.Uploads
|> List.map (fun u -> { u with Id = newUpIds[u.Id]; WebLogId = newWebLogId })
}
| None ->
return
{ 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)
printfn ""
printfn "- Importing theme..."
do! data.Theme.save restore.theme
let! _ = restore.assets |> List.map (EncodedAsset.fromAsset >> data.ThemeAsset.save) |> Task.WhenAll
do! data.Theme.Save restore.Theme
let! _ = restore.Assets |> List.map (EncodedAsset.toAsset >> data.ThemeAsset.Save) |> Task.WhenAll
// Restore web log data
printfn "- Restoring web log..."
do! data.WebLog.add restore.webLog
do! data.WebLog.Add restore.WebLog
printfn "- Restoring users..."
do! data.WebLogUser.restore restore.users
do! data.WebLogUser.Restore restore.Users
printfn "- Restoring categories and tag mappings..."
do! data.TagMap.restore restore.tagMappings
do! data.Category.restore restore.categories
do! data.TagMap.Restore restore.TagMappings
do! data.Category.Restore restore.Categories
printfn "- Restoring pages..."
do! data.Page.restore restore.pages
do! data.Page.Restore restore.Pages
printfn "- Restoring posts..."
do! data.Post.restore restore.posts
do! data.Post.Restore restore.Posts
// TODO: comments not yet implemented
displayStats "Restored for {{NAME}}:" restore.webLog restore
printfn "- Restoring uploads..."
do! data.Upload.Restore (restore.Uploads |> List.map EncodedUpload.toUpload)
displayStats "Restored for <>NAME<>:" restore.WebLog restore
}
/// Decide whether to restore a backup
@@ -366,22 +429,29 @@ module Backup =
if doOverwrite then
do! doRestore archive newUrlBase data
else
printfn $"{archive.webLog.name} backup restoration canceled"
printfn $"{archive.WebLog.Name} backup restoration canceled"
}
/// Generate a backup archive
let generateBackup (args : string[]) (sp : IServiceProvider) = task {
if args.Length = 3 || args.Length = 4 then
if args.Length > 1 && args.Length < 5 then
let data = sp.GetRequiredService<IData> ()
match! data.WebLog.findByHost args[1] with
match! data.WebLog.FindByHost args[1] with
| Some webLog ->
let fileName = if args[2].EndsWith ".json" then args[2] else $"{args[2]}.json"
let prettyOutput = args.Length = 4 && args[3] = "pretty"
do! createBackup webLog fileName prettyOutput data
| None -> printfn $"Error: no web log found for {args[1]}"
let fileName =
if args.Length = 2 || (args.Length = 3 && args[2] = "pretty") then
$"{webLog.Slug}.json"
elif args[2].EndsWith ".json" then
args[2]
else
printfn """Usage: MyWebLog backup [url-base] [backup-file-name] [*"pretty"]"""
printfn """ * optional - default is non-pretty JSON output"""
$"{args[2]}.json"
let prettyOutput = (args.Length = 3 && args[2] = "pretty") || (args.Length = 4 && args[3] = "pretty")
do! createBackup webLog fileName prettyOutput data
| None -> eprintfn $"Error: no web log found for {args[1]}"
else
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
@@ -391,8 +461,30 @@ module Backup =
let newUrlBase = if args.Length = 3 then Some args[2] else None
do! restoreBackup args[1] newUrlBase (args[0] <> "do-restore") data
else
printfn "Usage: MyWebLog restore [backup-file-name] [*url-base]"
printfn " * optional - will restore to original URL base if omitted"
printfn " (use do-restore to skip confirmation prompt)"
eprintfn "Usage: MyWebLog restore [backup-file-name] [*url-base]"
eprintfn " * optional - will restore to original URL base if omitted"
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]"
}

View File

@@ -12,12 +12,13 @@
<ItemGroup>
<Content Include="appsettings*.json" CopyToOutputDirectory="Always" />
<Compile Include="Caches.fs" />
<Compile Include="Handlers\Error.fs" />
<Compile Include="Handlers\Helpers.fs" />
<Compile Include="Handlers\Admin.fs" />
<Compile Include="Handlers\Feed.fs" />
<Compile Include="Handlers\Page.fs" />
<Compile Include="Handlers\Post.fs" />
<Compile Include="Handlers\User.fs" />
<Compile Include="Handlers\Upload.fs" />
<Compile Include="Handlers\Routes.fs" />
<Compile Include="DotLiquidBespoke.fs" />
<Compile Include="Maintenance.fs" />
@@ -27,8 +28,8 @@
<ItemGroup>
<PackageReference Include="DotLiquid" Version="2.2.656" />
<PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.7.0" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.7.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.8.0" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.0" />
<PackageReference Include="NeoSmart.Caching.Sqlite" Version="6.0.1" />
<PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
@@ -41,7 +42,7 @@
</ItemGroup>
<ItemGroup>
<None Include=".\wwwroot\img\*.png" CopyToOutputDirectory="Always" />
<None Include=".\wwwroot\upload\*" CopyToOutputDirectory="Always" />
</ItemGroup>
</Project>

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}"
match WebLogCache.tryGet path with
| 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
if PageListCache.exists ctx then () else do! PageListCache.update ctx
if CategoryCache.exists ctx then () else do! CategoryCache.update ctx
@@ -40,21 +40,46 @@ module DataImplementation =
/// Get the configured data implementation
let get (sp : IServiceProvider) : IData =
let config = sp.GetRequiredService<IConfiguration> ()
if (config.GetConnectionString >> isNull >> not) "SQLite" then
let conn = new SqliteConnection (config.GetConnectionString "SQLite")
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
upcast SQLiteData (conn, sp.GetRequiredService<ILogger<SQLiteData>> ())
elif (config.GetSection "RethinkDB").Exists () then
Json.all () |> Seq.iter Converter.Serializer.Converters.Add
let rethinkCfg = DataConfig.FromConfiguration (config.GetSection "RethinkDB")
let conn = rethinkCfg.CreateConnectionAsync () |> Async.AwaitTask |> Async.RunSynchronously
upcast RethinkDbData (conn, rethinkCfg, sp.GetRequiredService<ILogger<RethinkDbData>> ())
else
let await it = (Async.AwaitTask >> Async.RunSynchronously) it
let connStr name = config.GetConnectionString name
let hasConnStr name = (connStr >> isNull >> not) name
let createSQLite connStr =
let log = sp.GetRequiredService<ILogger<SQLiteData>> ()
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)
let conn = new SqliteConnection (connStr)
log.LogInformation $"Using SQLite database {conn.DataSource}"
await (SQLiteData.setUpConnection conn)
SQLiteData (conn, log)
if hasConnStr "SQLite" then
upcast createSQLite (connStr "SQLite")
elif hasConnStr "RethinkDB" then
let log = sp.GetRequiredService<ILogger<RethinkDbData>> ()
Json.all () |> Seq.iter Converter.Serializer.Converters.Add
let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB")
let conn = await (rethinkCfg.CreateConnectionAsync log)
upcast RethinkDbData (conn, rethinkCfg, log)
else
upcast createSQLite "Data Source=./myweblog.db;Cache=Shared"
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 "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 Giraffe
@@ -86,7 +111,7 @@ let rec main args =
let data = DataImplementation.get sp
task {
do! data.startUp ()
do! data.StartUp ()
do! WebLogCache.fill data
do! ThemeAssetCache.fill data
} |> Async.AwaitTask |> Async.RunSynchronously
@@ -132,7 +157,12 @@ let rec main args =
| 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 = "do-restore" -> Maintenance.Backup.restoreFromBackup args app.Services
| _ ->
| Some it when it = "upgrade-user" -> Maintenance.upgradeUser args app.Services
| Some it when it = "help" -> showHelp ()
| Some it ->
printfn $"""Unrecognized command "{it}" - valid commands are:"""
showHelp ()
| None ->
let _ = app.UseForwardedHeaders ()
let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
let _ = app.UseMiddleware<WebLogMiddleware> ()
@@ -142,7 +172,7 @@ let rec main args =
let _ = app.UseSession ()
let _ = app.UseGiraffe Handlers.Routes.endpoint
System.Threading.Tasks.Task.FromResult (app.Run ())
Task.FromResult (app.Run ())
|> Async.AwaitTask |> Async.RunSynchronously
0 // Exit code

View File

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

View File

View File

@@ -7,19 +7,27 @@
<span class="navbar-toggler-icon"></span>
</button>
<div class="collapse navbar-collapse" id="navbarText">
{% if logged_on -%}
{% if is_logged_on -%}
<ul class="navbar-nav">
{{ "admin/dashboard" | nav_link: "Dashboard" }}
{% if is_author %}
{{ "admin/pages" | nav_link: "Pages" }}
{{ "admin/posts" | nav_link: "Posts" }}
{{ "admin/uploads" | nav_link: "Uploads" }}
{% endif %}
{% if is_web_log_admin %}
{{ "admin/categories" | nav_link: "Categories" }}
{{ "admin/users" | nav_link: "Users" }}
{{ "admin/settings" | nav_link: "Settings" }}
{% endif %}
</ul>
{%- endif %}
<ul class="navbar-nav flex-grow-1 justify-content-end">
{% if logged_on -%}
{{ "admin/user/edit" | nav_link: "Edit User" }}
{{ "user/log-off" | nav_link: "Log Off" }}
{% if is_logged_on -%}
{{ "admin/user/my-info" | nav_link: "My Info" }}
<li class="nav-item">
<a class="nav-link" href="{{ "user/log-off" | relative_link }}" hx-boost="false">Log Off</a>
</li>
{%- else -%}
{{ "user/log-on" | nav_link: "Log On" }}
{%- endif %}
@@ -47,6 +55,8 @@
<div class="container-fluid">
<div class="row">
<div class="col-xs-12 text-end">
{%- assign version = generator | split: " " -%}
<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">
</div>
</div>

View File

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

View File

@@ -13,20 +13,19 @@
{%- 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 %}
{%- capture cat_edit %}admin/category/{{ cat.id }}/edit{% endcapture -%}
<a href="{{ cat_edit | relative_link }}" hx-target="#cat_{{ cat.id }}"
<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>
{%- capture cat_del %}admin/category/{{ cat.id }}/delete{% endcapture -%}
{%- capture cat_del_link %}{{ cat_del | relative_link }}{% endcapture -%}
{%- 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

View File

@@ -2,7 +2,7 @@
<article>
<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="id" value="{{ model.id }}">
<input type="hidden" name="Id" value="{{ model.id }}">
{%- assign typ = model.source_type -%}
<div class="container">
<div class="row pb-3">
@@ -17,7 +17,7 @@
<div class="row">
<div class="col">
<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 }}">
<label for="path">Relative Feed Path</label>
<span class="form-text fst-italic">Appended to {{ web_log.url_base }}/</span>
@@ -27,7 +27,7 @@
<div class="row">
<div class="col py-3 d-flex align-self-center justify-content-center">
<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()">
<label for="isPodcast" class="form-check-label">This Is a Podcast Feed</label>
</div>
@@ -41,7 +41,7 @@
<div class="row d-flex align-items-center">
<div class="col-1 d-flex justify-content-end pb-3">
<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 -%}
onclick="Admin.customFeedBy('category')">
<label for="sourceTypeCat" class="form-check-label d-none">Category</label>
@@ -49,7 +49,7 @@
</div>
<div class="col-11 pb-3">
<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 %}>
<option value="">&ndash; Select Category &ndash;</option>
{% for cat in categories -%}
@@ -64,14 +64,14 @@
</div>
<div class="col-1 d-flex justify-content-end pb-3">
<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')">
<label for="sourceTypeTag" class="form-check-label d-none">Tag</label>
</div>
</div>
<div class="col-11 pb-3">
<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
{%- if typ == "tag" %} value="{{ model.source_value }}"{% endif %}>
<label for="sourceValueTag">Tag</label>
@@ -88,21 +88,21 @@
<div class="row">
<div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3">
<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 }}">
<label for="title">Title</label>
</div>
</div>
<div class="col-12 col-md-4 col-lg-4 pb-3">
<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 }}">
<label for="subtitle">Podcast Subtitle</label>
</div>
</div>
<div class="col-12 col-md-3 col-lg-2 pb-3">
<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 }}">
<label for="itemsInFeed"># Episodes</label>
</div>
@@ -111,9 +111,9 @@
<div class="row">
<div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3">
<div class="form-floating">
<input type="text" name="itunesCategory" id="itunesCategory" class="form-control"
placeholder="iTunes Category" required value="{{ model.itunes_category }}">
<label for="itunesCategory">iTunes Category</label>
<input type="text" name="AppleCategory" id="appleCategory" class="form-control"
placeholder="iTunes Category" required value="{{ model.apple_category }}">
<label for="appleCategory">iTunes Category</label>
<span class="form-text fst-italic">
<a href="https://www.thepodcasthost.com/planning/itunes-podcast-categories/" target="_blank"
rel="noopener">
@@ -124,14 +124,14 @@
</div>
<div class="col-12 col-md-4 pb-3">
<div class="form-floating">
<input type="text" name="itunesSubcategory" id="itunesSubcategory" class="form-control"
placeholder="iTunes Subcategory" value="{{ model.itunes_subcategory }}">
<label for="itunesSubcategory">iTunes Subcategory</label>
<input type="text" name="AppleSubcategory" id="appleSubcategory" class="form-control"
placeholder="iTunes Subcategory" value="{{ model.apple_subcategory }}">
<label for="appleSubcategory">iTunes Subcategory</label>
</div>
</div>
<div class="col-12 col-md-3 col-lg-2 pb-3">
<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="no"{% if model.explicit == "no" %} selected="selected"{% endif %}>No</option>
<option value="clean"{% if model.explicit == "clean" %} selected="selected"{% endif %}>
@@ -145,14 +145,14 @@
<div class="row">
<div class="col-12 col-md-6 col-lg-4 offset-xxl-1 pb-3">
<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 }}">
<label for="displayedAuthor">Displayed Author</label>
</div>
</div>
<div class="col-12 col-md-6 col-lg-4 pb-3">
<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 }}">
<label for="email">Author E-mail</label>
<span class="form-text fst-italic">For iTunes, must match registered e-mail</span>
@@ -160,7 +160,7 @@
</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="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 }}">
<label for="defaultMediaType">Default Media Type</label>
<span class="form-text fst-italic">Optional; blank for no default</span>
@@ -168,7 +168,7 @@
</div>
<div class="col-12 col-sm-7 col-md-8 col-lg-10 offset-lg-1">
<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 }}">
<label for="imageUrl">Image URL</label>
<span class="form-text fst-italic">Relative URL will be appended to {{ web_log.url_base }}/</span>
@@ -178,23 +178,74 @@
<div class="row pb-3">
<div class="col-12 col-lg-10 offset-lg-1">
<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 }}">
<label for="summary">Summary</label>
<span class="form-text fst-italic">Displayed in podcast directories</span>
</div>
</div>
</div>
<div class="row">
<div class="row pb-3">
<div class="col-12 col-lg-10 offset-lg-1">
<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 }}">
<label for="mediaBaseUrl">Media Base URL</label>
<span class="form-text fst-italic">Optional; prepended to episode media file if present</span>
</div>
</div>
</div>
<div class="row">
<div class="col-12 col-lg-5 offset-lg-1 pb-3">
<div class="form-floating">
<input type="text" name="FundingUrl" id="fundingUrl" class="form-control" placeholder="Funding URL"
value="{{ model.funding_url }}">
<label for="fundingUrl">Funding URL</label>
<span class="form-text fst-italic">
Optional; URL describing donation options for this podcast, relative URL supported
</span>
</div>
</div>
<div class="col-12 col-lg-5 pb-3">
<div class="form-floating">
<input type="text" name="FundingText" id="fundingText" class="form-control" maxlength="128"
placeholder="Funding Text" value="{{ model.funding_text }}">
<label for="fundingText">Funding Text</label>
<span class="form-text fst-italic">Optional; text for the funding link</span>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col-8 col-lg-5 offset-lg-1 pb-3">
<div class="form-floating">
<input type="text" name="PodcastGuid" id="guid" class="form-control" placeholder="GUID"
value="{{ model.podcast_guid }}">
<label for="guid">Podcast GUID</label>
<span class="form-text fst-italic">
Optional; v5 UUID uniquely identifying this podcast; once entered, do not change this value
(<a href="https://github.com/Podcastindex-org/podcast-namespace/blob/main/docs/1.0.md#guid"
target="_blank">documentation</a>)
</span>
</div>
</div>
<div class="col-4 col-lg-3 offset-lg-2 pb-3">
<div class="form-floating">
<select name="Medium" id="medium" class="form-control">
{% for med in medium_values -%}
<option value="{{ med[0] }}"{% if model.medium == med[0] %} selected{% endif %}>
{{ med[1] }}
</option>
{%- endfor %}
</select>
<label for="medium">Medium</label>
<span class="form-text fst-italic">
Optional; medium of the podcast content
(<a href="https://github.com/Podcastindex-org/podcast-namespace/blob/main/docs/1.0.md#medium"
target="_blank">documentation</a>)
</span>
</div>
</div>
</div>
</fieldset>
</div>
</div>

View File

@@ -9,8 +9,10 @@
Published <span class="badge rounded-pill bg-secondary">{{ model.posts }}</span>
&nbsp; Drafts <span class="badge rounded-pill bg-secondary">{{ model.drafts }}</span>
</h6>
{% if is_author %}
<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>
</section>
@@ -22,8 +24,10 @@
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>
</h6>
{% if is_author %}
<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>
</section>
@@ -37,15 +41,19 @@
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>
</h6>
{% if is_web_log_admin %}
<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>
</section>
</div>
{% if is_web_log_admin %}
<div class="row pb-3">
<div class="col text-end">
<a href="{{ "admin/settings" | relative_link }}" class="btn btn-secondary">Modify Settings</a>
</div>
</div>
{% endif %}
</article>

View File

@@ -3,19 +3,19 @@
<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 }}">
{% 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 %}
<div class="container">
<div class="row">
<div class="col-12 col-md-6 col-lg-4 offset-lg-2 pb-3">
<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>
</div>
</div>
<div class="col-12 col-md-6 col-lg-4 pb-3">
<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>
</div>
</div>

View File

@@ -0,0 +1,77 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="{{ "admin/user/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,47 @@
<article>
<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="pageId" value="{{ model.page_id }}">
<input type="hidden" name="PageId" value="{{ model.page_id }}">
<div class="container">
<div class="row mb-3">
<div class="col-9">
<div class="form-floating pb-3">
<input type="text" name="title" id="title" class="form-control" autofocus required
<input type="text" name="Title" id="title" class="form-control" autofocus required
value="{{ model.title }}">
<label for="title">Title</label>
</div>
<div class="form-floating pb-3">
<input type="text" name="permalink" id="permalink" class="form-control" required
<input type="text" name="Permalink" id="permalink" class="form-control" required
value="{{ model.permalink }}">
<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 -%}
{%- unless model.is_new %}
<span class="form-text">
<a href="{{ "admin/page/" | append: model.page_id | append: "/permalinks" | relative_link }}">
Manage Permalinks
</a>
<span class="text-muted"> &bull; </span>
<a href="{{ "admin/page/" | append: model.page_id | append: "/revisions" | relative_link }}">
Manage Revisions
</a>
</span>
{% endunless -%}
</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"
<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"
<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>
<textarea name="Text" id="text" class="form-control">{{ model.text }}</textarea>
</div>
</div>
<div class="col-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 -%}
<option value="{{ tmpl[0] }}"{% if model.template == tmpl[0] %} selected="selected"{% endif %}>
{{ tmpl[1] }}
@@ -45,7 +52,7 @@
<label for="template">Page Template</label>
</div>
<div class="form-check form-switch">
<input type="checkbox" name="isShownInPageList" id="showList" class="form-check-input" value="true"
<input type="checkbox" name="IsShownInPageList" id="showList" class="form-check-input" value="true"
{%- if model.is_shown_in_page_list %} checked="checked"{% endif %}>
<label for="showList" class="form-check-label">Show in Page List</label>
</div>
@@ -77,14 +84,14 @@
</div>
<div class="col-3">
<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] }}">
<label for="metaNames_{{ meta[0] }}">Name</label>
</div>
</div>
<div class="col-8">
<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] }}">
<label for="metaValues_{{ meta[0] }}">Value</label>
</div>

View File

@@ -20,19 +20,22 @@
<div class="{{ title_col }}">
{{ pg.title }}
{%- 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>
{%- capture pg_link %}{% unless pg.is_default %}{{ pg.permalink }}{% endunless %}{% endcapture -%}
<a href="{{ pg_link | relative_link }}" target="_blank">View Page</a>
{% if is_editor or is_author and user_id == pg.author_id %}
<span class="text-muted"> &bull; </span>
<a href="{{ pg | edit_page_link }}">Edit</a>
{% endif %}
{% if is_web_log_admin %}
<span class="text-muted"> &bull; </span>
{%- capture pg_del %}admin/page/{{ pg.id }}/delete{% endcapture -%}
{%- capture pg_del_link %}{{ pg_del | relative_link }}{% endcapture -%}
{%- assign pg_del_link = "admin/page/" | append: pg.id | append: "/delete" | relative_link -%}
<a href="{{ pg_del_link }}" hx-post="{{ pg_del_link }}" class="text-danger"
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>
</div>
<div class="{{ link_col }}">
@@ -55,14 +58,18 @@
<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>
<p>
<a class="btn btn-default" href="{{ "admin/pages" | append: prev_page | 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>
<p>
<a class="btn btn-default" href="{{ "admin/pages" | append: next_page | relative_link }}">Next &raquo;</a>
</p>
{% endif %}
</div>
</div>

View File

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

View File

@@ -2,47 +2,54 @@
<article>
<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="postId" value="{{ model.post_id }}">
<input type="hidden" name="PostId" value="{{ model.post_id }}">
<div class="container">
<div class="row mb-3">
<div class="col-12 col-lg-9">
<div class="form-floating pb-3">
<input type="text" name="title" id="title" class="form-control" placeholder="Title" autofocus required
<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
<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 -%}
{%- unless model.is_new %}
<span class="form-text">
<a href="{{ "admin/post/" | append: model.post_id | append: "/permalinks" | relative_link }}">
Manage Permalinks
</a>
<span class="text-muted"> &bull; </span>
<a href="{{ "admin/post/" | append: model.post_id | 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"
<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"
<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>
<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"
<input type="text" name="Tags" id="tags" class="form-control" placeholder="Tags"
value="{{ model.tags }}">
<label for="tags">Tags</label>
<div class="form-text">comma-delimited</div>
</div>
{% if model.status == "Draft" %}
<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>
</div>
{% endif %}
@@ -52,7 +59,7 @@
<legend>
<span class="form-check form-switch">
<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()"
{%- if model.is_episode %}checked="checked"{% endif %}>
</small>
@@ -63,7 +70,7 @@
<div class="row">
<div class="col-12 col-md-8 pb-3">
<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 }}">
<label for="media">Media File</label>
<div class="form-text">
@@ -73,7 +80,7 @@
</div>
<div class="col-12 col-md-4 pb-3">
<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 }}">
<label for="mediaType">Media MIME Type</label>
<div class="form-text">Optional; overrides podcast default</div>
@@ -83,7 +90,7 @@
<div class="row pb-3">
<div class="col">
<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 }}">
<label for="length">Media Length (bytes)</label>
<div class="form-text">TODO: derive from above file name</div>
@@ -91,7 +98,7 @@
</div>
<div class="col">
<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 }}">
<label for="duration">Duration</label>
<div class="form-text">Recommended; enter in <code>HH:MM:SS</code> format</div>
@@ -101,7 +108,7 @@
<div class="row pb-3">
<div class="col">
<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 }}">
<label for="subtitle">Subtitle</label>
<div class="form-text">Optional; a subtitle for this episode</div>
@@ -111,7 +118,7 @@
<div class="row">
<div class="col-12 col-md-8 pb-3">
<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 }}">
<label for="imageUrl">Image URL</label>
<div class="form-text">
@@ -121,7 +128,7 @@
</div>
<div class="col-12 col-md-4 pb-3">
<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 %}
<option value="{{ exp_value[0] }}"
{%- if model.explicit == exp_value[0] %} selected="selected"{% endif -%}>
@@ -137,7 +144,7 @@
<div class="row">
<div class="col-12 col-md-8 pb-3">
<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 }}">
<label for="chapterFile">Chapter File</label>
<div class="form-text">Optional; relative URL served from this web log</div>
@@ -145,7 +152,7 @@
</div>
<div class="col-12 col-md-4 pb-3">
<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 }}">
<label for="chapterType">Chapter MIME Type</label>
<div class="form-text">
@@ -158,7 +165,7 @@
<div class="row">
<div class="col-12 col-md-8 pb-3">
<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 }}"
onkeyup="Admin.requireTranscriptType()">
<label for="transcriptUrl">Transcript URL</label>
@@ -167,7 +174,7 @@
</div>
<div class="col-12 col-md-4 pb-3">
<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 }}"
{%- if model.transcript_url != "" %} required{% endif %}>
<label for="transcriptType">Transcript MIME Type</label>
@@ -178,7 +185,7 @@
<div class="row pb-3">
<div class="col">
<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 }}">
<label for="transcriptLang">Transcript Language</label>
<div class="form-text">Optional; overrides podcast default</div>
@@ -186,7 +193,7 @@
</div>
<div class="col d-flex justify-content-center">
<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 %}>
<label for="transcriptCaptions">This is a captions file</label>
</div>
@@ -195,7 +202,7 @@
<div class="row pb-3">
<div class="col col-md-4">
<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 }}">
<label for="seasonNumber">Season Number</label>
<div class="form-text">Optional</div>
@@ -203,7 +210,7 @@
</div>
<div class="col col-md-8">
<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 }}">
<label for="seasonDescription">Season Description</label>
<div class="form-text">Optional</div>
@@ -213,7 +220,7 @@
<div class="row pb-3">
<div class="col col-md-4">
<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 }}">
<label for="episodeNumber">Episode Number</label>
<div class="form-text">Optional; up to 2 decimal points</div>
@@ -221,7 +228,7 @@
</div>
<div class="col col-md-8">
<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 }}">
<label for="episodeDescription">Episode Description</label>
<div class="form-text">Optional</div>
@@ -252,14 +259,14 @@
</div>
<div class="col-3">
<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] }}">
<label for="metaNames_{{ meta[0] }}">Name</label>
</div>
</div>
<div class="col-8">
<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] }}">
<label for="metaValues_{{ meta[0] }}">Value</label>
</div>
@@ -280,14 +287,14 @@
<div class="row">
<div class="col align-self-center">
<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">
<label for="setPublished" class="form-check-label">Set Published Date</label>
</div>
</div>
<div class="col-4">
<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"
{%- if model.pub_override -%}
value="{{ model.pub_override | date: "yyyy-MM-dd\THH:mm" }}"
@@ -297,7 +304,7 @@
</div>
<div class="col-5 align-self-center">
<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">
Purge revisions and<br>set as updated date as well
</label>
@@ -310,7 +317,7 @@
</div>
<div class="col-12 col-lg-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 -%}
<option value="{{ tmpl[0] }}"{% if model.template == tmpl[0] %} selected="selected"{% endif %}>
{{ tmpl[1] }}
@@ -323,7 +330,7 @@
<legend>Categories</legend>
{% for cat in categories %}
<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 %}>
<label for="categoryId_{{ cat.id }}" class="form-check-label"
{%- if cat.description %} title="{{ cat.description.value | strip_html | escape }}"{% endif %}>

View File

@@ -42,19 +42,22 @@
</span>
</div>
<div class="{{ title_col }}">
{%- if post.episode %}<span class="badge bg-success float-end text-uppercase">Episode</span>{% endif -%}
{%- if post.episode %}<span class="badge bg-success float-end text-uppercase mt-1">Episode</span>{% endif -%}
{{ post.title }}<br>
<small>
<a href="{{ post | relative_link }}" target="_blank">View Post</a>
{% if is_editor or is_author and user_id == post.author_id %}
<span class="text-muted"> &bull; </span>
<a href="{{ post | edit_post_link }}">Edit</a>
{% endif %}
{% if is_web_log_admin %}
<span class="text-muted"> &bull; </span>
{%- capture post_del %}admin/post/{{ post.id }}/delete{% endcapture -%}
{%- capture post_del_link %}{{ post_del | relative_link }}{% endcapture -%}
{%- assign post_del_link = "admin/post/" | append: post.id | append: "/delete" | relative_link -%}
<a href="{{ post_del_link }}" hx-post="{{ post_del_link }}" class="text-danger"
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>
</div>
<div class="{{ author_col }}">

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

@@ -8,18 +8,18 @@
<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 %}>
<input type="checkbox" name="IsFeedEnabled" id="feedEnabled" class="form-check-input" value="true"
{%- if 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="categoryEnabled" id="categoryEnabled" class="form-check-input" value="true"
{% if model.category_enabled %}checked="checked"{% endif %}>
<input type="checkbox" name="IsCategoryEnabled" id="categoryEnabled" class="form-check-input" value="true"
{%- if 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="tagEnabled" id="tagEnabled" class="form-check-input" value="true"
{% if model.tag_enabled %}checked="checked"{% endif %}>
<input type="checkbox" name="IsTagEnabled" 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>
@@ -28,7 +28,7 @@
<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"
<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>
@@ -36,7 +36,7 @@
</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"
<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>
@@ -44,7 +44,7 @@
</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"
<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">
@@ -85,13 +85,12 @@
{{ 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>
{%- capture feed_edit %}admin/settings/rss/{{ feed.id }}/edit{% endcapture -%}
<a href="{{ feed_edit | relative_link }}">Edit</a>
<a href="{{ feed_url | append: "/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 -%}
{%- 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

View File

@@ -8,47 +8,47 @@
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="container">
<div class="row">
<div class="col-12 col-md-6 col-xl-4 offset-xl-1 pb-3">
<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" value="{{ model.name }}" required autofocus>
<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="subtitle" id="subtitle" class="form-control" value="{{ model.subtitle }}">
<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-4 col-xl-2 pb-3">
<div class="col-12 col-md-6 col-xl-4 offset-xl-1 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 class="col-12 col-md-4 col-xl-3 pb-3">
<div class="form-floating">
<select name="themePath" id="themePath" class="form-control" required>
<select name="ThemeId" id="themeId" class="form-control" required>
{% for theme in themes -%}
<option value="{{ theme[0] }}"{% if model.theme_path == theme[0] %} selected="selected"{% endif %}>
<option value="{{ theme[0] }}"{% if model.theme_id == theme[0] %} selected="selected"{% endif %}>
{{ theme[1] }}
</option>
{%- endfor %}
</select>
<label for="themePath">Theme</label>
<label for="themeId">Theme</label>
</div>
</div>
<div class="col-12 col-md-4 col-xl-3 pb-3">
<div class="col-12 col-md-6 offset-md-1 col-xl-4 offset-xl-0 pb-3">
<div class="form-floating">
<input type="text" name="timeZone" id="timeZone" class="form-control" required
value="{{ model.time_zone }}">
<label for="timeZone">Time Zone</label>
</div>
</div>
<div class="col-12 col-md-4 pb-3">
<div class="form-floating">
<select name="defaultPage" id="defaultPage" class="form-control" required>
<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 %}>
@@ -59,9 +59,25 @@
<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 class="row">
<div class="col-12 col-md-4 col-xl-3 offset-xl-2 pb-3">
<div class="form-floating">
<input type="text" name="TimeZone" id="timeZone" class="form-control" placeholder="Time Zone" required
value="{{ model.time_zone }}">
<label for="timeZone">Time Zone</label>
</div>
</div>
<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"
<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>
@@ -69,6 +85,16 @@
<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">

View File

@@ -2,18 +2,18 @@
<form hx-post="{{ "admin/settings/tag-mapping/save" | relative_link }}" method="post" class="container"
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="id" value="{{ model.id }}">
<input type="hidden" name="Id" value="{{ model.id }}">
<div class="row mb-3">
<div class="col-6 col-lg-4 offset-lg-2">
<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 }}">
<label for="tag">Tag</label>
</div>
</div>
<div class="col-6 col-lg-4">
<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 }}">
<label for="urlValue">URL Value</label>
</div>

View File

@@ -9,14 +9,13 @@
<div class="col no-wrap">
{{ map.tag }}<br>
<small>
{%- capture map_edit %}admin/settings/tag-mapping/{{ map_id }}/edit{% endcapture -%}
<a href="{{ map_edit | relative_link }}" hx-target="#tag_{{ map_id }}"
{%- 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>
{%- capture map_del %}admin/settings/tag-mapping/{{ map_id }}/delete{% endcapture -%}
{%- capture map_del_link %}{{ map_del | relative_link }}{% endcapture -%}
{%- 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

View File

@@ -0,0 +1,76 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
{%- capture base_url %}{{ "" | relative_link }}{% endcapture -%}
{%- capture upload_path %}upload/{{ web_log.slug }}/{% endcapture -%}
{%- capture upload_base %}{{ base_url }}{{ upload_path }}{% endcapture -%}
<a href="{{ "admin/upload/new" | relative_link }}" class="btn btn-primary btn-sm mb-3">Upload a New File</a>
<form method="post" class="container" hx-target="body">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row">
<div class="col text-muted text-center"><em>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>
{%- assign file_count = files | size -%}
{%- if file_count > 0 %}
{% for file in files %}
<div class="row mwl-table-detail">
<div class="col-6">
{%- capture badge_class -%}
{%- if file.source == "disk" %}secondary{% else %}primary{% endif -%}
{%- endcapture -%}
{%- assign path_and_name = file.path | append: file.name -%}
{%- assign blog_rel = upload_path | append: path_and_name -%}
<span class="badge bg-{{ badge_class }} text-uppercase float-end mt-1">{{ file.source }}</span>
{{ file.name }}<br>
<small>
<a href="{{ upload_base | append: path_and_name }}" target="_blank">View File</a>
<span class="text-muted"> &bull; Copy </span>
<a href="{{ blog_rel | absolute_link }}" hx-boost="false"
onclick="return Admin.copyText('{{ blog_rel | absolute_link }}', this)">
Absolute
</a>
<span class="text-muted"> | </span>
<a href="{{ blog_rel | relative_link }}" hx-boost="false"
onclick="return Admin.copyText('{{ blog_rel | relative_link }}', this)">
Relative
</a>
{%- unless base_url == "/" %}
<span class="text-muted"> | </span>
<a href="{{ blog_rel }}" hx-boost="false"
onclick="return Admin.copyText('/{{ blog_rel }}', this)">
For Post
</a>
{%- endunless %}
<span class="text-muted"> Link</span>
{% if is_web_log_admin %}
<span class="text-muted"> &bull; </span>
{%- capture delete_url -%}
{%- if file.source == "disk" -%}
admin/upload/delete/{{ path_and_name }}
{%- else -%}
admin/upload/{{ file.id }}/delete
{%- endif -%}
{%- endcapture -%}
<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>
</div>
<div class="col-3">{{ file.path }}</div>
<div class="col-3">
{% if file.updated_on %}{{ file.updated_on.value | date: "yyyy-MM-dd/HH:mm" }}{% else %}--{% endif %}
</div>
</div>
{% endfor %}
{%- else -%}
<div class="row">
<div class="col text-muted fst-italic text-center">This web log has uploaded files</div>
</div>
{%- endif %}
</form>
</article>

View File

@@ -0,0 +1,31 @@
<h2>{{ page_title }}</h2>
<article>
<form action="{{ "admin/upload/save" | 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-md-6 pb-3">
<div class="form-floating">
<input type="file" id="file" name="File" class="form-control" placeholder="File" required>
<label for="file">File to Upload</label>
</div>
</div>
<div class="col-12 col-md-6 pb-3 d-flex align-self-center justify-content-around">
Destination<br>
<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"
{%- if destination == "database" %} checked="checked"{% endif %}>
<label class="btn btn-outline-primary" for="destination_db">Database</label>
<input type="radio" name="Destination" id="destination_disk" class="btn-check" value="disk"
{%- if destination == "disk" %} checked="checked"{% endif %}>
<label class="btn btn-outline-secondary" for="destination_disk">Disk</label>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col text-center">
<button type="submit" class="btn btn-primary">Upload File</button>
</div>
</div>
</form>
</article>

View File

@@ -1,64 +1,95 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="{{ "admin/user/save" | relative_link }}" method="post">
<div class="col-12">
<h5 class="my-3">{{ page_title }}</h5>
<form hx-post="{{ "admin/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 }}">
<div class="container">
<div class="row mb-3">
<div class="col-12 col-md-6 col-lg-4 pb-3">
<input type="hidden" name="Id" value="{{ model.id }}">
<div class="row">
<div class="col-12 col-md-5 col-lg-3 col-xxl-2 offset-xxl-1 mb-3">
<div class="form-floating">
<input type="text" name="firstName" id="firstName" class="form-control" autofocus required
placeholder="First" value="{{ model.first_name }}">
<select name="AccessLevel" id="accessLevel" class="form-control" required>
{%- for level in access_levels %}
<option value="{{ level[0] }}"{% if model.access_level == level[0] %} selected{% endif %}>
{{ level[1] }}
</option>
{%- endfor %}
</select>
<label for="accessLevel">Access Level</label>
</div>
</div>
<div class="col-12 col-md-7 col-lg-4 col-xxl-3 mb-3">
<div class="form-floating">
<input type="email" name="Email" id="email" class="form-control" placeholder="E-mail" required
value="{{ model.email | escape }}">
<label for="email">E-mail Address</label>
</div>
</div>
<div class="col-12 col-lg-5 mb-3">
<div class="form-floating">
<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 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 pb-3">
<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" required
placeholder="Last" value="{{ model.last_name }}">
<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 col-lg-4 pb-3">
<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" required
placeholder="Preferred" value="{{ model.preferred_name }}">
<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">
<fieldset class="container">
<legend>Change Password</legend>
<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 to keep your current password</p>
<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="newPassword" id="newPassword" class="form-control"
placeholder="Password">
<label for="newPassword">New Password</label>
<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="newPasswordConfirm" id="newPasswordConfirm" class="form-control"
placeholder="Confirm">
<label for="newPasswordConfirm">Confirm New Password</label>
<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">
<div class="col text-center mb-3">
<button type="submit" class="btn btn-primary">Save Changes</button>
</div>
<div class="row mb-3">
<div class="col text-center">
<button type="submit" class="btn btn-sm btn-primary">Save Changes</button>
<a href="{{ "admin/users/bare" | relative_link }}" class="btn btn-sm btn-secondary ms-3">Cancel</a>
</div>
</div>
</form>
</article>
</div>

View File

@@ -0,0 +1,60 @@
<form method="post" id="userList" class="container" hx-target="this" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row mwl-table-detail" id="user_new"></div>
{%- 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" -%}
{%- 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/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>

View File

@@ -0,0 +1,20 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<a href="{{ "admin/user/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3"
hx-target="#user_new">
Add a New User
</a>
<div class="container">
{%- 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" -%}
<div class="row mwl-table-heading">
<div class="{{ user_col }}">User<span class="d-md-none">; Details; Last Log On</span></div>
<div class="{{ email_col }} d-none d-md-inline-block">Details</div>
<div class="{{ cre8_col }}">Created</div>
<div class="{{ last_col }} d-none d-md-block">Last Log On</div>
</div>
</div>
{{ user_list }}
</article>

View File

@@ -1,2 +1,2 @@
myWebLog Admin
2.0.0-beta02
2.0.0-beta05

View File

@@ -85,3 +85,10 @@ a.text-danger:link:hover, a.text-danger:visited:hover {
background-color: var(--light-accent);
color: var(--dark-gray);
}
.mwl-revision-preview {
max-height: 90vh;
overflow: auto;
border: solid 1px black;
border-radius: .5rem;
padding: .5rem;
}

View File

@@ -1,13 +1,22 @@
const Admin = {
/** The next index for a metadata item */
/**
* Support functions for the administrative UI
*/
this.Admin = {
/**
* The next index for a metadata item
* @type {number}
*/
nextMetaIndex : 0,
/** The next index for a permalink */
/**
* The next index for a permalink
* @type {number}
*/
nextPermalink : 0,
/**
* Set the next meta item index
* @param idx The index to set
* @param {number} idx The index to set
*/
setNextMetaIndex(idx) {
this.nextMetaIndex = idx
@@ -15,7 +24,7 @@
/**
* Set the next permalink index
* @param idx The index to set
* @param {number} idx The index to set
*/
setPermalinkIndex(idx) {
this.nextPermalink = idx
@@ -47,7 +56,7 @@
const nameField = document.createElement("input")
nameField.type = "text"
nameField.name = "metaNames"
nameField.name = "MetaNames"
nameField.id = `metaNames_${this.nextMetaIndex}`
nameField.className = "form-control"
nameField.placeholder = "Name"
@@ -85,7 +94,7 @@
const valueField = document.createElement("input")
valueField.type = "text"
valueField.name = "metaValues"
valueField.name = "MetaValues"
valueField.id = `metaValues_${this.nextMetaIndex}`
valueField.className = "form-control"
valueField.placeholder = "Value"
@@ -173,7 +182,7 @@
// Link
const linkField = document.createElement("input")
linkField.type = "text"
linkField.name = "prior"
linkField.name = "Prior"
linkField.id = `prior_${this.nextPermalink}`
linkField.className = "form-control"
linkField.placeholder = "Link"
@@ -221,9 +230,21 @@
document.getElementById("podcastFields").disabled = !document.getElementById("isPodcast").checked
},
/**
* Copy text to the clipboard
* @param {string} text The text to be copied
* @param {HTMLAnchorElement} elt The element on which the click was generated
* @return {boolean} False, to prevent navigation
*/
copyText(text, elt) {
navigator.clipboard.writeText(text)
elt.innerText = "Copied"
return false
},
/**
* Toggle the source of a custom RSS feed
* @param source The source that was selected
* @param {string} source The source that was selected
*/
customFeedBy(source) {
const categoryInput = document.getElementById("sourceValueCat")
@@ -241,7 +262,7 @@
/**
* Remove a metadata item
* @param idx The index of the metadata item to remove
* @param {number} idx The index of the metadata item to remove
*/
removeMetaItem(idx) {
document.getElementById(`meta_${idx}`).remove()
@@ -249,7 +270,7 @@
/**
* Remove a permalink
* @param idx The index of the permalink to remove
* @param {number} idx The index of the permalink to remove
*/
removePermalink(idx) {
document.getElementById(`link_${idx}`).remove()
@@ -264,7 +285,7 @@
/**
* Show messages that may have come with an htmx response
* @param messages The messages from the response
* @param {string} messages The messages from the response
*/
showMessage(messages) {
const msgs = messages.split(", ")
@@ -311,3 +332,12 @@ htmx.on("htmx:afterOnLoad", function (evt) {
Admin.dismissSuccesses()
}
})
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

@@ -8,7 +8,9 @@
**DRAFT**
{% endif %}
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>
<div>
<article class="container mt-3">