bit-badger/myWebLog
1
0
Fork 0
Code Issues 4 Pull Requests Packages Projects Releases 11 Activity

Clean up database names (#21)

Browse Source 
- Moved user edit to "my info" (#19)
This commit is contained in:
Daniel J. Summers 2022-07-18 20:05:10 -04:00
parent 5fb3a73dcf
commit 7eaad4a076
36 changed files with 1993 additions and 1745 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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)
})

42
src/MyWebLog.Data/Converters.fs
View File

@ -100,13 +100,6 @@ module Json =
override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) =
(string >> ThemeId) reader.Value
type UploadDestinationConverter () =
inherit JsonConverter<UploadDestination> ()
override _.WriteJson (writer : JsonWriter, value : UploadDestination, _ : JsonSerializer) =
writer.WriteValue (UploadDestination.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadDestination, _ : bool, _ : JsonSerializer) =
(string >> UploadDestination.parse) reader.Value
type UploadIdConverter () =
inherit JsonConverter<UploadId> ()
override _.WriteJson (writer : JsonWriter, value : UploadId, _ : JsonSerializer) =
@ -134,23 +127,22 @@ module Json =
let all () : JsonConverter seq =
seq {
// Our converters
CategoryIdConverter ()
CommentIdConverter ()
CustomFeedIdConverter ()
CustomFeedSourceConverter ()
ExplicitRatingConverter ()
MarkupTextConverter ()
PermalinkConverter ()
PageIdConverter ()
PodcastMediumConverter ()
PostIdConverter ()
TagMapIdConverter ()
ThemeAssetIdConverter ()
ThemeIdConverter ()
UploadDestinationConverter ()
UploadIdConverter ()
WebLogIdConverter ()
WebLogUserIdConverter ()
CategoryIdConverter ()
CommentIdConverter ()
CustomFeedIdConverter ()
CustomFeedSourceConverter ()
ExplicitRatingConverter ()
MarkupTextConverter ()
PermalinkConverter ()
PageIdConverter ()
PodcastMediumConverter ()
PostIdConverter ()
TagMapIdConverter ()
ThemeAssetIdConverter ()
ThemeIdConverter ()
UploadIdConverter ()
WebLogIdConverter ()
WebLogUserIdConverter ()
// Handles DUs with no associated data, as well as option fields
CompactUnionJsonConverter ()
CompactUnionJsonConverter ()
}

2
src/MyWebLog.Data/MyWebLog.Data.fsproj
View File

@ -16,7 +16,7 @@
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-05" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-06" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup>

399
src/MyWebLog.Data/RethinkDbData.fs
View File

@ -45,7 +45,24 @@ module private RethinkHelpers =
/// A list of all tables
let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ]
/// Index names for indexes not on a data item's name
[<RequireQualifiedAccess>]
module Index =
/// An index by web log ID and e-mail address
let LogOn = "LogOn"
/// An index by web log ID and uploaded file path
let WebLogAndPath = "WebLogAndPath"
/// An index by web log ID and mapped tag
let WebLogAndTag = "WebLogAndTag"
/// An index by web log ID and tag URL value
let WebLogAndUrl = "WebLogAndUrl"
/// Shorthand for the ReQL starting point
let r = RethinkDB.R
@ -77,7 +94,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
/// Match theme asset IDs by their prefix (the theme ID)
let matchAssetByThemeId themeId =
let keyPrefix = $"^{ThemeId.toString themeId}/"
fun (row : Ast.ReqlExpr) -> row["id"].Match keyPrefix :> obj
fun (row : Ast.ReqlExpr) -> row[nameof ThemeAsset.empty.Id].Match keyPrefix :> obj
/// Ensure field indexes exist, as well as special indexes for selected tables
let ensureIndexes table fields = backgroundTask {
@ -88,24 +105,27 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink { withTable table; indexCreate field; write; withRetryOnce; ignoreResult conn }
// Post and page need index by web log ID and permalink
if [ Table.Page; Table.Post ] |> List.contains table then
if not (indexes |> List.contains "permalink") then
log.LogInformation $"Creating index {table}.permalink..."
let permalinkIdx = nameof Page.empty.Permalink
if not (indexes |> List.contains permalinkIdx) then
log.LogInformation $"Creating index {table}.{permalinkIdx}..."
do! rethink {
withTable table
indexCreate "permalink" (fun row -> r.Array (row["webLogId"], row["permalink"].Downcase ()) :> obj)
indexCreate permalinkIdx
(fun row -> r.Array (row[nameof Page.empty.WebLogId], row[permalinkIdx].Downcase ()) :> obj)
write; withRetryOnce; ignoreResult conn
}
// Prior permalinks are searched when a post or page permalink do not match the current URL
if not (indexes |> List.contains "priorPermalinks") then
log.LogInformation $"Creating index {table}.priorPermalinks..."
let priorIdx = nameof Post.empty.PriorPermalinks
if not (indexes |> List.contains priorIdx) then
log.LogInformation $"Creating index {table}.{priorIdx}..."
do! rethink {
withTable table
indexCreate "priorPermalinks" (fun row -> row["priorPermalinks"].Downcase () :> obj) [ Multi ]
indexCreate priorIdx (fun row -> row[priorIdx].Downcase () :> obj) [ Multi ]
write; withRetryOnce; ignoreResult conn
}
// Post needs indexes by category and tag (used for counting and retrieving posts)
if Table.Post = table then
for idx in [ "categoryIds"; "tags" ] do
for idx in [ nameof Post.empty.CategoryIds; nameof Post.empty.Tags ] do
if not (List.contains idx indexes) then
log.LogInformation $"Creating index {table}.{idx}..."
do! rethink {
@ -115,37 +135,42 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
}
// Tag mapping needs an index by web log ID and both tag and URL values
if Table.TagMap = table then
if not (indexes |> List.contains "webLogAndTag") then
log.LogInformation $"Creating index {table}.webLogAndTag..."
if not (indexes |> List.contains Index.WebLogAndTag) then
log.LogInformation $"Creating index {table}.{Index.WebLogAndTag}..."
do! rethink {
withTable table
indexCreate "webLogAndTag" (fun row -> r.Array (row["webLogId"], row["tag"]) :> obj)
indexCreate Index.WebLogAndTag (fun row ->
[| row[nameof TagMap.empty.WebLogId]; row[nameof TagMap.empty.Tag] |] :> obj)
write; withRetryOnce; ignoreResult conn
}
if not (indexes |> List.contains "webLogAndUrl") then
log.LogInformation $"Creating index {table}.webLogAndUrl..."
if not (indexes |> List.contains Index.WebLogAndUrl) then
log.LogInformation $"Creating index {table}.{Index.WebLogAndUrl}..."
do! rethink {
withTable table
indexCreate "webLogAndUrl" (fun row -> r.Array (row["webLogId"], row["urlValue"]) :> obj)
indexCreate Index.WebLogAndUrl (fun row ->
[| row[nameof TagMap.empty.WebLogId]; row[nameof TagMap.empty.UrlValue] |] :> obj)
write; withRetryOnce; ignoreResult conn
}
// Uploaded files need an index by web log ID and path, as that is how they are retrieved
if Table.Upload = table then
if not (indexes |> List.contains "webLogAndPath") then
log.LogInformation $"Creating index {table}.webLogAndPath..."
if not (indexes |> List.contains Index.WebLogAndPath) then
log.LogInformation $"Creating index {table}.{Index.WebLogAndPath}..."
do! rethink {
withTable table
indexCreate "webLogAndPath" (fun row -> r.Array (row["webLogId"], row["path"]) :> obj)
indexCreate Index.WebLogAndPath (fun row ->
[| row[nameof Upload.empty.WebLogId]; row[nameof Upload.empty.Path] |] :> obj)
write; withRetryOnce; ignoreResult conn
}
// Users log on with e-mail
if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then
log.LogInformation $"Creating index {table}.logOn..."
do! rethink {
withTable table
indexCreate "logOn" (fun row -> r.Array (row["webLogId"], row["userName"]) :> obj)
write; withRetryOnce; ignoreResult conn
}
if Table.WebLogUser = table then
if not (indexes |> List.contains Index.LogOn) then
log.LogInformation $"Creating index {table}.{Index.LogOn}..."
do! rethink {
withTable table
indexCreate Index.LogOn (fun row ->
[| row[nameof WebLogUser.empty.WebLogId]; row[nameof WebLogUser.empty.Email] |] :> obj)
write; withRetryOnce; ignoreResult conn
}
}
/// The batch size for restoration methods
@ -167,15 +192,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.CountAll webLogId = rethink<int> {
withTable Table.Category
getAll [ webLogId ] (nameof webLogId)
getAll [ webLogId ] (nameof Category.empty.WebLogId)
count
result; withRetryDefault conn
}
member _.CountTopLevel webLogId = rethink<int> {
withTable Table.Category
getAll [ webLogId ] (nameof webLogId)
filter "parentId" None
getAll [ webLogId ] (nameof Category.empty.WebLogId)
filter (nameof Category.empty.ParentId) None
count
result; withRetryDefault conn
}
@ -183,8 +208,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindAllForView webLogId = backgroundTask {
let! cats = rethink<Category list> {
withTable Table.Category
getAll [ webLogId ] (nameof webLogId)
orderByFunc (fun it -> it["name"].Downcase () :> obj)
getAll [ webLogId ] (nameof Category.empty.WebLogId)
orderByFunc (fun it -> it[nameof Category.empty.Name].Downcase () :> obj)
result; withRetryDefault conn
}
let ordered = Utils.orderByHierarchy cats None None []
@ -200,8 +225,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|> List.ofSeq
let! count = rethink<int> {
withTable Table.Post
getAll catIds "categoryIds"
filter "status" Published
getAll catIds (nameof Post.empty.CategoryIds)
filter (nameof Post.empty.Status) Published
distinct
count
result; withRetryDefault conn
@ -227,11 +252,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get catId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun c -> c.webLogId) <| conn
|> verifyWebLog webLogId (fun c -> c.WebLogId) <| conn
member _.FindByWebLog webLogId = rethink<Category list> {
withTable Table.Category
getAll [ webLogId ] (nameof webLogId)
getAll [ webLogId ] (nameof Category.empty.WebLogId)
result; withRetryDefault conn
}
@ -241,9 +266,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
// Delete the category off all posts where it is assigned
do! rethink {
withTable Table.Post
getAll [ webLogId ] (nameof webLogId)
filter (fun row -> row["categoryIds"].Contains catId :> obj)
update (fun row -> r.HashMap ("categoryIds", r.Array(row["categoryIds"]).Remove catId) :> obj)
getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (fun row -> row[nameof Post.empty.CategoryIds].Contains catId :> obj)
update (fun row ->
{| CategoryIds = r.Array(row[nameof Post.empty.CategoryIds]).Remove catId |} :> obj)
write; withRetryDefault; ignoreResult conn
}
// Delete the category itself
@ -268,11 +294,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Update cat = rethink {
withTable Table.Category
get cat.id
update [ "name", cat.name :> obj
"slug", cat.slug
"description", cat.description
"parentId", cat.parentId
get cat.Id
update [ nameof cat.Name, cat.Name :> obj
nameof cat.Slug, cat.Slug
nameof cat.Description, cat.Description
nameof cat.ParentId, cat.ParentId
]
write; withRetryDefault; ignoreResult conn
}
@ -289,23 +315,26 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All webLogId = rethink<Page list> {
withTable Table.Page
getAll [ webLogId ] (nameof webLogId)
without [ "text"; "metadata"; "revisions"; "priorPermalinks" ]
orderByFunc (fun row -> row["title"].Downcase () :> obj)
getAll [ webLogId ] (nameof Page.empty.WebLogId)
without [ nameof Page.empty.Text
nameof Page.empty.Metadata
nameof Page.empty.Revisions
nameof Page.empty.PriorPermalinks ]
orderByFunc (fun row -> row[nameof Page.empty.Title].Downcase () :> obj)
result; withRetryDefault conn
}
member _.CountAll webLogId = rethink<int> {
withTable Table.Page
getAll [ webLogId ] (nameof webLogId)
getAll [ webLogId ] (nameof Page.empty.WebLogId)
count
result; withRetryDefault conn
}
member _.CountListed webLogId = rethink<int> {
withTable Table.Page
getAll [ webLogId ] (nameof webLogId)
filter "showInPageList" true
getAll [ webLogId ] (nameof Page.empty.WebLogId)
filter (nameof Page.empty.IsInPageList) true
count
result; withRetryDefault conn
}
@ -314,7 +343,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result = rethink<Model.Result> {
withTable Table.Page
getAll [ pageId ]
filter (fun row -> row["webLogId"].Eq webLogId :> obj)
filter (fun row -> row[nameof Page.empty.WebLogId].Eq webLogId :> obj)
delete
write; withRetryDefault conn
}
@ -325,16 +354,16 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
rethink<Page> {
withTable Table.Page
get pageId
without [ "priorPermalinks"; "revisions" ]
without [ nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ]
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun it -> it.webLogId) <| conn
|> verifyWebLog webLogId (fun it -> it.WebLogId) <| conn
member _.FindByPermalink permalink webLogId =
rethink<Page list> {
withTable Table.Page
getAll [ r.Array (webLogId, permalink) ] (nameof permalink)
without [ "priorPermalinks"; "revisions" ]
getAll [ [| webLogId :> obj; permalink |] ] (nameof Page.empty.Permalink)
without [ nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ]
limit 1
result; withRetryDefault
}
@ -344,14 +373,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result =
(rethink<Page list> {
withTable Table.Page
getAll (objList permalinks) "priorPermalinks"
filter "webLogId" webLogId
without [ "revisions"; "text" ]
getAll (objList permalinks) (nameof Page.empty.PriorPermalinks)
filter (nameof Page.empty.WebLogId) webLogId
without [ nameof Page.empty.Revisions; nameof Page.empty.Text ]
limit 1
result; withRetryDefault
}
|> tryFirst) conn
return result |> Option.map (fun pg -> pg.permalink)
return result |> Option.map (fun pg -> pg.Permalink)
}
member _.FindFullById pageId webLogId =
@ -360,28 +389,30 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get pageId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun it -> it.webLogId) <| conn
|> verifyWebLog webLogId (fun it -> it.WebLogId) <| conn
member _.FindFullByWebLog webLogId = rethink<Page> {
withTable Table.Page
getAll [ webLogId ] (nameof webLogId)
getAll [ webLogId ] (nameof Page.empty.WebLogId)
resultCursor; withRetryCursorDefault; toList conn
}
member _.FindListed webLogId = rethink<Page list> {
withTable Table.Page
getAll [ webLogId ] (nameof webLogId)
filter [ "showInPageList", true :> obj ]
without [ "text"; "priorPermalinks"; "revisions" ]
getAll [ webLogId ] (nameof Page.empty.WebLogId)
filter [ nameof Page.empty.IsInPageList, true :> obj ]
without [ nameof Page.empty.Text; nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ]
orderBy "title"
result; withRetryDefault conn
}
member _.FindPageOfPages webLogId pageNbr = rethink<Page list> {
withTable Table.Page
getAll [ webLogId ] (nameof webLogId)
without [ "metadata"; "priorPermalinks"; "revisions" ]
orderByFunc (fun row -> row["title"].Downcase ())
getAll [ webLogId ] (nameof Page.empty.WebLogId)
without [ nameof Page.empty.Metadata
nameof Page.empty.PriorPermalinks
nameof Page.empty.Revisions ]
orderByFunc (fun row -> row[nameof Page.empty.Title].Downcase ())
skip ((pageNbr - 1) * 25)
limit 25
result; withRetryDefault conn
@ -398,17 +429,17 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Update page = rethink {
withTable Table.Page
get page.id
get page.Id
update [
"title", page.title :> obj
"permalink", page.permalink
"updatedOn", page.updatedOn
"showInPageList", page.showInPageList
"template", page.template
"text", page.text
"priorPermalinks", page.priorPermalinks
"metadata", page.metadata
"revisions", page.revisions
nameof page.Title, page.Title :> obj
nameof page.Permalink, page.Permalink
nameof page.UpdatedOn, page.UpdatedOn
nameof page.IsInPageList, page.IsInPageList
nameof page.Template, page.Template
nameof page.Text, page.Text
nameof page.PriorPermalinks, page.PriorPermalinks
nameof page.Metadata, page.Metadata
nameof page.Revisions, page.Revisions
]
write; withRetryDefault; ignoreResult conn
}
@ -419,7 +450,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink {
withTable Table.Page
get pageId
update [ "priorPermalinks", permalinks :> obj ]
update [ nameof Page.empty.PriorPermalinks, permalinks :> obj ]
write; withRetryDefault; ignoreResult conn
}
return true
@ -438,8 +469,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.CountByStatus status webLogId = rethink<int> {
withTable Table.Post
getAll [ webLogId ] (nameof webLogId)
filter "status" status
getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (nameof Post.empty.Status) status
count
result; withRetryDefault conn
}
@ -448,7 +479,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result = rethink<Model.Result> {
withTable Table.Post
getAll [ postId ]
filter (fun row -> row["webLogId"].Eq webLogId :> obj)
filter (fun row -> row[nameof Post.empty.WebLogId].Eq webLogId :> obj)
delete
write; withRetryDefault conn
}
@ -459,16 +490,16 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
rethink<Post> {
withTable Table.Post
get postId
without [ "priorPermalinks"; "revisions" ]
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun p -> p.webLogId) <| conn
|> verifyWebLog webLogId (fun p -> p.WebLogId) <| conn
member _.FindByPermalink permalink webLogId =
rethink<Post list> {
withTable Table.Post
getAll [ r.Array (webLogId, permalink) ] (nameof permalink)
without [ "priorPermalinks"; "revisions" ]
getAll [ [| webLogId :> obj; permalink |] ] (nameof Post.empty.Permalink)
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
limit 1
result; withRetryDefault
}
@ -480,36 +511,36 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get postId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun p -> p.webLogId) <| conn
|> verifyWebLog webLogId (fun p -> p.WebLogId) <| conn
member _.FindCurrentPermalink permalinks webLogId = backgroundTask {
let! result =
(rethink<Post list> {
withTable Table.Post
getAll (objList permalinks) "priorPermalinks"
filter "webLogId" webLogId
without [ "revisions"; "text" ]
getAll (objList permalinks) (nameof Post.empty.PriorPermalinks)
filter (nameof Post.empty.WebLogId) webLogId
without [ nameof Post.empty.Revisions; nameof Post.empty.Text ]
limit 1
result; withRetryDefault
}
|> tryFirst) conn
return result |> Option.map (fun post -> post.permalink)
return result |> Option.map (fun post -> post.Permalink)
}
member _.FindFullByWebLog webLogId = rethink<Post> {
withTable Table.Post
getAll [ webLogId ] (nameof webLogId)
getAll [ webLogId ] (nameof Post.empty.WebLogId)
resultCursor; withRetryCursorDefault; toList conn
}
member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post
getAll (objList categoryIds) "categoryIds"
filter "webLogId" webLogId
filter "status" Published
without [ "priorPermalinks"; "revisions" ]
getAll (objList categoryIds) (nameof Post.empty.CategoryIds)
filter [ nameof Post.empty.WebLogId, webLogId :> obj
nameof Post.empty.Status, Published ]
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
distinct
orderByDescending "publishedOn"
orderByDescending (nameof Post.empty.PublishedOn)
skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1)
result; withRetryDefault conn
@ -517,9 +548,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindPageOfPosts webLogId pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post
getAll [ webLogId ] (nameof webLogId)
without [ "priorPermalinks"; "revisions" ]
orderByFuncDescending (fun row -> row["publishedOn"].Default_ "updatedOn" :> obj)
getAll [ webLogId ] (nameof Post.empty.WebLogId)
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
orderByFuncDescending (fun row ->
row[nameof Post.empty.PublishedOn].Default_ (nameof Post.empty.UpdatedOn) :> obj)
skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1)
result; withRetryDefault conn
@ -527,10 +559,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post
getAll [ webLogId ] (nameof webLogId)
filter "status" Published
without [ "priorPermalinks"; "revisions" ]
orderByDescending "publishedOn"
getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (nameof Post.empty.Status) Published
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
orderByDescending (nameof Post.empty.PublishedOn)
skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1)
result; withRetryDefault conn
@ -538,11 +570,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post
getAll [ tag ] "tags"
filter "webLogId" webLogId
filter "status" Published
without [ "priorPermalinks"; "revisions" ]
orderByDescending "publishedOn"
getAll [ tag ] (nameof Post.empty.Tags)
filter [ nameof Post.empty.WebLogId, webLogId :> obj
nameof Post.empty.Status, Published ]
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
orderByDescending (nameof Post.empty.PublishedOn)
skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1)
result; withRetryDefault conn
@ -552,10 +584,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! older =
rethink<Post list> {
withTable Table.Post
getAll [ webLogId ] (nameof webLogId)
filter (fun row -> row["publishedOn"].Lt publishedOn :> obj)
without [ "priorPermalinks"; "revisions" ]
orderByDescending "publishedOn"
getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (fun row -> row[nameof Post.empty.PublishedOn].Lt publishedOn :> obj)
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
orderByDescending (nameof Post.empty.PublishedOn)
limit 1
result; withRetryDefault
}
@ -563,10 +595,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! newer =
rethink<Post list> {
withTable Table.Post
getAll [ webLogId ] (nameof webLogId)
filter (fun row -> row["publishedOn"].Gt publishedOn :> obj)
without [ "priorPermalinks"; "revisions" ]
orderBy "publishedOn"
getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (fun row -> row[nameof Post.empty.PublishedOn].Gt publishedOn :> obj)
without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
orderBy (nameof Post.empty.PublishedOn)
limit 1
result; withRetryDefault
}
@ -585,7 +617,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Update post = rethink {
withTable Table.Post
get post.id
get post.Id
replace post
write; withRetryDefault; ignoreResult conn
}
@ -595,15 +627,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
rethink<Post> {
withTable Table.Post
get postId
without [ "revisions"; "priorPermalinks" ]
without [ nameof Post.empty.Revisions; nameof Post.empty.PriorPermalinks ]
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun p -> p.webLogId)) conn with
|> verifyWebLog webLogId (fun p -> p.WebLogId)) conn with
| Some _ ->
do! rethink {
withTable Table.Post
get postId
update [ "priorPermalinks", permalinks :> obj ]
update [ nameof Post.empty.PriorPermalinks, permalinks :> obj ]
write; withRetryDefault; ignoreResult conn
}
return true
@ -618,7 +650,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result = rethink<Model.Result> {
withTable Table.TagMap
getAll [ tagMapId ]
filter (fun row -> row["webLogId"].Eq webLogId :> obj)
filter (fun row -> row[nameof TagMap.empty.WebLogId].Eq webLogId :> obj)
delete
write; withRetryDefault conn
}
@ -631,12 +663,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get tagMapId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun tm -> tm.webLogId) <| conn
|> verifyWebLog webLogId (fun tm -> tm.WebLogId) <| conn
member _.FindByUrlValue urlValue webLogId =
rethink<TagMap list> {
withTable Table.TagMap
getAll [ r.Array (webLogId, urlValue) ] "webLogAndUrl"
getAll [ [| webLogId :> obj; urlValue |] ] Index.WebLogAndUrl
limit 1
result; withRetryDefault
}
@ -644,14 +676,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByWebLog webLogId = rethink<TagMap list> {
withTable Table.TagMap
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) [ Index "webLogAndTag" ]
orderBy "tag"
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj, r.Maxval () |]
[ Index Index.WebLogAndTag ]
orderBy (nameof TagMap.empty.Tag)
result; withRetryDefault conn
}
member _.FindMappingForTags tags webLogId = rethink<TagMap list> {
withTable Table.TagMap
getAll (tags |> List.map (fun tag -> r.Array (webLogId, tag) :> obj)) "webLogAndTag"
getAll (tags |> List.map (fun tag -> [| webLogId :> obj; tag |] :> obj)) Index.WebLogAndTag
result; withRetryDefault conn
}
@ -666,7 +699,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Save tagMap = rethink {
withTable Table.TagMap
get tagMap.id
get tagMap.Id
replace tagMap
write; withRetryDefault; ignoreResult conn
}
@ -677,9 +710,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All () = rethink<Theme list> {
withTable Table.Theme
filter (fun row -> row["id"].Ne "admin" :> obj)
without [ "templates" ]
orderBy "id"
filter (fun row -> row[nameof Theme.empty.Id].Ne "admin" :> obj)
without [ nameof Theme.empty.Templates ]
orderBy (nameof Theme.empty.Id)
result; withRetryDefault conn
}
@ -692,13 +725,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByIdWithoutText themeId = rethink<Theme> {
withTable Table.Theme
get themeId
merge (fun row -> r.HashMap ("templates", row["templates"].Without [| "text" |]))
merge (fun row -> {| Templates = row[nameof Theme.empty.Templates].Without [| "Text" |] |})
resultOption; withRetryOptionDefault conn
}
member _.Save theme = rethink {
withTable Table.Theme
get theme.id
get theme.Id
replace theme
write; withRetryDefault; ignoreResult conn
}
@ -709,7 +742,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All () = rethink<ThemeAsset list> {
withTable Table.ThemeAsset
without [ "data" ]
without [ nameof ThemeAsset.empty.Data ]
result; withRetryDefault conn
}
@ -729,7 +762,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByTheme themeId = rethink<ThemeAsset list> {
withTable Table.ThemeAsset
filter (matchAssetByThemeId themeId)
without [ "data" ]
without [ nameof ThemeAsset.empty.Data ]
result; withRetryDefault conn
}
@ -741,7 +774,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Save asset = rethink {
withTable Table.ThemeAsset
get asset.id
get asset.Id
replace asset
write; withRetryDefault; ignoreResult conn
}
@ -763,7 +796,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get uploadId
resultOption; withRetryOptionDefault
}
|> verifyWebLog<Upload> webLogId (fun u -> u.webLogId) <| conn
|> verifyWebLog<Upload> webLogId (fun u -> u.WebLogId) <| conn
match upload with
| Some up ->
do! rethink {
@ -772,30 +805,30 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
delete
write; withRetryDefault; ignoreResult conn
}
return Ok (Permalink.toString up.path)
return Ok (Permalink.toString up.Path)
| None -> return Result.Error $"Upload ID {UploadId.toString uploadId} not found"
}
member _.FindByPath path webLogId =
rethink<Upload> {
withTable Table.Upload
getAll [ r.Array (webLogId, path) ] "webLogAndPath"
getAll [ [| webLogId :> obj; path |] ] Index.WebLogAndPath
resultCursor; withRetryCursorDefault; toList
}
|> tryFirst <| conn
member _.FindByWebLog webLogId = rethink<Upload> {
withTable Table.Upload
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
[ Index "webLogAndPath" ]
without [ "data" ]
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
[ Index Index.WebLogAndPath ]
without [ nameof Upload.empty.Data ]
resultCursor; withRetryCursorDefault; toList conn
}
member _.FindByWebLogWithData webLogId = rethink<Upload> {
withTable Table.Upload
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
[ Index "webLogAndPath" ]
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
[ Index Index.WebLogAndPath ]
resultCursor; withRetryCursorDefault; toList conn
}
@ -826,40 +859,40 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Delete webLogId = backgroundTask {
// Comments should be deleted by post IDs
let! thePostIds = rethink<{| id : string |} list> {
let! thePostIds = rethink<{| Id : string |} list> {
withTable Table.Post
getAll [ webLogId ] (nameof webLogId)
pluck [ "id" ]
getAll [ webLogId ] (nameof Post.empty.WebLogId)
pluck [ nameof Post.empty.Id ]
result; withRetryOnce conn
}
if not (List.isEmpty thePostIds) then
let postIds = thePostIds |> List.map (fun it -> it.id :> obj)
let postIds = thePostIds |> List.map (fun it -> it.Id :> obj)
do! rethink {
withTable Table.Comment
getAll postIds "postId"
getAll postIds (nameof Comment.empty.PostId)
delete
write; withRetryOnce; ignoreResult conn
}
// Tag mappings do not have a straightforward webLogId index
do! rethink {
withTable Table.TagMap
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
[ Index "webLogAndTag" ]
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
[ Index Index.WebLogAndTag ]
delete
write; withRetryOnce; ignoreResult conn
}
// Uploaded files do not have a straightforward webLogId index
do! rethink {
withTable Table.Upload
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
[ Index "webLogAndPath" ]
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
[ Index Index.WebLogAndPath ]
delete
write; withRetryOnce; ignoreResult conn
}
for table in [ Table.Post; Table.Category; Table.Page; Table.WebLogUser ] do
do! rethink {
withTable table
getAll [ webLogId ] (nameof webLogId)
getAll [ webLogId ] (nameof Post.empty.WebLogId)
delete
write; withRetryOnce; ignoreResult conn
}
@ -874,7 +907,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByHost url =
rethink<WebLog list> {
withTable Table.WebLog
getAll [ url ] "urlBase"
getAll [ url ] (nameof WebLog.empty.UrlBase)
limit 1
result; withRetryDefault
}
@ -888,24 +921,24 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.UpdateRssOptions webLog = rethink {
withTable Table.WebLog
get webLog.id
update [ "rss", webLog.rss :> obj ]
get webLog.Id
update [ nameof WebLog.empty.Rss, webLog.Rss :> obj ]
write; withRetryDefault; ignoreResult conn
}
member _.UpdateSettings webLog = rethink {
withTable Table.WebLog
get webLog.id
get webLog.Id
update [
"name", webLog.name :> obj
"slug", webLog.slug
"subtitle", webLog.subtitle
"defaultPage", webLog.defaultPage
"postsPerPage", webLog.postsPerPage
"timeZone", webLog.timeZone
"themePath", webLog.themePath
"autoHtmx", webLog.autoHtmx
"uploads", webLog.uploads
nameof webLog.Name, webLog.Name :> obj
nameof webLog.Slug, webLog.Slug
nameof webLog.Subtitle, webLog.Subtitle
nameof webLog.DefaultPage, webLog.DefaultPage
nameof webLog.PostsPerPage, webLog.PostsPerPage
nameof webLog.TimeZone, webLog.TimeZone
nameof webLog.ThemeId, webLog.ThemeId
nameof webLog.AutoHtmx, webLog.AutoHtmx
nameof webLog.Uploads, webLog.Uploads
]
write; withRetryDefault; ignoreResult conn
}
@ -923,7 +956,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByEmail email webLogId =
rethink<WebLogUser list> {
withTable Table.WebLogUser
getAll [ r.Array (webLogId, email) ] "logOn"
getAll [ [| webLogId :> obj; email |] ] Index.LogOn
limit 1
result; withRetryDefault
}
@ -935,11 +968,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get userId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun u -> u.webLogId) <| conn
|> verifyWebLog webLogId (fun u -> u.WebLogId) <| conn
member _.FindByWebLog webLogId = rethink<WebLogUser list> {
withTable Table.WebLogUser
getAll [ webLogId ] (nameof webLogId)
getAll [ webLogId ] (nameof WebLogUser.empty.WebLogId)
result; withRetryDefault conn
}
@ -947,12 +980,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! users = rethink<WebLogUser list> {
withTable Table.WebLogUser
getAll (objList userIds)
filter "webLogId" webLogId
filter (nameof WebLogUser.empty.WebLogId) webLogId
result; withRetryDefault conn
}
return
users
|> 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 })
}
member _.Restore users = backgroundTask {
@ -970,7 +1003,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink {
withTable Table.WebLogUser
get userId
update [ "lastSeenOn", DateTime.UtcNow :> obj ]
update [ nameof WebLogUser.empty.LastSeenOn, DateTime.UtcNow :> obj ]
write; withRetryOnce; ignoreResult conn
}
| None -> ()
@ -978,14 +1011,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Update user = rethink {
withTable Table.WebLogUser
get user.id
get user.Id
update [
"firstName", user.firstName :> obj
"lastName", user.lastName
"preferredName", user.preferredName
"passwordHash", user.passwordHash
"salt", user.salt
"accessLevel", user.accessLevel
nameof user.FirstName, user.FirstName :> obj
nameof user.LastName, user.LastName
nameof user.PreferredName, user.PreferredName
nameof user.PasswordHash, user.PasswordHash
nameof user.Salt, user.Salt
nameof user.AccessLevel, user.AccessLevel
]
write; withRetryDefault; ignoreResult conn
}
@ -1001,14 +1034,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
for tbl in Table.all do
if not (tables |> List.contains tbl) then
log.LogInformation $"Creating table {tbl}..."
do! rethink { tableCreate tbl; write; withRetryOnce; ignoreResult conn }
do! rethink { tableCreate tbl [ PrimaryKey "Id" ]; write; withRetryOnce; ignoreResult conn }
do! ensureIndexes Table.Category [ "webLogId" ]
do! ensureIndexes Table.Comment [ "postId" ]
do! ensureIndexes Table.Page [ "webLogId"; "authorId" ]
do! ensureIndexes Table.Post [ "webLogId"; "authorId" ]
do! ensureIndexes Table.Category [ nameof Category.empty.WebLogId ]
do! ensureIndexes Table.Comment [ nameof Comment.empty.PostId ]
do! ensureIndexes Table.Page [ nameof Page.empty.WebLogId; nameof Page.empty.AuthorId ]
do! ensureIndexes Table.Post [ nameof Post.empty.WebLogId; nameof Post.empty.AuthorId ]
do! ensureIndexes Table.TagMap []
do! ensureIndexes Table.Upload []
do! ensureIndexes Table.WebLog [ "urlBase" ]
do! ensureIndexes Table.WebLogUser [ "webLogId" ]
do! ensureIndexes Table.WebLog [ nameof WebLog.empty.UrlBase ]
do! ensureIndexes Table.WebLogUser [ nameof WebLogUser.empty.WebLogId ]
}

271
src/MyWebLog.Data/SQLite/Helpers.fs
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,19 +236,19 @@ 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 : SqliteDataReader) : Upload =
let toUpload includeData rdr : Upload =
let data =
if includeData then
use dataStream = new MemoryStream ()
@ -258,51 +257,51 @@ module Map =
dataStream.ToArray ()
else
[||]
{ id = UploadId (getString "id" rdr)
webLogId = WebLogId (getString "web_log_id" rdr)
path = Permalink (getString "path" rdr)
updatedOn = getDateTime "updated_on" rdr
data = data
{ 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
slug = getString "slug" 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
uploads = UploadDestination.parse (getString "uploads" 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
accessLevel = AccessLevel.parse (getString "access_level" rdr)
createdOn = getDateTime "created_on" rdr
lastSeenOn = tryDateTime "last_seen_on" 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

16
src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs
View File

@ -10,12 +10,12 @@ 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
@ -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 []
@ -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

90
src/MyWebLog.Data/SQLite/SQLitePageData.fs
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"
@ -141,17 +141,17 @@ type SQLitePageData (conn : SqliteConnection) =
// 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,
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,
@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)
@ -177,10 +177,10 @@ type SQLitePageData (conn : SqliteConnection) =
cmd.CommandText <- """
SELECT COUNT(id)
FROM page
WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList"""
WHERE web_log_id = @webLogId
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
@ -277,11 +277,11 @@ type SQLitePageData (conn : SqliteConnection) =
cmd.CommandText <- """
SELECT *
FROM page
WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList
WHERE web_log_id = @webLogId
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
@ -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
SET author_id = @authorId,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
show_in_page_list = @showInPageList,
template = @template,
page_text = @text
SET author_id = @authorId,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
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,7 +343,7 @@ 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
}

110
src/MyWebLog.Data/SQLite/SQLitePostData.fs
View File

@ -13,72 +13,72 @@ 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
@ -90,12 +90,12 @@ type SQLitePostData (conn : SqliteConnection) =
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 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 {
@ -153,10 +153,10 @@ 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
@ -184,7 +184,7 @@ 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 (
@ -213,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"
@ -265,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"
@ -295,12 +295,12 @@ type SQLitePostData (conn : SqliteConnection) =
)"""
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
@ -535,7 +535,7 @@ 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 <- """
@ -552,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 ()
}
@ -565,7 +565,7 @@ 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
}

14
src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs
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
@ -69,7 +69,7 @@ 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
@ -84,10 +84,10 @@ type SQLiteTagMapData (conn : SqliteConnection) =
) 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
}
@ -105,4 +105,4 @@ type SQLiteTagMapData (conn : SqliteConnection) =
member _.FindByWebLog webLogId = findByWebLog webLogId
member _.FindMappingForTags tags webLogId = findMappingForTags tags webLogId
member _.Save tagMap = save tagMap
member this.Restore tagMaps = restore tagMaps
member _.Restore tagMaps = restore tagMaps

42
src/MyWebLog.Data/SQLite/SQLiteThemeData.fs
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
@ -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,15 +185,15 @@ 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
}

14
src/MyWebLog.Data/SQLite/SQLiteUploadData.fs
View File

@ -10,11 +10,11 @@ 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)
[ 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
@ -32,7 +32,7 @@ type SQLiteUploadData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT ROWID FROM upload WHERE id = @id"
let! rowId = cmd.ExecuteScalarAsync ()
use dataStream = new MemoryStream (upload.data)
use dataStream = new MemoryStream (upload.Data)
use blobStream = new SqliteBlob (conn, "upload", "data", rowId :?> int64)
do! dataStream.CopyToAsync blobStream
}
@ -53,7 +53,7 @@ type SQLiteUploadData (conn : SqliteConnection) =
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)
return Ok (Permalink.toString upload.Path)
else
return Error $"""Upload ID {cmd.Parameters["@id"]} not found"""
}

166
src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs
View File

@ -15,57 +15,57 @@ 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 ("@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", webLog.themePath)
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)
[ 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
@ -76,7 +76,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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
}
@ -84,7 +84,7 @@ 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
@ -93,12 +93,12 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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
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
@appleCategory, @appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @podcastGuid,
@fundingUrl, @fundingText, @medium
)"""
addPodcastParameters cmd feedId podcast
do! write cmd
@ -107,12 +107,12 @@ 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
@ -120,7 +120,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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
@ -135,10 +135,10 @@ type SQLiteWebLogData (conn : SqliteConnection) =
@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
@ -152,10 +152,10 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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 <- """
@ -167,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
()
@ -203,10 +203,10 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.CommandText <- """
INSERT INTO web_log (
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
uploads, feed_enabled, feed_name, items_in_feed, category_enabled, tag_enabled, copyright
uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright
) VALUES (
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
@uploads, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled, @copyright
@uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
)"""
addWebLogParameters cmd webLog
do! write cmd
@ -286,22 +286,22 @@ type SQLiteWebLogData (conn : SqliteConnection) =
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
UPDATE web_log
SET name = @name,
slug = @slug,
subtitle = @subtitle,
default_page = @defaultPage,
posts_per_page = @postsPerPage,
theme_id = @themeId,
url_base = @urlBase,
time_zone = @timeZone,
auto_htmx = @autoHtmx,
uploads = @uploads,
feed_enabled = @feedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
category_enabled = @categoryEnabled,
tag_enabled = @tagEnabled,
copyright = @copyright
SET name = @name,
slug = @slug,
subtitle = @subtitle,
default_page = @defaultPage,
posts_per_page = @postsPerPage,
theme_id = @themeId,
url_base = @urlBase,
time_zone = @timeZone,
auto_htmx = @autoHtmx,
uploads = @uploads,
is_feed_enabled = @isFeedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright
WHERE id = @id"""
addWebLogParameters cmd webLog
do! write cmd
@ -312,12 +312,12 @@ type SQLiteWebLogData (conn : SqliteConnection) =
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
UPDATE web_log
SET feed_enabled = @feedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
category_enabled = @categoryEnabled,
tag_enabled = @tagEnabled,
copyright = @copyright
SET is_feed_enabled = @isFeedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright
WHERE id = @id"""
addWebLogRssParameters cmd webLog
do! write cmd

42
src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs
View File

@ -12,18 +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 ("@accessLevel", AccessLevel.toString user.accessLevel)
cmd.Parameters.AddWithValue ("@createdOn", user.createdOn)
cmd.Parameters.AddWithValue ("@lastSeenOn", maybe user.lastSeenOn)
[ 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
@ -33,11 +33,11 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
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,
access_level, created_on, last_seen_on
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,
@accessLevel, @createdOn, @lastSeenOn
@id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel,
@createdOn, @lastSeenOn
)"""
addWebLogUserParameters cmd user
do! write cmd
@ -46,9 +46,9 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// 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"
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND email = @email"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@userName", email) |> ignore
cmd.Parameters.AddWithValue ("@email", email) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toWebLogUser rdr) else None
}
@ -59,7 +59,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
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
}
/// Get all users for the given web log
@ -85,7 +85,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
@ -115,7 +115,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
UPDATE web_log_user
SET user_name = @userName,
SET email = @email,
first_name = @firstName,
last_name = @lastName,
preferred_name = @preferredName,

100
src/MyWebLog.Data/SQLiteData.fs
View File

@ -86,23 +86,23 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
log.LogInformation "Creating web_log table..."
cmd.CommandText <- """
CREATE TABLE web_log (
id TEXT PRIMARY KEY,
name TEXT NOT NULL,
slug TEXT NOT NULL,
subtitle TEXT,
default_page TEXT NOT NULL,
posts_per_page INTEGER NOT NULL,
theme_id TEXT NOT NULL REFERENCES theme (id),
url_base TEXT NOT NULL,
time_zone TEXT NOT NULL,
auto_htmx INTEGER NOT NULL DEFAULT 0,
uploads TEXT NOT NULL,
feed_enabled INTEGER NOT NULL DEFAULT 0,
feed_name TEXT NOT NULL,
items_in_feed INTEGER,
category_enabled INTEGER NOT NULL DEFAULT 0,
tag_enabled INTEGER NOT NULL DEFAULT 0,
copyright TEXT);
id TEXT PRIMARY KEY,
name TEXT NOT NULL,
slug TEXT NOT NULL,
subtitle TEXT,
default_page TEXT NOT NULL,
posts_per_page INTEGER NOT NULL,
theme_id TEXT NOT NULL REFERENCES theme (id),
url_base TEXT NOT NULL,
time_zone TEXT NOT NULL,
auto_htmx INTEGER NOT NULL DEFAULT 0,
uploads TEXT NOT NULL,
is_feed_enabled INTEGER NOT NULL DEFAULT 0,
feed_name TEXT NOT NULL,
items_in_feed INTEGER,
is_category_enabled INTEGER NOT NULL DEFAULT 0,
is_tag_enabled INTEGER NOT NULL DEFAULT 0,
copyright TEXT);
CREATE INDEX web_log_theme_idx ON web_log (theme_id)"""
do! write cmd
match! tableExists "web_log_feed" with
@ -131,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)"""
@ -149,12 +149,12 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
log.LogInformation "Creating category table..."
cmd.CommandText <- """
CREATE TABLE category (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
name TEXT NOT NULL,
slug TEXT NOT NULL,
description TEXT,
parent_id TEXT);
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
name TEXT NOT NULL,
slug TEXT NOT NULL,
description TEXT,
parent_id TEXT);
CREATE INDEX category_web_log_idx ON category (web_log_id)"""
do! write cmd
@ -165,20 +165,20 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
log.LogInformation "Creating web_log_user table..."
cmd.CommandText <- """
CREATE TABLE web_log_user (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
user_name TEXT NOT NULL,
first_name TEXT NOT NULL,
last_name TEXT NOT NULL,
preferred_name TEXT NOT NULL,
password_hash TEXT NOT NULL,
salt TEXT NOT NULL,
url TEXT,
access_level TEXT NOT NULL,
created_on TEXT NOT NULL,
last_seen_on TEXT NOT NULL);
CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id);
CREATE INDEX web_log_user_user_name_idx ON web_log_user (web_log_id, user_name)"""
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
email TEXT NOT NULL,
first_name TEXT NOT NULL,
last_name TEXT NOT NULL,
preferred_name TEXT NOT NULL,
password_hash TEXT NOT NULL,
salt TEXT NOT NULL,
url TEXT,
access_level TEXT NOT NULL,
created_on TEXT NOT NULL,
last_seen_on TEXT);
CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id);
CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)"""
do! write cmd
// Page tables
@ -188,16 +188,16 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
log.LogInformation "Creating page table..."
cmd.CommandText <- """
CREATE TABLE page (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id),
title TEXT NOT NULL,
permalink TEXT NOT NULL,
published_on TEXT NOT NULL,
updated_on TEXT NOT NULL,
show_in_page_list INTEGER NOT NULL DEFAULT 0,
template TEXT,
page_text TEXT NOT NULL);
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id),
title TEXT NOT NULL,
permalink TEXT NOT NULL,
published_on TEXT NOT NULL,
updated_on TEXT NOT NULL,
is_in_page_list INTEGER NOT NULL DEFAULT 0,
template TEXT,
page_text TEXT NOT NULL);
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)"""

12
src/MyWebLog.Data/Utils.fs
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
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
Name = cat.Name
Description = cat.Description
ParentNames = Array.ofList parentNames
// Post counts are filled on a second pass
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)
}

352
src/MyWebLog.Domain/DataTypes.fs
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,32 +285,42 @@ 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
Id : UploadId
/// The ID of the web log to which this upload belongs
webLogId : WebLogId
WebLogId : WebLogId
/// The link at which this upload is served
path : Permalink
Path : Permalink
/// The updated date/time for this upload
updatedOn : DateTime
UpdatedOn : DateTime
/// The data for the upload
data : byte[]
Data : byte[]
}
/// Functions to support uploaded files
@ -318,11 +328,11 @@ module Upload =
/// An empty upload
let empty = {
id = UploadId.empty
webLogId = WebLogId.empty
path = Permalink.empty
updatedOn = DateTime.MinValue
data = [||]
Id = UploadId.empty
WebLogId = WebLogId.empty
Path = Permalink.empty
UpdatedOn = DateTime.MinValue
Data = [||]
}
@ -330,40 +340,40 @@ module Upload =
[<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
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
Uploads : UploadDestination
}
/// Functions to support web logs
@ -371,29 +381,29 @@ module WebLog =
/// An empty web log
let empty =
{ id = WebLogId.empty
name = ""
slug = ""
subtitle = None
defaultPage = ""
postsPerPage = 10
themePath = "default"
urlBase = ""
timeZone = ""
rss = RssOptions.empty
autoHtmx = false
uploads = Database
{ 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 =
@ -403,47 +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)
(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 access level
accessLevel : AccessLevel
AccessLevel : AccessLevel
/// When the user was created
createdOn : DateTime
CreatedOn : DateTime
/// When the user last logged on
lastSeenOn : DateTime option
LastSeenOn : DateTime option
}
/// Functions to support web log users
@ -451,27 +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
accessLevel = Author
createdOn = DateTime.UnixEpoch
lastSeenOn = None
{ 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
AccessLevel.hasAccess level user.AccessLevel

176
src/MyWebLog.Domain/SupportTypes.fs
View File

@ -8,8 +8,8 @@ module private Helpers =
/// Create a new ID (short GUID)
// https://www.madskristensen.net/blog/A-shorter-and-URL-friendly-GUID
let newId() =
Convert.ToBase64String(Guid.NewGuid().ToByteArray()).Replace('/', '_').Replace('+', '-').Substring (0, 22)
let newId () =
Convert.ToBase64String(Guid.NewGuid().ToByteArray ()).Replace('/', '_').Replace('+', '-').Substring (0, 22)
/// A user's access level
@ -140,55 +140,55 @@ 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
@ -196,23 +196,23 @@ 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
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
}
@ -256,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
@ -267,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
@ -285,8 +285,8 @@ module Revision =
/// An empty revision
let empty =
{ asOf = DateTime.UtcNow
text = Html ""
{ AsOf = DateTime.UtcNow
Text = Html ""
}
@ -436,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
@ -505,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
}
@ -516,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
@ -542,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 = []
}
@ -594,10 +594,10 @@ 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
}
@ -610,13 +610,13 @@ type UploadDestination =
module UploadDestination =
/// Convert an upload destination to its string representation
let toString = function Database -> "database" | Disk -> "disk"
let toString = function Database -> "Database" | Disk -> "Disk"
/// Parse an upload destination from its string representation
let parse value =
match value with
| "database" -> Database
| "disk" -> Disk
| "Database" -> Database
| "Disk" -> Disk
| it -> invalidOp $"{it} is not a valid upload destination"

550
src/MyWebLog.Domain/ViewModels.fs
View File

@ -76,13 +76,13 @@ type DisplayCustomFeed =
/// Create a display version from a custom feed
static member fromFeed (cats : DisplayCategory[]) (feed : CustomFeed) : DisplayCustomFeed =
let source =
match feed.source with
match feed.Source with
| Category (CategoryId catId) -> $"Category: {(cats |> Array.find (fun cat -> cat.Id = catId)).Name}"
| Tag tag -> $"Tag: {tag}"
{ Id = CustomFeedId.toString feed.id
{ Id = CustomFeedId.toString feed.Id
Source = source
Path = Permalink.toString feed.path
IsPodcast = Option.isSome feed.podcast
Path = Permalink.toString feed.Path
IsPodcast = Option.isSome feed.Podcast
}
@ -108,7 +108,7 @@ type DisplayPage =
UpdatedOn : DateTime
/// Whether this page shows as part of the web log's navigation
ShowInPageList : bool
IsInPageList : bool
/// Is this the default page?
IsDefault : bool
@ -122,33 +122,33 @@ type DisplayPage =
/// Create a minimal display page (no text or metadata) from a database page
static member fromPageMinimal webLog (page : Page) =
let pageId = PageId.toString page.id
{ Id = pageId
AuthorId = WebLogUserId.toString page.authorId
Title = page.title
Permalink = Permalink.toString page.permalink
PublishedOn = page.publishedOn
UpdatedOn = page.updatedOn
ShowInPageList = page.showInPageList
IsDefault = pageId = webLog.defaultPage
Text = ""
Metadata = []
let pageId = PageId.toString page.Id
{ Id = pageId
AuthorId = WebLogUserId.toString page.AuthorId
Title = page.Title
Permalink = Permalink.toString page.Permalink
PublishedOn = page.PublishedOn
UpdatedOn = page.UpdatedOn
IsInPageList = page.IsInPageList
IsDefault = pageId = webLog.DefaultPage
Text = ""
Metadata = []
}
/// Create a display page from a database page
static member fromPage webLog (page : Page) =
let _, extra = WebLog.hostAndPath webLog
let pageId = PageId.toString page.id
{ Id = pageId
AuthorId = WebLogUserId.toString page.authorId
Title = page.title
Permalink = Permalink.toString page.permalink
PublishedOn = page.publishedOn
UpdatedOn = page.updatedOn
ShowInPageList = page.showInPageList
IsDefault = pageId = webLog.defaultPage
Text = if extra = "" then page.text else page.text.Replace ("href=\"/", $"href=\"{extra}/")
Metadata = page.metadata
let pageId = PageId.toString page.Id
{ Id = pageId
AuthorId = WebLogUserId.toString page.AuthorId
Title = page.Title
Permalink = Permalink.toString page.Permalink
PublishedOn = page.PublishedOn
UpdatedOn = page.UpdatedOn
IsInPageList = page.IsInPageList
IsDefault = pageId = webLog.DefaultPage
Text = if extra = "" then page.Text else page.Text.Replace ("href=\"/", $"href=\"{extra}/")
Metadata = page.Metadata
}
@ -168,9 +168,9 @@ with
/// Create a display revision from an actual revision
static member fromRevision webLog (rev : Revision) =
{ AsOf = rev.asOf
AsOfLocal = WebLog.localTime webLog rev.asOf
Format = MarkupText.sourceType rev.text
{ AsOf = rev.AsOf
AsOfLocal = WebLog.localTime webLog rev.AsOf
Format = MarkupText.sourceType rev.Text
}
@ -197,12 +197,12 @@ type DisplayUpload =
/// Create a display uploaded file
static member fromUpload webLog source (upload : Upload) =
let path = Permalink.toString upload.path
let path = Permalink.toString upload.Path
let name = Path.GetFileName path
{ Id = UploadId.toString upload.id
{ Id = UploadId.toString upload.Id
Name = name
Path = path.Replace (name, "")
UpdatedOn = Some (WebLog.localTime webLog upload.updatedOn)
UpdatedOn = Some (WebLog.localTime webLog upload.UpdatedOn)
Source = UploadDestination.toString source
}
@ -228,11 +228,11 @@ type EditCategoryModel =
/// Create an edit model from an existing category
static member fromCategory (cat : Category) =
{ CategoryId = CategoryId.toString cat.id
Name = cat.name
Slug = cat.slug
Description = defaultArg cat.description ""
ParentId = cat.parentId |> Option.map CategoryId.toString |> Option.defaultValue ""
{ CategoryId = CategoryId.toString cat.Id
Name = cat.Name
Slug = cat.Slug
Description = defaultArg cat.Description ""
ParentId = cat.ParentId |> Option.map CategoryId.toString |> Option.defaultValue ""
}
@ -275,11 +275,11 @@ type EditCustomFeedModel =
/// The link to the image for the podcast
ImageUrl : string
/// 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
/// A further refinement of the categorization of this podcast (Apple Podcasts/iTunes field / values)
AppleSubcategory : string
/// The explictness rating (iTunes field)
Explicit : string
@ -305,92 +305,122 @@ type EditCustomFeedModel =
/// An empty custom feed model
static member empty =
{ Id = ""
SourceType = "category"
SourceValue = ""
Path = ""
IsPodcast = false
Title = ""
Subtitle = ""
ItemsInFeed = 25
Summary = ""
DisplayedAuthor = ""
Email = ""
ImageUrl = ""
iTunesCategory = ""
iTunesSubcategory = ""
Explicit = "no"
DefaultMediaType = "audio/mpeg"
MediaBaseUrl = ""
FundingUrl = ""
FundingText = ""
PodcastGuid = ""
Medium = ""
{ Id = ""
SourceType = "category"
SourceValue = ""
Path = ""
IsPodcast = false
Title = ""
Subtitle = ""
ItemsInFeed = 25
Summary = ""
DisplayedAuthor = ""
Email = ""
ImageUrl = ""
AppleCategory = ""
AppleSubcategory = ""
Explicit = "no"
DefaultMediaType = "audio/mpeg"
MediaBaseUrl = ""
FundingUrl = ""
FundingText = ""
PodcastGuid = ""
Medium = ""
}
/// Create a model from a custom feed
static member fromFeed (feed : CustomFeed) =
let rss =
{ EditCustomFeedModel.empty with
Id = CustomFeedId.toString feed.id
SourceType = match feed.source with Category _ -> "category" | Tag _ -> "tag"
SourceValue = match feed.source with Category (CategoryId catId) -> catId | Tag tag -> tag
Path = Permalink.toString feed.path
Id = CustomFeedId.toString feed.Id
SourceType = match feed.Source with Category _ -> "category" | Tag _ -> "tag"
SourceValue = match feed.Source with Category (CategoryId catId) -> catId | Tag tag -> tag
Path = Permalink.toString feed.Path
}
match feed.podcast with
match feed.Podcast with
| Some p ->
{ rss with
IsPodcast = true
Title = p.title
Subtitle = defaultArg p.subtitle ""
ItemsInFeed = p.itemsInFeed
Summary = p.summary
DisplayedAuthor = p.displayedAuthor
Email = p.email
ImageUrl = Permalink.toString p.imageUrl
iTunesCategory = p.iTunesCategory
iTunesSubcategory = defaultArg p.iTunesSubcategory ""
Explicit = ExplicitRating.toString p.explicit
DefaultMediaType = defaultArg p.defaultMediaType ""
MediaBaseUrl = defaultArg p.mediaBaseUrl ""
FundingUrl = defaultArg p.fundingUrl ""
FundingText = defaultArg p.fundingText ""
PodcastGuid = p.guid
|> Option.map (fun it -> it.ToString().ToLowerInvariant ())
|> Option.defaultValue ""
Medium = p.medium |> Option.map PodcastMedium.toString |> Option.defaultValue ""
IsPodcast = true
Title = p.Title
Subtitle = defaultArg p.Subtitle ""
ItemsInFeed = p.ItemsInFeed
Summary = p.Summary
DisplayedAuthor = p.DisplayedAuthor
Email = p.Email
ImageUrl = Permalink.toString p.ImageUrl
AppleCategory = p.AppleCategory
AppleSubcategory = defaultArg p.AppleSubcategory ""
Explicit = ExplicitRating.toString p.Explicit
DefaultMediaType = defaultArg p.DefaultMediaType ""
MediaBaseUrl = defaultArg p.MediaBaseUrl ""
FundingUrl = defaultArg p.FundingUrl ""
FundingText = defaultArg p.FundingText ""
PodcastGuid = p.PodcastGuid
|> Option.map (fun it -> it.ToString().ToLowerInvariant ())
|> Option.defaultValue ""
Medium = p.Medium |> Option.map PodcastMedium.toString |> Option.defaultValue ""
}
| None -> rss
/// Update a feed with values from this model
member this.updateFeed (feed : CustomFeed) =
member this.UpdateFeed (feed : CustomFeed) =
{ feed with
source = if this.SourceType = "tag" then Tag this.SourceValue else Category (CategoryId this.SourceValue)
path = Permalink this.Path
podcast =
Source = if this.SourceType = "tag" then Tag this.SourceValue else Category (CategoryId this.SourceValue)
Path = Permalink this.Path
Podcast =
if this.IsPodcast then
Some {
title = this.Title
subtitle = noneIfBlank this.Subtitle
itemsInFeed = this.ItemsInFeed
summary = this.Summary
displayedAuthor = this.DisplayedAuthor
email = this.Email
imageUrl = Permalink this.ImageUrl
iTunesCategory = this.iTunesCategory
iTunesSubcategory = noneIfBlank this.iTunesSubcategory
explicit = ExplicitRating.parse this.Explicit
defaultMediaType = noneIfBlank this.DefaultMediaType
mediaBaseUrl = noneIfBlank this.MediaBaseUrl
guid = noneIfBlank this.PodcastGuid |> Option.map Guid.Parse
fundingUrl = noneIfBlank this.FundingUrl
fundingText = noneIfBlank this.FundingText
medium = noneIfBlank this.Medium |> Option.map PodcastMedium.parse
Title = this.Title
Subtitle = noneIfBlank this.Subtitle
ItemsInFeed = this.ItemsInFeed
Summary = this.Summary
DisplayedAuthor = this.DisplayedAuthor
Email = this.Email
ImageUrl = Permalink this.ImageUrl
AppleCategory = this.AppleCategory
AppleSubcategory = noneIfBlank this.AppleSubcategory
Explicit = ExplicitRating.parse this.Explicit
DefaultMediaType = noneIfBlank this.DefaultMediaType
MediaBaseUrl = noneIfBlank this.MediaBaseUrl
PodcastGuid = noneIfBlank this.PodcastGuid |> Option.map Guid.Parse
FundingUrl = noneIfBlank this.FundingUrl
FundingText = noneIfBlank this.FundingText
Medium = noneIfBlank this.Medium |> Option.map PodcastMedium.parse
}
else
None
}
/// View model for a user to edit their own information
[<CLIMutable; NoComparison; NoEquality>]
type EditMyInfoModel =
{ /// The user's first name
FirstName : string
/// The user's last name
LastName : string
/// The user's preferred name
PreferredName : string
/// A new password for the user
NewPassword : string
/// A new password for the user, confirmed
NewPasswordConfirm : string
}
/// Create an edit model from a user
static member fromUser (user : WebLogUser) =
{ FirstName = user.FirstName
LastName = user.LastName
PreferredName = user.PreferredName
NewPassword = ""
NewPasswordConfirm = ""
}
/// View model to edit a page
[<CLIMutable; NoComparison; NoEquality>]
type EditPageModel =
@ -425,19 +455,19 @@ type EditPageModel =
/// Create an edit model from an existing page
static member fromPage (page : Page) =
let latest =
match page.revisions |> List.sortByDescending (fun r -> r.asOf) |> List.tryHead with
match page.Revisions |> List.sortByDescending (fun r -> r.AsOf) |> List.tryHead with
| Some rev -> rev
| None -> Revision.empty
let page = if page.metadata |> List.isEmpty then { page with metadata = [ MetaItem.empty ] } else page
{ PageId = PageId.toString page.id
Title = page.title
Permalink = Permalink.toString page.permalink
Template = defaultArg page.template ""
IsShownInPageList = page.showInPageList
Source = MarkupText.sourceType latest.text
Text = MarkupText.text latest.text
MetaNames = page.metadata |> List.map (fun m -> m.name) |> Array.ofList
MetaValues = page.metadata |> List.map (fun m -> m.value) |> Array.ofList
let page = if page.Metadata |> List.isEmpty then { page with Metadata = [ MetaItem.empty ] } else page
{ PageId = PageId.toString page.Id
Title = page.Title
Permalink = Permalink.toString page.Permalink
Template = defaultArg page.Template ""
IsShownInPageList = page.IsInPageList
Source = MarkupText.sourceType latest.Text
Text = MarkupText.text latest.Text
MetaNames = page.Metadata |> List.map (fun m -> m.Name) |> Array.ofList
MetaValues = page.Metadata |> List.map (fun m -> m.Value) |> Array.ofList
}
@ -547,94 +577,94 @@ type EditPostModel =
/// Create an edit model from an existing past
static member fromPost webLog (post : Post) =
let latest =
match post.revisions |> List.sortByDescending (fun r -> r.asOf) |> List.tryHead with
match post.Revisions |> List.sortByDescending (fun r -> r.AsOf) |> List.tryHead with
| Some rev -> rev
| None -> Revision.empty
let post = if post.metadata |> List.isEmpty then { post with metadata = [ MetaItem.empty ] } else post
let episode = defaultArg post.episode Episode.empty
{ PostId = PostId.toString post.id
Title = post.title
Permalink = Permalink.toString post.permalink
Source = MarkupText.sourceType latest.text
Text = MarkupText.text latest.text
Tags = String.Join (", ", post.tags)
Template = defaultArg post.template ""
CategoryIds = post.categoryIds |> List.map CategoryId.toString |> Array.ofList
Status = PostStatus.toString post.status
let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.empty ] } else post
let episode = defaultArg post.Episode Episode.empty
{ PostId = PostId.toString post.Id
Title = post.Title
Permalink = Permalink.toString post.Permalink
Source = MarkupText.sourceType latest.Text
Text = MarkupText.text latest.Text
Tags = String.Join (", ", post.Tags)
Template = defaultArg post.Template ""
CategoryIds = post.CategoryIds |> List.map CategoryId.toString |> Array.ofList
Status = PostStatus.toString post.Status
DoPublish = false
MetaNames = post.metadata |> List.map (fun m -> m.name) |> Array.ofList
MetaValues = post.metadata |> List.map (fun m -> m.value) |> Array.ofList
MetaNames = post.Metadata |> List.map (fun m -> m.Name) |> Array.ofList
MetaValues = post.Metadata |> List.map (fun m -> m.Value) |> Array.ofList
SetPublished = false
PubOverride = post.publishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable
PubOverride = post.PublishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable
SetUpdated = false
IsEpisode = Option.isSome post.episode
Media = episode.media
Length = episode.length
Duration = defaultArg (episode.duration |> Option.map (fun it -> it.ToString """hh\:mm\:ss""")) ""
MediaType = defaultArg episode.mediaType ""
ImageUrl = defaultArg episode.imageUrl ""
Subtitle = defaultArg episode.subtitle ""
Explicit = defaultArg (episode.explicit |> Option.map ExplicitRating.toString) ""
ChapterFile = defaultArg episode.chapterFile ""
ChapterType = defaultArg episode.chapterType ""
TranscriptUrl = defaultArg episode.transcriptUrl ""
TranscriptType = defaultArg episode.transcriptType ""
TranscriptLang = defaultArg episode.transcriptLang ""
TranscriptCaptions = defaultArg episode.transcriptCaptions false
SeasonNumber = defaultArg episode.seasonNumber 0
SeasonDescription = defaultArg episode.seasonDescription ""
EpisodeNumber = defaultArg (episode.episodeNumber |> Option.map string) ""
EpisodeDescription = defaultArg episode.episodeDescription ""
IsEpisode = Option.isSome post.Episode
Media = episode.Media
Length = episode.Length
Duration = defaultArg (episode.Duration |> Option.map (fun it -> it.ToString """hh\:mm\:ss""")) ""
MediaType = defaultArg episode.MediaType ""
ImageUrl = defaultArg episode.ImageUrl ""
Subtitle = defaultArg episode.Subtitle ""
Explicit = defaultArg (episode.Explicit |> Option.map ExplicitRating.toString) ""
ChapterFile = defaultArg episode.ChapterFile ""
ChapterType = defaultArg episode.ChapterType ""
TranscriptUrl = defaultArg episode.TranscriptUrl ""
TranscriptType = defaultArg episode.TranscriptType ""
TranscriptLang = defaultArg episode.TranscriptLang ""
TranscriptCaptions = defaultArg episode.TranscriptCaptions false
SeasonNumber = defaultArg episode.SeasonNumber 0
SeasonDescription = defaultArg episode.SeasonDescription ""
EpisodeNumber = defaultArg (episode.EpisodeNumber |> Option.map string) ""
EpisodeDescription = defaultArg episode.EpisodeDescription ""
}
/// Update a post with values from the submitted form
member this.updatePost (post : Post) (revision : Revision) now =
member this.UpdatePost (post : Post) (revision : Revision) now =
{ post with
title = this.Title
permalink = Permalink this.Permalink
publishedOn = if this.DoPublish then Some now else post.publishedOn
updatedOn = now
text = MarkupText.toHtml revision.text
tags = this.Tags.Split ","
Title = this.Title
Permalink = Permalink this.Permalink
PublishedOn = if this.DoPublish then Some now else post.PublishedOn
UpdatedOn = now
Text = MarkupText.toHtml revision.Text
Tags = this.Tags.Split ","
|> Seq.ofArray
|> Seq.map (fun it -> it.Trim().ToLower ())
|> Seq.filter (fun it -> it <> "")
|> Seq.sort
|> List.ofSeq
template = match this.Template.Trim () with "" -> None | tmpl -> Some tmpl
categoryIds = this.CategoryIds |> Array.map CategoryId |> List.ofArray
status = if this.DoPublish then Published else post.status
metadata = Seq.zip this.MetaNames this.MetaValues
Template = match this.Template.Trim () with "" -> None | tmpl -> Some tmpl
CategoryIds = this.CategoryIds |> Array.map CategoryId |> List.ofArray
Status = if this.DoPublish then Published else post.Status
Metadata = Seq.zip this.MetaNames this.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 ()}")
|> Seq.map (fun it -> { Name = fst it; Value = snd it })
|> Seq.sortBy (fun it -> $"{it.Name.ToLower ()} {it.Value.ToLower ()}")
|> List.ofSeq
revisions = match post.revisions |> List.tryHead with
| Some r when r.text = revision.text -> post.revisions
| _ -> revision :: post.revisions
episode =
Revisions = match post.Revisions |> List.tryHead with
| Some r when r.Text = revision.Text -> post.Revisions
| _ -> revision :: post.Revisions
Episode =
if this.IsEpisode then
Some {
media = this.Media
length = this.Length
duration = noneIfBlank this.Duration |> Option.map TimeSpan.Parse
mediaType = noneIfBlank this.MediaType
imageUrl = noneIfBlank this.ImageUrl
subtitle = noneIfBlank this.Subtitle
explicit = noneIfBlank this.Explicit |> Option.map ExplicitRating.parse
chapterFile = noneIfBlank this.ChapterFile
chapterType = noneIfBlank this.ChapterType
transcriptUrl = noneIfBlank this.TranscriptUrl
transcriptType = noneIfBlank this.TranscriptType
transcriptLang = noneIfBlank this.TranscriptLang
transcriptCaptions = if this.TranscriptCaptions then Some true else None
seasonNumber = if this.SeasonNumber = 0 then None else Some this.SeasonNumber
seasonDescription = noneIfBlank this.SeasonDescription
episodeNumber = match noneIfBlank this.EpisodeNumber |> Option.map Double.Parse with
Media = this.Media
Length = this.Length
Duration = noneIfBlank this.Duration |> Option.map TimeSpan.Parse
MediaType = noneIfBlank this.MediaType
ImageUrl = noneIfBlank this.ImageUrl
Subtitle = noneIfBlank this.Subtitle
Explicit = noneIfBlank this.Explicit |> Option.map ExplicitRating.parse
ChapterFile = noneIfBlank this.ChapterFile
ChapterType = noneIfBlank this.ChapterType
TranscriptUrl = noneIfBlank this.TranscriptUrl
TranscriptType = noneIfBlank this.TranscriptType
TranscriptLang = noneIfBlank this.TranscriptLang
TranscriptCaptions = if this.TranscriptCaptions then Some true else None
SeasonNumber = if this.SeasonNumber = 0 then None else Some this.SeasonNumber
SeasonDescription = noneIfBlank this.SeasonDescription
EpisodeNumber = match noneIfBlank this.EpisodeNumber |> Option.map Double.Parse with
| Some it when it = 0.0 -> None
| Some it -> Some (double it)
| None -> None
episodeDescription = noneIfBlank this.EpisodeDescription
EpisodeDescription = noneIfBlank this.EpisodeDescription
}
else
None
@ -665,23 +695,23 @@ type EditRssModel =
/// Create an edit model from a set of RSS options
static member fromRssOptions (rss : RssOptions) =
{ IsFeedEnabled = rss.feedEnabled
FeedName = rss.feedName
ItemsInFeed = defaultArg rss.itemsInFeed 0
IsCategoryEnabled = rss.categoryEnabled
IsTagEnabled = rss.tagEnabled
Copyright = defaultArg rss.copyright ""
{ IsFeedEnabled = rss.IsFeedEnabled
FeedName = rss.FeedName
ItemsInFeed = defaultArg rss.ItemsInFeed 0
IsCategoryEnabled = rss.IsCategoryEnabled
IsTagEnabled = rss.IsTagEnabled
Copyright = defaultArg rss.Copyright ""
}
/// Update RSS options from values in this mode
member this.updateOptions (rss : RssOptions) =
member this.UpdateOptions (rss : RssOptions) =
{ rss with
feedEnabled = this.IsFeedEnabled
feedName = this.FeedName
itemsInFeed = if this.ItemsInFeed = 0 then None else Some this.ItemsInFeed
categoryEnabled = this.IsCategoryEnabled
tagEnabled = this.IsTagEnabled
copyright = noneIfBlank this.Copyright
IsFeedEnabled = this.IsFeedEnabled
FeedName = this.FeedName
ItemsInFeed = if this.ItemsInFeed = 0 then None else Some this.ItemsInFeed
IsCategoryEnabled = this.IsCategoryEnabled
IsTagEnabled = this.IsTagEnabled
Copyright = noneIfBlank this.Copyright
}
@ -703,37 +733,9 @@ type EditTagMapModel =
/// Create an edit model from the tag mapping
static member fromMapping (tagMap : TagMap) : EditTagMapModel =
{ Id = TagMapId.toString tagMap.id
Tag = tagMap.tag
UrlValue = tagMap.urlValue
}
/// View model to edit a user
[<CLIMutable; NoComparison; NoEquality>]
type EditUserModel =
{ /// The user's first name
FirstName : string
/// The user's last name
LastName : string
/// The user's preferred name
PreferredName : string
/// A new password for the user
NewPassword : string
/// A new password for the user, confirmed
NewPasswordConfirm : string
}
/// Create an edit model from a user
static member fromUser (user : WebLogUser) =
{ FirstName = user.firstName
LastName = user.lastName
PreferredName = user.preferredName
NewPassword = ""
NewPasswordConfirm = ""
{ Id = TagMapId.toString tagMap.Id
Tag = tagMap.Tag
UrlValue = tagMap.UrlValue
}
@ -776,20 +778,20 @@ type ManagePermalinksModel =
/// Create a permalink model from a page
static member fromPage (pg : Page) =
{ Id = PageId.toString pg.id
{ Id = PageId.toString pg.Id
Entity = "page"
CurrentTitle = pg.title
CurrentPermalink = Permalink.toString pg.permalink
Prior = pg.priorPermalinks |> List.map Permalink.toString |> Array.ofList
CurrentTitle = pg.Title
CurrentPermalink = Permalink.toString pg.Permalink
Prior = pg.PriorPermalinks |> List.map Permalink.toString |> Array.ofList
}
/// Create a permalink model from a post
static member fromPost (post : Post) =
{ Id = PostId.toString post.id
{ Id = PostId.toString post.Id
Entity = "post"
CurrentTitle = post.title
CurrentPermalink = Permalink.toString post.permalink
Prior = post.priorPermalinks |> List.map Permalink.toString |> Array.ofList
CurrentTitle = post.Title
CurrentPermalink = Permalink.toString post.Permalink
Prior = post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList
}
@ -811,18 +813,18 @@ type ManageRevisionsModel =
/// Create a revision model from a page
static member fromPage webLog (pg : Page) =
{ Id = PageId.toString pg.id
{ Id = PageId.toString pg.Id
Entity = "page"
CurrentTitle = pg.title
Revisions = pg.revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
CurrentTitle = pg.Title
Revisions = pg.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
}
/// Create a revision model from a post
static member fromPost webLog (post : Post) =
{ Id = PostId.toString post.id
{ Id = PostId.toString post.Id
Entity = "post"
CurrentTitle = post.title
Revisions = post.revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
CurrentTitle = post.Title
Revisions = post.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
}
@ -870,18 +872,18 @@ type PostListItem =
static member fromPost (webLog : WebLog) (post : Post) =
let _, extra = WebLog.hostAndPath webLog
let inTZ = WebLog.localTime webLog
{ Id = PostId.toString post.id
AuthorId = WebLogUserId.toString post.authorId
Status = PostStatus.toString post.status
Title = post.title
Permalink = Permalink.toString post.permalink
PublishedOn = post.publishedOn |> Option.map inTZ |> Option.toNullable
UpdatedOn = inTZ post.updatedOn
Text = if extra = "" then post.text else post.text.Replace ("href=\"/", $"href=\"{extra}/")
CategoryIds = post.categoryIds |> List.map CategoryId.toString
Tags = post.tags
Episode = post.episode
Metadata = post.metadata
{ Id = PostId.toString post.Id
AuthorId = WebLogUserId.toString post.AuthorId
Status = PostStatus.toString post.Status
Title = post.Title
Permalink = Permalink.toString post.Permalink
PublishedOn = post.PublishedOn |> Option.map inTZ |> Option.toNullable
UpdatedOn = inTZ post.UpdatedOn
Text = if extra = "" then post.Text else post.Text.Replace ("href=\"/", $"href=\"{extra}/")
CategoryIds = post.CategoryIds |> List.map CategoryId.toString
Tags = post.Tags
Episode = post.Episode
Metadata = post.Metadata
}
@ -932,7 +934,7 @@ type SettingsModel =
TimeZone : string
/// The theme to use to display the web log
ThemePath : string
ThemeId : string
/// Whether to automatically load htmx
AutoHtmx : bool
@ -943,29 +945,29 @@ type SettingsModel =
/// Create a settings model from a web log
static member fromWebLog (webLog : WebLog) =
{ Name = webLog.name
Slug = webLog.slug
Subtitle = defaultArg webLog.subtitle ""
DefaultPage = webLog.defaultPage
PostsPerPage = webLog.postsPerPage
TimeZone = webLog.timeZone
ThemePath = webLog.themePath
AutoHtmx = webLog.autoHtmx
Uploads = UploadDestination.toString webLog.uploads
{ Name = webLog.Name
Slug = webLog.Slug
Subtitle = defaultArg webLog.Subtitle ""
DefaultPage = webLog.DefaultPage
PostsPerPage = webLog.PostsPerPage
TimeZone = webLog.TimeZone
ThemeId = ThemeId.toString webLog.ThemeId
AutoHtmx = webLog.AutoHtmx
Uploads = UploadDestination.toString webLog.Uploads
}
/// Update a web log with settings from the form
member this.update (webLog : WebLog) =
{ webLog with
name = this.Name
slug = this.Slug
subtitle = if this.Subtitle = "" then None else Some this.Subtitle
defaultPage = this.DefaultPage
postsPerPage = this.PostsPerPage
timeZone = this.TimeZone
themePath = this.ThemePath
autoHtmx = this.AutoHtmx
uploads = UploadDestination.parse this.Uploads
Name = this.Name
Slug = this.Slug
Subtitle = if this.Subtitle = "" then None else Some this.Subtitle
DefaultPage = this.DefaultPage
PostsPerPage = this.PostsPerPage
TimeZone = this.TimeZone
ThemeId = ThemeId this.ThemeId
AutoHtmx = this.AutoHtmx
Uploads = UploadDestination.parse this.Uploads
}

32
src/MyWebLog/Caches.fs
View File

@ -67,13 +67,13 @@ 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 {
@ -91,18 +91,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
}
@ -116,15 +116,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
}
@ -149,10 +149,10 @@ module TemplateCache =
| false ->
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 -> ()
@ -179,14 +179,14 @@ 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)
_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 ()
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]
}

52
src/MyWebLog/DotLiquidBespoke.fs
View File

@ -12,11 +12,13 @@ open MyWebLog.ViewModels
type Context with
/// Get the current web log from the DotLiquid context
member this.WebLog = this.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) =
@ -24,7 +26,7 @@ let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> st
| :? 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
| :? DropProxy as proxy -> Option.ofObj proxy["Permalink"] |> Option.map string
| _ -> None
|> function
| Some link -> linkFunc ctx.WebLog (Permalink link)
@ -42,7 +44,7 @@ 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
| :? DropProxy as proxy -> Option.ofObj proxy["Slug"] |> Option.map string
| _ -> None
|> function
| Some slug -> WebLog.relativeUrl ctx.WebLog (Permalink $"category/{slug}/")
@ -54,7 +56,7 @@ 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
| :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId
| _ -> None
|> function
@ -67,7 +69,7 @@ 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
| :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId
| _ -> None
|> function
@ -89,13 +91,13 @@ type NavLinkFilter () =
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) =
WebLog.relativeUrl ctx.WebLog (Permalink $"themes/{ctx.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
@ -107,7 +109,7 @@ type PageHeadTag () =
// 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,17 +125,17 @@ 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
@ -155,7 +157,7 @@ type PageFootTag () =
// 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,9 +174,9 @@ 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 ctx.WebLog (Permalink $"tag/{tagUrl}/")
@ -201,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 --"
@ -225,11 +227,11 @@ let register () =
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<DisplayRevision>; typeof<DisplayUpload>; typeof<EditCategoryModel>; typeof<EditCustomFeedModel>
typeof<EditPageModel>; typeof<EditPostModel>; typeof<EditRssModel>; typeof<EditTagMapModel>
typeof<EditUserModel>; typeof<LogOnModel>; typeof<ManagePermalinksModel>; typeof<ManageRevisionsModel>
typeof<PostDisplay>; typeof<PostListItem>; typeof<SettingsModel>; typeof<UserMessage>
typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayCustomFeed>; typeof<DisplayPage>
typeof<DisplayRevision>; typeof<DisplayUpload>; typeof<EditCategoryModel>; typeof<EditCustomFeedModel>
typeof<EditMyInfoModel>; typeof<EditPageModel>; typeof<EditPostModel>; typeof<EditRssModel>
typeof<EditTagMapModel>; typeof<LogOnModel>; typeof<ManagePermalinksModel>; typeof<ManageRevisionsModel>
typeof<PostDisplay>; typeof<PostListItem>; typeof<SettingsModel>; typeof<UserMessage>
// Framework types
typeof<AntiforgeryTokenSet>; typeof<DateTime option>; typeof<int option>; typeof<KeyValuePair>
typeof<MetaItem list>; typeof<string list>; typeof<string option>; typeof<TagMap list>

97
src/MyWebLog/Handlers/Admin.fs
View File

@ -9,7 +9,7 @@ open MyWebLog.ViewModels
// GET /admin
let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let getCount (f : WebLogId -> Task<int>) = f ctx.WebLog.id
let getCount (f : WebLogId -> Task<int>) = f ctx.WebLog.Id
let data = ctx.Data
let posts = getCount (data.Post.CountByStatus Published)
let drafts = getCount (data.Post.CountByStatus Draft)
@ -30,7 +30,7 @@ let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
TopLevelCategories = topCats.Result
}
|}
|> viewForTheme "admin" "dashboard" next ctx
|> adminView "dashboard" next ctx
}
// -- CATEGORIES --
@ -44,8 +44,9 @@ let listCategories : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
web_log = ctx.WebLog
categories = CategoryCache.get ctx
|}
hash.Add ("category_list", catListTemplate.Render hash)
return! viewForTheme "admin" "category-list" next ctx hash
return!
addToHash "category_list" (catListTemplate.Render hash) hash
|> adminView "category-list" next ctx
}
// GET /admin/categories/bare
@ -54,16 +55,16 @@ let listCategoriesBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ct
categories = CategoryCache.get ctx
csrf = ctx.CsrfTokenSet
|}
|> bareForTheme "admin" "category-list-body" next ctx
|> adminBareView "category-list-body" next ctx
// GET /admin/category/{id}/edit
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
}
@ -76,7 +77,7 @@ let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ct
model = EditCategoryModel.fromCategory cat
categories = CategoryCache.get ctx
|}
|> bareForTheme "admin" "category-edit" next ctx
|> adminBareView "category-edit" next ctx
| None -> return! Error.notFound next ctx
}
@ -86,16 +87,16 @@ let saveCategory : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
let! model = ctx.BindFormAsync<EditCategoryModel> ()
let category =
match model.CategoryId with
| "new" -> Task.FromResult (Some { Category.empty with id = CategoryId.create (); webLogId = ctx.WebLog.id })
| catId -> data.Category.FindById (CategoryId catId) ctx.WebLog.id
| "new" -> Task.FromResult (Some { Category.empty with Id = CategoryId.create (); WebLogId = ctx.WebLog.Id })
| catId -> data.Category.FindById (CategoryId catId) ctx.WebLog.Id
match! category with
| Some cat ->
let cat =
{ 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! CategoryCache.update ctx
@ -106,7 +107,7 @@ let saveCategory : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
// POST /admin/category/{id}/delete
let deleteCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Category.Delete (CategoryId catId) ctx.WebLog.id with
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" }
@ -120,12 +121,12 @@ 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
let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
return Hash.FromAnonymousObject {|
csrf = ctx.CsrfTokenSet
web_log = ctx.WebLog
mappings = mappings
mapping_ids = mappings |> List.map (fun it -> { name = it.tag; value = TagMapId.toString it.id })
mapping_ids = mappings |> List.map (fun it -> { Name = it.Tag; Value = TagMapId.toString it.Id })
|}
}
@ -136,30 +137,30 @@ let tagMappings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta
return!
addToHash "tag_mapping_list" (listTemplate.Render hash) hash
|> addToHash "page_title" "Tag Mappings"
|> viewForTheme "admin" "tag-mapping-list" next ctx
|> adminView "tag-mapping-list" next ctx
}
// GET /admin/settings/tag-mappings/bare
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 = 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 Task.FromResult (Some { TagMap.empty with Id = TagMapId "new" })
else ctx.Data.TagMap.FindById (TagMapId tagMapId) ctx.WebLog.Id
match! tagMap with
| Some tm ->
return!
Hash.FromAnonymousObject {|
page_title = if isNew then "Add Tag Mapping" else $"Mapping for {tm.tag} Tag"
page_title = if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag"
csrf = ctx.CsrfTokenSet
model = EditTagMapModel.fromMapping tm
|}
|> bareForTheme "admin" "tag-mapping-edit" next ctx
|> adminBareView "tag-mapping-edit" next ctx
| None -> return! Error.notFound next ctx
}
@ -169,11 +170,11 @@ let saveMapping : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta
let! model = ctx.BindFormAsync<EditTagMapModel> ()
let tagMap =
if model.IsNew then
Task.FromResult (Some { TagMap.empty with id = TagMapId.create (); webLogId = ctx.WebLog.id })
else data.TagMap.FindById (TagMapId model.Id) ctx.WebLog.id
Task.FromResult (Some { 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! 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
@ -181,7 +182,7 @@ let saveMapping : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta
// POST /admin/settings/tag-mapping/{id}/delete
let deleteMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.TagMap.Delete (TagMapId tagMapId) ctx.WebLog.id with
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
@ -201,7 +202,7 @@ let themeUpdatePage : HttpHandler = requireAccess Administrator >=> fun next ctx
page_title = "Upload Theme"
csrf = ctx.CsrfTokenSet
|}
|> viewForTheme "admin" "upload-theme" next 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 {
@ -211,17 +212,17 @@ 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 = [] }
do! data.ThemeAsset.DeleteByTheme theme.Id
return { theme with Templates = [] }
else return theme
}
@ -233,13 +234,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
}
@ -251,9 +252,9 @@ let private updateAssets themeId (zip : ZipArchive) (data : IData) = backgroundT
use stream = new MemoryStream ()
do! asset.Open().CopyToAsync stream
do! data.ThemeAsset.Save
{ id = ThemeAssetId (themeId, assetName)
updatedOn = asset.LastWriteTime.DateTime
data = stream.ToArray ()
{ Id = ThemeAssetId (themeId, assetName)
UpdatedOn = asset.LastWriteTime.DateTime
Data = stream.ToArray ()
}
}
@ -269,7 +270,7 @@ let loadThemeFromZip themeName file clean (data : IData) = backgroundTask {
let! theme = backgroundTask {
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
@ -308,7 +309,7 @@ open System.Collections.Generic
// GET /admin/settings
let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! allPages = data.Page.All ctx.WebLog.id
let! allPages = data.Page.All ctx.WebLog.Id
let! themes = data.Theme.All ()
return!
Hash.FromAnonymousObject {|
@ -318,41 +319,41 @@ let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task
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
|> Seq.ofList
|> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.id, $"{it.name} (v{it.version})"))
|> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.Id, $"{it.Name} (v{it.Version})"))
|> Array.ofSeq
upload_values = [|
KeyValuePair.Create (UploadDestination.toString Database, "Database")
KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
|]
|}
|> viewForTheme "admin" "settings" next ctx
|> adminView "settings" next ctx
}
// POST /admin/settings
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<SettingsModel> ()
match! data.WebLog.FindById ctx.WebLog.id with
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
let oldSlug = webLog.slug
let oldSlug = webLog.Slug
let webLog = model.update webLog
do! data.WebLog.UpdateSettings webLog
// Update cache
WebLogCache.set webLog
if oldSlug <> webLog.slug then
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))
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

212
src/MyWebLog/Handlers/Feed.fs
View File

@ -26,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
@ -53,13 +53,13 @@ let private getFeedPosts ctx feedType =
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)*?>", "")
@ -90,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)
@ -104,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
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)"))
]
@ -137,19 +137,19 @@ let toAbsolute webLog (link : string) =
/// Add episode information to a podcast feed item
let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (post : Post) (item : SyndicationItem) =
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 webLog
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 =
@ -159,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 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
@ -180,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 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)
@ -203,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)
@ -214,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)
@ -247,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 ()
@ -266,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
]
@ -284,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))
@ -300,62 +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))
podcast.fundingUrl
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"
funding.InnerText <- defaultArg podcast.FundingText "Support This Podcast"
rssFeed.ElementExtensions.Add funding)
podcast.guid
podcast.PodcastGuid
|> Option.iter (fun guid ->
rssFeed.ElementExtensions.Add ("guid", Namespace.podcast, guid.ToString().ToLowerInvariant ()))
podcast.medium
podcast.Medium
|> Option.iter (fun med -> rssFeed.ElementExtensions.Add ("medium", Namespace.podcast, PodcastMedium.toString med))
/// 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.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.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
@ -365,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
@ -381,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.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)
@ -419,24 +419,24 @@ open DotLiquid
// GET: /admin/settings/rss
let editSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let feeds =
ctx.WebLog.rss.customFeeds
ctx.WebLog.Rss.CustomFeeds
|> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx))
|> Array.ofList
Hash.FromAnonymousObject {|
page_title = "RSS Settings"
csrf = ctx.CsrfTokenSet
model = EditRssModel.fromRssOptions ctx.WebLog.rss
model = EditRssModel.fromRssOptions ctx.WebLog.Rss
custom_feeds = feeds
|}
|> viewForTheme "admin" "rss-settings" next ctx
|> adminView "rss-settings" next ctx
// 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 }
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" }
@ -448,8 +448,8 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
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 ->
Hash.FromAnonymousObject {|
@ -468,30 +468,30 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
KeyValuePair.Create (PodcastMedium.toString Blog, "Blog")
|]
|}
|> viewForTheme "admin" "custom-feed-edit" next ctx
|> adminView "custom-feed-edit" next ctx
| None -> Error.notFound next ctx
// 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)
| "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 } }
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"""
}
return! redirectToGet $"admin/settings/rss/{CustomFeedId.toString feed.id}/edit" 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
}
@ -499,15 +499,15 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
// 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

36
src/MyWebLog/Handlers/Helpers.fs
View File

@ -58,7 +58,7 @@ open DotLiquid
/// 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) =
hash.Add (key, value)
if hash.ContainsKey key then hash[key] <- value else hash.Add (key, value)
hash
open System.Security.Claims
@ -101,11 +101,11 @@ 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 theme template next ctx (hash : Hash) = task {
if not (hash.ContainsKey "web_log") then
let viewForTheme themeId template next ctx (hash : Hash) = task {
if not (hash.ContainsKey "htmx_script") then
let! _ = populateHash hash ctx
()
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
@ -134,8 +134,9 @@ let messagesToHeaders (messages : UserMessage array) : HttpHandler =
|> Seq.reduce (>=>)
/// Render a bare view for the specified theme, using the specified template and hash
let bareForTheme theme template next ctx (hash : Hash) = task {
let bareForTheme themeId template next ctx (hash : Hash) = task {
let! hash = populateHash hash ctx
let (ThemeId theme) = themeId
if not (hash.ContainsKey "content") then
let! contentTemplate = TemplateCache.get theme template ctx.Data
@ -151,9 +152,16 @@ let bareForTheme theme template next ctx (hash : Hash) = task {
/// Return a view for the web log's default theme
let themedView template next ctx hash = task {
let! hash = populateHash hash ctx
return! viewForTheme (hash["web_log"] :?> WebLog).themePath template next ctx hash
return! viewForTheme (hash["web_log"] :?> 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 _ ctx -> task {
@ -232,15 +240,15 @@ 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}) -") |]
@ -249,17 +257,17 @@ 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 =

104
src/MyWebLog/Handlers/Page.fs
View File

@ -9,7 +9,7 @@ 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
let! pages = ctx.Data.Page.FindPageOfPages ctx.WebLog.Id pageNbr
return!
Hash.FromAnonymousObject {|
page_title = "Pages"
@ -19,21 +19,21 @@ let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
prev_page = if pageNbr = 2 then "" else $"/page/{pageNbr - 1}"
next_page = $"/page/{pageNbr + 1}"
|}
|> viewForTheme "admin" "page-list" next ctx
|> 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 })
| "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
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 ->
| Some (title, page) when canEdit page.AuthorId ctx ->
let model = EditPageModel.fromPage page
let! templates = templatesForTheme ctx "page"
return!
@ -45,14 +45,14 @@ let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
templates = templates
|}
|> viewForTheme "admin" "page-edit" next ctx
|> 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
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" }
@ -62,15 +62,15 @@ let delete pgId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta
// 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 ->
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
Hash.FromAnonymousObject {|
page_title = "Manage Prior Permalinks"
csrf = ctx.CsrfTokenSet
model = ManagePermalinksModel.fromPage pg
|}
|> viewForTheme "admin" "permalinks" next ctx
|> adminView "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
@ -79,10 +79,10 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
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 ->
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
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
@ -93,15 +93,15 @@ let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task
// 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 ->
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
Hash.FromAnonymousObject {|
page_title = "Manage Page Revisions"
csrf = ctx.CsrfTokenSet
model = ManageRevisionsModel.fromPage ctx.WebLog pg
|}
|> viewForTheme "admin" "revisions" next ctx
|> adminView "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
@ -109,9 +109,9 @@ let editRevisions pgId : HttpHandler = requireAccess Author >=> fun 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
match! data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg ->
do! data.Page.Update { pg with revisions = [ List.head pg.revisions ] }
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
@ -121,22 +121,22 @@ 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
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)
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 ->
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
return!
Hash.FromAnonymousObject {|
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.text}</div>"""
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.Text}</div>"""
|}
|> bareForTheme "admin" "" next ctx
|> adminBareView "" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
@ -147,11 +147,11 @@ 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 ->
| 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))
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
@ -163,10 +163,10 @@ let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
// 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) }
| 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! bareForTheme "admin" "" next ctx (Hash.FromAnonymousObject {| content = "" |})
return! adminBareView "" next ctx (Hash.FromAnonymousObject {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
@ -187,43 +187,43 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
Task.FromResult (
Some
{ Page.empty with
id = PageId.create ()
webLogId = ctx.WebLog.id
authorId = ctx.UserId
publishedOn = now
Id = PageId.create ()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
PublishedOn = now
})
| pgId -> data.Page.FindFullById (PageId pgId) ctx.WebLog.id
| pgId -> data.Page.FindFullById (PageId pgId) ctx.WebLog.Id
match! pg with
| Some page when canEdit page.authorId ctx ->
let updateList = page.showInPageList <> model.IsShownInPageList
let revision = { asOf = now; text = MarkupText.parse $"{model.Source}: {model.Text}" }
| Some page when canEdit page.AuthorId ctx ->
let updateList = page.IsInPageList <> 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
match Permalink.toString page.Permalink with
| "" -> page
| link when link = model.Permalink -> page
| _ -> { page with priorPermalinks = page.permalink :: page.priorPermalinks }
| _ -> { 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
Title = model.Title
Permalink = Permalink model.Permalink
UpdatedOn = now
IsInPageList = 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 ()}")
|> 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
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 $"admin/page/{PageId.toString page.id}/edit" next ctx
return! redirectToGet $"admin/page/{PageId.toString page.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}

152
src/MyWebLog/Handlers/Post.fs
View File

@ -10,10 +10,10 @@ 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
@ -54,14 +54,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}"
@ -71,7 +71,7 @@ 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}"
@ -82,9 +82,9 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (da
Authors = authors
Subtitle = None
NewerLink = newerLink
NewerName = newerPost |> Option.map (fun p -> p.title)
NewerName = newerPost |> Option.map (fun p -> p.Title)
OlderLink = olderLink
OlderName = olderPost |> Option.map (fun p -> p.title)
OlderName = olderPost |> Option.map (fun p -> p.Title)
}
return Hash.FromAnonymousObject {|
model = model
@ -98,17 +98,17 @@ open Giraffe
// GET /page/{pageNbr}
let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
let count = ctx.WebLog.postsPerPage
let count = ctx.WebLog.PostsPerPage
let data = ctx.Data
let! posts = data.Post.FindPageOfPublishedPosts ctx.WebLog.id pageNbr count
let! posts = data.Post.FindPageOfPublishedPosts ctx.WebLog.Id pageNbr count
let! hash = preparePostList ctx.WebLog posts PostList "" pageNbr count ctx data
let title =
match pageNbr, ctx.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 && ctx.WebLog.defaultPage = "posts" then hash.Add ("is_home", true)
if pageNbr = 1 && ctx.WebLog.DefaultPage = "posts" then hash.Add ("is_home", true)
return! themedView "index" next ctx hash
}
@ -125,14 +125,14 @@ let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task {
| Some pageNbr, slug, isFeed ->
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 ctx data
let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
return!
addToHash "page_title" $"{cat.Name}: Category Archive{pgTitle}" hash
@ -157,17 +157,17 @@ 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 ctx data
let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
return!
addToHash "page_title" $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}" hash
@ -178,7 +178,7 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
// 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!
@ -192,19 +192,19 @@ 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_title = page.title
page_title = page.Title
page = DisplayPage.fromPage webLog page
categories = CategoryCache.get ctx
is_home = true
|}
|> themedView (defaultArg page.template "single-page") next ctx
|> themedView (defaultArg page.Template "single-page") next ctx
| None -> return! Error.notFound next ctx
}
@ -212,12 +212,12 @@ let home : HttpHandler = fun next ctx -> task {
// GET /admin/posts/page/{pageNbr}
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
let! posts = data.Post.FindPageOfPosts ctx.WebLog.id pageNbr 25
let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25
let! hash = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 ctx data
return!
addToHash "page_title" "Posts" hash
|> addToHash "csrf" ctx.CsrfTokenSet
|> viewForTheme "admin" "post-list" next ctx
|> adminView "post-list" next ctx
}
// GET /admin/post/{id}/edit
@ -225,15 +225,15 @@ 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) ctx.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) when canEdit post.authorId ctx ->
let! cats = data.Category.FindAllForView ctx.WebLog.id
| Some (title, post) when canEdit post.AuthorId ctx ->
let! cats = data.Category.FindAllForView ctx.WebLog.Id
let! templates = templatesForTheme ctx "post"
let model = EditPostModel.fromPost ctx.WebLog post
return!
@ -252,14 +252,14 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
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
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
@ -267,15 +267,15 @@ let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
// GET /admin/post/{id}/permalinks
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 ->
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
Hash.FromAnonymousObject {|
page_title = "Manage Prior Permalinks"
csrf = ctx.CsrfTokenSet
model = ManagePermalinksModel.fromPost post
|}
|> viewForTheme "admin" "permalinks" next ctx
|> adminView "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
@ -284,10 +284,10 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx
let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let postId = PostId model.Id
match! ctx.Data.Post.FindById postId ctx.WebLog.id with
| Some post when canEdit post.authorId ctx ->
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
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 $"admin/post/{model.Id}/permalinks" next ctx
@ -298,15 +298,15 @@ let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task
// 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 ->
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
Hash.FromAnonymousObject {|
page_title = "Manage Post Revisions"
csrf = ctx.CsrfTokenSet
model = ManageRevisionsModel.fromPost ctx.WebLog post
|}
|> viewForTheme "admin" "revisions" next ctx
|> adminView "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
@ -314,9 +314,9 @@ let editRevisions postId : HttpHandler = requireAccess Author >=> fun 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 ] }
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
@ -327,22 +327,22 @@ 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
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)
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 ->
| Some post, Some rev when canEdit post.AuthorId ctx ->
return!
Hash.FromAnonymousObject {|
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.text}</div>"""
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.Text}</div>"""
|}
|> bareForTheme "admin" "" next ctx
|> adminBareView "" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
@ -351,11 +351,11 @@ let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
// 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 ->
| 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))
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
@ -367,10 +367,10 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
// 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) }
| 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! bareForTheme "admin" "" next ctx (Hash.FromAnonymousObject {| content = "" |})
return! adminBareView "" next ctx (Hash.FromAnonymousObject {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
@ -388,43 +388,43 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
Task.FromResult (
Some
{ Post.empty with
id = PostId.create ()
webLogId = ctx.WebLog.id
authorId = ctx.UserId
Id = PostId.create ()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
})
else data.Post.FindFullById (PostId model.PostId) ctx.WebLog.id
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 revision = { asOf = now; text = MarkupText.parse $"{model.Source}: {model.Text}" }
| Some post when canEdit post.AuthorId ctx ->
let priorCats = post.CategoryIds
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
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
| _ -> { post with PriorPermalinks = post.Permalink :: post.PriorPermalinks }
let post = model.UpdatePost post revision now
let 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 } ]
PublishedOn = Some dt
UpdatedOn = dt
Revisions = [ { (List.head post.Revisions) with AsOf = dt } ]
}
else { post with publishedOn = Some dt }
else { post with PublishedOn = Some dt }
else 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 (priorCats
|> List.append post.categoryIds
|> List.append post.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
return! redirectToGet $"admin/post/{PostId.toString post.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}

36
src/MyWebLog/Handlers/Routes.fs
View File

@ -27,25 +27,25 @@ 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
model.Add ("page_title", post.Title)
yield fun next ctx -> themedView (defaultArg post.Template "single-post") next ctx model
| 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")
yield fun next ctx ->
Hash.FromAnonymousObject {|
page_title = page.title
page_title = page.Title
page = DisplayPage.fromPage webLog page
categories = CategoryCache.get ctx
is_page = true
|}
|> themedView (defaultArg page.template "single-page") next ctx
|> themedView (defaultArg page.Template "single-page") next ctx
| None -> ()
// RSS feed
match Feed.deriveFeedType ctx textLink with
@ -56,25 +56,25 @@ module CatchAll =
// 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)
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)
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")
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")
yield redirectTo true (WebLog.relativeUrl webLog link)
@ -95,9 +95,9 @@ module Asset =
let path = urlParts |> Seq.skip 1 |> Seq.head
match! ctx.Data.ThemeAsset.FindById (ThemeAssetId.ofString path) with
| Some asset ->
match Upload.checkModified asset.updatedOn ctx with
match Upload.checkModified asset.UpdatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx
| None -> return! Upload.sendFile asset.updatedOn path asset.data next ctx
| None -> return! Upload.sendFile asset.UpdatedOn path asset.Data next ctx
| None -> return! Error.notFound next ctx
}
@ -148,7 +148,9 @@ let router : HttpHandler = choose [
route "s" >=> Upload.list
route "/new" >=> Upload.showNew
])
route "/user/edit" >=> User.edit
subRoute "/user" (choose [
route "/my-info" >=> User.myInfo
])
]
POST >=> validateCsrf >=> choose [
subRoute "/category" (choose [
@ -189,7 +191,9 @@ let router : HttpHandler = choose [
routexp "/delete/(.*)" Upload.deleteFromDisk
routef "/%s/delete" Upload.deleteFromDb
])
route "/user/save" >=> User.save
subRoute "/user" (choose [
route "/my-info" >=> User.saveMyInfo
])
]
])
GET_HEAD >=> routexp "/category/(.*)" Post.pageOfCategorizedPosts

36
src/MyWebLog/Handlers/Upload.fs
View File

@ -58,18 +58,18 @@ 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
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
match! ctx.Data.Upload.FindByPath path webLog.Id with
| Some upload ->
match checkModified upload.updatedOn ctx with
match checkModified upload.UpdatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx
| None -> return! sendFile upload.updatedOn path upload.data next ctx
| None -> return! sendFile upload.UpdatedOn path upload.Data next ctx
| None -> return! Error.notFound next ctx
else
return! Error.notFound next ctx
@ -87,9 +87,9 @@ let makeSlug it = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 ]").Replace (it,
// 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! dbUploads = ctx.Data.Upload.FindByWebLog webLog.Id
let diskUploads =
let path = Path.Combine (uploadDir, webLog.slug)
let path = Path.Combine (uploadDir, webLog.Slug)
try
Directory.EnumerateFiles (path, "*", SearchOption.AllDirectories)
|> Seq.map (fun file ->
@ -122,7 +122,7 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
csrf = ctx.CsrfTokenSet
files = allFiles
|}
|> viewForTheme "admin" "upload-list" next ctx
|> adminView "upload-list" next ctx
}
// GET /admin/upload/new
@ -130,9 +130,9 @@ let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
Hash.FromAnonymousObject {|
page_title = "Upload a File"
csrf = ctx.CsrfTokenSet
destination = UploadDestination.toString ctx.WebLog.uploads
destination = UploadDestination.toString ctx.WebLog.Uploads
|}
|> viewForTheme "admin" "upload-new" next ctx
|> adminView "upload-new" next ctx
/// Redirect to the upload list
@ -155,15 +155,15 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
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 ()
{ 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 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
@ -176,7 +176,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
// 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
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
@ -188,7 +188,7 @@ 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)
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)
@ -197,7 +197,7 @@ let removeEmptyDirectories (webLog : WebLog) (filePath : string) =
// 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)
let path = Path.Combine (uploadDir, ctx.WebLog.Slug, filePath)
if File.Exists path then
File.Delete path
removeEmptyDirectories ctx.WebLog filePath

81
src/MyWebLog/Handlers/User.fs
View File

@ -27,7 +27,7 @@ let logOn returnUrl : HttpHandler = fun next ctx ->
csrf = ctx.CsrfTokenSet
model = { LogOnModel.empty with ReturnTo = returnTo }
|}
|> viewForTheme "admin" "log-on" next ctx
|> adminView "log-on" next ctx
open System.Security.Claims
@ -38,21 +38,21 @@ open Microsoft.AspNetCore.Authentication.Cookies
let doLogOn : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel> ()
let data = ctx.Data
match! data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.id with
| Some user when user.passwordHash = hashedPassword model.Password user.userName user.salt ->
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, AccessLevel.toString user.accessLevel)
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! data.WebLogUser.SetLastSeen user.Id user.WebLogId
do! addMessage ctx
{ UserMessage.success with Message = $"Logged on successfully | Welcome to {ctx.WebLog.name}!" }
{ UserMessage.success with Message = $"Logged on successfully | Welcome to {ctx.WebLog.Name}!" }
return!
match model.ReturnTo with
| Some url -> redirectTo false url next ctx
@ -69,49 +69,52 @@ let logOff : HttpHandler = fun next ctx -> task {
return! redirectToGet "" next ctx
}
/// Display the user edit page, with information possibly filled in
let private showEdit (hash : Hash) : HttpHandler = fun next ctx ->
addToHash "page_title" "Edit Your Information" hash
|> addToHash "csrf" ctx.CsrfTokenSet
|> viewForTheme "admin" "user-edit" next ctx
/// Display the user "my info" page, with information possibly filled in
let private showMyInfo (user : WebLogUser) (hash : Hash) : HttpHandler = fun next ctx ->
addToHash "page_title" "Edit Your Information" hash
|> addToHash "csrf" ctx.CsrfTokenSet
|> 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/edit
let edit : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.id with
| Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) 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 user (Hash.FromAnonymousObject {| model = EditMyInfoModel.fromUser user |}) next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/user/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel> ()
if model.NewPassword = model.NewPasswordConfirm then
let data = ctx.Data
match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.id with
| Some user ->
// 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 ->
if model.NewPassword = model.NewPasswordConfirm then
let pw, salt =
if model.NewPassword = "" then
user.passwordHash, user.salt
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 "admin/user/edit" 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
return! redirectToGet "admin/user/my-info" next ctx
else
do! addMessage ctx { UserMessage.error with Message = "Passwords did not match; no updates made" }
return! showMyInfo user (Hash.FromAnonymousObject {|
model = { model with NewPassword = ""; NewPasswordConfirm = "" }
|}) next ctx
| None -> return! Error.notFound next ctx
}

274
src/MyWebLog/Maintenance.fs
View File

@ -32,12 +32,12 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
do! data.WebLog.Add
{ WebLog.empty with
id = webLogId
name = args[2]
slug = slug
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
@ -46,32 +46,32 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
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
accessLevel = accessLevel
createdOn = now
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
{ Page.empty with
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>"
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>"
}
]
}
@ -107,11 +107,11 @@ let private 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 -> eprintfn $"Cannot find current post for {Permalink.toString current}"
printfn "Done!"
@ -160,93 +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 fromEncoded (encoded : EncodedAsset) : ThemeAsset =
{ id = encoded.id
updatedOn = encoded.updatedOn
data = Convert.FromBase64String encoded.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
Id : UploadId
/// The ID of the web log to which the upload belongs
webLogId : WebLogId
WebLogId : WebLogId
/// The path at which this upload is served
path : Permalink
Path : Permalink
/// The date/time this upload was last updated (file time)
updatedOn : DateTime
UpdatedOn : DateTime
/// The data for the upload, base-64 encoded
data : string
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
{ 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 fromEncoded (encoded : EncodedUpload) : Upload =
{ id = encoded.id
webLogId = encoded.webLogId
path = encoded.path
updatedOn = encoded.updatedOn
data = Convert.FromBase64String encoded.data
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
Uploads : EncodedUpload list
}
/// Create a JSON serializer (uses RethinkDB data implementation's JSON converters)
@ -259,21 +259,21 @@ 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 uploadCount = List.length archive.uploads
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"}"""
@ -284,39 +284,37 @@ module Backup =
/// 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
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 })
uploads = uploads |> List.map EncodedUpload.fromUpload
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
@ -331,83 +329,83 @@ module Backup =
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 newUpIds = archive.uploads |> List.map (fun up -> up.id, UploadId.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 })
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.fromEncoded >> 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
printfn "- Restoring uploads..."
do! data.Upload.Restore (restore.uploads |> List.map EncodedUpload.fromEncoded)
do! data.Upload.Restore (restore.Uploads |> List.map EncodedUpload.toUpload)
displayStats "Restored for <>NAME<>:" restore.webLog restore
displayStats "Restored for <>NAME<>:" restore.WebLog restore
}
/// Decide whether to restore a backup
@ -431,7 +429,7 @@ 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
@ -442,7 +440,7 @@ module Backup =
| Some webLog ->
let fileName =
if args.Length = 2 || (args.Length = 3 && args[2] = "pretty") then
$"{webLog.slug}.json"
$"{webLog.Slug}.json"
elif args[2].EndsWith ".json" then
args[2]
else
@ -473,11 +471,11 @@ module Backup =
let private doUserUpgrade urlBase email (data : IData) = task {
match! data.WebLog.FindByHost urlBase with
| Some webLog ->
match! data.WebLogUser.FindByEmail email webLog.id with
match! data.WebLogUser.FindByEmail email webLog.Id with
| Some user ->
match user.accessLevel with
match user.AccessLevel with
| WebLogAdmin ->
do! data.WebLogUser.Update { user with accessLevel = Administrator }
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}"

2
src/MyWebLog/Program.fs
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

2
src/admin-theme/_layout.liquid
View File

@ -23,7 +23,7 @@
{%- endif %}
<ul class="navbar-nav flex-grow-1 justify-content-end">
{% if is_logged_on -%}
{{ "admin/user/edit" | nav_link: "Edit User" }}
{{ "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>

12
src/admin-theme/custom-feed-edit.liquid
View File

@ -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,9 +124,9 @@
</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">

19
src/admin-theme/user-edit.liquid → src/admin-theme/my-info.liquid
View File

@ -1,8 +1,21 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="{{ "admin/user/save" | relative_link }}" method="post">
<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">
@ -28,8 +41,8 @@
</div>
<div class="row mb-3">
<div class="col">
<fieldset class="container">
<legend>Change Password</legend>
<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>

2
src/admin-theme/page-list.liquid
View File

@ -20,7 +20,7 @@
<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>

6
src/admin-theme/settings.liquid
View File

@ -36,14 +36,14 @@
</div>
<div class="col-12 col-md-6 col-xl-4 offset-xl-1 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-6 offset-md-1 col-xl-4 offset-xl-0 pb-3">

14
src/admin-theme/wwwroot/admin.js
View File

@ -331,4 +331,16 @@ htmx.on("htmx:afterOnLoad", function (evt) {
Admin.showMessage(evt.detail.xhr.getResponseHeader("x-message"))
Admin.dismissSuccesses()
}
})
})
htmx.on("htmx:responseError", function (evt) {
/** @type {XMLHttpRequest} */
const xhr = evt.detail.xhr
const hdrs = xhr.getAllResponseHeaders()
// Show messages if there were any in the response
if (hdrs.indexOf("x-message") >= 0) {
Admin.showMessage(evt.detail.xhr.getResponseHeader("x-message"))
} else {
Admin.showMessage(`danger|||${xhr.status}: ${xhr.statusText}`)
}
})