bit-badger/myWebLog
1
0
Fork 0
Code Issues 3 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)
})

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

@ -100,13 +100,6 @@ module Json =
override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) = override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) =
(string >> ThemeId) reader.Value (string >> ThemeId) reader.Value
type UploadDestinationConverter () =
inherit JsonConverter<UploadDestination> ()
override _.WriteJson (writer : JsonWriter, value : UploadDestination, _ : JsonSerializer) =
writer.WriteValue (UploadDestination.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadDestination, _ : bool, _ : JsonSerializer) =
(string >> UploadDestination.parse) reader.Value
type UploadIdConverter () = type UploadIdConverter () =
inherit JsonConverter<UploadId> () inherit JsonConverter<UploadId> ()
override _.WriteJson (writer : JsonWriter, value : UploadId, _ : JsonSerializer) = override _.WriteJson (writer : JsonWriter, value : UploadId, _ : JsonSerializer) =
@ -147,7 +140,6 @@ module Json =
TagMapIdConverter () TagMapIdConverter ()
ThemeAssetIdConverter () ThemeAssetIdConverter ()
ThemeIdConverter () ThemeIdConverter ()
UploadDestinationConverter ()
UploadIdConverter () UploadIdConverter ()
WebLogIdConverter () WebLogIdConverter ()
WebLogUserIdConverter () WebLogUserIdConverter ()

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

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

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

@ -46,6 +46,23 @@ module private RethinkHelpers =
let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ] 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 /// Shorthand for the ReQL starting point
let r = RethinkDB.R 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) /// Match theme asset IDs by their prefix (the theme ID)
let matchAssetByThemeId themeId = let matchAssetByThemeId themeId =
let keyPrefix = $"^{ThemeId.toString 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 /// Ensure field indexes exist, as well as special indexes for selected tables
let ensureIndexes table fields = backgroundTask { 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 } do! rethink { withTable table; indexCreate field; write; withRetryOnce; ignoreResult conn }
// Post and page need index by web log ID and permalink // Post and page need index by web log ID and permalink
if [ Table.Page; Table.Post ] |> List.contains table then if [ Table.Page; Table.Post ] |> List.contains table then
if not (indexes |> List.contains "permalink") then let permalinkIdx = nameof Page.empty.Permalink
log.LogInformation $"Creating index {table}.permalink..." if not (indexes |> List.contains permalinkIdx) then
log.LogInformation $"Creating index {table}.{permalinkIdx}..."
do! rethink { do! rethink {
withTable table 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 write; withRetryOnce; ignoreResult conn
} }
// Prior permalinks are searched when a post or page permalink do not match the current URL // Prior permalinks are searched when a post or page permalink do not match the current URL
if not (indexes |> List.contains "priorPermalinks") then let priorIdx = nameof Post.empty.PriorPermalinks
log.LogInformation $"Creating index {table}.priorPermalinks..." if not (indexes |> List.contains priorIdx) then
log.LogInformation $"Creating index {table}.{priorIdx}..."
do! rethink { do! rethink {
withTable table withTable table
indexCreate "priorPermalinks" (fun row -> row["priorPermalinks"].Downcase () :> obj) [ Multi ] indexCreate priorIdx (fun row -> row[priorIdx].Downcase () :> obj) [ Multi ]
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
// Post needs indexes by category and tag (used for counting and retrieving posts) // Post needs indexes by category and tag (used for counting and retrieving posts)
if Table.Post = table then 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 if not (List.contains idx indexes) then
log.LogInformation $"Creating index {table}.{idx}..." log.LogInformation $"Creating index {table}.{idx}..."
do! rethink { do! rethink {
@ -115,35 +135,40 @@ 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 // Tag mapping needs an index by web log ID and both tag and URL values
if Table.TagMap = table then if Table.TagMap = table then
if not (indexes |> List.contains "webLogAndTag") then if not (indexes |> List.contains Index.WebLogAndTag) then
log.LogInformation $"Creating index {table}.webLogAndTag..." log.LogInformation $"Creating index {table}.{Index.WebLogAndTag}..."
do! rethink { do! rethink {
withTable table 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 write; withRetryOnce; ignoreResult conn
} }
if not (indexes |> List.contains "webLogAndUrl") then if not (indexes |> List.contains Index.WebLogAndUrl) then
log.LogInformation $"Creating index {table}.webLogAndUrl..." log.LogInformation $"Creating index {table}.{Index.WebLogAndUrl}..."
do! rethink { do! rethink {
withTable table 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 write; withRetryOnce; ignoreResult conn
} }
// Uploaded files need an index by web log ID and path, as that is how they are retrieved // Uploaded files need an index by web log ID and path, as that is how they are retrieved
if Table.Upload = table then if Table.Upload = table then
if not (indexes |> List.contains "webLogAndPath") then if not (indexes |> List.contains Index.WebLogAndPath) then
log.LogInformation $"Creating index {table}.webLogAndPath..." log.LogInformation $"Creating index {table}.{Index.WebLogAndPath}..."
do! rethink { do! rethink {
withTable table 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 write; withRetryOnce; ignoreResult conn
} }
// Users log on with e-mail // Users log on with e-mail
if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then if Table.WebLogUser = table then
log.LogInformation $"Creating index {table}.logOn..." if not (indexes |> List.contains Index.LogOn) then
log.LogInformation $"Creating index {table}.{Index.LogOn}..."
do! rethink { do! rethink {
withTable table withTable table
indexCreate "logOn" (fun row -> r.Array (row["webLogId"], row["userName"]) :> obj) indexCreate Index.LogOn (fun row ->
[| row[nameof WebLogUser.empty.WebLogId]; row[nameof WebLogUser.empty.Email] |] :> obj)
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
} }
@ -167,15 +192,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.CountAll webLogId = rethink<int> { member _.CountAll webLogId = rethink<int> {
withTable Table.Category withTable Table.Category
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Category.empty.WebLogId)
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.CountTopLevel webLogId = rethink<int> { member _.CountTopLevel webLogId = rethink<int> {
withTable Table.Category withTable Table.Category
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Category.empty.WebLogId)
filter "parentId" None filter (nameof Category.empty.ParentId) None
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -183,8 +208,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindAllForView webLogId = backgroundTask { member _.FindAllForView webLogId = backgroundTask {
let! cats = rethink<Category list> { let! cats = rethink<Category list> {
withTable Table.Category withTable Table.Category
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Category.empty.WebLogId)
orderByFunc (fun it -> it["name"].Downcase () :> obj) orderByFunc (fun it -> it[nameof Category.empty.Name].Downcase () :> obj)
result; withRetryDefault conn result; withRetryDefault conn
} }
let ordered = Utils.orderByHierarchy cats None None [] let ordered = Utils.orderByHierarchy cats None None []
@ -200,8 +225,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|> List.ofSeq |> List.ofSeq
let! count = rethink<int> { let! count = rethink<int> {
withTable Table.Post withTable Table.Post
getAll catIds "categoryIds" getAll catIds (nameof Post.empty.CategoryIds)
filter "status" Published filter (nameof Post.empty.Status) Published
distinct distinct
count count
result; withRetryDefault conn result; withRetryDefault conn
@ -227,11 +252,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get catId get catId
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId (fun c -> c.webLogId) <| conn |> verifyWebLog webLogId (fun c -> c.WebLogId) <| conn
member _.FindByWebLog webLogId = rethink<Category list> { member _.FindByWebLog webLogId = rethink<Category list> {
withTable Table.Category withTable Table.Category
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Category.empty.WebLogId)
result; withRetryDefault conn 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 // Delete the category off all posts where it is assigned
do! rethink { do! rethink {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (fun row -> row["categoryIds"].Contains catId :> obj) filter (fun row -> row[nameof Post.empty.CategoryIds].Contains catId :> obj)
update (fun row -> r.HashMap ("categoryIds", r.Array(row["categoryIds"]).Remove catId) :> obj) update (fun row ->
{| CategoryIds = r.Array(row[nameof Post.empty.CategoryIds]).Remove catId |} :> obj)
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
// Delete the category itself // Delete the category itself
@ -268,11 +294,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Update cat = rethink { member _.Update cat = rethink {
withTable Table.Category withTable Table.Category
get cat.id get cat.Id
update [ "name", cat.name :> obj update [ nameof cat.Name, cat.Name :> obj
"slug", cat.slug nameof cat.Slug, cat.Slug
"description", cat.description nameof cat.Description, cat.Description
"parentId", cat.parentId nameof cat.ParentId, cat.ParentId
] ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
@ -289,23 +315,26 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All webLogId = rethink<Page list> { member _.All webLogId = rethink<Page list> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Page.empty.WebLogId)
without [ "text"; "metadata"; "revisions"; "priorPermalinks" ] without [ nameof Page.empty.Text
orderByFunc (fun row -> row["title"].Downcase () :> obj) 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 result; withRetryDefault conn
} }
member _.CountAll webLogId = rethink<int> { member _.CountAll webLogId = rethink<int> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Page.empty.WebLogId)
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.CountListed webLogId = rethink<int> { member _.CountListed webLogId = rethink<int> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Page.empty.WebLogId)
filter "showInPageList" true filter (nameof Page.empty.IsInPageList) true
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -314,7 +343,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result = rethink<Model.Result> { let! result = rethink<Model.Result> {
withTable Table.Page withTable Table.Page
getAll [ pageId ] getAll [ pageId ]
filter (fun row -> row["webLogId"].Eq webLogId :> obj) filter (fun row -> row[nameof Page.empty.WebLogId].Eq webLogId :> obj)
delete delete
write; withRetryDefault conn write; withRetryDefault conn
} }
@ -325,16 +354,16 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
rethink<Page> { rethink<Page> {
withTable Table.Page withTable Table.Page
get pageId get pageId
without [ "priorPermalinks"; "revisions" ] without [ nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ]
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId (fun it -> it.webLogId) <| conn |> verifyWebLog webLogId (fun it -> it.WebLogId) <| conn
member _.FindByPermalink permalink webLogId = member _.FindByPermalink permalink webLogId =
rethink<Page list> { rethink<Page list> {
withTable Table.Page withTable Table.Page
getAll [ r.Array (webLogId, permalink) ] (nameof permalink) getAll [ [| webLogId :> obj; permalink |] ] (nameof Page.empty.Permalink)
without [ "priorPermalinks"; "revisions" ] without [ nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ]
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
@ -344,14 +373,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result = let! result =
(rethink<Page list> { (rethink<Page list> {
withTable Table.Page withTable Table.Page
getAll (objList permalinks) "priorPermalinks" getAll (objList permalinks) (nameof Page.empty.PriorPermalinks)
filter "webLogId" webLogId filter (nameof Page.empty.WebLogId) webLogId
without [ "revisions"; "text" ] without [ nameof Page.empty.Revisions; nameof Page.empty.Text ]
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
|> tryFirst) conn |> tryFirst) conn
return result |> Option.map (fun pg -> pg.permalink) return result |> Option.map (fun pg -> pg.Permalink)
} }
member _.FindFullById pageId webLogId = member _.FindFullById pageId webLogId =
@ -360,28 +389,30 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get pageId get pageId
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId (fun it -> it.webLogId) <| conn |> verifyWebLog webLogId (fun it -> it.WebLogId) <| conn
member _.FindFullByWebLog webLogId = rethink<Page> { member _.FindFullByWebLog webLogId = rethink<Page> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Page.empty.WebLogId)
resultCursor; withRetryCursorDefault; toList conn resultCursor; withRetryCursorDefault; toList conn
} }
member _.FindListed webLogId = rethink<Page list> { member _.FindListed webLogId = rethink<Page list> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Page.empty.WebLogId)
filter [ "showInPageList", true :> obj ] filter [ nameof Page.empty.IsInPageList, true :> obj ]
without [ "text"; "priorPermalinks"; "revisions" ] without [ nameof Page.empty.Text; nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ]
orderBy "title" orderBy "title"
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.FindPageOfPages webLogId pageNbr = rethink<Page list> { member _.FindPageOfPages webLogId pageNbr = rethink<Page list> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Page.empty.WebLogId)
without [ "metadata"; "priorPermalinks"; "revisions" ] without [ nameof Page.empty.Metadata
orderByFunc (fun row -> row["title"].Downcase ()) nameof Page.empty.PriorPermalinks
nameof Page.empty.Revisions ]
orderByFunc (fun row -> row[nameof Page.empty.Title].Downcase ())
skip ((pageNbr - 1) * 25) skip ((pageNbr - 1) * 25)
limit 25 limit 25
result; withRetryDefault conn result; withRetryDefault conn
@ -398,17 +429,17 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Update page = rethink { member _.Update page = rethink {
withTable Table.Page withTable Table.Page
get page.id get page.Id
update [ update [
"title", page.title :> obj nameof page.Title, page.Title :> obj
"permalink", page.permalink nameof page.Permalink, page.Permalink
"updatedOn", page.updatedOn nameof page.UpdatedOn, page.UpdatedOn
"showInPageList", page.showInPageList nameof page.IsInPageList, page.IsInPageList
"template", page.template nameof page.Template, page.Template
"text", page.text nameof page.Text, page.Text
"priorPermalinks", page.priorPermalinks nameof page.PriorPermalinks, page.PriorPermalinks
"metadata", page.metadata nameof page.Metadata, page.Metadata
"revisions", page.revisions nameof page.Revisions, page.Revisions
] ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
@ -419,7 +450,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink { do! rethink {
withTable Table.Page withTable Table.Page
get pageId get pageId
update [ "priorPermalinks", permalinks :> obj ] update [ nameof Page.empty.PriorPermalinks, permalinks :> obj ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
return true return true
@ -438,8 +469,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.CountByStatus status webLogId = rethink<int> { member _.CountByStatus status webLogId = rethink<int> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter "status" status filter (nameof Post.empty.Status) status
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -448,7 +479,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result = rethink<Model.Result> { let! result = rethink<Model.Result> {
withTable Table.Post withTable Table.Post
getAll [ postId ] getAll [ postId ]
filter (fun row -> row["webLogId"].Eq webLogId :> obj) filter (fun row -> row[nameof Post.empty.WebLogId].Eq webLogId :> obj)
delete delete
write; withRetryDefault conn write; withRetryDefault conn
} }
@ -459,16 +490,16 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
rethink<Post> { rethink<Post> {
withTable Table.Post withTable Table.Post
get postId get postId
without [ "priorPermalinks"; "revisions" ] without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId (fun p -> p.webLogId) <| conn |> verifyWebLog webLogId (fun p -> p.WebLogId) <| conn
member _.FindByPermalink permalink webLogId = member _.FindByPermalink permalink webLogId =
rethink<Post list> { rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll [ r.Array (webLogId, permalink) ] (nameof permalink) getAll [ [| webLogId :> obj; permalink |] ] (nameof Post.empty.Permalink)
without [ "priorPermalinks"; "revisions" ] without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
@ -480,36 +511,36 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get postId get postId
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId (fun p -> p.webLogId) <| conn |> verifyWebLog webLogId (fun p -> p.WebLogId) <| conn
member _.FindCurrentPermalink permalinks webLogId = backgroundTask { member _.FindCurrentPermalink permalinks webLogId = backgroundTask {
let! result = let! result =
(rethink<Post list> { (rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll (objList permalinks) "priorPermalinks" getAll (objList permalinks) (nameof Post.empty.PriorPermalinks)
filter "webLogId" webLogId filter (nameof Post.empty.WebLogId) webLogId
without [ "revisions"; "text" ] without [ nameof Post.empty.Revisions; nameof Post.empty.Text ]
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
|> tryFirst) conn |> tryFirst) conn
return result |> Option.map (fun post -> post.permalink) return result |> Option.map (fun post -> post.Permalink)
} }
member _.FindFullByWebLog webLogId = rethink<Post> { member _.FindFullByWebLog webLogId = rethink<Post> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Post.empty.WebLogId)
resultCursor; withRetryCursorDefault; toList conn resultCursor; withRetryCursorDefault; toList conn
} }
member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink<Post list> { member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll (objList categoryIds) "categoryIds" getAll (objList categoryIds) (nameof Post.empty.CategoryIds)
filter "webLogId" webLogId filter [ nameof Post.empty.WebLogId, webLogId :> obj
filter "status" Published nameof Post.empty.Status, Published ]
without [ "priorPermalinks"; "revisions" ] without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
distinct distinct
orderByDescending "publishedOn" orderByDescending (nameof Post.empty.PublishedOn)
skip ((pageNbr - 1) * postsPerPage) skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1) limit (postsPerPage + 1)
result; withRetryDefault conn 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> { member _.FindPageOfPosts webLogId pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Post.empty.WebLogId)
without [ "priorPermalinks"; "revisions" ] without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
orderByFuncDescending (fun row -> row["publishedOn"].Default_ "updatedOn" :> obj) orderByFuncDescending (fun row ->
row[nameof Post.empty.PublishedOn].Default_ (nameof Post.empty.UpdatedOn) :> obj)
skip ((pageNbr - 1) * postsPerPage) skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1) limit (postsPerPage + 1)
result; withRetryDefault conn 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> { member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter "status" Published filter (nameof Post.empty.Status) Published
without [ "priorPermalinks"; "revisions" ] without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
orderByDescending "publishedOn" orderByDescending (nameof Post.empty.PublishedOn)
skip ((pageNbr - 1) * postsPerPage) skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1) limit (postsPerPage + 1)
result; withRetryDefault conn 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> { member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll [ tag ] "tags" getAll [ tag ] (nameof Post.empty.Tags)
filter "webLogId" webLogId filter [ nameof Post.empty.WebLogId, webLogId :> obj
filter "status" Published nameof Post.empty.Status, Published ]
without [ "priorPermalinks"; "revisions" ] without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
orderByDescending "publishedOn" orderByDescending (nameof Post.empty.PublishedOn)
skip ((pageNbr - 1) * postsPerPage) skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1) limit (postsPerPage + 1)
result; withRetryDefault conn result; withRetryDefault conn
@ -552,10 +584,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! older = let! older =
rethink<Post list> { rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (fun row -> row["publishedOn"].Lt publishedOn :> obj) filter (fun row -> row[nameof Post.empty.PublishedOn].Lt publishedOn :> obj)
without [ "priorPermalinks"; "revisions" ] without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
orderByDescending "publishedOn" orderByDescending (nameof Post.empty.PublishedOn)
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
@ -563,10 +595,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! newer = let! newer =
rethink<Post list> { rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (fun row -> row["publishedOn"].Gt publishedOn :> obj) filter (fun row -> row[nameof Post.empty.PublishedOn].Gt publishedOn :> obj)
without [ "priorPermalinks"; "revisions" ] without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
orderBy "publishedOn" orderBy (nameof Post.empty.PublishedOn)
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
@ -585,7 +617,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Update post = rethink { member _.Update post = rethink {
withTable Table.Post withTable Table.Post
get post.id get post.Id
replace post replace post
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
@ -595,15 +627,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
rethink<Post> { rethink<Post> {
withTable Table.Post withTable Table.Post
get postId get postId
without [ "revisions"; "priorPermalinks" ] without [ nameof Post.empty.Revisions; nameof Post.empty.PriorPermalinks ]
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId (fun p -> p.webLogId)) conn with |> verifyWebLog webLogId (fun p -> p.WebLogId)) conn with
| Some _ -> | Some _ ->
do! rethink { do! rethink {
withTable Table.Post withTable Table.Post
get postId get postId
update [ "priorPermalinks", permalinks :> obj ] update [ nameof Post.empty.PriorPermalinks, permalinks :> obj ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
return true return true
@ -618,7 +650,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! result = rethink<Model.Result> { let! result = rethink<Model.Result> {
withTable Table.TagMap withTable Table.TagMap
getAll [ tagMapId ] getAll [ tagMapId ]
filter (fun row -> row["webLogId"].Eq webLogId :> obj) filter (fun row -> row[nameof TagMap.empty.WebLogId].Eq webLogId :> obj)
delete delete
write; withRetryDefault conn write; withRetryDefault conn
} }
@ -631,12 +663,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get tagMapId get tagMapId
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId (fun tm -> tm.webLogId) <| conn |> verifyWebLog webLogId (fun tm -> tm.WebLogId) <| conn
member _.FindByUrlValue urlValue webLogId = member _.FindByUrlValue urlValue webLogId =
rethink<TagMap list> { rethink<TagMap list> {
withTable Table.TagMap withTable Table.TagMap
getAll [ r.Array (webLogId, urlValue) ] "webLogAndUrl" getAll [ [| webLogId :> obj; urlValue |] ] Index.WebLogAndUrl
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
@ -644,14 +676,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByWebLog webLogId = rethink<TagMap list> { member _.FindByWebLog webLogId = rethink<TagMap list> {
withTable Table.TagMap 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 () |]
orderBy "tag" [ Index Index.WebLogAndTag ]
orderBy (nameof TagMap.empty.Tag)
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.FindMappingForTags tags webLogId = rethink<TagMap list> { member _.FindMappingForTags tags webLogId = rethink<TagMap list> {
withTable Table.TagMap 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 result; withRetryDefault conn
} }
@ -666,7 +699,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Save tagMap = rethink { member _.Save tagMap = rethink {
withTable Table.TagMap withTable Table.TagMap
get tagMap.id get tagMap.Id
replace tagMap replace tagMap
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
@ -677,9 +710,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All () = rethink<Theme list> { member _.All () = rethink<Theme list> {
withTable Table.Theme withTable Table.Theme
filter (fun row -> row["id"].Ne "admin" :> obj) filter (fun row -> row[nameof Theme.empty.Id].Ne "admin" :> obj)
without [ "templates" ] without [ nameof Theme.empty.Templates ]
orderBy "id" orderBy (nameof Theme.empty.Id)
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -692,13 +725,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByIdWithoutText themeId = rethink<Theme> { member _.FindByIdWithoutText themeId = rethink<Theme> {
withTable Table.Theme withTable Table.Theme
get themeId 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 resultOption; withRetryOptionDefault conn
} }
member _.Save theme = rethink { member _.Save theme = rethink {
withTable Table.Theme withTable Table.Theme
get theme.id get theme.Id
replace theme replace theme
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
@ -709,7 +742,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All () = rethink<ThemeAsset list> { member _.All () = rethink<ThemeAsset list> {
withTable Table.ThemeAsset withTable Table.ThemeAsset
without [ "data" ] without [ nameof ThemeAsset.empty.Data ]
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -729,7 +762,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByTheme themeId = rethink<ThemeAsset list> { member _.FindByTheme themeId = rethink<ThemeAsset list> {
withTable Table.ThemeAsset withTable Table.ThemeAsset
filter (matchAssetByThemeId themeId) filter (matchAssetByThemeId themeId)
without [ "data" ] without [ nameof ThemeAsset.empty.Data ]
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -741,7 +774,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Save asset = rethink { member _.Save asset = rethink {
withTable Table.ThemeAsset withTable Table.ThemeAsset
get asset.id get asset.Id
replace asset replace asset
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
@ -763,7 +796,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get uploadId get uploadId
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog<Upload> webLogId (fun u -> u.webLogId) <| conn |> verifyWebLog<Upload> webLogId (fun u -> u.WebLogId) <| conn
match upload with match upload with
| Some up -> | Some up ->
do! rethink { do! rethink {
@ -772,30 +805,30 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
delete delete
write; withRetryDefault; ignoreResult conn 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" | None -> return Result.Error $"Upload ID {UploadId.toString uploadId} not found"
} }
member _.FindByPath path webLogId = member _.FindByPath path webLogId =
rethink<Upload> { rethink<Upload> {
withTable Table.Upload withTable Table.Upload
getAll [ r.Array (webLogId, path) ] "webLogAndPath" getAll [ [| webLogId :> obj; path |] ] Index.WebLogAndPath
resultCursor; withRetryCursorDefault; toList resultCursor; withRetryCursorDefault; toList
} }
|> tryFirst <| conn |> tryFirst <| conn
member _.FindByWebLog webLogId = rethink<Upload> { member _.FindByWebLog webLogId = rethink<Upload> {
withTable Table.Upload withTable Table.Upload
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
[ Index "webLogAndPath" ] [ Index Index.WebLogAndPath ]
without [ "data" ] without [ nameof Upload.empty.Data ]
resultCursor; withRetryCursorDefault; toList conn resultCursor; withRetryCursorDefault; toList conn
} }
member _.FindByWebLogWithData webLogId = rethink<Upload> { member _.FindByWebLogWithData webLogId = rethink<Upload> {
withTable Table.Upload withTable Table.Upload
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
[ Index "webLogAndPath" ] [ Index Index.WebLogAndPath ]
resultCursor; withRetryCursorDefault; toList conn resultCursor; withRetryCursorDefault; toList conn
} }
@ -826,40 +859,40 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Delete webLogId = backgroundTask { member _.Delete webLogId = backgroundTask {
// Comments should be deleted by post IDs // Comments should be deleted by post IDs
let! thePostIds = rethink<{| id : string |} list> { let! thePostIds = rethink<{| Id : string |} list> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Post.empty.WebLogId)
pluck [ "id" ] pluck [ nameof Post.empty.Id ]
result; withRetryOnce conn result; withRetryOnce conn
} }
if not (List.isEmpty thePostIds) then 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 { do! rethink {
withTable Table.Comment withTable Table.Comment
getAll postIds "postId" getAll postIds (nameof Comment.empty.PostId)
delete delete
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
// Tag mappings do not have a straightforward webLogId index // Tag mappings do not have a straightforward webLogId index
do! rethink { do! rethink {
withTable Table.TagMap withTable Table.TagMap
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
[ Index "webLogAndTag" ] [ Index Index.WebLogAndTag ]
delete delete
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
// Uploaded files do not have a straightforward webLogId index // Uploaded files do not have a straightforward webLogId index
do! rethink { do! rethink {
withTable Table.Upload withTable Table.Upload
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
[ Index "webLogAndPath" ] [ Index Index.WebLogAndPath ]
delete delete
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
for table in [ Table.Post; Table.Category; Table.Page; Table.WebLogUser ] do for table in [ Table.Post; Table.Category; Table.Page; Table.WebLogUser ] do
do! rethink { do! rethink {
withTable table withTable table
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof Post.empty.WebLogId)
delete delete
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
@ -874,7 +907,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByHost url = member _.FindByHost url =
rethink<WebLog list> { rethink<WebLog list> {
withTable Table.WebLog withTable Table.WebLog
getAll [ url ] "urlBase" getAll [ url ] (nameof WebLog.empty.UrlBase)
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
@ -888,24 +921,24 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.UpdateRssOptions webLog = rethink { member _.UpdateRssOptions webLog = rethink {
withTable Table.WebLog withTable Table.WebLog
get webLog.id get webLog.Id
update [ "rss", webLog.rss :> obj ] update [ nameof WebLog.empty.Rss, webLog.Rss :> obj ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
member _.UpdateSettings webLog = rethink { member _.UpdateSettings webLog = rethink {
withTable Table.WebLog withTable Table.WebLog
get webLog.id get webLog.Id
update [ update [
"name", webLog.name :> obj nameof webLog.Name, webLog.Name :> obj
"slug", webLog.slug nameof webLog.Slug, webLog.Slug
"subtitle", webLog.subtitle nameof webLog.Subtitle, webLog.Subtitle
"defaultPage", webLog.defaultPage nameof webLog.DefaultPage, webLog.DefaultPage
"postsPerPage", webLog.postsPerPage nameof webLog.PostsPerPage, webLog.PostsPerPage
"timeZone", webLog.timeZone nameof webLog.TimeZone, webLog.TimeZone
"themePath", webLog.themePath nameof webLog.ThemeId, webLog.ThemeId
"autoHtmx", webLog.autoHtmx nameof webLog.AutoHtmx, webLog.AutoHtmx
"uploads", webLog.uploads nameof webLog.Uploads, webLog.Uploads
] ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
@ -923,7 +956,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByEmail email webLogId = member _.FindByEmail email webLogId =
rethink<WebLogUser list> { rethink<WebLogUser list> {
withTable Table.WebLogUser withTable Table.WebLogUser
getAll [ r.Array (webLogId, email) ] "logOn" getAll [ [| webLogId :> obj; email |] ] Index.LogOn
limit 1 limit 1
result; withRetryDefault result; withRetryDefault
} }
@ -935,11 +968,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get userId get userId
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId (fun u -> u.webLogId) <| conn |> verifyWebLog webLogId (fun u -> u.WebLogId) <| conn
member _.FindByWebLog webLogId = rethink<WebLogUser list> { member _.FindByWebLog webLogId = rethink<WebLogUser list> {
withTable Table.WebLogUser withTable Table.WebLogUser
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof WebLogUser.empty.WebLogId)
result; withRetryDefault conn result; withRetryDefault conn
} }
@ -947,12 +980,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let! users = rethink<WebLogUser list> { let! users = rethink<WebLogUser list> {
withTable Table.WebLogUser withTable Table.WebLogUser
getAll (objList userIds) getAll (objList userIds)
filter "webLogId" webLogId filter (nameof WebLogUser.empty.WebLogId) webLogId
result; withRetryDefault conn result; withRetryDefault conn
} }
return return
users 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 { member _.Restore users = backgroundTask {
@ -970,7 +1003,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink { do! rethink {
withTable Table.WebLogUser withTable Table.WebLogUser
get userId get userId
update [ "lastSeenOn", DateTime.UtcNow :> obj ] update [ nameof WebLogUser.empty.LastSeenOn, DateTime.UtcNow :> obj ]
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
| None -> () | None -> ()
@ -978,14 +1011,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.Update user = rethink { member _.Update user = rethink {
withTable Table.WebLogUser withTable Table.WebLogUser
get user.id get user.Id
update [ update [
"firstName", user.firstName :> obj nameof user.FirstName, user.FirstName :> obj
"lastName", user.lastName nameof user.LastName, user.LastName
"preferredName", user.preferredName nameof user.PreferredName, user.PreferredName
"passwordHash", user.passwordHash nameof user.PasswordHash, user.PasswordHash
"salt", user.salt nameof user.Salt, user.Salt
"accessLevel", user.accessLevel nameof user.AccessLevel, user.AccessLevel
] ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
@ -1001,14 +1034,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
for tbl in Table.all do for tbl in Table.all do
if not (tables |> List.contains tbl) then if not (tables |> List.contains tbl) then
log.LogInformation $"Creating table {tbl}..." 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.Category [ nameof Category.empty.WebLogId ]
do! ensureIndexes Table.Comment [ "postId" ] do! ensureIndexes Table.Comment [ nameof Comment.empty.PostId ]
do! ensureIndexes Table.Page [ "webLogId"; "authorId" ] do! ensureIndexes Table.Page [ nameof Page.empty.WebLogId; nameof Page.empty.AuthorId ]
do! ensureIndexes Table.Post [ "webLogId"; "authorId" ] do! ensureIndexes Table.Post [ nameof Post.empty.WebLogId; nameof Post.empty.AuthorId ]
do! ensureIndexes Table.TagMap [] do! ensureIndexes Table.TagMap []
do! ensureIndexes Table.Upload [] do! ensureIndexes Table.Upload []
do! ensureIndexes Table.WebLog [ "urlBase" ] do! ensureIndexes Table.WebLog [ nameof WebLog.empty.UrlBase ]
do! ensureIndexes Table.WebLogUser [ "webLogId" ] 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 /// Find meta items added and removed
let diffMetaItems (oldItems : MetaItem list) newItems = 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 /// Find the permalinks added and removed
let diffPermalinks oldLinks newLinks = let diffPermalinks oldLinks newLinks =
@ -27,7 +27,7 @@ let diffPermalinks oldLinks newLinks =
/// Find the revisions added and removed /// Find the revisions added and removed
let diffRevisions oldRevs newRevs = 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 /// Create a list of items from the given data reader
let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) = let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) =
@ -39,8 +39,7 @@ let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (it : SqliteDataReader ->
if rdr.Read () then if rdr.Read () then
let item = it rdr let item = it rdr
if prop item = webLogId then Some item else None if prop item = webLogId then Some item else None
else else None
None
/// Execute a command that returns no data /// Execute a command that returns no data
let write (cmd : SqliteCommand) = backgroundTask { let write (cmd : SqliteCommand) = backgroundTask {
@ -101,134 +100,134 @@ module Map =
let tryTimeSpan col (rdr : SqliteDataReader) = let tryTimeSpan col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr) if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
/// Create a category ID from the current row in the given data reader /// Map an id field to a category ID
let toCategoryId = getString "id" >> CategoryId let toCategoryId rdr = getString "id" rdr |> CategoryId
/// Create a category from the current row in the given data reader /// Create a category from the current row in the given data reader
let toCategory (rdr : SqliteDataReader) : Category = let toCategory rdr : Category =
{ id = toCategoryId rdr { Id = toCategoryId rdr
webLogId = WebLogId (getString "web_log_id" rdr) WebLogId = getString "web_log_id" rdr |> WebLogId
name = getString "name" rdr Name = getString "name" rdr
slug = getString "slug" rdr Slug = getString "slug" rdr
description = tryString "description" rdr Description = tryString "description" rdr
parentId = tryString "parent_id" rdr |> Option.map CategoryId ParentId = tryString "parent_id" rdr |> Option.map CategoryId
} }
/// Create a custom feed from the current row in the given data reader /// Create a custom feed from the current row in the given data reader
let toCustomFeed (rdr : SqliteDataReader) : CustomFeed = let toCustomFeed rdr : CustomFeed =
{ id = CustomFeedId (getString "id" rdr) { Id = getString "id" rdr |> CustomFeedId
source = CustomFeedSource.parse (getString "source" rdr) Source = getString "source" rdr |> CustomFeedSource.parse
path = Permalink (getString "path" rdr) Path = getString "path" rdr |> Permalink
podcast = Podcast =
if rdr.IsDBNull (rdr.GetOrdinal "title") then if rdr.IsDBNull (rdr.GetOrdinal "title") then
None None
else else
Some { Some {
title = getString "title" rdr Title = getString "title" rdr
subtitle = tryString "subtitle" rdr Subtitle = tryString "subtitle" rdr
itemsInFeed = getInt "items_in_feed" rdr ItemsInFeed = getInt "items_in_feed" rdr
summary = getString "summary" rdr Summary = getString "summary" rdr
displayedAuthor = getString "displayed_author" rdr DisplayedAuthor = getString "displayed_author" rdr
email = getString "email" rdr Email = getString "email" rdr
imageUrl = Permalink (getString "image_url" rdr) ImageUrl = getString "image_url" rdr |> Permalink
iTunesCategory = getString "itunes_category" rdr AppleCategory = getString "apple_category" rdr
iTunesSubcategory = tryString "itunes_subcategory" rdr AppleSubcategory = tryString "apple_subcategory" rdr
explicit = ExplicitRating.parse (getString "explicit" rdr) Explicit = getString "explicit" rdr |> ExplicitRating.parse
defaultMediaType = tryString "default_media_type" rdr DefaultMediaType = tryString "default_media_type" rdr
mediaBaseUrl = tryString "media_base_url" rdr MediaBaseUrl = tryString "media_base_url" rdr
guid = tryGuid "guid" rdr PodcastGuid = tryGuid "podcast_guid" rdr
fundingUrl = tryString "funding_url" rdr FundingUrl = tryString "funding_url" rdr
fundingText = tryString "funding_text" rdr FundingText = tryString "funding_text" rdr
medium = tryString "medium" rdr |> Option.map PodcastMedium.parse Medium = tryString "medium" rdr |> Option.map PodcastMedium.parse
} }
} }
/// Create a meta item from the current row in the given data reader /// Create a meta item from the current row in the given data reader
let toMetaItem (rdr : SqliteDataReader) : MetaItem = let toMetaItem rdr : MetaItem =
{ name = getString "name" rdr { Name = getString "name" rdr
value = getString "value" rdr Value = getString "value" rdr
} }
/// Create a permalink from the current row in the given data reader /// Create a permalink from the current row in the given data reader
let toPermalink = getString "permalink" >> Permalink let toPermalink rdr = getString "permalink" rdr |> Permalink
/// Create a page from the current row in the given data reader /// Create a page from the current row in the given data reader
let toPage (rdr : SqliteDataReader) : Page = let toPage rdr : Page =
{ Page.empty with { Page.empty with
id = PageId (getString "id" rdr) Id = getString "id" rdr |> PageId
webLogId = WebLogId (getString "web_log_id" rdr) WebLogId = getString "web_log_id" rdr |> WebLogId
authorId = WebLogUserId (getString "author_id" rdr) AuthorId = getString "author_id" rdr |> WebLogUserId
title = getString "title" rdr Title = getString "title" rdr
permalink = toPermalink rdr Permalink = toPermalink rdr
publishedOn = getDateTime "published_on" rdr PublishedOn = getDateTime "published_on" rdr
updatedOn = getDateTime "updated_on" rdr UpdatedOn = getDateTime "updated_on" rdr
showInPageList = getBoolean "show_in_page_list" rdr IsInPageList = getBoolean "is_in_page_list" rdr
template = tryString "template" rdr Template = tryString "template" rdr
text = getString "page_text" rdr Text = getString "page_text" rdr
} }
/// Create a post from the current row in the given data reader /// Create a post from the current row in the given data reader
let toPost (rdr : SqliteDataReader) : Post = let toPost rdr : Post =
{ Post.empty with { Post.empty with
id = PostId (getString "id" rdr) Id = getString "id" rdr |> PostId
webLogId = WebLogId (getString "web_log_id" rdr) WebLogId = getString "web_log_id" rdr |> WebLogId
authorId = WebLogUserId (getString "author_id" rdr) AuthorId = getString "author_id" rdr |> WebLogUserId
status = PostStatus.parse (getString "status" rdr) Status = getString "status" rdr |> PostStatus.parse
title = getString "title" rdr Title = getString "title" rdr
permalink = toPermalink rdr Permalink = toPermalink rdr
publishedOn = tryDateTime "published_on" rdr PublishedOn = tryDateTime "published_on" rdr
updatedOn = getDateTime "updated_on" rdr UpdatedOn = getDateTime "updated_on" rdr
template = tryString "template" rdr Template = tryString "template" rdr
text = getString "post_text" rdr Text = getString "post_text" rdr
episode = Episode =
match tryString "media" rdr with match tryString "media" rdr with
| Some media -> | Some media ->
Some { Some {
media = media Media = media
length = getLong "length" rdr Length = getLong "length" rdr
duration = tryTimeSpan "duration" rdr Duration = tryTimeSpan "duration" rdr
mediaType = tryString "media_type" rdr MediaType = tryString "media_type" rdr
imageUrl = tryString "image_url" rdr ImageUrl = tryString "image_url" rdr
subtitle = tryString "subtitle" rdr Subtitle = tryString "subtitle" rdr
explicit = tryString "explicit" rdr |> Option.map ExplicitRating.parse Explicit = tryString "explicit" rdr |> Option.map ExplicitRating.parse
chapterFile = tryString "chapter_file" rdr ChapterFile = tryString "chapter_file" rdr
chapterType = tryString "chapter_type" rdr ChapterType = tryString "chapter_type" rdr
transcriptUrl = tryString "transcript_url" rdr TranscriptUrl = tryString "transcript_url" rdr
transcriptType = tryString "transcript_type" rdr TranscriptType = tryString "transcript_type" rdr
transcriptLang = tryString "transcript_lang" rdr TranscriptLang = tryString "transcript_lang" rdr
transcriptCaptions = tryBoolean "transcript_captions" rdr TranscriptCaptions = tryBoolean "transcript_captions" rdr
seasonNumber = tryInt "season_number" rdr SeasonNumber = tryInt "season_number" rdr
seasonDescription = tryString "season_description" rdr SeasonDescription = tryString "season_description" rdr
episodeNumber = tryString "episode_number" rdr |> Option.map Double.Parse EpisodeNumber = tryString "episode_number" rdr |> Option.map Double.Parse
episodeDescription = tryString "episode_description" rdr EpisodeDescription = tryString "episode_description" rdr
} }
| None -> None | None -> None
} }
/// Create a revision from the current row in the given data reader /// Create a revision from the current row in the given data reader
let toRevision (rdr : SqliteDataReader) : Revision = let toRevision rdr : Revision =
{ asOf = getDateTime "as_of" rdr { AsOf = getDateTime "as_of" rdr
text = MarkupText.parse (getString "revision_text" rdr) Text = getString "revision_text" rdr |> MarkupText.parse
} }
/// Create a tag mapping from the current row in the given data reader /// Create a tag mapping from the current row in the given data reader
let toTagMap (rdr : SqliteDataReader) : TagMap = let toTagMap rdr : TagMap =
{ id = TagMapId (getString "id" rdr) { Id = getString "id" rdr |> TagMapId
webLogId = WebLogId (getString "web_log_id" rdr) WebLogId = getString "web_log_id" rdr |> WebLogId
tag = getString "tag" rdr Tag = getString "tag" rdr
urlValue = getString "url_value" rdr UrlValue = getString "url_value" rdr
} }
/// Create a theme from the current row in the given data reader (excludes templates) /// Create a theme from the current row in the given data reader (excludes templates)
let toTheme (rdr : SqliteDataReader) : Theme = let toTheme rdr : Theme =
{ Theme.empty with { Theme.empty with
id = ThemeId (getString "id" rdr) Id = getString "id" rdr |> ThemeId
name = getString "name" rdr Name = getString "name" rdr
version = getString "version" rdr Version = getString "version" rdr
} }
/// Create a theme asset from the current row in the given data reader /// Create a theme asset from the current row in the given data reader
let toThemeAsset includeData (rdr : SqliteDataReader) : ThemeAsset = let toThemeAsset includeData rdr : ThemeAsset =
let assetData = let assetData =
if includeData then if includeData then
use dataStream = new MemoryStream () use dataStream = new MemoryStream ()
@ -237,19 +236,19 @@ module Map =
dataStream.ToArray () dataStream.ToArray ()
else else
[||] [||]
{ id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr) { Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
updatedOn = getDateTime "updated_on" rdr UpdatedOn = getDateTime "updated_on" rdr
data = assetData Data = assetData
} }
/// Create a theme template from the current row in the given data reader /// Create a theme template from the current row in the given data reader
let toThemeTemplate (rdr : SqliteDataReader) : ThemeTemplate = let toThemeTemplate rdr : ThemeTemplate =
{ name = getString "name" rdr { Name = getString "name" rdr
text = getString "template" rdr Text = getString "template" rdr
} }
/// Create an uploaded file from the current row in the given data reader /// Create an uploaded file from the current row in the given data reader
let toUpload includeData (rdr : SqliteDataReader) : Upload = let toUpload includeData rdr : Upload =
let data = let data =
if includeData then if includeData then
use dataStream = new MemoryStream () use dataStream = new MemoryStream ()
@ -258,51 +257,51 @@ module Map =
dataStream.ToArray () dataStream.ToArray ()
else else
[||] [||]
{ id = UploadId (getString "id" rdr) { Id = getString "id" rdr |> UploadId
webLogId = WebLogId (getString "web_log_id" rdr) WebLogId = getString "web_log_id" rdr |> WebLogId
path = Permalink (getString "path" rdr) Path = getString "path" rdr |> Permalink
updatedOn = getDateTime "updated_on" rdr UpdatedOn = getDateTime "updated_on" rdr
data = data Data = data
} }
/// Create a web log from the current row in the given data reader /// Create a web log from the current row in the given data reader
let toWebLog (rdr : SqliteDataReader) : WebLog = let toWebLog rdr : WebLog =
{ id = WebLogId (getString "id" rdr) { Id = getString "id" rdr |> WebLogId
name = getString "name" rdr Name = getString "name" rdr
slug = getString "slug" rdr Slug = getString "slug" rdr
subtitle = tryString "subtitle" rdr Subtitle = tryString "subtitle" rdr
defaultPage = getString "default_page" rdr DefaultPage = getString "default_page" rdr
postsPerPage = getInt "posts_per_page" rdr PostsPerPage = getInt "posts_per_page" rdr
themePath = getString "theme_id" rdr ThemeId = getString "theme_id" rdr |> ThemeId
urlBase = getString "url_base" rdr UrlBase = getString "url_base" rdr
timeZone = getString "time_zone" rdr TimeZone = getString "time_zone" rdr
autoHtmx = getBoolean "auto_htmx" rdr AutoHtmx = getBoolean "auto_htmx" rdr
uploads = UploadDestination.parse (getString "uploads" rdr) Uploads = getString "uploads" rdr |> UploadDestination.parse
rss = { Rss = {
feedEnabled = getBoolean "feed_enabled" rdr IsFeedEnabled = getBoolean "is_feed_enabled" rdr
feedName = getString "feed_name" rdr FeedName = getString "feed_name" rdr
itemsInFeed = tryInt "items_in_feed" rdr ItemsInFeed = tryInt "items_in_feed" rdr
categoryEnabled = getBoolean "category_enabled" rdr IsCategoryEnabled = getBoolean "is_category_enabled" rdr
tagEnabled = getBoolean "tag_enabled" rdr IsTagEnabled = getBoolean "is_tag_enabled" rdr
copyright = tryString "copyright" rdr Copyright = tryString "copyright" rdr
customFeeds = [] CustomFeeds = []
} }
} }
/// Create a web log user from the current row in the given data reader /// Create a web log user from the current row in the given data reader
let toWebLogUser (rdr : SqliteDataReader) : WebLogUser = let toWebLogUser rdr : WebLogUser =
{ id = WebLogUserId (getString "id" rdr) { Id = getString "id" rdr |> WebLogUserId
webLogId = WebLogId (getString "web_log_id" rdr) WebLogId = getString "web_log_id" rdr |> WebLogId
userName = getString "user_name" rdr Email = getString "email" rdr
firstName = getString "first_name" rdr FirstName = getString "first_name" rdr
lastName = getString "last_name" rdr LastName = getString "last_name" rdr
preferredName = getString "preferred_name" rdr PreferredName = getString "preferred_name" rdr
passwordHash = getString "password_hash" rdr PasswordHash = getString "password_hash" rdr
salt = getGuid "salt" rdr Salt = getGuid "salt" rdr
url = tryString "url" rdr Url = tryString "url" rdr
accessLevel = AccessLevel.parse (getString "access_level" rdr) AccessLevel = getString "access_level" rdr |> AccessLevel.parse
createdOn = getDateTime "created_on" rdr CreatedOn = getDateTime "created_on" rdr
lastSeenOn = tryDateTime "last_seen_on" rdr LastSeenOn = tryDateTime "last_seen_on" rdr
} }
/// Add a possibly-missing parameter, substituting null for None /// 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 /// Add parameters for category INSERT or UPDATE statements
let addCategoryParameters (cmd : SqliteCommand) (cat : Category) = let addCategoryParameters (cmd : SqliteCommand) (cat : Category) =
[ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.id) [ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.webLogId) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId)
cmd.Parameters.AddWithValue ("@name", cat.name) cmd.Parameters.AddWithValue ("@name", cat.Name)
cmd.Parameters.AddWithValue ("@slug", cat.slug) cmd.Parameters.AddWithValue ("@slug", cat.Slug)
cmd.Parameters.AddWithValue ("@description", maybe cat.description) cmd.Parameters.AddWithValue ("@description", maybe cat.Description)
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.parentId |> Option.map CategoryId.toString)) cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
] |> ignore ] |> ignore
/// Add a category /// Add a category
@ -60,7 +60,7 @@ type SQLiteCategoryData (conn : SqliteConnection) =
while rdr.Read () do while rdr.Read () do
Map.toCategory rdr Map.toCategory rdr
} }
|> Seq.sortBy (fun cat -> cat.name.ToLowerInvariant ()) |> Seq.sortBy (fun cat -> cat.Name.ToLowerInvariant ())
|> List.ofSeq |> List.ofSeq
do! rdr.CloseAsync () do! rdr.CloseAsync ()
let ordered = Utils.orderByHierarchy cats None None [] let ordered = Utils.orderByHierarchy cats None None []
@ -107,7 +107,7 @@ type SQLiteCategoryData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT * FROM category WHERE id = @id" cmd.CommandText <- "SELECT * FROM category WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) |> ignore cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<Category> webLogId (fun c -> c.webLogId) Map.toCategory rdr return Helpers.verifyWebLog<Category> webLogId (fun c -> c.WebLogId) Map.toCategory rdr
} }
/// Find all categories for the given web log /// Find all categories for the given web log

72
src/MyWebLog.Data/SQLite/SQLitePageData.fs
View File

@ -12,45 +12,45 @@ type SQLitePageData (conn : SqliteConnection) =
/// Add parameters for page INSERT or UPDATE statements /// Add parameters for page INSERT or UPDATE statements
let addPageParameters (cmd : SqliteCommand) (page : Page) = let addPageParameters (cmd : SqliteCommand) (page : Page) =
[ cmd.Parameters.AddWithValue ("@id", PageId.toString page.id) [ cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.webLogId) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.authorId) cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId)
cmd.Parameters.AddWithValue ("@title", page.title) cmd.Parameters.AddWithValue ("@title", page.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.permalink) cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", page.publishedOn) cmd.Parameters.AddWithValue ("@publishedOn", page.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", page.updatedOn) cmd.Parameters.AddWithValue ("@updatedOn", page.UpdatedOn)
cmd.Parameters.AddWithValue ("@showInPageList", page.showInPageList) cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
cmd.Parameters.AddWithValue ("@template", maybe page.template) cmd.Parameters.AddWithValue ("@template", maybe page.Template)
cmd.Parameters.AddWithValue ("@text", page.text) cmd.Parameters.AddWithValue ("@text", page.Text)
] |> ignore ] |> ignore
/// Append meta items to a page /// Append meta items to a page
let appendPageMeta (page : Page) = backgroundTask { let appendPageMeta (page : Page) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT name, value FROM page_meta WHERE page_id = @id" 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 () 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 /// Append revisions and permalinks to a page
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask { let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.id) |> ignore cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.Id) |> ignore
cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId" cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let page = { page with priorPermalinks = toList Map.toPermalink rdr } let page = { page with PriorPermalinks = toList Map.toPermalink rdr }
do! rdr.CloseAsync () do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC" cmd.CommandText <- "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return { page with revisions = toList Map.toRevision rdr } return { page with Revisions = toList Map.toRevision rdr }
} }
/// Return a page with no text (or meta items, prior permalinks, or revisions) /// Return a page with no text (or meta items, prior permalinks, or revisions)
let pageWithoutTextOrMeta rdr = let pageWithoutTextOrMeta rdr =
{ Map.toPage rdr with text = "" } { Map.toPage rdr with Text = "" }
/// Update a page's metadata items /// Update a page's metadata items
let updatePageMeta pageId oldItems newItems = backgroundTask { let updatePageMeta pageId oldItems newItems = backgroundTask {
@ -64,8 +64,8 @@ type SQLitePageData (conn : SqliteConnection) =
cmd.Parameters.Add ("@value", SqliteType.Text) cmd.Parameters.Add ("@value", SqliteType.Text)
] |> ignore ] |> ignore
let runCmd (item : MetaItem) = backgroundTask { let runCmd (item : MetaItem) = backgroundTask {
cmd.Parameters["@name" ].Value <- item.name cmd.Parameters["@name" ].Value <- item.Name
cmd.Parameters["@value"].Value <- item.value cmd.Parameters["@value"].Value <- item.Value
do! write cmd do! write cmd
} }
cmd.CommandText <- "DELETE FROM page_meta WHERE page_id = @pageId AND name = @name AND value = @value" 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 { let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear () cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId) [ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
cmd.Parameters.AddWithValue ("@asOf", rev.asOf) cmd.Parameters.AddWithValue ("@asOf", rev.AsOf)
] |> ignore ] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.text) |> ignore if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
do! write cmd do! write cmd
} }
cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf" cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf"
@ -141,17 +141,17 @@ type SQLitePageData (conn : SqliteConnection) =
// The page itself // The page itself
cmd.CommandText <- """ cmd.CommandText <- """
INSERT INTO page ( INSERT INTO page (
id, web_log_id, author_id, title, permalink, published_on, updated_on, show_in_page_list, template, id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template,
page_text page_text
) VALUES ( ) VALUES (
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @showInPageList, @template, @id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template,
@text @text
)""" )"""
addPageParameters cmd page addPageParameters cmd page
do! write cmd do! write cmd
do! updatePageMeta page.id [] page.metadata do! updatePageMeta page.Id [] page.Metadata
do! updatePagePermalinks page.id [] page.priorPermalinks do! updatePagePermalinks page.Id [] page.PriorPermalinks
do! updatePageRevisions page.id [] page.revisions do! updatePageRevisions page.Id [] page.Revisions
} }
/// Get all pages for a web log (without text, revisions, prior permalinks, or metadata) /// Get all pages for a web log (without text, revisions, prior permalinks, or metadata)
@ -178,9 +178,9 @@ type SQLitePageData (conn : SqliteConnection) =
SELECT COUNT(id) SELECT COUNT(id)
FROM page FROM page
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList""" AND is_in_page_list = @isInPageList"""
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
return! count cmd return! count cmd
} }
@ -190,7 +190,7 @@ type SQLitePageData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT * FROM page WHERE id = @id" cmd.CommandText <- "SELECT * FROM page WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
match Helpers.verifyWebLog<Page> webLogId (fun it -> it.webLogId) Map.toPage rdr with match Helpers.verifyWebLog<Page> webLogId (fun it -> it.WebLogId) Map.toPage rdr with
| Some page -> | Some page ->
let! page = appendPageMeta page let! page = appendPageMeta page
return Some page return Some page
@ -278,10 +278,10 @@ type SQLitePageData (conn : SqliteConnection) =
SELECT * SELECT *
FROM page FROM page
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList AND is_in_page_list = @isInPageList
ORDER BY LOWER(title)""" ORDER BY LOWER(title)"""
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! pages = let! pages =
toList pageWithoutTextOrMeta rdr toList pageWithoutTextOrMeta rdr
@ -315,7 +315,7 @@ type SQLitePageData (conn : SqliteConnection) =
/// Update a page /// Update a page
let update (page : Page) = backgroundTask { let update (page : Page) = backgroundTask {
match! findFullById page.id page.webLogId with match! findFullById page.Id page.WebLogId with
| Some oldPage -> | Some oldPage ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <- """
@ -325,16 +325,16 @@ type SQLitePageData (conn : SqliteConnection) =
permalink = @permalink, permalink = @permalink,
published_on = @publishedOn, published_on = @publishedOn,
updated_on = @updatedOn, updated_on = @updatedOn,
show_in_page_list = @showInPageList, is_in_page_list = @isInPageList,
template = @template, template = @template,
page_text = @text page_text = @text
WHERE id = @pageId WHERE id = @pageId
AND web_log_id = @webLogId""" AND web_log_id = @webLogId"""
addPageParameters cmd page addPageParameters cmd page
do! write cmd do! write cmd
do! updatePageMeta page.id oldPage.metadata page.metadata do! updatePageMeta page.Id oldPage.Metadata page.Metadata
do! updatePagePermalinks page.id oldPage.priorPermalinks page.priorPermalinks do! updatePagePermalinks page.Id oldPage.PriorPermalinks page.PriorPermalinks
do! updatePageRevisions page.id oldPage.revisions page.revisions do! updatePageRevisions page.Id oldPage.Revisions page.Revisions
return () return ()
| None -> return () | None -> return ()
} }
@ -343,7 +343,7 @@ type SQLitePageData (conn : SqliteConnection) =
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask { let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
match! findFullById pageId webLogId with match! findFullById pageId webLogId with
| Some page -> | Some page ->
do! updatePagePermalinks pageId page.priorPermalinks permalinks do! updatePagePermalinks pageId page.PriorPermalinks permalinks
return true return true
| None -> return false | None -> return false
} }

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 /// Add parameters for post INSERT or UPDATE statements
let addPostParameters (cmd : SqliteCommand) (post : Post) = let addPostParameters (cmd : SqliteCommand) (post : Post) =
[ cmd.Parameters.AddWithValue ("@id", PostId.toString post.id) [ cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.webLogId) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.authorId) cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId)
cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.status) cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status)
cmd.Parameters.AddWithValue ("@title", post.title) cmd.Parameters.AddWithValue ("@title", post.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.permalink) cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", maybe post.publishedOn) cmd.Parameters.AddWithValue ("@publishedOn", maybe post.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", post.updatedOn) cmd.Parameters.AddWithValue ("@updatedOn", post.UpdatedOn)
cmd.Parameters.AddWithValue ("@template", maybe post.template) cmd.Parameters.AddWithValue ("@template", maybe post.Template)
cmd.Parameters.AddWithValue ("@text", post.text) cmd.Parameters.AddWithValue ("@text", post.Text)
] |> ignore ] |> ignore
/// Add parameters for episode INSERT or UPDATE statements /// Add parameters for episode INSERT or UPDATE statements
let addEpisodeParameters (cmd : SqliteCommand) (ep : Episode) = let addEpisodeParameters (cmd : SqliteCommand) (ep : Episode) =
[ cmd.Parameters.AddWithValue ("@media", ep.media) [ cmd.Parameters.AddWithValue ("@media", ep.Media)
cmd.Parameters.AddWithValue ("@length", ep.length) cmd.Parameters.AddWithValue ("@length", ep.Length)
cmd.Parameters.AddWithValue ("@duration", maybe ep.duration) cmd.Parameters.AddWithValue ("@duration", maybe ep.Duration)
cmd.Parameters.AddWithValue ("@mediaType", maybe ep.mediaType) cmd.Parameters.AddWithValue ("@mediaType", maybe ep.MediaType)
cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.imageUrl) cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.ImageUrl)
cmd.Parameters.AddWithValue ("@subtitle", maybe ep.subtitle) cmd.Parameters.AddWithValue ("@subtitle", maybe ep.Subtitle)
cmd.Parameters.AddWithValue ("@explicit", maybe (ep.explicit |> Option.map ExplicitRating.toString)) cmd.Parameters.AddWithValue ("@explicit", maybe (ep.Explicit |> Option.map ExplicitRating.toString))
cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.chapterFile) cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.ChapterFile)
cmd.Parameters.AddWithValue ("@chapterType", maybe ep.chapterType) cmd.Parameters.AddWithValue ("@chapterType", maybe ep.ChapterType)
cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.transcriptUrl) cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.TranscriptUrl)
cmd.Parameters.AddWithValue ("@transcriptType", maybe ep.transcriptType) cmd.Parameters.AddWithValue ("@transcriptType", maybe ep.TranscriptType)
cmd.Parameters.AddWithValue ("@transcriptLang", maybe ep.transcriptLang) cmd.Parameters.AddWithValue ("@transcriptLang", maybe ep.TranscriptLang)
cmd.Parameters.AddWithValue ("@transcriptCaptions", maybe ep.transcriptCaptions) cmd.Parameters.AddWithValue ("@transcriptCaptions", maybe ep.TranscriptCaptions)
cmd.Parameters.AddWithValue ("@seasonNumber", maybe ep.seasonNumber) cmd.Parameters.AddWithValue ("@seasonNumber", maybe ep.SeasonNumber)
cmd.Parameters.AddWithValue ("@seasonDescription", maybe ep.seasonDescription) cmd.Parameters.AddWithValue ("@seasonDescription", maybe ep.SeasonDescription)
cmd.Parameters.AddWithValue ("@episodeNumber", maybe (ep.episodeNumber |> Option.map string)) cmd.Parameters.AddWithValue ("@episodeNumber", maybe (ep.EpisodeNumber |> Option.map string))
cmd.Parameters.AddWithValue ("@episodeDescription", maybe ep.episodeDescription) cmd.Parameters.AddWithValue ("@episodeDescription", maybe ep.EpisodeDescription)
] |> ignore ] |> ignore
/// Append category IDs, tags, and meta items to a post /// Append category IDs, tags, and meta items to a post
let appendPostCategoryTagAndMeta (post : Post) = backgroundTask { let appendPostCategoryTagAndMeta (post : Post) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PostId.toString post.id) |> ignore cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id) |> ignore
cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id" cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let post = { post with categoryIds = toList Map.toCategoryId rdr } let post = { post with CategoryIds = toList Map.toCategoryId rdr }
do! rdr.CloseAsync () do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id" cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let post = { post with tags = toList (Map.getString "tag") rdr } let post = { post with Tags = toList (Map.getString "tag") rdr }
do! rdr.CloseAsync () do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT name, value FROM post_meta WHERE post_id = @id" cmd.CommandText <- "SELECT name, value FROM post_meta WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync () 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 /// Append revisions and permalinks to a post
let appendPostRevisionsAndPermalinks (post : Post) = backgroundTask { let appendPostRevisionsAndPermalinks (post : Post) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@postId", PostId.toString post.id) |> ignore cmd.Parameters.AddWithValue ("@postId", PostId.toString post.Id) |> ignore
cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId" cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let post = { post with priorPermalinks = toList Map.toPermalink rdr } let post = { post with PriorPermalinks = toList Map.toPermalink rdr }
do! rdr.CloseAsync () do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT as_of, revision_text FROM post_revision WHERE post_id = @postId ORDER BY as_of DESC" cmd.CommandText <- "SELECT as_of, revision_text FROM post_revision WHERE post_id = @postId ORDER BY as_of DESC"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return { post with revisions = toList Map.toRevision rdr } return { post with Revisions = toList Map.toRevision rdr }
} }
/// The SELECT statement for a post that will include episode data, if it exists /// 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.CommandText <- $"{selectPost} WHERE p.id = @id"
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
use! rdr = cmd.ExecuteReaderAsync () 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 /// Return a post with no revisions, prior permalinks, or text
let postWithoutText rdr = let postWithoutText rdr =
{ Map.toPost rdr with text = "" } { Map.toPost rdr with Text = "" }
/// Update a post's assigned categories /// Update a post's assigned categories
let updatePostCategories postId oldCats newCats = backgroundTask { let updatePostCategories postId oldCats newCats = backgroundTask {
@ -153,10 +153,10 @@ type SQLitePostData (conn : SqliteConnection) =
let updatePostEpisode (post : Post) = backgroundTask { let updatePostEpisode (post : Post) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(post_id) FROM post_episode WHERE post_id = @postId" 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 let! count = count cmd
if count = 1 then if count = 1 then
match post.episode with match post.Episode with
| Some ep -> | Some ep ->
cmd.CommandText <- """ cmd.CommandText <- """
UPDATE post_episode UPDATE post_episode
@ -184,7 +184,7 @@ type SQLitePostData (conn : SqliteConnection) =
cmd.CommandText <- "DELETE FROM post_episode WHERE post_id = @postId" cmd.CommandText <- "DELETE FROM post_episode WHERE post_id = @postId"
do! write cmd do! write cmd
else else
match post.episode with match post.Episode with
| Some ep -> | Some ep ->
cmd.CommandText <- """ cmd.CommandText <- """
INSERT INTO post_episode ( INSERT INTO post_episode (
@ -213,8 +213,8 @@ type SQLitePostData (conn : SqliteConnection) =
cmd.Parameters.Add ("@value", SqliteType.Text) cmd.Parameters.Add ("@value", SqliteType.Text)
] |> ignore ] |> ignore
let runCmd (item : MetaItem) = backgroundTask { let runCmd (item : MetaItem) = backgroundTask {
cmd.Parameters["@name" ].Value <- item.name cmd.Parameters["@name" ].Value <- item.Name
cmd.Parameters["@value"].Value <- item.value cmd.Parameters["@value"].Value <- item.Value
do! write cmd do! write cmd
} }
cmd.CommandText <- "DELETE FROM post_meta WHERE post_id = @postId AND name = @name AND value = @value" 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 { let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear () cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.AddWithValue ("@asOf", rev.asOf) cmd.Parameters.AddWithValue ("@asOf", rev.AsOf)
] |> ignore ] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.text) |> ignore if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
do! write cmd do! write cmd
} }
cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf" cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf"
@ -295,12 +295,12 @@ type SQLitePostData (conn : SqliteConnection) =
)""" )"""
addPostParameters cmd post addPostParameters cmd post
do! write cmd do! write cmd
do! updatePostCategories post.id [] post.categoryIds do! updatePostCategories post.Id [] post.CategoryIds
do! updatePostTags post.id [] post.tags do! updatePostTags post.Id [] post.Tags
do! updatePostEpisode post do! updatePostEpisode post
do! updatePostMeta post.id [] post.metadata do! updatePostMeta post.Id [] post.Metadata
do! updatePostPermalinks post.id [] post.priorPermalinks do! updatePostPermalinks post.Id [] post.PriorPermalinks
do! updatePostRevisions post.id [] post.revisions do! updatePostRevisions post.Id [] post.Revisions
} }
/// Count posts in a status for the given web log /// Count posts in a status for the given web log
@ -535,7 +535,7 @@ type SQLitePostData (conn : SqliteConnection) =
/// Update a post /// Update a post
let update (post : Post) = backgroundTask { let update (post : Post) = backgroundTask {
match! findFullById post.id post.webLogId with match! findFullById post.Id post.WebLogId with
| Some oldPost -> | Some oldPost ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <- """
@ -552,12 +552,12 @@ type SQLitePostData (conn : SqliteConnection) =
AND web_log_id = @webLogId""" AND web_log_id = @webLogId"""
addPostParameters cmd post addPostParameters cmd post
do! write cmd do! write cmd
do! updatePostCategories post.id oldPost.categoryIds post.categoryIds do! updatePostCategories post.Id oldPost.CategoryIds post.CategoryIds
do! updatePostTags post.id oldPost.tags post.tags do! updatePostTags post.Id oldPost.Tags post.Tags
do! updatePostEpisode post do! updatePostEpisode post
do! updatePostMeta post.id oldPost.metadata post.metadata do! updatePostMeta post.Id oldPost.Metadata post.Metadata
do! updatePostPermalinks post.id oldPost.priorPermalinks post.priorPermalinks do! updatePostPermalinks post.Id oldPost.PriorPermalinks post.PriorPermalinks
do! updatePostRevisions post.id oldPost.revisions post.revisions do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
| None -> return () | None -> return ()
} }
@ -565,7 +565,7 @@ type SQLitePostData (conn : SqliteConnection) =
let updatePriorPermalinks postId webLogId permalinks = backgroundTask { let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
match! findFullById postId webLogId with match! findFullById postId webLogId with
| Some post -> | Some post ->
do! updatePostPermalinks postId post.priorPermalinks permalinks do! updatePostPermalinks postId post.PriorPermalinks permalinks
return true return true
| None -> return false | None -> return false
} }

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.CommandText <- "SELECT * FROM tag_map WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<TagMap> webLogId (fun tm -> tm.webLogId) Map.toTagMap rdr return Helpers.verifyWebLog<TagMap> webLogId (fun tm -> tm.WebLogId) Map.toTagMap rdr
} }
/// Delete a tag mapping for the given web log /// Delete a tag mapping for the given web log
@ -69,7 +69,7 @@ type SQLiteTagMapData (conn : SqliteConnection) =
/// Save a tag mapping /// Save a tag mapping
let save (tagMap : TagMap) = backgroundTask { let save (tagMap : TagMap) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
match! findById tagMap.id tagMap.webLogId with match! findById tagMap.Id tagMap.WebLogId with
| Some _ -> | Some _ ->
cmd.CommandText <- """ cmd.CommandText <- """
UPDATE tag_map UPDATE tag_map
@ -84,10 +84,10 @@ type SQLiteTagMapData (conn : SqliteConnection) =
) VALUES ( ) VALUES (
@id, @webLogId, @tag, @urlValue @id, @webLogId, @tag, @urlValue
)""" )"""
addWebLogId cmd tagMap.webLogId addWebLogId cmd tagMap.WebLogId
[ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.id) [ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id)
cmd.Parameters.AddWithValue ("@tag", tagMap.tag) cmd.Parameters.AddWithValue ("@tag", tagMap.Tag)
cmd.Parameters.AddWithValue ("@urlValue", tagMap.urlValue) cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue)
] |> ignore ] |> ignore
do! write cmd do! write cmd
} }
@ -105,4 +105,4 @@ type SQLiteTagMapData (conn : SqliteConnection) =
member _.FindByWebLog webLogId = findByWebLog webLogId member _.FindByWebLog webLogId = findByWebLog webLogId
member _.FindMappingForTags tags webLogId = findMappingForTags tags webLogId member _.FindMappingForTags tags webLogId = findMappingForTags tags webLogId
member _.Save tagMap = save tagMap member _.Save tagMap = save tagMap
member this.Restore tagMaps = restore tagMaps member _.Restore tagMaps = restore tagMaps

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.CommandText <- "SELECT * FROM theme_template WHERE theme_id = @id"
templateCmd.Parameters.Add cmd.Parameters["@id"] |> ignore templateCmd.Parameters.Add cmd.Parameters["@id"] |> ignore
use! templateRdr = templateCmd.ExecuteReaderAsync () use! templateRdr = templateCmd.ExecuteReaderAsync ()
return Some { theme with templates = toList Map.toThemeTemplate templateRdr } return Some { theme with Templates = toList Map.toThemeTemplate templateRdr }
else else
return None return None
} }
@ -38,7 +38,7 @@ type SQLiteThemeData (conn : SqliteConnection) =
match! findById themeId with match! findById themeId with
| Some theme -> | Some theme ->
return Some { return Some {
theme with templates = theme.templates |> List.map (fun t -> { t with text = "" }) theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" })
} }
| None -> return None | None -> return None
} }
@ -46,36 +46,36 @@ type SQLiteThemeData (conn : SqliteConnection) =
/// Save a theme /// Save a theme
let save (theme : Theme) = backgroundTask { let save (theme : Theme) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
let! oldTheme = findById theme.id let! oldTheme = findById theme.Id
cmd.CommandText <- cmd.CommandText <-
match oldTheme with match oldTheme with
| Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id" | Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id"
| None -> "INSERT INTO theme VALUES (@id, @name, @version)" | None -> "INSERT INTO theme VALUES (@id, @name, @version)"
[ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.id) [ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.Id)
cmd.Parameters.AddWithValue ("@name", theme.name) cmd.Parameters.AddWithValue ("@name", theme.Name)
cmd.Parameters.AddWithValue ("@version", theme.version) cmd.Parameters.AddWithValue ("@version", theme.Version)
] |> ignore ] |> ignore
do! write cmd do! write cmd
let toDelete, toAdd = let toDelete, toAdd =
diffLists (oldTheme |> Option.map (fun t -> t.templates) |> Option.defaultValue []) diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue [])
theme.templates (fun t -> t.name) theme.Templates (fun t -> t.Name)
let toUpdate = let toUpdate =
theme.templates theme.Templates
|> List.filter (fun t -> |> List.filter (fun t ->
not (toDelete |> List.exists (fun d -> d.name = t.name)) not (toDelete |> List.exists (fun d -> d.Name = t.Name))
&& not (toAdd |> List.exists (fun a -> a.name = t.name))) && not (toAdd |> List.exists (fun a -> a.Name = t.Name)))
cmd.CommandText <- cmd.CommandText <-
"UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name" "UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name"
cmd.Parameters.Clear () cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.id) [ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.Id)
cmd.Parameters.Add ("@name", SqliteType.Text) cmd.Parameters.Add ("@name", SqliteType.Text)
cmd.Parameters.Add ("@template", SqliteType.Text) cmd.Parameters.Add ("@template", SqliteType.Text)
] |> ignore ] |> ignore
toUpdate toUpdate
|> List.map (fun template -> backgroundTask { |> List.map (fun template -> backgroundTask {
cmd.Parameters["@name" ].Value <- template.name cmd.Parameters["@name" ].Value <- template.Name
cmd.Parameters["@template"].Value <- template.text cmd.Parameters["@template"].Value <- template.Text
do! write cmd do! write cmd
}) })
|> Task.WhenAll |> Task.WhenAll
@ -83,8 +83,8 @@ type SQLiteThemeData (conn : SqliteConnection) =
cmd.CommandText <- "INSERT INTO theme_template VALUES (@themeId, @name, @template)" cmd.CommandText <- "INSERT INTO theme_template VALUES (@themeId, @name, @template)"
toAdd toAdd
|> List.map (fun template -> backgroundTask { |> List.map (fun template -> backgroundTask {
cmd.Parameters["@name" ].Value <- template.name cmd.Parameters["@name" ].Value <- template.Name
cmd.Parameters["@template"].Value <- template.text cmd.Parameters["@template"].Value <- template.Text
do! write cmd do! write cmd
}) })
|> Task.WhenAll |> Task.WhenAll
@ -93,7 +93,7 @@ type SQLiteThemeData (conn : SqliteConnection) =
cmd.Parameters.Remove cmd.Parameters["@template"] cmd.Parameters.Remove cmd.Parameters["@template"]
toDelete toDelete
|> List.map (fun template -> backgroundTask { |> List.map (fun template -> backgroundTask {
cmd.Parameters["@name"].Value <- template.name cmd.Parameters["@name"].Value <- template.Name
do! write cmd do! write cmd
}) })
|> Task.WhenAll |> Task.WhenAll
@ -163,7 +163,7 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
use sideCmd = conn.CreateCommand () use sideCmd = conn.CreateCommand ()
sideCmd.CommandText <- sideCmd.CommandText <-
"SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path" "SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path"
let (ThemeAssetId (ThemeId themeId, path)) = asset.id let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
[ sideCmd.Parameters.AddWithValue ("@themeId", themeId) [ sideCmd.Parameters.AddWithValue ("@themeId", themeId)
sideCmd.Parameters.AddWithValue ("@path", path) sideCmd.Parameters.AddWithValue ("@path", path)
] |> ignore ] |> ignore
@ -185,15 +185,15 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
)""" )"""
[ cmd.Parameters.AddWithValue ("@themeId", themeId) [ cmd.Parameters.AddWithValue ("@themeId", themeId)
cmd.Parameters.AddWithValue ("@path", path) cmd.Parameters.AddWithValue ("@path", path)
cmd.Parameters.AddWithValue ("@updatedOn", asset.updatedOn) cmd.Parameters.AddWithValue ("@updatedOn", asset.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", asset.data.Length) cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length)
] |> ignore ] |> ignore
do! write cmd do! write cmd
sideCmd.CommandText <- "SELECT ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path" sideCmd.CommandText <- "SELECT ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
let! rowId = sideCmd.ExecuteScalarAsync () let! rowId = sideCmd.ExecuteScalarAsync ()
use dataStream = new MemoryStream (asset.data) use dataStream = new MemoryStream (asset.Data)
use blobStream = new SqliteBlob (conn, "theme_asset", "data", rowId :?> int64) use blobStream = new SqliteBlob (conn, "theme_asset", "data", rowId :?> int64)
do! dataStream.CopyToAsync blobStream do! dataStream.CopyToAsync blobStream
} }

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 /// Add parameters for uploaded file INSERT and UPDATE statements
let addUploadParameters (cmd : SqliteCommand) (upload : Upload) = let addUploadParameters (cmd : SqliteCommand) (upload : Upload) =
[ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.id) [ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.webLogId) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId)
cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.path) cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.Path)
cmd.Parameters.AddWithValue ("@updatedOn", upload.updatedOn) cmd.Parameters.AddWithValue ("@updatedOn", upload.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", upload.data.Length) cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length)
] |> ignore ] |> ignore
/// Save an uploaded file /// Save an uploaded file
@ -32,7 +32,7 @@ type SQLiteUploadData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT ROWID FROM upload WHERE id = @id" cmd.CommandText <- "SELECT ROWID FROM upload WHERE id = @id"
let! rowId = cmd.ExecuteScalarAsync () let! rowId = cmd.ExecuteScalarAsync ()
use dataStream = new MemoryStream (upload.data) use dataStream = new MemoryStream (upload.Data)
use blobStream = new SqliteBlob (conn, "upload", "data", rowId :?> int64) use blobStream = new SqliteBlob (conn, "upload", "data", rowId :?> int64)
do! dataStream.CopyToAsync blobStream do! dataStream.CopyToAsync blobStream
} }
@ -53,7 +53,7 @@ type SQLiteUploadData (conn : SqliteConnection) =
do! rdr.CloseAsync () do! rdr.CloseAsync ()
cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId" cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
do! write cmd do! write cmd
return Ok (Permalink.toString upload.path) return Ok (Permalink.toString upload.Path)
else else
return Error $"""Upload ID {cmd.Parameters["@id"]} not found""" return Error $"""Upload ID {cmd.Parameters["@id"]} not found"""
} }

134
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 /// Add parameters for web log INSERT or web log/RSS options UPDATE statements
let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) = let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@feedEnabled", webLog.rss.feedEnabled) [ cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled)
cmd.Parameters.AddWithValue ("@feedName", webLog.rss.feedName) cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName)
cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.rss.itemsInFeed) cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed)
cmd.Parameters.AddWithValue ("@categoryEnabled", webLog.rss.categoryEnabled) cmd.Parameters.AddWithValue ("@isCategoryEnabled", webLog.Rss.IsCategoryEnabled)
cmd.Parameters.AddWithValue ("@tagEnabled", webLog.rss.tagEnabled) cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled)
cmd.Parameters.AddWithValue ("@copyright", maybe webLog.rss.copyright) cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright)
] |> ignore ] |> ignore
/// Add parameters for web log INSERT or UPDATE statements /// Add parameters for web log INSERT or UPDATE statements
let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) = let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.id) [ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id)
cmd.Parameters.AddWithValue ("@name", webLog.name) cmd.Parameters.AddWithValue ("@name", webLog.Name)
cmd.Parameters.AddWithValue ("@slug", webLog.slug) cmd.Parameters.AddWithValue ("@slug", webLog.Slug)
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.subtitle) cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle)
cmd.Parameters.AddWithValue ("@defaultPage", webLog.defaultPage) cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage)
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.postsPerPage) cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage)
cmd.Parameters.AddWithValue ("@themeId", webLog.themePath) cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId)
cmd.Parameters.AddWithValue ("@urlBase", webLog.urlBase) cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase)
cmd.Parameters.AddWithValue ("@timeZone", webLog.timeZone) cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone)
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.autoHtmx) cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx)
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.uploads) cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads)
] |> ignore ] |> ignore
addWebLogRssParameters cmd webLog addWebLogRssParameters cmd webLog
/// Add parameters for custom feed INSERT or UPDATE statements /// Add parameters for custom feed INSERT or UPDATE statements
let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) = let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) =
[ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.id) [ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId)
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.source) cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source)
cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.path) cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path)
] |> ignore ] |> ignore
/// Add parameters for podcast INSERT or UPDATE statements /// Add parameters for podcast INSERT or UPDATE statements
let addPodcastParameters (cmd : SqliteCommand) feedId (podcast : PodcastOptions) = let addPodcastParameters (cmd : SqliteCommand) feedId (podcast : PodcastOptions) =
[ cmd.Parameters.AddWithValue ("@feedId", CustomFeedId.toString feedId) [ cmd.Parameters.AddWithValue ("@feedId", CustomFeedId.toString feedId)
cmd.Parameters.AddWithValue ("@title", podcast.title) cmd.Parameters.AddWithValue ("@title", podcast.Title)
cmd.Parameters.AddWithValue ("@subtitle", maybe podcast.subtitle) cmd.Parameters.AddWithValue ("@subtitle", maybe podcast.Subtitle)
cmd.Parameters.AddWithValue ("@itemsInFeed", podcast.itemsInFeed) cmd.Parameters.AddWithValue ("@itemsInFeed", podcast.ItemsInFeed)
cmd.Parameters.AddWithValue ("@summary", podcast.summary) cmd.Parameters.AddWithValue ("@summary", podcast.Summary)
cmd.Parameters.AddWithValue ("@displayedAuthor", podcast.displayedAuthor) cmd.Parameters.AddWithValue ("@displayedAuthor", podcast.DisplayedAuthor)
cmd.Parameters.AddWithValue ("@email", podcast.email) cmd.Parameters.AddWithValue ("@email", podcast.Email)
cmd.Parameters.AddWithValue ("@imageUrl", Permalink.toString podcast.imageUrl) cmd.Parameters.AddWithValue ("@imageUrl", Permalink.toString podcast.ImageUrl)
cmd.Parameters.AddWithValue ("@iTunesCategory", podcast.iTunesCategory) cmd.Parameters.AddWithValue ("@appleCategory", podcast.AppleCategory)
cmd.Parameters.AddWithValue ("@iTunesSubcategory", maybe podcast.iTunesSubcategory) cmd.Parameters.AddWithValue ("@appleSubcategory", maybe podcast.AppleSubcategory)
cmd.Parameters.AddWithValue ("@explicit", ExplicitRating.toString podcast.explicit) cmd.Parameters.AddWithValue ("@explicit", ExplicitRating.toString podcast.Explicit)
cmd.Parameters.AddWithValue ("@defaultMediaType", maybe podcast.defaultMediaType) cmd.Parameters.AddWithValue ("@defaultMediaType", maybe podcast.DefaultMediaType)
cmd.Parameters.AddWithValue ("@mediaBaseUrl", maybe podcast.mediaBaseUrl) cmd.Parameters.AddWithValue ("@mediaBaseUrl", maybe podcast.MediaBaseUrl)
cmd.Parameters.AddWithValue ("@guid", maybe podcast.guid) cmd.Parameters.AddWithValue ("@podcastGuid", maybe podcast.PodcastGuid)
cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.fundingUrl) cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.FundingUrl)
cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.fundingText) cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.FundingText)
cmd.Parameters.AddWithValue ("@medium", maybe (podcast.medium |> Option.map PodcastMedium.toString)) cmd.Parameters.AddWithValue ("@medium", maybe (podcast.Medium |> Option.map PodcastMedium.toString))
] |> ignore ] |> ignore
/// Get the current custom feeds for a web log /// Get the current custom feeds for a web log
@ -76,7 +76,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
FROM web_log_feed f FROM web_log_feed f
LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id
WHERE f.web_log_id = @webLogId""" WHERE f.web_log_id = @webLogId"""
addWebLogId cmd webLog.id addWebLogId cmd webLog.Id
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toCustomFeed rdr return toList Map.toCustomFeed rdr
} }
@ -84,7 +84,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Append custom feeds to a web log /// Append custom feeds to a web log
let appendCustomFeeds (webLog : WebLog) = backgroundTask { let appendCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog let! feeds = getCustomFeeds webLog
return { webLog with rss = { webLog.rss with customFeeds = feeds } } return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
} }
/// Add a podcast to a custom feed /// Add a podcast to a custom feed
@ -93,12 +93,12 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.CommandText <- """ cmd.CommandText <- """
INSERT INTO web_log_feed_podcast ( INSERT INTO web_log_feed_podcast (
feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url, 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, apple_category, apple_subcategory, explicit, default_media_type, media_base_url, podcast_guid,
funding_text, medium funding_url, funding_text, medium
) VALUES ( ) VALUES (
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl, @feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl,
@iTunesCategory, @iTunesSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @guid, @fundingUrl, @appleCategory, @appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @podcastGuid,
@fundingText, @medium @fundingUrl, @fundingText, @medium
)""" )"""
addPodcastParameters cmd feedId podcast addPodcastParameters cmd feedId podcast
do! write cmd do! write cmd
@ -107,12 +107,12 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Update the custom feeds for a web log /// Update the custom feeds for a web log
let updateCustomFeeds (webLog : WebLog) = backgroundTask { let updateCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog let! feeds = getCustomFeeds webLog
let toDelete, toAdd = diffLists feeds webLog.rss.customFeeds (fun it -> $"{CustomFeedId.toString it.id}") let toDelete, toAdd = diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
let toId (feed : CustomFeed) = feed.id let toId (feed : CustomFeed) = feed.Id
let toUpdate = let toUpdate =
webLog.rss.customFeeds webLog.Rss.CustomFeeds
|> List.filter (fun f -> |> List.filter (fun f ->
not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.id)) not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.Id))
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
toDelete toDelete
@ -120,7 +120,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.CommandText <- """ cmd.CommandText <- """
DELETE FROM web_log_feed_podcast WHERE feed_id = @id; DELETE FROM web_log_feed_podcast WHERE feed_id = @id;
DELETE FROM web_log_feed WHERE 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 do! write cmd
}) })
|> Task.WhenAll |> Task.WhenAll
@ -135,10 +135,10 @@ type SQLiteWebLogData (conn : SqliteConnection) =
@id, @webLogId, @source, @path @id, @webLogId, @source, @path
)""" )"""
cmd.Parameters.Clear () cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.id it addCustomFeedParameters cmd webLog.Id it
do! write cmd do! write cmd
match it.podcast with match it.Podcast with
| Some podcast -> do! addPodcast it.id podcast | Some podcast -> do! addPodcast it.Id podcast
| None -> () | None -> ()
}) })
|> Task.WhenAll |> Task.WhenAll
@ -152,10 +152,10 @@ type SQLiteWebLogData (conn : SqliteConnection) =
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId""" AND web_log_id = @webLogId"""
cmd.Parameters.Clear () cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.id it addCustomFeedParameters cmd webLog.Id it
do! write cmd do! write cmd
let hadPodcast = Option.isSome (feeds |> List.find (fun f -> f.id = it.id)).podcast let hadPodcast = Option.isSome (feeds |> List.find (fun f -> f.Id = it.Id)).Podcast
match it.podcast with match it.Podcast with
| Some podcast -> | Some podcast ->
if hadPodcast then if hadPodcast then
cmd.CommandText <- """ cmd.CommandText <- """
@ -167,26 +167,26 @@ type SQLiteWebLogData (conn : SqliteConnection) =
displayed_author = @displayedAuthor, displayed_author = @displayedAuthor,
email = @email, email = @email,
image_url = @imageUrl, image_url = @imageUrl,
itunes_category = @iTunesCategory, apple_category = @appleCategory,
itunes_subcategory = @iTunesSubcategory, apple_subcategory = @appleSubcategory,
explicit = @explicit, explicit = @explicit,
default_media_type = @defaultMediaType, default_media_type = @defaultMediaType,
media_base_url = @mediaBaseUrl, media_base_url = @mediaBaseUrl,
guid = @guid, podcast_guid = @podcastGuid,
funding_url = @fundingUrl, funding_url = @fundingUrl,
funding_text = @fundingText, funding_text = @fundingText,
medium = @medium medium = @medium
WHERE feed_id = @feedId""" WHERE feed_id = @feedId"""
cmd.Parameters.Clear () cmd.Parameters.Clear ()
addPodcastParameters cmd it.id podcast addPodcastParameters cmd it.Id podcast
do! write cmd do! write cmd
else else
do! addPodcast it.id podcast do! addPodcast it.Id podcast
| None -> | None ->
if hadPodcast then if hadPodcast then
cmd.CommandText <- "DELETE FROM web_log_feed_podcast WHERE feed_id = @id" cmd.CommandText <- "DELETE FROM web_log_feed_podcast WHERE feed_id = @id"
cmd.Parameters.Clear () cmd.Parameters.Clear ()
cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString it.id) |> ignore cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString it.Id) |> ignore
do! write cmd do! write cmd
else else
() ()
@ -203,10 +203,10 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.CommandText <- """ cmd.CommandText <- """
INSERT INTO web_log ( INSERT INTO web_log (
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx, id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
uploads, feed_enabled, feed_name, items_in_feed, category_enabled, tag_enabled, copyright uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright
) VALUES ( ) VALUES (
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx, @id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
@uploads, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled, @copyright @uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
)""" )"""
addWebLogParameters cmd webLog addWebLogParameters cmd webLog
do! write cmd do! write cmd
@ -296,11 +296,11 @@ type SQLiteWebLogData (conn : SqliteConnection) =
time_zone = @timeZone, time_zone = @timeZone,
auto_htmx = @autoHtmx, auto_htmx = @autoHtmx,
uploads = @uploads, uploads = @uploads,
feed_enabled = @feedEnabled, is_feed_enabled = @isFeedEnabled,
feed_name = @feedName, feed_name = @feedName,
items_in_feed = @itemsInFeed, items_in_feed = @itemsInFeed,
category_enabled = @categoryEnabled, is_category_enabled = @isCategoryEnabled,
tag_enabled = @tagEnabled, is_tag_enabled = @isTagEnabled,
copyright = @copyright copyright = @copyright
WHERE id = @id""" WHERE id = @id"""
addWebLogParameters cmd webLog addWebLogParameters cmd webLog
@ -312,11 +312,11 @@ type SQLiteWebLogData (conn : SqliteConnection) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <- """
UPDATE web_log UPDATE web_log
SET feed_enabled = @feedEnabled, SET is_feed_enabled = @isFeedEnabled,
feed_name = @feedName, feed_name = @feedName,
items_in_feed = @itemsInFeed, items_in_feed = @itemsInFeed,
category_enabled = @categoryEnabled, is_category_enabled = @isCategoryEnabled,
tag_enabled = @tagEnabled, is_tag_enabled = @isTagEnabled,
copyright = @copyright copyright = @copyright
WHERE id = @id""" WHERE id = @id"""
addWebLogRssParameters cmd webLog addWebLogRssParameters cmd webLog

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 /// Add parameters for web log user INSERT or UPDATE statements
let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) = let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) =
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.id) [ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.webLogId) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.WebLogId)
cmd.Parameters.AddWithValue ("@userName", user.userName) cmd.Parameters.AddWithValue ("@email", user.Email)
cmd.Parameters.AddWithValue ("@firstName", user.firstName) cmd.Parameters.AddWithValue ("@firstName", user.FirstName)
cmd.Parameters.AddWithValue ("@lastName", user.lastName) cmd.Parameters.AddWithValue ("@lastName", user.LastName)
cmd.Parameters.AddWithValue ("@preferredName", user.preferredName) cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName)
cmd.Parameters.AddWithValue ("@passwordHash", user.passwordHash) cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash)
cmd.Parameters.AddWithValue ("@salt", user.salt) cmd.Parameters.AddWithValue ("@salt", user.Salt)
cmd.Parameters.AddWithValue ("@url", maybe user.url) cmd.Parameters.AddWithValue ("@url", maybe user.Url)
cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.accessLevel) cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel)
cmd.Parameters.AddWithValue ("@createdOn", user.createdOn) cmd.Parameters.AddWithValue ("@createdOn", user.CreatedOn)
cmd.Parameters.AddWithValue ("@lastSeenOn", maybe user.lastSeenOn) cmd.Parameters.AddWithValue ("@lastSeenOn", maybe user.LastSeenOn)
] |> ignore ] |> ignore
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
@ -33,11 +33,11 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <- """
INSERT INTO web_log_user ( INSERT INTO web_log_user (
id, web_log_id, user_name, first_name, last_name, preferred_name, password_hash, salt, url, id, web_log_id, email, first_name, last_name, preferred_name, password_hash, salt, url, access_level,
access_level, created_on, last_seen_on created_on, last_seen_on
) VALUES ( ) VALUES (
@id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel,
@accessLevel, @createdOn, @lastSeenOn @createdOn, @lastSeenOn
)""" )"""
addWebLogUserParameters cmd user addWebLogUserParameters cmd user
do! write cmd do! write cmd
@ -46,9 +46,9 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Find a user by their e-mail address for the given web log /// Find a user by their e-mail address for the given web log
let findByEmail (email : string) webLogId = backgroundTask { let findByEmail (email : string) webLogId = backgroundTask {
use cmd = conn.CreateCommand () 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 addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@userName", email) |> ignore cmd.Parameters.AddWithValue ("@email", email) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toWebLogUser rdr) else None 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.CommandText <- "SELECT * FROM web_log_user WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<WebLogUser> webLogId (fun u -> u.webLogId) Map.toWebLogUser rdr return Helpers.verifyWebLog<WebLogUser> webLogId (fun u -> u.WebLogId) Map.toWebLogUser rdr
} }
/// Get all users for the given web log /// Get all users for the given web log
@ -85,7 +85,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return return
toList Map.toWebLogUser rdr toList Map.toWebLogUser rdr
|> List.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u }) |> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
} }
/// Restore users from a backup /// Restore users from a backup
@ -115,7 +115,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <- """
UPDATE web_log_user UPDATE web_log_user
SET user_name = @userName, SET email = @email,
first_name = @firstName, first_name = @firstName,
last_name = @lastName, last_name = @lastName,
preferred_name = @preferredName, preferred_name = @preferredName,

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

@ -97,11 +97,11 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
time_zone TEXT NOT NULL, time_zone TEXT NOT NULL,
auto_htmx INTEGER NOT NULL DEFAULT 0, auto_htmx INTEGER NOT NULL DEFAULT 0,
uploads TEXT NOT NULL, uploads TEXT NOT NULL,
feed_enabled INTEGER NOT NULL DEFAULT 0, is_feed_enabled INTEGER NOT NULL DEFAULT 0,
feed_name TEXT NOT NULL, feed_name TEXT NOT NULL,
items_in_feed INTEGER, items_in_feed INTEGER,
category_enabled INTEGER NOT NULL DEFAULT 0, is_category_enabled INTEGER NOT NULL DEFAULT 0,
tag_enabled INTEGER NOT NULL DEFAULT 0, is_tag_enabled INTEGER NOT NULL DEFAULT 0,
copyright TEXT); copyright TEXT);
CREATE INDEX web_log_theme_idx ON web_log (theme_id)""" CREATE INDEX web_log_theme_idx ON web_log (theme_id)"""
do! write cmd do! write cmd
@ -131,12 +131,12 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
displayed_author TEXT NOT NULL, displayed_author TEXT NOT NULL,
email TEXT NOT NULL, email TEXT NOT NULL,
image_url TEXT NOT NULL, image_url TEXT NOT NULL,
itunes_category TEXT NOT NULL, apple_category TEXT NOT NULL,
itunes_subcategory TEXT, apple_subcategory TEXT,
explicit TEXT NOT NULL, explicit TEXT NOT NULL,
default_media_type TEXT, default_media_type TEXT,
media_base_url TEXT, media_base_url TEXT,
guid TEXT, podcast_guid TEXT,
funding_url TEXT, funding_url TEXT,
funding_text TEXT, funding_text TEXT,
medium TEXT)""" medium TEXT)"""
@ -167,7 +167,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
CREATE TABLE web_log_user ( CREATE TABLE web_log_user (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
user_name TEXT NOT NULL, email TEXT NOT NULL,
first_name TEXT NOT NULL, first_name TEXT NOT NULL,
last_name TEXT NOT NULL, last_name TEXT NOT NULL,
preferred_name TEXT NOT NULL, preferred_name TEXT NOT NULL,
@ -176,9 +176,9 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
url TEXT, url TEXT,
access_level TEXT NOT NULL, access_level TEXT NOT NULL,
created_on TEXT NOT NULL, created_on TEXT NOT NULL,
last_seen_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_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)""" CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)"""
do! write cmd do! write cmd
// Page tables // Page tables
@ -195,7 +195,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
permalink TEXT NOT NULL, permalink TEXT NOT NULL,
published_on TEXT NOT NULL, published_on TEXT NOT NULL,
updated_on TEXT NOT NULL, updated_on TEXT NOT NULL,
show_in_page_list INTEGER NOT NULL DEFAULT 0, is_in_page_list INTEGER NOT NULL DEFAULT 0,
template TEXT, template TEXT,
page_text TEXT NOT NULL); page_text TEXT NOT NULL);
CREATE INDEX page_web_log_idx ON page (web_log_id); CREATE INDEX page_web_log_idx ON page (web_log_id);

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 /// Create a category hierarchy from the given list of categories
let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq { let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq {
for cat in cats |> List.filter (fun c -> c.parentId = parentId) do for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do
let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.slug let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug
{ Id = CategoryId.toString cat.id { Id = CategoryId.toString cat.Id
Slug = fullSlug Slug = fullSlug
Name = cat.name Name = cat.Name
Description = cat.description Description = cat.Description
ParentNames = Array.ofList parentNames ParentNames = Array.ofList parentNames
// Post counts are filled on a second pass // Post counts are filled on a second pass
PostCount = 0 PostCount = 0
} }
yield! orderByHierarchy cats (Some cat.id) (Some fullSlug) ([ cat.name ] |> List.append parentNames) yield! orderByHierarchy cats (Some cat.Id) (Some fullSlug) ([ cat.Name ] |> List.append parentNames)
} }

352
src/MyWebLog.Domain/DataTypes.fs
View File

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

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

@ -140,55 +140,55 @@ module ExplicitRating =
/// A podcast episode /// A podcast episode
type Episode = type Episode =
{ /// The URL to the media file for the episode (may be permalink) { /// The URL to the media file for the episode (may be permalink)
media : string Media : string
/// The length of the media file, in bytes /// The length of the media file, in bytes
length : int64 Length : int64
/// The duration of the episode /// The duration of the episode
duration : TimeSpan option Duration : TimeSpan option
/// The media type of the file (overrides podcast default if present) /// The media type of the file (overrides podcast default if present)
mediaType : string option MediaType : string option
/// The URL to the image file for this episode (overrides podcast image if present, may be permalink) /// The URL to the image file for this episode (overrides podcast image if present, may be permalink)
imageUrl : string option ImageUrl : string option
/// A subtitle for this episode /// A subtitle for this episode
subtitle : string option Subtitle : string option
/// This episode's explicit rating (overrides podcast rating if present) /// This episode's explicit rating (overrides podcast rating if present)
explicit : ExplicitRating option Explicit : ExplicitRating option
/// A link to a chapter file /// A link to a chapter file
chapterFile : string option ChapterFile : string option
/// The MIME type for the chapter file /// The MIME type for the chapter file
chapterType : string option ChapterType : string option
/// The URL for the transcript of the episode (may be permalink) /// The URL for the transcript of the episode (may be permalink)
transcriptUrl : string option TranscriptUrl : string option
/// The MIME type of the transcript /// The MIME type of the transcript
transcriptType : string option TranscriptType : string option
/// The language in which the transcript is written /// The language in which the transcript is written
transcriptLang : string option TranscriptLang : string option
/// If true, the transcript will be declared (in the feed) to be a captions file /// If true, the transcript will be declared (in the feed) to be a captions file
transcriptCaptions : bool option TranscriptCaptions : bool option
/// The season number (for serialized podcasts) /// The season number (for serialized podcasts)
seasonNumber : int option SeasonNumber : int option
/// A description of the season /// A description of the season
seasonDescription : string option SeasonDescription : string option
/// The episode number /// The episode number
episodeNumber : double option EpisodeNumber : double option
/// A description of the episode /// A description of the episode
episodeDescription : string option EpisodeDescription : string option
} }
/// Functions to support episodes /// Functions to support episodes
@ -196,23 +196,23 @@ module Episode =
/// An empty episode /// An empty episode
let empty = { let empty = {
media = "" Media = ""
length = 0L Length = 0L
duration = None Duration = None
mediaType = None MediaType = None
imageUrl = None ImageUrl = None
subtitle = None Subtitle = None
explicit = None Explicit = None
chapterFile = None ChapterFile = None
chapterType = None ChapterType = None
transcriptUrl = None TranscriptUrl = None
transcriptType = None TranscriptType = None
transcriptLang = None TranscriptLang = None
transcriptCaptions = None TranscriptCaptions = None
seasonNumber = None SeasonNumber = None
seasonDescription = None SeasonDescription = None
episodeNumber = None EpisodeNumber = None
episodeDescription = None EpisodeDescription = None
} }
@ -256,10 +256,10 @@ module MarkupText =
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type MetaItem = type MetaItem =
{ /// The name of the metadata value { /// The name of the metadata value
name : string Name : string
/// The metadata value /// The metadata value
value : string Value : string
} }
/// Functions to support metadata items /// Functions to support metadata items
@ -267,17 +267,17 @@ module MetaItem =
/// An empty metadata item /// An empty metadata item
let empty = let empty =
{ name = ""; value = "" } { Name = ""; Value = "" }
/// A revision of a page or post /// A revision of a page or post
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Revision = type Revision =
{ /// When this revision was saved { /// When this revision was saved
asOf : DateTime AsOf : DateTime
/// The text of the revision /// The text of the revision
text : MarkupText Text : MarkupText
} }
/// Functions to support revisions /// Functions to support revisions
@ -285,8 +285,8 @@ module Revision =
/// An empty revision /// An empty revision
let empty = let empty =
{ asOf = DateTime.UtcNow { AsOf = DateTime.UtcNow
text = Html "" Text = Html ""
} }
@ -436,68 +436,68 @@ module CustomFeedSource =
/// Options for a feed that describes a podcast /// Options for a feed that describes a podcast
type PodcastOptions = type PodcastOptions =
{ /// The title of the podcast { /// The title of the podcast
title : string Title : string
/// A subtitle for the podcast /// A subtitle for the podcast
subtitle : string option Subtitle : string option
/// The number of items in the podcast feed /// The number of items in the podcast feed
itemsInFeed : int ItemsInFeed : int
/// A summary of the podcast (iTunes field) /// A summary of the podcast (iTunes field)
summary : string Summary : string
/// The display name of the podcast author (iTunes field) /// The display name of the podcast author (iTunes field)
displayedAuthor : string DisplayedAuthor : string
/// The e-mail address of the user who registered the podcast at iTunes /// The e-mail address of the user who registered the podcast at iTunes
email : string Email : string
/// The link to the image for the podcast /// The link to the image for the podcast
imageUrl : Permalink ImageUrl : Permalink
/// The category from iTunes under which this podcast is categorized /// The category from Apple Podcasts (iTunes) under which this podcast is categorized
iTunesCategory : string AppleCategory : string
/// A further refinement of the categorization of this podcast (iTunes field / values) /// A further refinement of the categorization of this podcast (Apple Podcasts/iTunes field / values)
iTunesSubcategory : string option AppleSubcategory : string option
/// The explictness rating (iTunes field) /// The explictness rating (iTunes field)
explicit : ExplicitRating Explicit : ExplicitRating
/// The default media type for files in this podcast /// The default media type for files in this podcast
defaultMediaType : string option DefaultMediaType : string option
/// The base URL for relative URL media files for this podcast (optional; defaults to web log base) /// The base URL for relative URL media files for this podcast (optional; defaults to web log base)
mediaBaseUrl : string option MediaBaseUrl : string option
/// A GUID for this podcast /// A GUID for this podcast
guid : Guid option PodcastGuid : Guid option
/// A URL at which information on supporting the podcast may be found (supports permalinks) /// A URL at which information on supporting the podcast may be found (supports permalinks)
fundingUrl : string option FundingUrl : string option
/// The text to be displayed in the funding item within the feed /// The text to be displayed in the funding item within the feed
fundingText : string option FundingText : string option
/// The medium (what the podcast IS, not what it is ABOUT) /// The medium (what the podcast IS, not what it is ABOUT)
medium : PodcastMedium option Medium : PodcastMedium option
} }
/// A custom feed /// A custom feed
type CustomFeed = type CustomFeed =
{ /// The ID of the custom feed { /// The ID of the custom feed
id : CustomFeedId Id : CustomFeedId
/// The source for the custom feed /// The source for the custom feed
source : CustomFeedSource Source : CustomFeedSource
/// The path for the custom feed /// The path for the custom feed
path : Permalink Path : Permalink
/// Podcast options, if the feed defines a podcast /// Podcast options, if the feed defines a podcast
podcast : PodcastOptions option Podcast : PodcastOptions option
} }
/// Functions to support custom feeds /// Functions to support custom feeds
@ -505,10 +505,10 @@ module CustomFeed =
/// An empty custom feed /// An empty custom feed
let empty = let empty =
{ id = CustomFeedId "" { Id = CustomFeedId ""
source = Category (CategoryId "") Source = Category (CategoryId "")
path = Permalink "" Path = Permalink ""
podcast = None Podcast = None
} }
@ -516,25 +516,25 @@ module CustomFeed =
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type RssOptions = type RssOptions =
{ /// Whether the site feed of posts is enabled { /// Whether the site feed of posts is enabled
feedEnabled : bool IsFeedEnabled : bool
/// The name of the file generated for the site feed /// The name of the file generated for the site feed
feedName : string FeedName : string
/// Override the "posts per page" setting for the site feed /// Override the "posts per page" setting for the site feed
itemsInFeed : int option ItemsInFeed : int option
/// Whether feeds are enabled for all categories /// Whether feeds are enabled for all categories
categoryEnabled : bool IsCategoryEnabled : bool
/// Whether feeds are enabled for all tags /// Whether feeds are enabled for all tags
tagEnabled : bool IsTagEnabled : bool
/// A copyright string to be placed in all feeds /// A copyright string to be placed in all feeds
copyright : string option Copyright : string option
/// Custom feeds for this web log /// Custom feeds for this web log
customFeeds: CustomFeed list CustomFeeds: CustomFeed list
} }
/// Functions to support RSS options /// Functions to support RSS options
@ -542,13 +542,13 @@ module RssOptions =
/// An empty set of RSS options /// An empty set of RSS options
let empty = let empty =
{ feedEnabled = true { IsFeedEnabled = true
feedName = "feed.xml" FeedName = "feed.xml"
itemsInFeed = None ItemsInFeed = None
categoryEnabled = true IsCategoryEnabled = true
tagEnabled = true IsTagEnabled = true
copyright = None Copyright = None
customFeeds = [] CustomFeeds = []
} }
@ -594,10 +594,10 @@ module ThemeAssetId =
/// A template for a theme /// A template for a theme
type ThemeTemplate = type ThemeTemplate =
{ /// The name of the template { /// The name of the template
name : string Name : string
/// The text of the template /// The text of the template
text : string Text : string
} }
@ -610,13 +610,13 @@ type UploadDestination =
module UploadDestination = module UploadDestination =
/// Convert an upload destination to its string representation /// Convert an upload destination to its string representation
let toString = function Database -> "database" | Disk -> "disk" let toString = function Database -> "Database" | Disk -> "Disk"
/// Parse an upload destination from its string representation /// Parse an upload destination from its string representation
let parse value = let parse value =
match value with match value with
| "database" -> Database | "Database" -> Database
| "disk" -> Disk | "Disk" -> Disk
| it -> invalidOp $"{it} is not a valid upload destination" | it -> invalidOp $"{it} is not a valid upload destination"

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

@ -76,13 +76,13 @@ type DisplayCustomFeed =
/// Create a display version from a custom feed /// Create a display version from a custom feed
static member fromFeed (cats : DisplayCategory[]) (feed : CustomFeed) : DisplayCustomFeed = static member fromFeed (cats : DisplayCategory[]) (feed : CustomFeed) : DisplayCustomFeed =
let source = let source =
match feed.source with match feed.Source with
| Category (CategoryId catId) -> $"Category: {(cats |> Array.find (fun cat -> cat.Id = catId)).Name}" | Category (CategoryId catId) -> $"Category: {(cats |> Array.find (fun cat -> cat.Id = catId)).Name}"
| Tag tag -> $"Tag: {tag}" | Tag tag -> $"Tag: {tag}"
{ Id = CustomFeedId.toString feed.id { Id = CustomFeedId.toString feed.Id
Source = source Source = source
Path = Permalink.toString feed.path Path = Permalink.toString feed.Path
IsPodcast = Option.isSome feed.podcast IsPodcast = Option.isSome feed.Podcast
} }
@ -108,7 +108,7 @@ type DisplayPage =
UpdatedOn : DateTime UpdatedOn : DateTime
/// Whether this page shows as part of the web log's navigation /// Whether this page shows as part of the web log's navigation
ShowInPageList : bool IsInPageList : bool
/// Is this the default page? /// Is this the default page?
IsDefault : bool IsDefault : bool
@ -122,15 +122,15 @@ type DisplayPage =
/// Create a minimal display page (no text or metadata) from a database page /// Create a minimal display page (no text or metadata) from a database page
static member fromPageMinimal webLog (page : Page) = static member fromPageMinimal webLog (page : Page) =
let pageId = PageId.toString page.id let pageId = PageId.toString page.Id
{ Id = pageId { Id = pageId
AuthorId = WebLogUserId.toString page.authorId AuthorId = WebLogUserId.toString page.AuthorId
Title = page.title Title = page.Title
Permalink = Permalink.toString page.permalink Permalink = Permalink.toString page.Permalink
PublishedOn = page.publishedOn PublishedOn = page.PublishedOn
UpdatedOn = page.updatedOn UpdatedOn = page.UpdatedOn
ShowInPageList = page.showInPageList IsInPageList = page.IsInPageList
IsDefault = pageId = webLog.defaultPage IsDefault = pageId = webLog.DefaultPage
Text = "" Text = ""
Metadata = [] Metadata = []
} }
@ -138,17 +138,17 @@ type DisplayPage =
/// Create a display page from a database page /// Create a display page from a database page
static member fromPage webLog (page : Page) = static member fromPage webLog (page : Page) =
let _, extra = WebLog.hostAndPath webLog let _, extra = WebLog.hostAndPath webLog
let pageId = PageId.toString page.id let pageId = PageId.toString page.Id
{ Id = pageId { Id = pageId
AuthorId = WebLogUserId.toString page.authorId AuthorId = WebLogUserId.toString page.AuthorId
Title = page.title Title = page.Title
Permalink = Permalink.toString page.permalink Permalink = Permalink.toString page.Permalink
PublishedOn = page.publishedOn PublishedOn = page.PublishedOn
UpdatedOn = page.updatedOn UpdatedOn = page.UpdatedOn
ShowInPageList = page.showInPageList IsInPageList = page.IsInPageList
IsDefault = pageId = webLog.defaultPage IsDefault = pageId = webLog.DefaultPage
Text = if extra = "" then page.text else page.text.Replace ("href=\"/", $"href=\"{extra}/") Text = if extra = "" then page.Text else page.Text.Replace ("href=\"/", $"href=\"{extra}/")
Metadata = page.metadata Metadata = page.Metadata
} }
@ -168,9 +168,9 @@ with
/// Create a display revision from an actual revision /// Create a display revision from an actual revision
static member fromRevision webLog (rev : Revision) = static member fromRevision webLog (rev : Revision) =
{ AsOf = rev.asOf { AsOf = rev.AsOf
AsOfLocal = WebLog.localTime webLog rev.asOf AsOfLocal = WebLog.localTime webLog rev.AsOf
Format = MarkupText.sourceType rev.text Format = MarkupText.sourceType rev.Text
} }
@ -197,12 +197,12 @@ type DisplayUpload =
/// Create a display uploaded file /// Create a display uploaded file
static member fromUpload webLog source (upload : Upload) = static member fromUpload webLog source (upload : Upload) =
let path = Permalink.toString upload.path let path = Permalink.toString upload.Path
let name = Path.GetFileName path let name = Path.GetFileName path
{ Id = UploadId.toString upload.id { Id = UploadId.toString upload.Id
Name = name Name = name
Path = path.Replace (name, "") Path = path.Replace (name, "")
UpdatedOn = Some (WebLog.localTime webLog upload.updatedOn) UpdatedOn = Some (WebLog.localTime webLog upload.UpdatedOn)
Source = UploadDestination.toString source Source = UploadDestination.toString source
} }
@ -228,11 +228,11 @@ type EditCategoryModel =
/// Create an edit model from an existing category /// Create an edit model from an existing category
static member fromCategory (cat : Category) = static member fromCategory (cat : Category) =
{ CategoryId = CategoryId.toString cat.id { CategoryId = CategoryId.toString cat.Id
Name = cat.name Name = cat.Name
Slug = cat.slug Slug = cat.Slug
Description = defaultArg cat.description "" Description = defaultArg cat.Description ""
ParentId = cat.parentId |> Option.map CategoryId.toString |> Option.defaultValue "" ParentId = cat.ParentId |> Option.map CategoryId.toString |> Option.defaultValue ""
} }
@ -275,11 +275,11 @@ type EditCustomFeedModel =
/// The link to the image for the podcast /// The link to the image for the podcast
ImageUrl : string ImageUrl : string
/// The category from iTunes under which this podcast is categorized /// The category from Apple Podcasts (iTunes) under which this podcast is categorized
iTunesCategory : string AppleCategory : string
/// A further refinement of the categorization of this podcast (iTunes field / values) /// A further refinement of the categorization of this podcast (Apple Podcasts/iTunes field / values)
iTunesSubcategory : string AppleSubcategory : string
/// The explictness rating (iTunes field) /// The explictness rating (iTunes field)
Explicit : string Explicit : string
@ -317,8 +317,8 @@ type EditCustomFeedModel =
DisplayedAuthor = "" DisplayedAuthor = ""
Email = "" Email = ""
ImageUrl = "" ImageUrl = ""
iTunesCategory = "" AppleCategory = ""
iTunesSubcategory = "" AppleSubcategory = ""
Explicit = "no" Explicit = "no"
DefaultMediaType = "audio/mpeg" DefaultMediaType = "audio/mpeg"
MediaBaseUrl = "" MediaBaseUrl = ""
@ -332,65 +332,95 @@ type EditCustomFeedModel =
static member fromFeed (feed : CustomFeed) = static member fromFeed (feed : CustomFeed) =
let rss = let rss =
{ EditCustomFeedModel.empty with { EditCustomFeedModel.empty with
Id = CustomFeedId.toString feed.id Id = CustomFeedId.toString feed.Id
SourceType = match feed.source with Category _ -> "category" | Tag _ -> "tag" SourceType = match feed.Source with Category _ -> "category" | Tag _ -> "tag"
SourceValue = match feed.source with Category (CategoryId catId) -> catId | Tag tag -> tag SourceValue = match feed.Source with Category (CategoryId catId) -> catId | Tag tag -> tag
Path = Permalink.toString feed.path Path = Permalink.toString feed.Path
} }
match feed.podcast with match feed.Podcast with
| Some p -> | Some p ->
{ rss with { rss with
IsPodcast = true IsPodcast = true
Title = p.title Title = p.Title
Subtitle = defaultArg p.subtitle "" Subtitle = defaultArg p.Subtitle ""
ItemsInFeed = p.itemsInFeed ItemsInFeed = p.ItemsInFeed
Summary = p.summary Summary = p.Summary
DisplayedAuthor = p.displayedAuthor DisplayedAuthor = p.DisplayedAuthor
Email = p.email Email = p.Email
ImageUrl = Permalink.toString p.imageUrl ImageUrl = Permalink.toString p.ImageUrl
iTunesCategory = p.iTunesCategory AppleCategory = p.AppleCategory
iTunesSubcategory = defaultArg p.iTunesSubcategory "" AppleSubcategory = defaultArg p.AppleSubcategory ""
Explicit = ExplicitRating.toString p.explicit Explicit = ExplicitRating.toString p.Explicit
DefaultMediaType = defaultArg p.defaultMediaType "" DefaultMediaType = defaultArg p.DefaultMediaType ""
MediaBaseUrl = defaultArg p.mediaBaseUrl "" MediaBaseUrl = defaultArg p.MediaBaseUrl ""
FundingUrl = defaultArg p.fundingUrl "" FundingUrl = defaultArg p.FundingUrl ""
FundingText = defaultArg p.fundingText "" FundingText = defaultArg p.FundingText ""
PodcastGuid = p.guid PodcastGuid = p.PodcastGuid
|> Option.map (fun it -> it.ToString().ToLowerInvariant ()) |> Option.map (fun it -> it.ToString().ToLowerInvariant ())
|> Option.defaultValue "" |> Option.defaultValue ""
Medium = p.medium |> Option.map PodcastMedium.toString |> Option.defaultValue "" Medium = p.Medium |> Option.map PodcastMedium.toString |> Option.defaultValue ""
} }
| None -> rss | None -> rss
/// Update a feed with values from this model /// Update a feed with values from this model
member this.updateFeed (feed : CustomFeed) = member this.UpdateFeed (feed : CustomFeed) =
{ feed with { feed with
source = if this.SourceType = "tag" then Tag this.SourceValue else Category (CategoryId this.SourceValue) Source = if this.SourceType = "tag" then Tag this.SourceValue else Category (CategoryId this.SourceValue)
path = Permalink this.Path Path = Permalink this.Path
podcast = Podcast =
if this.IsPodcast then if this.IsPodcast then
Some { Some {
title = this.Title Title = this.Title
subtitle = noneIfBlank this.Subtitle Subtitle = noneIfBlank this.Subtitle
itemsInFeed = this.ItemsInFeed ItemsInFeed = this.ItemsInFeed
summary = this.Summary Summary = this.Summary
displayedAuthor = this.DisplayedAuthor DisplayedAuthor = this.DisplayedAuthor
email = this.Email Email = this.Email
imageUrl = Permalink this.ImageUrl ImageUrl = Permalink this.ImageUrl
iTunesCategory = this.iTunesCategory AppleCategory = this.AppleCategory
iTunesSubcategory = noneIfBlank this.iTunesSubcategory AppleSubcategory = noneIfBlank this.AppleSubcategory
explicit = ExplicitRating.parse this.Explicit Explicit = ExplicitRating.parse this.Explicit
defaultMediaType = noneIfBlank this.DefaultMediaType DefaultMediaType = noneIfBlank this.DefaultMediaType
mediaBaseUrl = noneIfBlank this.MediaBaseUrl MediaBaseUrl = noneIfBlank this.MediaBaseUrl
guid = noneIfBlank this.PodcastGuid |> Option.map Guid.Parse PodcastGuid = noneIfBlank this.PodcastGuid |> Option.map Guid.Parse
fundingUrl = noneIfBlank this.FundingUrl FundingUrl = noneIfBlank this.FundingUrl
fundingText = noneIfBlank this.FundingText FundingText = noneIfBlank this.FundingText
medium = noneIfBlank this.Medium |> Option.map PodcastMedium.parse Medium = noneIfBlank this.Medium |> Option.map PodcastMedium.parse
} }
else else
None 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 /// View model to edit a page
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type EditPageModel = type EditPageModel =
@ -425,19 +455,19 @@ type EditPageModel =
/// Create an edit model from an existing page /// Create an edit model from an existing page
static member fromPage (page : Page) = static member fromPage (page : Page) =
let latest = 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 | Some rev -> rev
| None -> Revision.empty | None -> Revision.empty
let page = if page.metadata |> List.isEmpty then { page with metadata = [ MetaItem.empty ] } else page let page = if page.Metadata |> List.isEmpty then { page with Metadata = [ MetaItem.empty ] } else page
{ PageId = PageId.toString page.id { PageId = PageId.toString page.Id
Title = page.title Title = page.Title
Permalink = Permalink.toString page.permalink Permalink = Permalink.toString page.Permalink
Template = defaultArg page.template "" Template = defaultArg page.Template ""
IsShownInPageList = page.showInPageList IsShownInPageList = page.IsInPageList
Source = MarkupText.sourceType latest.text Source = MarkupText.sourceType latest.Text
Text = MarkupText.text latest.text Text = MarkupText.text latest.Text
MetaNames = page.metadata |> List.map (fun m -> m.name) |> Array.ofList MetaNames = page.Metadata |> List.map (fun m -> m.Name) |> Array.ofList
MetaValues = page.metadata |> List.map (fun m -> m.value) |> 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 /// Create an edit model from an existing past
static member fromPost webLog (post : Post) = static member fromPost webLog (post : Post) =
let latest = 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 | Some rev -> rev
| None -> Revision.empty | None -> Revision.empty
let post = if post.metadata |> List.isEmpty then { post with metadata = [ MetaItem.empty ] } else post let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.empty ] } else post
let episode = defaultArg post.episode Episode.empty let episode = defaultArg post.Episode Episode.empty
{ PostId = PostId.toString post.id { PostId = PostId.toString post.Id
Title = post.title Title = post.Title
Permalink = Permalink.toString post.permalink Permalink = Permalink.toString post.Permalink
Source = MarkupText.sourceType latest.text Source = MarkupText.sourceType latest.Text
Text = MarkupText.text latest.text Text = MarkupText.text latest.Text
Tags = String.Join (", ", post.tags) Tags = String.Join (", ", post.Tags)
Template = defaultArg post.template "" Template = defaultArg post.Template ""
CategoryIds = post.categoryIds |> List.map CategoryId.toString |> Array.ofList CategoryIds = post.CategoryIds |> List.map CategoryId.toString |> Array.ofList
Status = PostStatus.toString post.status Status = PostStatus.toString post.Status
DoPublish = false DoPublish = false
MetaNames = post.metadata |> List.map (fun m -> m.name) |> Array.ofList MetaNames = post.Metadata |> List.map (fun m -> m.Name) |> Array.ofList
MetaValues = post.metadata |> List.map (fun m -> m.value) |> Array.ofList MetaValues = post.Metadata |> List.map (fun m -> m.Value) |> Array.ofList
SetPublished = false SetPublished = false
PubOverride = post.publishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable PubOverride = post.PublishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable
SetUpdated = false SetUpdated = false
IsEpisode = Option.isSome post.episode IsEpisode = Option.isSome post.Episode
Media = episode.media Media = episode.Media
Length = episode.length Length = episode.Length
Duration = defaultArg (episode.duration |> Option.map (fun it -> it.ToString """hh\:mm\:ss""")) "" Duration = defaultArg (episode.Duration |> Option.map (fun it -> it.ToString """hh\:mm\:ss""")) ""
MediaType = defaultArg episode.mediaType "" MediaType = defaultArg episode.MediaType ""
ImageUrl = defaultArg episode.imageUrl "" ImageUrl = defaultArg episode.ImageUrl ""
Subtitle = defaultArg episode.subtitle "" Subtitle = defaultArg episode.Subtitle ""
Explicit = defaultArg (episode.explicit |> Option.map ExplicitRating.toString) "" Explicit = defaultArg (episode.Explicit |> Option.map ExplicitRating.toString) ""
ChapterFile = defaultArg episode.chapterFile "" ChapterFile = defaultArg episode.ChapterFile ""
ChapterType = defaultArg episode.chapterType "" ChapterType = defaultArg episode.ChapterType ""
TranscriptUrl = defaultArg episode.transcriptUrl "" TranscriptUrl = defaultArg episode.TranscriptUrl ""
TranscriptType = defaultArg episode.transcriptType "" TranscriptType = defaultArg episode.TranscriptType ""
TranscriptLang = defaultArg episode.transcriptLang "" TranscriptLang = defaultArg episode.TranscriptLang ""
TranscriptCaptions = defaultArg episode.transcriptCaptions false TranscriptCaptions = defaultArg episode.TranscriptCaptions false
SeasonNumber = defaultArg episode.seasonNumber 0 SeasonNumber = defaultArg episode.SeasonNumber 0
SeasonDescription = defaultArg episode.seasonDescription "" SeasonDescription = defaultArg episode.SeasonDescription ""
EpisodeNumber = defaultArg (episode.episodeNumber |> Option.map string) "" EpisodeNumber = defaultArg (episode.EpisodeNumber |> Option.map string) ""
EpisodeDescription = defaultArg episode.episodeDescription "" EpisodeDescription = defaultArg episode.EpisodeDescription ""
} }
/// Update a post with values from the submitted form /// 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 { post with
title = this.Title Title = this.Title
permalink = Permalink this.Permalink Permalink = Permalink this.Permalink
publishedOn = if this.DoPublish then Some now else post.publishedOn PublishedOn = if this.DoPublish then Some now else post.PublishedOn
updatedOn = now UpdatedOn = now
text = MarkupText.toHtml revision.text Text = MarkupText.toHtml revision.Text
tags = this.Tags.Split "," Tags = this.Tags.Split ","
|> Seq.ofArray |> Seq.ofArray
|> Seq.map (fun it -> it.Trim().ToLower ()) |> Seq.map (fun it -> it.Trim().ToLower ())
|> Seq.filter (fun it -> it <> "") |> Seq.filter (fun it -> it <> "")
|> Seq.sort |> Seq.sort
|> List.ofSeq |> List.ofSeq
template = match this.Template.Trim () with "" -> None | tmpl -> Some tmpl Template = match this.Template.Trim () with "" -> None | tmpl -> Some tmpl
categoryIds = this.CategoryIds |> Array.map CategoryId |> List.ofArray CategoryIds = this.CategoryIds |> Array.map CategoryId |> List.ofArray
status = if this.DoPublish then Published else post.status Status = if this.DoPublish then Published else post.Status
metadata = Seq.zip this.MetaNames this.MetaValues Metadata = Seq.zip this.MetaNames this.MetaValues
|> Seq.filter (fun it -> fst it > "") |> Seq.filter (fun it -> fst it > "")
|> Seq.map (fun it -> { name = fst it; value = snd it }) |> Seq.map (fun it -> { Name = fst it; Value = snd it })
|> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}") |> Seq.sortBy (fun it -> $"{it.Name.ToLower ()} {it.Value.ToLower ()}")
|> List.ofSeq |> List.ofSeq
revisions = match post.revisions |> List.tryHead with Revisions = match post.Revisions |> List.tryHead with
| Some r when r.text = revision.text -> post.revisions | Some r when r.Text = revision.Text -> post.Revisions
| _ -> revision :: post.revisions | _ -> revision :: post.Revisions
episode = Episode =
if this.IsEpisode then if this.IsEpisode then
Some { Some {
media = this.Media Media = this.Media
length = this.Length Length = this.Length
duration = noneIfBlank this.Duration |> Option.map TimeSpan.Parse Duration = noneIfBlank this.Duration |> Option.map TimeSpan.Parse
mediaType = noneIfBlank this.MediaType MediaType = noneIfBlank this.MediaType
imageUrl = noneIfBlank this.ImageUrl ImageUrl = noneIfBlank this.ImageUrl
subtitle = noneIfBlank this.Subtitle Subtitle = noneIfBlank this.Subtitle
explicit = noneIfBlank this.Explicit |> Option.map ExplicitRating.parse Explicit = noneIfBlank this.Explicit |> Option.map ExplicitRating.parse
chapterFile = noneIfBlank this.ChapterFile ChapterFile = noneIfBlank this.ChapterFile
chapterType = noneIfBlank this.ChapterType ChapterType = noneIfBlank this.ChapterType
transcriptUrl = noneIfBlank this.TranscriptUrl TranscriptUrl = noneIfBlank this.TranscriptUrl
transcriptType = noneIfBlank this.TranscriptType TranscriptType = noneIfBlank this.TranscriptType
transcriptLang = noneIfBlank this.TranscriptLang TranscriptLang = noneIfBlank this.TranscriptLang
transcriptCaptions = if this.TranscriptCaptions then Some true else None TranscriptCaptions = if this.TranscriptCaptions then Some true else None
seasonNumber = if this.SeasonNumber = 0 then None else Some this.SeasonNumber SeasonNumber = if this.SeasonNumber = 0 then None else Some this.SeasonNumber
seasonDescription = noneIfBlank this.SeasonDescription SeasonDescription = noneIfBlank this.SeasonDescription
episodeNumber = match noneIfBlank this.EpisodeNumber |> Option.map Double.Parse with EpisodeNumber = match noneIfBlank this.EpisodeNumber |> Option.map Double.Parse with
| Some it when it = 0.0 -> None | Some it when it = 0.0 -> None
| Some it -> Some (double it) | Some it -> Some (double it)
| None -> None | None -> None
episodeDescription = noneIfBlank this.EpisodeDescription EpisodeDescription = noneIfBlank this.EpisodeDescription
} }
else else
None None
@ -665,23 +695,23 @@ type EditRssModel =
/// Create an edit model from a set of RSS options /// Create an edit model from a set of RSS options
static member fromRssOptions (rss : RssOptions) = static member fromRssOptions (rss : RssOptions) =
{ IsFeedEnabled = rss.feedEnabled { IsFeedEnabled = rss.IsFeedEnabled
FeedName = rss.feedName FeedName = rss.FeedName
ItemsInFeed = defaultArg rss.itemsInFeed 0 ItemsInFeed = defaultArg rss.ItemsInFeed 0
IsCategoryEnabled = rss.categoryEnabled IsCategoryEnabled = rss.IsCategoryEnabled
IsTagEnabled = rss.tagEnabled IsTagEnabled = rss.IsTagEnabled
Copyright = defaultArg rss.copyright "" Copyright = defaultArg rss.Copyright ""
} }
/// Update RSS options from values in this mode /// Update RSS options from values in this mode
member this.updateOptions (rss : RssOptions) = member this.UpdateOptions (rss : RssOptions) =
{ rss with { rss with
feedEnabled = this.IsFeedEnabled IsFeedEnabled = this.IsFeedEnabled
feedName = this.FeedName FeedName = this.FeedName
itemsInFeed = if this.ItemsInFeed = 0 then None else Some this.ItemsInFeed ItemsInFeed = if this.ItemsInFeed = 0 then None else Some this.ItemsInFeed
categoryEnabled = this.IsCategoryEnabled IsCategoryEnabled = this.IsCategoryEnabled
tagEnabled = this.IsTagEnabled IsTagEnabled = this.IsTagEnabled
copyright = noneIfBlank this.Copyright Copyright = noneIfBlank this.Copyright
} }
@ -703,37 +733,9 @@ type EditTagMapModel =
/// Create an edit model from the tag mapping /// Create an edit model from the tag mapping
static member fromMapping (tagMap : TagMap) : EditTagMapModel = static member fromMapping (tagMap : TagMap) : EditTagMapModel =
{ Id = TagMapId.toString tagMap.id { Id = TagMapId.toString tagMap.Id
Tag = tagMap.tag Tag = tagMap.Tag
UrlValue = tagMap.urlValue 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 = ""
} }
@ -776,20 +778,20 @@ type ManagePermalinksModel =
/// Create a permalink model from a page /// Create a permalink model from a page
static member fromPage (pg : Page) = static member fromPage (pg : Page) =
{ Id = PageId.toString pg.id { Id = PageId.toString pg.Id
Entity = "page" Entity = "page"
CurrentTitle = pg.title CurrentTitle = pg.Title
CurrentPermalink = Permalink.toString pg.permalink CurrentPermalink = Permalink.toString pg.Permalink
Prior = pg.priorPermalinks |> List.map Permalink.toString |> Array.ofList Prior = pg.PriorPermalinks |> List.map Permalink.toString |> Array.ofList
} }
/// Create a permalink model from a post /// Create a permalink model from a post
static member fromPost (post : Post) = static member fromPost (post : Post) =
{ Id = PostId.toString post.id { Id = PostId.toString post.Id
Entity = "post" Entity = "post"
CurrentTitle = post.title CurrentTitle = post.Title
CurrentPermalink = Permalink.toString post.permalink CurrentPermalink = Permalink.toString post.Permalink
Prior = post.priorPermalinks |> List.map Permalink.toString |> Array.ofList Prior = post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList
} }
@ -811,18 +813,18 @@ type ManageRevisionsModel =
/// Create a revision model from a page /// Create a revision model from a page
static member fromPage webLog (pg : Page) = static member fromPage webLog (pg : Page) =
{ Id = PageId.toString pg.id { Id = PageId.toString pg.Id
Entity = "page" Entity = "page"
CurrentTitle = pg.title CurrentTitle = pg.Title
Revisions = pg.revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList Revisions = pg.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
} }
/// Create a revision model from a post /// Create a revision model from a post
static member fromPost webLog (post : Post) = static member fromPost webLog (post : Post) =
{ Id = PostId.toString post.id { Id = PostId.toString post.Id
Entity = "post" Entity = "post"
CurrentTitle = post.title CurrentTitle = post.Title
Revisions = post.revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList Revisions = post.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
} }
@ -870,18 +872,18 @@ type PostListItem =
static member fromPost (webLog : WebLog) (post : Post) = static member fromPost (webLog : WebLog) (post : Post) =
let _, extra = WebLog.hostAndPath webLog let _, extra = WebLog.hostAndPath webLog
let inTZ = WebLog.localTime webLog let inTZ = WebLog.localTime webLog
{ Id = PostId.toString post.id { Id = PostId.toString post.Id
AuthorId = WebLogUserId.toString post.authorId AuthorId = WebLogUserId.toString post.AuthorId
Status = PostStatus.toString post.status Status = PostStatus.toString post.Status
Title = post.title Title = post.Title
Permalink = Permalink.toString post.permalink Permalink = Permalink.toString post.Permalink
PublishedOn = post.publishedOn |> Option.map inTZ |> Option.toNullable PublishedOn = post.PublishedOn |> Option.map inTZ |> Option.toNullable
UpdatedOn = inTZ post.updatedOn UpdatedOn = inTZ post.UpdatedOn
Text = if extra = "" then post.text else post.text.Replace ("href=\"/", $"href=\"{extra}/") Text = if extra = "" then post.Text else post.Text.Replace ("href=\"/", $"href=\"{extra}/")
CategoryIds = post.categoryIds |> List.map CategoryId.toString CategoryIds = post.CategoryIds |> List.map CategoryId.toString
Tags = post.tags Tags = post.Tags
Episode = post.episode Episode = post.Episode
Metadata = post.metadata Metadata = post.Metadata
} }
@ -932,7 +934,7 @@ type SettingsModel =
TimeZone : string TimeZone : string
/// The theme to use to display the web log /// The theme to use to display the web log
ThemePath : string ThemeId : string
/// Whether to automatically load htmx /// Whether to automatically load htmx
AutoHtmx : bool AutoHtmx : bool
@ -943,29 +945,29 @@ type SettingsModel =
/// Create a settings model from a web log /// Create a settings model from a web log
static member fromWebLog (webLog : WebLog) = static member fromWebLog (webLog : WebLog) =
{ Name = webLog.name { Name = webLog.Name
Slug = webLog.slug Slug = webLog.Slug
Subtitle = defaultArg webLog.subtitle "" Subtitle = defaultArg webLog.Subtitle ""
DefaultPage = webLog.defaultPage DefaultPage = webLog.DefaultPage
PostsPerPage = webLog.postsPerPage PostsPerPage = webLog.PostsPerPage
TimeZone = webLog.timeZone TimeZone = webLog.TimeZone
ThemePath = webLog.themePath ThemeId = ThemeId.toString webLog.ThemeId
AutoHtmx = webLog.autoHtmx AutoHtmx = webLog.AutoHtmx
Uploads = UploadDestination.toString webLog.uploads Uploads = UploadDestination.toString webLog.Uploads
} }
/// Update a web log with settings from the form /// Update a web log with settings from the form
member this.update (webLog : WebLog) = member this.update (webLog : WebLog) =
{ webLog with { webLog with
name = this.Name Name = this.Name
slug = this.Slug Slug = this.Slug
subtitle = if this.Subtitle = "" then None else Some this.Subtitle Subtitle = if this.Subtitle = "" then None else Some this.Subtitle
defaultPage = this.DefaultPage DefaultPage = this.DefaultPage
postsPerPage = this.PostsPerPage PostsPerPage = this.PostsPerPage
timeZone = this.TimeZone TimeZone = this.TimeZone
themePath = this.ThemePath ThemeId = ThemeId this.ThemeId
autoHtmx = this.AutoHtmx AutoHtmx = this.AutoHtmx
uploads = UploadDestination.parse this.Uploads 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) /// Try to get the web log for the current request (longest matching URL base wins)
let tryGet (path : string) = let tryGet (path : string) =
_cache _cache
|> List.filter (fun wl -> path.StartsWith wl.urlBase) |> List.filter (fun wl -> path.StartsWith wl.UrlBase)
|> List.sortByDescending (fun wl -> wl.urlBase.Length) |> List.sortByDescending (fun wl -> wl.UrlBase.Length)
|> List.tryHead |> List.tryHead
/// Cache the web log for a particular host /// Cache the web log for a particular host
let set webLog = let set webLog =
_cache <- webLog :: (_cache |> List.filter (fun wl -> wl.id <> webLog.id)) _cache <- webLog :: (_cache |> List.filter (fun wl -> wl.Id <> webLog.Id))
/// Fill the web log cache from the database /// Fill the web log cache from the database
let fill (data : IData) = backgroundTask { let fill (data : IData) = backgroundTask {
@ -91,18 +91,18 @@ module PageListCache =
let private _cache = ConcurrentDictionary<string, DisplayPage[]> () let private _cache = ConcurrentDictionary<string, DisplayPage[]> ()
/// Are there pages cached for this web log? /// Are there pages cached for this web log?
let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.urlBase let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.UrlBase
/// Get the pages for the web log for this request /// Get the pages for the web log for this request
let get (ctx : HttpContext) = _cache[ctx.WebLog.urlBase] let get (ctx : HttpContext) = _cache[ctx.WebLog.UrlBase]
/// Update the pages for the current web log /// Update the pages for the current web log
let update (ctx : HttpContext) = backgroundTask { let update (ctx : HttpContext) = backgroundTask {
let webLog = ctx.WebLog let webLog = ctx.WebLog
let! pages = ctx.Data.Page.FindListed webLog.id let! pages = ctx.Data.Page.FindListed webLog.Id
_cache[webLog.urlBase] <- _cache[webLog.UrlBase] <-
pages pages
|> List.map (fun pg -> DisplayPage.fromPage webLog { pg with text = "" }) |> List.map (fun pg -> DisplayPage.fromPage webLog { pg with Text = "" })
|> Array.ofList |> Array.ofList
} }
@ -116,15 +116,15 @@ module CategoryCache =
let private _cache = ConcurrentDictionary<string, DisplayCategory[]> () let private _cache = ConcurrentDictionary<string, DisplayCategory[]> ()
/// Are there categories cached for this web log? /// Are there categories cached for this web log?
let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.urlBase let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.UrlBase
/// Get the categories for the web log for this request /// Get the categories for the web log for this request
let get (ctx : HttpContext) = _cache[ctx.WebLog.urlBase] let get (ctx : HttpContext) = _cache[ctx.WebLog.UrlBase]
/// Update the cache with fresh data /// Update the cache with fresh data
let update (ctx : HttpContext) = backgroundTask { let update (ctx : HttpContext) = backgroundTask {
let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.id let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.Id
_cache[ctx.WebLog.urlBase] <- cats _cache[ctx.WebLog.UrlBase] <- cats
} }
@ -149,10 +149,10 @@ module TemplateCache =
| false -> | false ->
match! data.Theme.FindById (ThemeId themeId) with match! data.Theme.FindById (ThemeId themeId) with
| Some theme -> | 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 while hasInclude.IsMatch text do
let child = hasInclude.Match text 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) text <- text.Replace (child.Value, childText)
_cache[templatePath] <- Template.Parse (text, SyntaxCompatibility.DotLiquid22) _cache[templatePath] <- Template.Parse (text, SyntaxCompatibility.DotLiquid22)
| None -> () | None -> ()
@ -179,14 +179,14 @@ module ThemeAssetCache =
/// Refresh the list of assets for the given theme /// Refresh the list of assets for the given theme
let refreshTheme themeId (data : IData) = backgroundTask { let refreshTheme themeId (data : IData) = backgroundTask {
let! assets = data.ThemeAsset.FindByTheme themeId let! assets = data.ThemeAsset.FindByTheme themeId
_cache[themeId] <- assets |> List.map (fun a -> match a.id with ThemeAssetId (_, path) -> path) _cache[themeId] <- assets |> List.map (fun a -> match a.Id with ThemeAssetId (_, path) -> path)
} }
/// Fill the theme asset cache /// Fill the theme asset cache
let fill (data : IData) = backgroundTask { let fill (data : IData) = backgroundTask {
let! assets = data.ThemeAsset.All () let! assets = data.ThemeAsset.All ()
for asset in assets do for asset in assets do
let (ThemeAssetId (themeId, path)) = asset.id let (ThemeAssetId (themeId, path)) = asset.Id
if not (_cache.ContainsKey themeId) then _cache[themeId] <- [] if not (_cache.ContainsKey themeId) then _cache[themeId] <- []
_cache[themeId] <- path :: _cache[themeId] _cache[themeId] <- path :: _cache[themeId]
} }

46
src/MyWebLog/DotLiquidBespoke.fs
View File

@ -12,11 +12,13 @@ open MyWebLog.ViewModels
type Context with type Context with
/// Get the current web log from the DotLiquid context /// 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? /// Does an asset exist for the current theme?
let assetExists fileName (webLog : WebLog) = let assetExists fileName (webLog : WebLog) =
ThemeAssetCache.get (ThemeId webLog.themePath) |> List.exists (fun it -> it = fileName) ThemeAssetCache.get webLog.ThemeId |> List.exists (fun it -> it = fileName)
/// Obtain the link from known types /// Obtain the link from known types
let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> string) = let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> string) =
@ -24,7 +26,7 @@ let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> st
| :? String as link -> Some link | :? String as link -> Some link
| :? DisplayPage as page -> Some page.Permalink | :? DisplayPage as page -> Some page.Permalink
| :? PostListItem as post -> Some post.Permalink | :? PostListItem as post -> Some post.Permalink
| :? DropProxy as proxy -> Option.ofObj proxy["permalink"] |> Option.map string | :? DropProxy as proxy -> Option.ofObj proxy["Permalink"] |> Option.map string
| _ -> None | _ -> None
|> function |> function
| Some link -> linkFunc ctx.WebLog (Permalink link) | Some link -> linkFunc ctx.WebLog (Permalink link)
@ -42,7 +44,7 @@ type CategoryLinkFilter () =
static member CategoryLink (ctx : Context, catObj : obj) = static member CategoryLink (ctx : Context, catObj : obj) =
match catObj with match catObj with
| :? DisplayCategory as cat -> Some cat.Slug | :? DisplayCategory as cat -> Some cat.Slug
| :? DropProxy as proxy -> Option.ofObj proxy["slug"] |> Option.map string | :? DropProxy as proxy -> Option.ofObj proxy["Slug"] |> Option.map string
| _ -> None | _ -> None
|> function |> function
| Some slug -> WebLog.relativeUrl ctx.WebLog (Permalink $"category/{slug}/") | Some slug -> WebLog.relativeUrl ctx.WebLog (Permalink $"category/{slug}/")
@ -54,7 +56,7 @@ type EditPageLinkFilter () =
static member EditPageLink (ctx : Context, pageObj : obj) = static member EditPageLink (ctx : Context, pageObj : obj) =
match pageObj with match pageObj with
| :? DisplayPage as page -> Some page.Id | :? DisplayPage as page -> Some page.Id
| :? DropProxy as proxy -> Option.ofObj proxy["id"] |> Option.map string | :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId | :? String as theId -> Some theId
| _ -> None | _ -> None
|> function |> function
@ -67,7 +69,7 @@ type EditPostLinkFilter () =
static member EditPostLink (ctx : Context, postObj : obj) = static member EditPostLink (ctx : Context, postObj : obj) =
match postObj with match postObj with
| :? PostListItem as post -> Some post.Id | :? PostListItem as post -> Some post.Id
| :? DropProxy as proxy -> Option.ofObj proxy["id"] |> Option.map string | :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId | :? String as theId -> Some theId
| _ -> None | _ -> None
|> function |> function
@ -89,13 +91,13 @@ type NavLinkFilter () =
text text
"</a></li>" "</a></li>"
} }
|> Seq.fold (+) "" |> String.concat ""
/// A filter to generate a link for theme asset (image, stylesheet, script, etc.) /// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
type ThemeAssetFilter () = type ThemeAssetFilter () =
static member ThemeAsset (ctx : Context, asset : string) = static member ThemeAsset (ctx : Context, asset : string) =
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 /// Create various items in the page header based on the state of the page being generated
@ -107,7 +109,7 @@ type PageHeadTag () =
// spacer // spacer
let s = " " let s = " "
let getBool name = let getBool name =
context.Environments[0].[name] |> Option.ofObj |> Option.map Convert.ToBoolean |> Option.defaultValue false defaultArg (context.Environments[0].[name] |> Option.ofObj |> Option.map Convert.ToBoolean) false
result.WriteLine $"""<meta name="generator" content="{context.Environments[0].["generator"]}">""" result.WriteLine $"""<meta name="generator" content="{context.Environments[0].["generator"]}">"""
@ -123,17 +125,17 @@ type PageHeadTag () =
let relUrl = WebLog.relativeUrl webLog (Permalink url) let relUrl = WebLog.relativeUrl webLog (Permalink url)
$"""{s}<link rel="alternate" type="application/rss+xml" title="{escTitle}" href="{relUrl}">""" $"""{s}<link rel="alternate" type="application/rss+xml" title="{escTitle}" href="{relUrl}">"""
if webLog.rss.feedEnabled && getBool "is_home" then if webLog.Rss.IsFeedEnabled && getBool "is_home" then
result.WriteLine (feedLink webLog.name webLog.rss.feedName) result.WriteLine (feedLink webLog.Name webLog.Rss.FeedName)
result.WriteLine $"""{s}<link rel="canonical" href="{WebLog.absoluteUrl webLog Permalink.empty}">""" result.WriteLine $"""{s}<link rel="canonical" href="{WebLog.absoluteUrl webLog Permalink.empty}">"""
if webLog.rss.categoryEnabled && getBool "is_category_home" then if webLog.Rss.IsCategoryEnabled && getBool "is_category_home" then
let slug = context.Environments[0].["slug"] :?> string let slug = context.Environments[0].["slug"] :?> string
result.WriteLine (feedLink webLog.name $"category/{slug}/{webLog.rss.feedName}") result.WriteLine (feedLink webLog.Name $"category/{slug}/{webLog.Rss.FeedName}")
if webLog.rss.tagEnabled && getBool "is_tag_home" then if webLog.Rss.IsTagEnabled && getBool "is_tag_home" then
let slug = context.Environments[0].["slug"] :?> string let slug = context.Environments[0].["slug"] :?> string
result.WriteLine (feedLink webLog.name $"tag/{slug}/{webLog.rss.feedName}") result.WriteLine (feedLink webLog.Name $"tag/{slug}/{webLog.Rss.FeedName}")
if getBool "is_post" then if getBool "is_post" then
let post = context.Environments[0].["model"] :?> PostDisplay let post = context.Environments[0].["model"] :?> PostDisplay
@ -155,7 +157,7 @@ type PageFootTag () =
// spacer // spacer
let s = " " let s = " "
if webLog.autoHtmx then if webLog.AutoHtmx then
result.WriteLine $"{s}{RenderView.AsString.htmlNode Htmx.Script.minified}" result.WriteLine $"{s}{RenderView.AsString.htmlNode Htmx.Script.minified}"
if assetExists "script.js" webLog then if assetExists "script.js" webLog then
@ -172,9 +174,9 @@ type RelativeLinkFilter () =
type TagLinkFilter () = type TagLinkFilter () =
static member TagLink (ctx : Context, tag : string) = static member TagLink (ctx : Context, tag : string) =
ctx.Environments[0].["tag_mappings"] :?> TagMap list ctx.Environments[0].["tag_mappings"] :?> TagMap list
|> List.tryFind (fun it -> it.tag = tag) |> List.tryFind (fun it -> it.Tag = tag)
|> function |> function
| Some tagMap -> tagMap.urlValue | Some tagMap -> tagMap.UrlValue
| None -> tag.Replace (" ", "+") | None -> tag.Replace (" ", "+")
|> function tagUrl -> WebLog.relativeUrl ctx.WebLog (Permalink $"tag/{tagUrl}/") |> 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 }}`) // (shorter than `{% assign item = list | where: "name", [name] | first %}{{ item.value }}`)
type ValueFilter () = type ValueFilter () =
static member Value (_ : Context, items : MetaItem list, name : string) = static member Value (_ : Context, items : MetaItem list, name : string) =
match items |> List.tryFind (fun it -> it.name = name) with match items |> List.tryFind (fun it -> it.Name = name) with
| Some item -> item.value | Some item -> item.Value
| None -> $"-- {name} not found --" | None -> $"-- {name} not found --"
@ -227,8 +229,8 @@ let register () =
// View models // View models
typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayCustomFeed>; typeof<DisplayPage> typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayCustomFeed>; typeof<DisplayPage>
typeof<DisplayRevision>; typeof<DisplayUpload>; typeof<EditCategoryModel>; typeof<EditCustomFeedModel> typeof<DisplayRevision>; typeof<DisplayUpload>; typeof<EditCategoryModel>; typeof<EditCustomFeedModel>
typeof<EditPageModel>; typeof<EditPostModel>; typeof<EditRssModel>; typeof<EditTagMapModel> typeof<EditMyInfoModel>; typeof<EditPageModel>; typeof<EditPostModel>; typeof<EditRssModel>
typeof<EditUserModel>; typeof<LogOnModel>; typeof<ManagePermalinksModel>; typeof<ManageRevisionsModel> typeof<EditTagMapModel>; typeof<LogOnModel>; typeof<ManagePermalinksModel>; typeof<ManageRevisionsModel>
typeof<PostDisplay>; typeof<PostListItem>; typeof<SettingsModel>; typeof<UserMessage> typeof<PostDisplay>; typeof<PostListItem>; typeof<SettingsModel>; typeof<UserMessage>
// Framework types // Framework types
typeof<AntiforgeryTokenSet>; typeof<DateTime option>; typeof<int option>; typeof<KeyValuePair> typeof<AntiforgeryTokenSet>; typeof<DateTime option>; typeof<int option>; typeof<KeyValuePair>

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

@ -9,7 +9,7 @@ open MyWebLog.ViewModels
// GET /admin // GET /admin
let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task { 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 data = ctx.Data
let posts = getCount (data.Post.CountByStatus Published) let posts = getCount (data.Post.CountByStatus Published)
let drafts = getCount (data.Post.CountByStatus Draft) let drafts = getCount (data.Post.CountByStatus Draft)
@ -30,7 +30,7 @@ let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
TopLevelCategories = topCats.Result TopLevelCategories = topCats.Result
} }
|} |}
|> viewForTheme "admin" "dashboard" next ctx |> adminView "dashboard" next ctx
} }
// -- CATEGORIES -- // -- CATEGORIES --
@ -44,8 +44,9 @@ let listCategories : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
web_log = ctx.WebLog web_log = ctx.WebLog
categories = CategoryCache.get ctx categories = CategoryCache.get ctx
|} |}
hash.Add ("category_list", catListTemplate.Render hash) return!
return! viewForTheme "admin" "category-list" next ctx hash addToHash "category_list" (catListTemplate.Render hash) hash
|> adminView "category-list" next ctx
} }
// GET /admin/categories/bare // GET /admin/categories/bare
@ -54,16 +55,16 @@ let listCategoriesBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ct
categories = CategoryCache.get ctx categories = CategoryCache.get ctx
csrf = ctx.CsrfTokenSet csrf = ctx.CsrfTokenSet
|} |}
|> bareForTheme "admin" "category-list-body" next ctx |> adminBareView "category-list-body" next ctx
// GET /admin/category/{id}/edit // GET /admin/category/{id}/edit
let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! result = task { let! result = task {
match catId with 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) | Some cat -> return Some ("Edit Category", cat)
| None -> return None | None -> return None
} }
@ -76,7 +77,7 @@ let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ct
model = EditCategoryModel.fromCategory cat model = EditCategoryModel.fromCategory cat
categories = CategoryCache.get ctx categories = CategoryCache.get ctx
|} |}
|> bareForTheme "admin" "category-edit" next ctx |> adminBareView "category-edit" next ctx
| None -> return! Error.notFound 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! model = ctx.BindFormAsync<EditCategoryModel> ()
let category = let category =
match model.CategoryId with match model.CategoryId with
| "new" -> Task.FromResult (Some { Category.empty with id = CategoryId.create (); webLogId = 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 | catId -> data.Category.FindById (CategoryId catId) ctx.WebLog.Id
match! category with match! category with
| Some cat -> | Some cat ->
let cat = let cat =
{ cat with { cat with
name = model.Name Name = model.Name
slug = model.Slug Slug = model.Slug
description = if model.Description = "" then None else Some model.Description Description = if model.Description = "" then None else Some model.Description
parentId = if model.ParentId = "" then None else Some (CategoryId model.ParentId) 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! (match model.CategoryId with "new" -> data.Category.Add | _ -> data.Category.Update) cat
do! CategoryCache.update ctx do! CategoryCache.update ctx
@ -106,7 +107,7 @@ let saveCategory : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
// POST /admin/category/{id}/delete // POST /admin/category/{id}/delete
let deleteCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { 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 -> | true ->
do! CategoryCache.update ctx do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Category deleted successfully" } 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 /// Get the hash necessary to render the tag mapping list
let private tagMappingHash (ctx : HttpContext) = task { 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 {| return Hash.FromAnonymousObject {|
csrf = ctx.CsrfTokenSet csrf = ctx.CsrfTokenSet
web_log = ctx.WebLog web_log = ctx.WebLog
mappings = mappings 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! return!
addToHash "tag_mapping_list" (listTemplate.Render hash) hash addToHash "tag_mapping_list" (listTemplate.Render hash) hash
|> addToHash "page_title" "Tag Mappings" |> addToHash "page_title" "Tag Mappings"
|> viewForTheme "admin" "tag-mapping-list" next ctx |> adminView "tag-mapping-list" next ctx
} }
// GET /admin/settings/tag-mappings/bare // GET /admin/settings/tag-mappings/bare
let tagMappingsBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let tagMappingsBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash = tagMappingHash ctx 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 // GET /admin/settings/tag-mapping/{id}/edit
let editMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let editMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let isNew = tagMapId = "new" let isNew = tagMapId = "new"
let tagMap = let tagMap =
if isNew then Task.FromResult (Some { TagMap.empty with id = TagMapId "new" }) if isNew then Task.FromResult (Some { TagMap.empty with Id = TagMapId "new" })
else ctx.Data.TagMap.FindById (TagMapId tagMapId) ctx.WebLog.id else ctx.Data.TagMap.FindById (TagMapId tagMapId) ctx.WebLog.Id
match! tagMap with match! tagMap with
| Some tm -> | Some tm ->
return! return!
Hash.FromAnonymousObject {| 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 csrf = ctx.CsrfTokenSet
model = EditTagMapModel.fromMapping tm model = EditTagMapModel.fromMapping tm
|} |}
|> bareForTheme "admin" "tag-mapping-edit" next ctx |> adminBareView "tag-mapping-edit" next ctx
| None -> return! Error.notFound 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! model = ctx.BindFormAsync<EditTagMapModel> ()
let tagMap = let tagMap =
if model.IsNew then if model.IsNew then
Task.FromResult (Some { TagMap.empty with id = TagMapId.create (); webLogId = 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 else data.TagMap.FindById (TagMapId model.Id) ctx.WebLog.Id
match! tagMap with match! tagMap with
| Some tm -> | 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" } do! addMessage ctx { UserMessage.success with Message = "Tag mapping saved successfully" }
return! tagMappingsBare next ctx return! tagMappingsBare next ctx
| None -> return! Error.notFound 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 // POST /admin/settings/tag-mapping/{id}/delete
let deleteMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { 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" } | 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" } | false -> do! addMessage ctx { UserMessage.error with Message = "Tag mapping not found; nothing deleted" }
return! tagMappingsBare next ctx return! tagMappingsBare next ctx
@ -201,7 +202,7 @@ let themeUpdatePage : HttpHandler = requireAccess Administrator >=> fun next ctx
page_title = "Upload Theme" page_title = "Upload Theme"
csrf = ctx.CsrfTokenSet 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 /// Update the name and version for a theme based on the version.txt file, if present
let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = backgroundTask { let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = backgroundTask {
@ -211,17 +212,17 @@ let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = background
use versionFile = new StreamReader(versionItem.Open ()) use versionFile = new StreamReader(versionItem.Open ())
let! versionText = versionFile.ReadToEndAsync () let! versionText = versionFile.ReadToEndAsync ()
let parts = versionText.Trim().Replace("\r", "").Split "\n" 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 () let version = if parts.Length > 1 && parts[1] > "" then parts[1] else now ()
return { theme with name = displayName; version = version } return { theme with Name = displayName; Version = version }
| None -> return { theme with name = ThemeId.toString theme.id; version = now () } | None -> return { theme with Name = ThemeId.toString theme.Id; Version = now () }
} }
/// Delete all theme assets, and remove templates from theme /// Delete all theme assets, and remove templates from theme
let private checkForCleanLoad (theme : Theme) cleanLoad (data : IData) = backgroundTask { let private checkForCleanLoad (theme : Theme) cleanLoad (data : IData) = backgroundTask {
if cleanLoad then if cleanLoad then
do! data.ThemeAsset.DeleteByTheme theme.id do! data.ThemeAsset.DeleteByTheme theme.Id
return { theme with templates = [] } return { theme with Templates = [] }
else return theme else return theme
} }
@ -233,13 +234,13 @@ let private updateTemplates (theme : Theme) (zip : ZipArchive) = backgroundTask
|> Seq.map (fun templateItem -> backgroundTask { |> Seq.map (fun templateItem -> backgroundTask {
use templateFile = new StreamReader (templateItem.Open ()) use templateFile = new StreamReader (templateItem.Open ())
let! template = templateFile.ReadToEndAsync () 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 let! templates = Task.WhenAll tasks
return return
templates templates
|> Array.fold (fun t template -> |> 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 theme
} }
@ -251,9 +252,9 @@ let private updateAssets themeId (zip : ZipArchive) (data : IData) = backgroundT
use stream = new MemoryStream () use stream = new MemoryStream ()
do! asset.Open().CopyToAsync stream do! asset.Open().CopyToAsync stream
do! data.ThemeAsset.Save do! data.ThemeAsset.Save
{ id = ThemeAssetId (themeId, assetName) { Id = ThemeAssetId (themeId, assetName)
updatedOn = asset.LastWriteTime.DateTime UpdatedOn = asset.LastWriteTime.DateTime
data = stream.ToArray () Data = stream.ToArray ()
} }
} }
@ -269,7 +270,7 @@ let loadThemeFromZip themeName file clean (data : IData) = backgroundTask {
let! theme = backgroundTask { let! theme = backgroundTask {
match! data.Theme.FindById themeId with match! data.Theme.FindById themeId with
| Some t -> return t | 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 = updateNameAndVersion theme zip
let! theme = checkForCleanLoad theme clean data let! theme = checkForCleanLoad theme clean data
@ -308,7 +309,7 @@ open System.Collections.Generic
// GET /admin/settings // GET /admin/settings
let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data 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 () let! themes = data.Theme.All ()
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
@ -318,41 +319,41 @@ let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task
pages = seq pages = seq
{ KeyValuePair.Create ("posts", "- First Page of Posts -") { KeyValuePair.Create ("posts", "- First Page of Posts -")
yield! allPages yield! allPages
|> List.sortBy (fun p -> p.title.ToLower ()) |> List.sortBy (fun p -> p.Title.ToLower ())
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.id, p.title)) |> List.map (fun p -> KeyValuePair.Create (PageId.toString p.Id, p.Title))
} }
|> Array.ofSeq |> Array.ofSeq
themes = themes =
themes themes
|> Seq.ofList |> 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 |> Array.ofSeq
upload_values = [| upload_values = [|
KeyValuePair.Create (UploadDestination.toString Database, "Database") KeyValuePair.Create (UploadDestination.toString Database, "Database")
KeyValuePair.Create (UploadDestination.toString Disk, "Disk") KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
|] |]
|} |}
|> viewForTheme "admin" "settings" next ctx |> adminView "settings" next ctx
} }
// POST /admin/settings // POST /admin/settings
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
let! model = ctx.BindFormAsync<SettingsModel> () let! model = ctx.BindFormAsync<SettingsModel> ()
match! data.WebLog.FindById ctx.WebLog.id with match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog -> | Some webLog ->
let oldSlug = webLog.slug let oldSlug = webLog.Slug
let webLog = model.update webLog let webLog = model.update webLog
do! data.WebLog.UpdateSettings webLog do! data.WebLog.UpdateSettings webLog
// Update cache // Update cache
WebLogCache.set webLog WebLogCache.set webLog
if oldSlug <> webLog.slug then if oldSlug <> webLog.Slug then
// Rename disk directory if it exists // Rename disk directory if it exists
let uploadRoot = Path.Combine ("wwwroot", "upload") let uploadRoot = Path.Combine ("wwwroot", "upload")
let oldDir = Path.Combine (uploadRoot, oldSlug) 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" } do! addMessage ctx { UserMessage.success with Message = "Web log settings saved successfully" }
return! redirectToGet "admin/settings" next ctx 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 deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
let webLog = ctx.WebLog let webLog = ctx.WebLog
let debug = debug "Feed" ctx let debug = debug "Feed" ctx
let name = $"/{webLog.rss.feedName}" let name = $"/{webLog.Rss.FeedName}"
let postCount = defaultArg webLog.rss.itemsInFeed webLog.postsPerPage let postCount = defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage
debug (fun () -> $"Considering potential feed for {feedPath} (configured feed name {name})") debug (fun () -> $"Considering potential feed for {feedPath} (configured feed name {name})")
// Standard feed // Standard feed
match webLog.rss.feedEnabled && feedPath = name with match webLog.Rss.IsFeedEnabled && feedPath = name with
| true -> | true ->
debug (fun () -> "Found standard feed") debug (fun () -> "Found standard feed")
Some (StandardFeed feedPath, postCount) Some (StandardFeed feedPath, postCount)
| false -> | false ->
// Category and tag feeds are handled by defined routes; check for custom feed // Category and tag feeds are handled by defined routes; check for custom feed
match webLog.rss.customFeeds match webLog.Rss.CustomFeeds
|> List.tryFind (fun it -> feedPath.EndsWith (Permalink.toString it.path)) with |> List.tryFind (fun it -> feedPath.EndsWith (Permalink.toString it.Path)) with
| Some feed -> | Some feed ->
debug (fun () -> "Found custom feed") debug (fun () -> "Found custom feed")
Some (Custom (feed, feedPath), Some (Custom (feed, feedPath),
feed.podcast |> Option.map (fun p -> p.itemsInFeed) |> Option.defaultValue postCount) feed.Podcast |> Option.map (fun p -> p.ItemsInFeed) |> Option.defaultValue postCount)
| None -> | None ->
debug (fun () -> $"No matching feed found") debug (fun () -> $"No matching feed found")
None None
@ -53,13 +53,13 @@ let private getFeedPosts ctx feedType =
getCategoryIds cat.Slug ctx getCategoryIds cat.Slug ctx
let data = ctx.Data let data = ctx.Data
match feedType with match feedType with
| StandardFeed _ -> data.Post.FindPageOfPublishedPosts ctx.WebLog.id 1 | StandardFeed _ -> data.Post.FindPageOfPublishedPosts ctx.WebLog.Id 1
| CategoryFeed (catId, _) -> data.Post.FindPageOfCategorizedPosts ctx.WebLog.id (childIds catId) 1 | CategoryFeed (catId, _) -> data.Post.FindPageOfCategorizedPosts ctx.WebLog.Id (childIds catId) 1
| TagFeed (tag, _) -> data.Post.FindPageOfTaggedPosts ctx.WebLog.id tag 1 | TagFeed (tag, _) -> data.Post.FindPageOfTaggedPosts ctx.WebLog.Id tag 1
| Custom (feed, _) -> | Custom (feed, _) ->
match feed.source with match feed.Source with
| Category catId -> data.Post.FindPageOfCategorizedPosts ctx.WebLog.id (childIds catId) 1 | Category catId -> data.Post.FindPageOfCategorizedPosts ctx.WebLog.Id (childIds catId) 1
| Tag tag -> data.Post.FindPageOfTaggedPosts ctx.WebLog.id tag 1 | Tag tag -> data.Post.FindPageOfTaggedPosts ctx.WebLog.Id tag 1
/// Strip HTML from a string /// Strip HTML from a string
let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace (text, "<(.|\n)*?>", "") let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace (text, "<(.|\n)*?>", "")
@ -90,13 +90,13 @@ module private Namespace =
let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[]) (tagMaps : TagMap list) let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[]) (tagMaps : TagMap list)
(post : Post) = (post : Post) =
let plainText = let plainText =
let endingP = post.text.IndexOf "</p>" let endingP = post.Text.IndexOf "</p>"
stripHtml <| if endingP >= 0 then post.text[..(endingP - 1)] else post.text stripHtml <| if endingP >= 0 then post.Text[..(endingP - 1)] else post.Text
let item = SyndicationItem ( let item = SyndicationItem (
Id = WebLog.absoluteUrl webLog post.permalink, Id = WebLog.absoluteUrl webLog post.Permalink,
Title = TextSyndicationContent.CreateHtmlContent post.title, Title = TextSyndicationContent.CreateHtmlContent post.Title,
PublishDate = DateTimeOffset post.publishedOn.Value, PublishDate = DateTimeOffset post.PublishedOn.Value,
LastUpdatedTime = DateTimeOffset post.updatedOn, LastUpdatedTime = DateTimeOffset post.UpdatedOn,
Content = TextSyndicationContent.CreatePlaintextContent plainText) Content = TextSyndicationContent.CreatePlaintextContent plainText)
item.AddPermalink (Uri item.Id) item.AddPermalink (Uri item.Id)
@ -104,25 +104,25 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[
let encoded = let encoded =
let txt = let txt =
post.text post.Text
.Replace("src=\"/", $"src=\"{webLog.urlBase}/") .Replace("src=\"/", $"src=\"{webLog.UrlBase}/")
.Replace ("href=\"/", $"href=\"{webLog.urlBase}/") .Replace ("href=\"/", $"href=\"{webLog.UrlBase}/")
let it = xmlDoc.CreateElement ("content", "encoded", Namespace.content) let it = xmlDoc.CreateElement ("content", "encoded", Namespace.content)
let _ = it.AppendChild (xmlDoc.CreateCDataSection txt) let _ = it.AppendChild (xmlDoc.CreateCDataSection txt)
it it
item.ElementExtensions.Add encoded item.ElementExtensions.Add encoded
item.Authors.Add (SyndicationPerson ( item.Authors.Add (SyndicationPerson (
Name = (authors |> List.find (fun a -> a.name = WebLogUserId.toString post.authorId)).value)) Name = (authors |> List.find (fun a -> a.Name = WebLogUserId.toString post.AuthorId)).Value))
[ post.categoryIds [ post.CategoryIds
|> List.map (fun catId -> |> List.map (fun catId ->
let cat = cats |> Array.find (fun c -> c.Id = CategoryId.toString catId) let cat = cats |> Array.find (fun c -> c.Id = CategoryId.toString catId)
SyndicationCategory (cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name)) SyndicationCategory (cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name))
post.tags post.Tags
|> List.map (fun tag -> |> List.map (fun tag ->
let urlTag = let urlTag =
match tagMaps |> List.tryFind (fun tm -> tm.tag = tag) with match tagMaps |> List.tryFind (fun tm -> tm.Tag = tag) with
| Some tm -> tm.urlValue | Some tm -> tm.UrlValue
| None -> tag.Replace (" ", "+") | None -> tag.Replace (" ", "+")
SyndicationCategory (tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)")) SyndicationCategory (tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)"))
] ]
@ -137,19 +137,19 @@ let toAbsolute webLog (link : string) =
/// Add episode information to a podcast feed item /// Add episode information to a podcast feed item
let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (post : Post) (item : SyndicationItem) = let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (post : Post) (item : SyndicationItem) =
let epMediaUrl = let epMediaUrl =
match episode.media with match episode.Media with
| link when link.StartsWith "http" -> link | link when link.StartsWith "http" -> link
| link when Option.isSome podcast.mediaBaseUrl -> $"{podcast.mediaBaseUrl.Value}{link}" | link when Option.isSome podcast.MediaBaseUrl -> $"{podcast.MediaBaseUrl.Value}{link}"
| link -> WebLog.absoluteUrl webLog (Permalink link) | link -> WebLog.absoluteUrl webLog (Permalink link)
let epMediaType = [ episode.mediaType; podcast.defaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
let epImageUrl = defaultArg episode.imageUrl (Permalink.toString podcast.imageUrl) |> toAbsolute webLog let epImageUrl = defaultArg episode.ImageUrl (Permalink.toString podcast.ImageUrl) |> toAbsolute webLog
let epExplicit = defaultArg episode.explicit podcast.explicit |> ExplicitRating.toString let epExplicit = defaultArg episode.Explicit podcast.Explicit |> ExplicitRating.toString
let xmlDoc = XmlDocument () let xmlDoc = XmlDocument ()
let enclosure = let enclosure =
let it = xmlDoc.CreateElement "enclosure" let it = xmlDoc.CreateElement "enclosure"
it.SetAttribute ("url", epMediaUrl) it.SetAttribute ("url", epMediaUrl)
it.SetAttribute ("length", string episode.length) it.SetAttribute ("length", string episode.Length)
epMediaType |> Option.iter (fun typ -> it.SetAttribute ("type", typ)) epMediaType |> Option.iter (fun typ -> it.SetAttribute ("type", typ))
it it
let image = let image =
@ -159,18 +159,18 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
item.ElementExtensions.Add enclosure item.ElementExtensions.Add enclosure
item.ElementExtensions.Add image item.ElementExtensions.Add image
item.ElementExtensions.Add ("creator", Namespace.dc, podcast.displayedAuthor) item.ElementExtensions.Add ("creator", Namespace.dc, podcast.DisplayedAuthor)
item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.displayedAuthor) item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor)
item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit) item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit)
episode.subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it)) episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it))
episode.duration episode.Duration
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.ToString """hh\:mm\:ss""")) |> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.ToString """hh\:mm\:ss"""))
match episode.chapterFile with match episode.ChapterFile with
| Some chapters -> | Some chapters ->
let url = toAbsolute webLog chapters let url = toAbsolute webLog chapters
let typ = let typ =
match episode.chapterType with match episode.ChapterType with
| Some mime -> Some mime | Some mime -> Some mime
| None when chapters.EndsWith ".json" -> Some "application/json+chapters" | None when chapters.EndsWith ".json" -> Some "application/json+chapters"
| None -> None | None -> None
@ -180,21 +180,21 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
item.ElementExtensions.Add elt item.ElementExtensions.Add elt
| None -> () | None -> ()
match episode.transcriptUrl with match episode.TranscriptUrl with
| Some transcript -> | Some transcript ->
let url = toAbsolute webLog transcript let url = toAbsolute webLog transcript
let elt = xmlDoc.CreateElement ("podcast", "transcript", Namespace.podcast) let elt = xmlDoc.CreateElement ("podcast", "transcript", Namespace.podcast)
elt.SetAttribute ("url", url) elt.SetAttribute ("url", url)
elt.SetAttribute ("type", Option.get episode.transcriptType) elt.SetAttribute ("type", Option.get episode.TranscriptType)
episode.transcriptLang |> Option.iter (fun it -> elt.SetAttribute ("language", it)) episode.TranscriptLang |> Option.iter (fun it -> elt.SetAttribute ("language", it))
if defaultArg episode.transcriptCaptions false then if defaultArg episode.TranscriptCaptions false then
elt.SetAttribute ("rel", "captions") elt.SetAttribute ("rel", "captions")
item.ElementExtensions.Add elt item.ElementExtensions.Add elt
| None -> () | None -> ()
match episode.seasonNumber with match episode.SeasonNumber with
| Some season -> | Some season ->
match episode.seasonDescription with match episode.SeasonDescription with
| Some desc -> | Some desc ->
let elt = xmlDoc.CreateElement ("podcast", "season", Namespace.podcast) let elt = xmlDoc.CreateElement ("podcast", "season", Namespace.podcast)
elt.SetAttribute ("name", desc) elt.SetAttribute ("name", desc)
@ -203,9 +203,9 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
| None -> item.ElementExtensions.Add ("season", Namespace.podcast, string season) | None -> item.ElementExtensions.Add ("season", Namespace.podcast, string season)
| None -> () | None -> ()
match episode.episodeNumber with match episode.EpisodeNumber with
| Some epNumber -> | Some epNumber ->
match episode.episodeDescription with match episode.EpisodeDescription with
| Some desc -> | Some desc ->
let elt = xmlDoc.CreateElement ("podcast", "episode", Namespace.podcast) let elt = xmlDoc.CreateElement ("podcast", "episode", Namespace.podcast)
elt.SetAttribute ("name", desc) elt.SetAttribute ("name", desc)
@ -214,15 +214,15 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
| None -> item.ElementExtensions.Add ("episode", Namespace.podcast, string epNumber) | None -> item.ElementExtensions.Add ("episode", Namespace.podcast, string epNumber)
| None -> () | None -> ()
if post.metadata |> List.exists (fun it -> it.name = "chapter") then if post.Metadata |> List.exists (fun it -> it.Name = "chapter") then
try try
let chapters = xmlDoc.CreateElement ("psc", "chapters", Namespace.psc) let chapters = xmlDoc.CreateElement ("psc", "chapters", Namespace.psc)
chapters.SetAttribute ("version", "1.2") chapters.SetAttribute ("version", "1.2")
post.metadata post.Metadata
|> List.filter (fun it -> it.name = "chapter") |> List.filter (fun it -> it.Name = "chapter")
|> List.map (fun it -> |> List.map (fun it ->
TimeSpan.Parse (it.value.Split(" ")[0]), it.value.Substring (it.value.IndexOf(" ") + 1)) TimeSpan.Parse (it.Value.Split(" ")[0]), it.Value.Substring (it.Value.IndexOf(" ") + 1))
|> List.sortBy fst |> List.sortBy fst
|> List.iter (fun chap -> |> List.iter (fun chap ->
let chapter = xmlDoc.CreateElement ("psc", "chapter", Namespace.psc) let chapter = xmlDoc.CreateElement ("psc", "chapter", Namespace.psc)
@ -247,12 +247,12 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
child.InnerText <- value child.InnerText <- value
elt elt
let podcast = Option.get feed.podcast let podcast = Option.get feed.Podcast
let feedUrl = WebLog.absoluteUrl webLog feed.path let feedUrl = WebLog.absoluteUrl webLog feed.Path
let imageUrl = let imageUrl =
match podcast.imageUrl with match podcast.ImageUrl with
| Permalink link when link.StartsWith "http" -> link | Permalink link when link.StartsWith "http" -> link
| Permalink _ -> WebLog.absoluteUrl webLog podcast.imageUrl | Permalink _ -> WebLog.absoluteUrl webLog podcast.ImageUrl
let xmlDoc = XmlDocument () let xmlDoc = XmlDocument ()
@ -266,15 +266,15 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
let categorization = let categorization =
let it = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes) let it = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
it.SetAttribute ("text", podcast.iTunesCategory) it.SetAttribute ("text", podcast.AppleCategory)
podcast.iTunesSubcategory podcast.AppleSubcategory
|> Option.iter (fun subCat -> |> Option.iter (fun subCat ->
let subCatElt = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes) let subCatElt = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
subCatElt.SetAttribute ("text", subCat) subCatElt.SetAttribute ("text", subCat)
it.AppendChild subCatElt |> ignore) it.AppendChild subCatElt |> ignore)
it it
let image = let image =
[ "title", podcast.title [ "title", podcast.Title
"url", imageUrl "url", imageUrl
"link", feedUrl "link", feedUrl
] ]
@ -284,8 +284,8 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
it.SetAttribute ("href", imageUrl) it.SetAttribute ("href", imageUrl)
it it
let owner = let owner =
[ "name", podcast.displayedAuthor [ "name", podcast.DisplayedAuthor
"email", podcast.email "email", podcast.Email
] ]
|> List.fold (fun elt (name, value) -> addChild xmlDoc Namespace.iTunes "itunes" name value elt) |> List.fold (fun elt (name, value) -> addChild xmlDoc Namespace.iTunes "itunes" name value elt)
(xmlDoc.CreateElement ("itunes", "owner", Namespace.iTunes)) (xmlDoc.CreateElement ("itunes", "owner", Namespace.iTunes))
@ -300,62 +300,62 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
rssFeed.ElementExtensions.Add categorization rssFeed.ElementExtensions.Add categorization
rssFeed.ElementExtensions.Add iTunesImage rssFeed.ElementExtensions.Add iTunesImage
rssFeed.ElementExtensions.Add rawVoice rssFeed.ElementExtensions.Add rawVoice
rssFeed.ElementExtensions.Add ("summary", Namespace.iTunes, podcast.summary) rssFeed.ElementExtensions.Add ("summary", Namespace.iTunes, podcast.Summary)
rssFeed.ElementExtensions.Add ("author", Namespace.iTunes, podcast.displayedAuthor) rssFeed.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor)
rssFeed.ElementExtensions.Add ("explicit", Namespace.iTunes, ExplicitRating.toString podcast.explicit) rssFeed.ElementExtensions.Add ("explicit", Namespace.iTunes, ExplicitRating.toString podcast.Explicit)
podcast.subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub)) podcast.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub))
podcast.fundingUrl podcast.FundingUrl
|> Option.iter (fun url -> |> Option.iter (fun url ->
let funding = xmlDoc.CreateElement ("podcast", "funding", Namespace.podcast) let funding = xmlDoc.CreateElement ("podcast", "funding", Namespace.podcast)
funding.SetAttribute ("url", toAbsolute webLog url) funding.SetAttribute ("url", toAbsolute webLog url)
funding.InnerText <- defaultArg podcast.fundingText "Support This Podcast" funding.InnerText <- defaultArg podcast.FundingText "Support This Podcast"
rssFeed.ElementExtensions.Add funding) rssFeed.ElementExtensions.Add funding)
podcast.guid podcast.PodcastGuid
|> Option.iter (fun guid -> |> Option.iter (fun guid ->
rssFeed.ElementExtensions.Add ("guid", Namespace.podcast, guid.ToString().ToLowerInvariant ())) rssFeed.ElementExtensions.Add ("guid", Namespace.podcast, guid.ToString().ToLowerInvariant ()))
podcast.medium podcast.Medium
|> Option.iter (fun med -> rssFeed.ElementExtensions.Add ("medium", Namespace.podcast, PodcastMedium.toString med)) |> Option.iter (fun med -> rssFeed.ElementExtensions.Add ("medium", Namespace.podcast, PodcastMedium.toString med))
/// Get the feed's self reference and non-feed link /// Get the feed's self reference and non-feed link
let private selfAndLink webLog feedType ctx = let private selfAndLink webLog feedType ctx =
let withoutFeed (it : string) = Permalink (it.Replace ($"/{webLog.rss.feedName}", "")) let withoutFeed (it : string) = Permalink (it.Replace ($"/{webLog.Rss.FeedName}", ""))
match feedType with match feedType with
| StandardFeed path | StandardFeed path
| CategoryFeed (_, path) | CategoryFeed (_, path)
| TagFeed (_, path) -> Permalink path[1..], withoutFeed path | TagFeed (_, path) -> Permalink path[1..], withoutFeed path
| Custom (feed, _) -> | Custom (feed, _) ->
match feed.source with match feed.Source with
| Category (CategoryId catId) -> | Category (CategoryId catId) ->
feed.path, Permalink $"category/{(CategoryCache.get ctx |> Array.find (fun c -> c.Id = catId)).Slug}" feed.Path, Permalink $"category/{(CategoryCache.get ctx |> Array.find (fun c -> c.Id = catId)).Slug}"
| Tag tag -> feed.path, Permalink $"""tag/{tag.Replace(" ", "+")}/""" | Tag tag -> feed.Path, Permalink $"""tag/{tag.Replace(" ", "+")}/"""
/// Set the title and description of the feed based on its source /// Set the title and description of the feed based on its source
let private setTitleAndDescription feedType (webLog : WebLog) (cats : DisplayCategory[]) (feed : SyndicationFeed) = let private setTitleAndDescription feedType (webLog : WebLog) (cats : DisplayCategory[]) (feed : SyndicationFeed) =
let cleanText opt def = TextSyndicationContent (stripHtml (defaultArg opt def)) let cleanText opt def = TextSyndicationContent (stripHtml (defaultArg opt def))
match feedType with match feedType with
| StandardFeed _ -> | StandardFeed _ ->
feed.Title <- cleanText None webLog.name feed.Title <- cleanText None webLog.Name
feed.Description <- cleanText webLog.subtitle webLog.name feed.Description <- cleanText webLog.Subtitle webLog.Name
| CategoryFeed (CategoryId catId, _) -> | CategoryFeed (CategoryId catId, _) ->
let cat = cats |> Array.find (fun it -> it.Id = catId) let cat = cats |> Array.find (fun it -> it.Id = catId)
feed.Title <- cleanText None $"""{webLog.name} - "{stripHtml cat.Name}" Category""" feed.Title <- cleanText None $"""{webLog.Name} - "{stripHtml cat.Name}" Category"""
feed.Description <- cleanText cat.Description $"""Posts categorized under "{cat.Name}" """ feed.Description <- cleanText cat.Description $"""Posts categorized under "{cat.Name}" """
| TagFeed (tag, _) -> | TagFeed (tag, _) ->
feed.Title <- cleanText None $"""{webLog.name} - "{tag}" Tag""" feed.Title <- cleanText None $"""{webLog.Name} - "{tag}" Tag"""
feed.Description <- cleanText None $"""Posts with the "{tag}" tag""" feed.Description <- cleanText None $"""Posts with the "{tag}" tag"""
| Custom (custom, _) -> | Custom (custom, _) ->
match custom.podcast with match custom.Podcast with
| Some podcast -> | Some podcast ->
feed.Title <- cleanText None podcast.title feed.Title <- cleanText None podcast.Title
feed.Description <- cleanText podcast.subtitle podcast.title feed.Description <- cleanText podcast.Subtitle podcast.Title
| None -> | None ->
match custom.source with match custom.Source with
| Category (CategoryId catId) -> | Category (CategoryId catId) ->
let cat = cats |> Array.find (fun it -> it.Id = catId) let cat = cats |> Array.find (fun it -> it.Id = catId)
feed.Title <- cleanText None $"""{webLog.name} - "{stripHtml cat.Name}" Category""" feed.Title <- cleanText None $"""{webLog.Name} - "{stripHtml cat.Name}" Category"""
feed.Description <- cleanText cat.Description $"""Posts categorized under "{cat.Name}" """ feed.Description <- cleanText cat.Description $"""Posts categorized under "{cat.Name}" """
| Tag tag -> | Tag tag ->
feed.Title <- cleanText None $"""{webLog.name} - "{tag}" Tag""" feed.Title <- cleanText None $"""{webLog.Name} - "{tag}" Tag"""
feed.Description <- cleanText None $"""Posts with the "{tag}" tag""" feed.Description <- cleanText None $"""Posts with the "{tag}" tag"""
/// Create a feed with a known non-zero-length list of posts /// Create a feed with a known non-zero-length list of posts
@ -365,15 +365,15 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
let! authors = getAuthors webLog posts data let! authors = getAuthors webLog posts data
let! tagMaps = getTagMappings webLog posts data let! tagMaps = getTagMappings webLog posts data
let cats = CategoryCache.get ctx let cats = CategoryCache.get ctx
let podcast = match feedType with Custom (feed, _) when Option.isSome feed.podcast -> Some feed | _ -> None let podcast = match feedType with Custom (feed, _) when Option.isSome feed.Podcast -> Some feed | _ -> None
let self, link = selfAndLink webLog feedType ctx let self, link = selfAndLink webLog feedType ctx
let toItem post = let toItem post =
let item = toFeedItem webLog authors cats tagMaps post let item = toFeedItem webLog authors cats tagMaps post
match podcast, post.episode with match podcast, post.Episode with
| Some feed, Some episode -> addEpisode webLog (Option.get feed.podcast) episode post item | Some feed, Some episode -> addEpisode webLog (Option.get feed.Podcast) episode post item
| Some _, _ -> | Some _, _ ->
warn "Feed" ctx $"[{webLog.name} {Permalink.toString self}] \"{stripHtml post.title}\" has no media" warn "Feed" ctx $"[{webLog.Name} {Permalink.toString self}] \"{stripHtml post.Title}\" has no media"
item item
| _ -> item | _ -> item
@ -381,12 +381,12 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
addNamespace feed "content" Namespace.content addNamespace feed "content" Namespace.content
setTitleAndDescription feedType webLog cats feed setTitleAndDescription feedType webLog cats feed
feed.LastUpdatedTime <- (List.head posts).updatedOn |> DateTimeOffset feed.LastUpdatedTime <- (List.head posts).UpdatedOn |> DateTimeOffset
feed.Generator <- ctx.Generator feed.Generator <- ctx.Generator
feed.Items <- posts |> Seq.ofList |> Seq.map toItem feed.Items <- posts |> Seq.ofList |> Seq.map toItem
feed.Language <- "en" feed.Language <- "en"
feed.Id <- WebLog.absoluteUrl webLog link feed.Id <- WebLog.absoluteUrl webLog link
webLog.rss.copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy) webLog.Rss.Copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy)
feed.Links.Add (SyndicationLink (Uri (WebLog.absoluteUrl webLog self), "self", "", "application/rss+xml", 0L)) feed.Links.Add (SyndicationLink (Uri (WebLog.absoluteUrl webLog self), "self", "", "application/rss+xml", 0L))
feed.ElementExtensions.Add ("link", "", WebLog.absoluteUrl webLog link) feed.ElementExtensions.Add ("link", "", WebLog.absoluteUrl webLog link)
@ -419,24 +419,24 @@ open DotLiquid
// GET: /admin/settings/rss // GET: /admin/settings/rss
let editSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> let editSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let feeds = let feeds =
ctx.WebLog.rss.customFeeds ctx.WebLog.Rss.CustomFeeds
|> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx)) |> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx))
|> Array.ofList |> Array.ofList
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
page_title = "RSS Settings" page_title = "RSS Settings"
csrf = ctx.CsrfTokenSet csrf = ctx.CsrfTokenSet
model = EditRssModel.fromRssOptions ctx.WebLog.rss model = EditRssModel.fromRssOptions ctx.WebLog.Rss
custom_feeds = feeds custom_feeds = feeds
|} |}
|> viewForTheme "admin" "rss-settings" next ctx |> adminView "rss-settings" next ctx
// POST: /admin/settings/rss // POST: /admin/settings/rss
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
let! model = ctx.BindFormAsync<EditRssModel> () let! model = ctx.BindFormAsync<EditRssModel> ()
match! data.WebLog.FindById ctx.WebLog.id with match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog -> | Some webLog ->
let webLog = { webLog with rss = model.updateOptions webLog.rss } let webLog = { webLog with Rss = model.UpdateOptions webLog.Rss }
do! data.WebLog.UpdateRssOptions webLog do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog WebLogCache.set webLog
do! addMessage ctx { UserMessage.success with Message = "RSS settings updated successfully" } do! addMessage ctx { UserMessage.success with Message = "RSS settings updated successfully" }
@ -448,8 +448,8 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let customFeed = let customFeed =
match feedId with match feedId with
| "new" -> Some { CustomFeed.empty with id = CustomFeedId "new" } | "new" -> Some { CustomFeed.empty with Id = CustomFeedId "new" }
| _ -> ctx.WebLog.rss.customFeeds |> List.tryFind (fun f -> f.id = CustomFeedId feedId) | _ -> ctx.WebLog.Rss.CustomFeeds |> List.tryFind (fun f -> f.Id = CustomFeedId feedId)
match customFeed with match customFeed with
| Some f -> | Some f ->
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
@ -468,30 +468,30 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
KeyValuePair.Create (PodcastMedium.toString Blog, "Blog") KeyValuePair.Create (PodcastMedium.toString Blog, "Blog")
|] |]
|} |}
|> viewForTheme "admin" "custom-feed-edit" next ctx |> adminView "custom-feed-edit" next ctx
| None -> Error.notFound next ctx | None -> Error.notFound next ctx
// POST: /admin/settings/rss/save // POST: /admin/settings/rss/save
let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
match! data.WebLog.FindById ctx.WebLog.id with match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog -> | Some webLog ->
let! model = ctx.BindFormAsync<EditCustomFeedModel> () let! model = ctx.BindFormAsync<EditCustomFeedModel> ()
let theFeed = let theFeed =
match model.Id with match model.Id with
| "new" -> Some { CustomFeed.empty with id = CustomFeedId.create () } | "new" -> Some { CustomFeed.empty with Id = CustomFeedId.create () }
| _ -> webLog.rss.customFeeds |> List.tryFind (fun it -> CustomFeedId.toString it.id = model.Id) | _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> CustomFeedId.toString it.Id = model.Id)
match theFeed with match theFeed with
| Some feed -> | Some feed ->
let feeds = model.updateFeed feed :: (webLog.rss.customFeeds |> List.filter (fun it -> it.id <> feed.id)) let feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun it -> it.Id <> feed.Id))
let webLog = { webLog with rss = { webLog.rss with customFeeds = feeds } } let webLog = { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
do! data.WebLog.UpdateRssOptions webLog do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog WebLogCache.set webLog
do! addMessage ctx { do! addMessage ctx {
UserMessage.success with UserMessage.success with
Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed""" Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed"""
} }
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
| 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 // POST /admin/settings/rss/{id}/delete
let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
match! data.WebLog.FindById ctx.WebLog.id with match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog -> | Some webLog ->
let customId = CustomFeedId feedId let customId = CustomFeedId feedId
if webLog.rss.customFeeds |> List.exists (fun f -> f.id = customId) then if webLog.Rss.CustomFeeds |> List.exists (fun f -> f.Id = customId) then
let webLog = { let webLog = {
webLog with webLog with
rss = { Rss = {
webLog.rss with webLog.Rss with
customFeeds = webLog.rss.customFeeds |> List.filter (fun f -> f.id <> customId) CustomFeeds = webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> customId)
} }
} }
do! data.WebLog.UpdateRssOptions webLog do! data.WebLog.UpdateRssOptions webLog

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

@ -58,7 +58,7 @@ open DotLiquid
/// Add a key to the hash, returning the modified hash /// 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) // (note that the hash itself is mutated; this is only used to make it pipeable)
let addToHash key (value : obj) (hash : Hash) = 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 hash
open System.Security.Claims open System.Security.Claims
@ -101,11 +101,11 @@ let isHtmx (ctx : HttpContext) =
ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
/// Render a view for the specified theme, using the specified template, layout, and hash /// Render a view for the specified theme, using the specified template, layout, and hash
let viewForTheme theme template next ctx (hash : Hash) = task { let viewForTheme themeId template next ctx (hash : Hash) = task {
if not (hash.ContainsKey "web_log") then if not (hash.ContainsKey "htmx_script") then
let! _ = populateHash hash ctx 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; // NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render;
// the net effect is a "layout" capability similar to Razor or Pug // the net effect is a "layout" capability similar to Razor or Pug
@ -134,8 +134,9 @@ let messagesToHeaders (messages : UserMessage array) : HttpHandler =
|> Seq.reduce (>=>) |> Seq.reduce (>=>)
/// Render a bare view for the specified theme, using the specified template and hash /// Render a bare view for the specified theme, using the specified template and hash
let bareForTheme theme template next ctx (hash : Hash) = task { let bareForTheme themeId template next ctx (hash : Hash) = task {
let! hash = populateHash hash ctx let! hash = populateHash hash ctx
let (ThemeId theme) = themeId
if not (hash.ContainsKey "content") then if not (hash.ContainsKey "content") then
let! contentTemplate = TemplateCache.get theme template ctx.Data 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 /// Return a view for the web log's default theme
let themedView template next ctx hash = task { let themedView template next ctx hash = task {
let! hash = populateHash hash ctx 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 /// Redirect after doing some action; commits session and issues a temporary redirect
let redirectToGet url : HttpHandler = fun _ ctx -> task { 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) /// Get the templates available for the current web log's theme (in a key/value pair list)
let templatesForTheme (ctx : HttpContext) (typ : string) = backgroundTask { let templatesForTheme (ctx : HttpContext) (typ : string) = backgroundTask {
match! ctx.Data.Theme.FindByIdWithoutText (ThemeId ctx.WebLog.themePath) with match! ctx.Data.Theme.FindByIdWithoutText ctx.WebLog.ThemeId with
| Some theme -> | Some theme ->
return seq { return seq {
KeyValuePair.Create ("", $"- Default (single-{typ}) -") KeyValuePair.Create ("", $"- Default (single-{typ}) -")
yield! yield!
theme.templates theme.Templates
|> Seq.ofList |> Seq.ofList
|> Seq.filter (fun it -> it.name.EndsWith $"-{typ}" && it.name <> $"single-{typ}") |> Seq.filter (fun it -> it.Name.EndsWith $"-{typ}" && it.Name <> $"single-{typ}")
|> Seq.map (fun it -> KeyValuePair.Create (it.name, it.name)) |> Seq.map (fun it -> KeyValuePair.Create (it.Name, it.Name))
} }
|> Array.ofSeq |> Array.ofSeq
| None -> return [| KeyValuePair.Create ("", $"- Default (single-{typ}) -") |] | None -> return [| KeyValuePair.Create ("", $"- Default (single-{typ}) -") |]
@ -249,17 +257,17 @@ let templatesForTheme (ctx : HttpContext) (typ : string) = backgroundTask {
/// Get all authors for a list of posts as metadata items /// Get all authors for a list of posts as metadata items
let getAuthors (webLog : WebLog) (posts : Post list) (data : IData) = let getAuthors (webLog : WebLog) (posts : Post list) (data : IData) =
posts posts
|> List.map (fun p -> p.authorId) |> List.map (fun p -> p.AuthorId)
|> List.distinct |> List.distinct
|> data.WebLogUser.FindNames webLog.id |> data.WebLogUser.FindNames webLog.Id
/// Get all tag mappings for a list of posts as metadata items /// Get all tag mappings for a list of posts as metadata items
let getTagMappings (webLog : WebLog) (posts : Post list) (data : IData) = let getTagMappings (webLog : WebLog) (posts : Post list) (data : IData) =
posts posts
|> List.map (fun p -> p.tags) |> List.map (fun p -> p.Tags)
|> List.concat |> List.concat
|> List.distinct |> List.distinct
|> fun tags -> data.TagMap.FindMappingForTags tags webLog.id |> fun tags -> data.TagMap.FindMappingForTags tags webLog.Id
/// Get all category IDs for the given slug (includes owned subcategories) /// Get all category IDs for the given slug (includes owned subcategories)
let getCategoryIds slug ctx = let getCategoryIds slug ctx =

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

@ -9,7 +9,7 @@ open MyWebLog.ViewModels
// GET /admin/pages // GET /admin/pages
// GET /admin/pages/page/{pageNbr} // GET /admin/pages/page/{pageNbr}
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task { 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! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
page_title = "Pages" 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}" prev_page = if pageNbr = 2 then "" else $"/page/{pageNbr - 1}"
next_page = $"/page/{pageNbr + 1}" next_page = $"/page/{pageNbr + 1}"
|} |}
|> viewForTheme "admin" "page-list" next ctx |> adminView "page-list" next ctx
} }
// GET /admin/page/{id}/edit // GET /admin/page/{id}/edit
let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! result = task { let! result = task {
match pgId with 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) | Some page -> return Some ("Edit Page", page)
| None -> return None | None -> return None
} }
match result with 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 model = EditPageModel.fromPage page
let! templates = templatesForTheme ctx "page" let! templates = templatesForTheme ctx "page"
return! 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 |]) |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
templates = templates templates = templates
|} |}
|> viewForTheme "admin" "page-edit" next ctx |> adminView "page-edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// POST /admin/page/{id}/delete // POST /admin/page/{id}/delete
let delete pgId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { 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 -> | true ->
do! PageListCache.update ctx do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Page deleted successfully" } 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 // GET /admin/page/{id}/permalinks
let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx -> 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 when canEdit pg.authorId ctx -> | Some pg when canEdit pg.AuthorId ctx ->
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
page_title = "Manage Prior Permalinks" page_title = "Manage Prior Permalinks"
csrf = ctx.CsrfTokenSet csrf = ctx.CsrfTokenSet
model = ManagePermalinksModel.fromPage pg model = ManagePermalinksModel.fromPage pg
|} |}
|> viewForTheme "admin" "permalinks" next ctx |> adminView "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -79,10 +79,10 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task { let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel> () let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let pageId = PageId model.Id let pageId = PageId model.Id
match! ctx.Data.Page.FindById pageId ctx.WebLog.id with match! ctx.Data.Page.FindById pageId ctx.WebLog.Id with
| Some pg when canEdit pg.authorId ctx -> | Some pg when canEdit pg.AuthorId ctx ->
let links = model.Prior |> Array.map Permalink |> List.ofArray 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 -> | true ->
do! addMessage ctx { UserMessage.success with Message = "Page permalinks saved successfully" } do! addMessage ctx { UserMessage.success with Message = "Page permalinks saved successfully" }
return! redirectToGet $"admin/page/{model.Id}/permalinks" next ctx 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 // GET /admin/page/{id}/revisions
let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> 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 when canEdit pg.authorId ctx -> | Some pg when canEdit pg.AuthorId ctx ->
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
page_title = "Manage Page Revisions" page_title = "Manage Page Revisions"
csrf = ctx.CsrfTokenSet csrf = ctx.CsrfTokenSet
model = ManageRevisionsModel.fromPage ctx.WebLog pg model = ManageRevisionsModel.fromPage ctx.WebLog pg
|} |}
|> viewForTheme "admin" "revisions" next ctx |> adminView "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -109,9 +109,9 @@ let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
// GET /admin/page/{id}/revisions/purge // GET /admin/page/{id}/revisions/purge
let purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data 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 -> | 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" } do! addMessage ctx { UserMessage.success with Message = "Prior revisions purged successfully" }
return! redirectToGet $"admin/page/{pgId}/revisions" next ctx return! redirectToGet $"admin/page/{pgId}/revisions" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@ -121,22 +121,22 @@ open Microsoft.AspNetCore.Http
/// Find the page and the requested revision /// Find the page and the requested revision
let private findPageRevision pgId revDate (ctx : HttpContext) = task { 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 -> | Some pg ->
let asOf = parseToUtc revDate 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 | None -> return None, None
} }
// GET /admin/page/{id}/revision/{revision-date}/preview // GET /admin/page/{id}/revision/{revision-date}/preview
let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.authorId ctx -> | Some pg, Some rev when canEdit pg.AuthorId ctx ->
return! return!
Hash.FromAnonymousObject {| 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 | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | None, _
| _, None -> return! Error.notFound next ctx | _, None -> return! Error.notFound next ctx
@ -147,11 +147,11 @@ open System
// POST /admin/page/{id}/revision/{revision-date}/restore // POST /admin/page/{id}/revision/{revision-date}/restore
let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.authorId ctx -> | Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update do! ctx.Data.Page.Update
{ pg with { pg with
revisions = { rev with asOf = DateTime.UtcNow } Revisions = { rev with AsOf = DateTime.UtcNow }
:: (pg.revisions |> List.filter (fun r -> r.asOf <> rev.asOf)) :: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
} }
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" } do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/page/{pgId}/revisions" next ctx 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 // POST /admin/page/{id}/revision/{revision-date}/delete
let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.authorId ctx -> | Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update { pg with revisions = pg.revisions |> List.filter (fun r -> r.asOf <> rev.asOf) } do! ctx.Data.Page.Update { pg with Revisions = pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
do! addMessage ctx { UserMessage.success with Message = "Revision deleted successfully" } do! addMessage ctx { UserMessage.success with Message = "Revision deleted successfully" }
return! bareForTheme "admin" "" next ctx (Hash.FromAnonymousObject {| content = "" |}) return! adminBareView "" next ctx (Hash.FromAnonymousObject {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | None, _
| _, None -> return! Error.notFound next ctx | _, None -> return! Error.notFound next ctx
@ -187,43 +187,43 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
Task.FromResult ( Task.FromResult (
Some Some
{ Page.empty with { Page.empty with
id = PageId.create () Id = PageId.create ()
webLogId = ctx.WebLog.id WebLogId = ctx.WebLog.Id
authorId = ctx.UserId AuthorId = ctx.UserId
publishedOn = now PublishedOn = now
}) })
| pgId -> data.Page.FindFullById (PageId pgId) ctx.WebLog.id | pgId -> data.Page.FindFullById (PageId pgId) ctx.WebLog.Id
match! pg with match! pg with
| Some page when canEdit page.authorId ctx -> | Some page when canEdit page.AuthorId ctx ->
let updateList = page.showInPageList <> model.IsShownInPageList let updateList = page.IsInPageList <> model.IsShownInPageList
let revision = { asOf = now; text = MarkupText.parse $"{model.Source}: {model.Text}" } let revision = { AsOf = now; Text = MarkupText.parse $"{model.Source}: {model.Text}" }
// Detect a permalink change, and add the prior one to the prior list // Detect a permalink change, and add the prior one to the prior list
let page = let page =
match Permalink.toString page.permalink with match Permalink.toString page.Permalink with
| "" -> page | "" -> page
| link when link = model.Permalink -> page | link when link = model.Permalink -> page
| _ -> { page with priorPermalinks = page.permalink :: page.priorPermalinks } | _ -> { page with PriorPermalinks = page.Permalink :: page.PriorPermalinks }
let page = let page =
{ page with { page with
title = model.Title Title = model.Title
permalink = Permalink model.Permalink Permalink = Permalink model.Permalink
updatedOn = now UpdatedOn = now
showInPageList = model.IsShownInPageList IsInPageList = model.IsShownInPageList
template = match model.Template with "" -> None | tmpl -> Some tmpl Template = match model.Template with "" -> None | tmpl -> Some tmpl
text = MarkupText.toHtml revision.text Text = MarkupText.toHtml revision.Text
metadata = Seq.zip model.MetaNames model.MetaValues Metadata = Seq.zip model.MetaNames model.MetaValues
|> Seq.filter (fun it -> fst it > "") |> Seq.filter (fun it -> fst it > "")
|> Seq.map (fun it -> { name = fst it; value = snd it }) |> Seq.map (fun it -> { Name = fst it; Value = snd it })
|> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}") |> Seq.sortBy (fun it -> $"{it.Name.ToLower ()} {it.Value.ToLower ()}")
|> List.ofSeq |> List.ofSeq
revisions = match page.revisions |> List.tryHead with Revisions = match page.Revisions |> List.tryHead with
| Some r when r.text = revision.text -> page.revisions | Some r when r.Text = revision.Text -> page.Revisions
| _ -> revision :: page.revisions | _ -> revision :: page.Revisions
} }
do! (if model.PageId = "new" then data.Page.Add else data.Page.Update) page do! (if model.PageId = "new" then data.Page.Add else data.Page.Update) page
if updateList then do! PageListCache.update ctx if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Page saved successfully" } 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 | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound 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 fullPath = slugAndPage |> Seq.head
let slugPath = slugAndPage |> Seq.skip 1 |> Seq.head let slugPath = slugAndPage |> Seq.skip 1 |> Seq.head
let slugs, isFeed = let slugs, isFeed =
let feedName = $"/{webLog.rss.feedName}" let feedName = $"/{webLog.Rss.FeedName}"
let notBlank = Array.filter (fun it -> it <> "") let notBlank = Array.filter (fun it -> it <> "")
if ( (webLog.rss.categoryEnabled && fullPath.StartsWith "/category/") if ( (webLog.Rss.IsCategoryEnabled && fullPath.StartsWith "/category/")
|| (webLog.rss.tagEnabled && fullPath.StartsWith "/tag/" )) || (webLog.Rss.IsTagEnabled && fullPath.StartsWith "/tag/" ))
&& slugPath.EndsWith feedName then && slugPath.EndsWith feedName then
notBlank (slugPath.Replace(feedName, "").Split "/"), true notBlank (slugPath.Replace(feedName, "").Split "/"), true
else notBlank (slugPath.Split "/"), false else notBlank (slugPath.Split "/"), false
@ -54,14 +54,14 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (da
match listType with match listType with
| SinglePost -> | SinglePost ->
let post = List.head posts let post = List.head posts
let dateTime = defaultArg post.publishedOn post.updatedOn let dateTime = defaultArg post.PublishedOn post.UpdatedOn
data.Post.FindSurroundingPosts webLog.id dateTime data.Post.FindSurroundingPosts webLog.Id dateTime
| _ -> Task.FromResult (None, None) | _ -> Task.FromResult (None, None)
let newerLink = let newerLink =
match listType, pageNbr with match listType, pageNbr with
| SinglePost, _ -> newerPost |> Option.map (fun p -> Permalink.toString p.permalink) | SinglePost, _ -> newerPost |> Option.map (fun p -> Permalink.toString p.Permalink)
| _, 1 -> None | _, 1 -> None
| PostList, 2 when webLog.defaultPage = "posts" -> Some "" | PostList, 2 when webLog.DefaultPage = "posts" -> Some ""
| PostList, _ -> relUrl $"page/{pageNbr - 1}" | PostList, _ -> relUrl $"page/{pageNbr - 1}"
| CategoryList, 2 -> relUrl $"category/{url}/" | CategoryList, 2 -> relUrl $"category/{url}/"
| CategoryList, _ -> relUrl $"category/{url}/page/{pageNbr - 1}" | CategoryList, _ -> relUrl $"category/{url}/page/{pageNbr - 1}"
@ -71,7 +71,7 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (da
| AdminList, _ -> relUrl $"admin/posts/page/{pageNbr - 1}" | AdminList, _ -> relUrl $"admin/posts/page/{pageNbr - 1}"
let olderLink = let olderLink =
match listType, List.length posts > perPage with match listType, List.length posts > perPage with
| SinglePost, _ -> olderPost |> Option.map (fun p -> Permalink.toString p.permalink) | SinglePost, _ -> olderPost |> Option.map (fun p -> Permalink.toString p.Permalink)
| _, false -> None | _, false -> None
| PostList, true -> relUrl $"page/{pageNbr + 1}" | PostList, true -> relUrl $"page/{pageNbr + 1}"
| CategoryList, true -> relUrl $"category/{url}/page/{pageNbr + 1}" | CategoryList, true -> relUrl $"category/{url}/page/{pageNbr + 1}"
@ -82,9 +82,9 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (da
Authors = authors Authors = authors
Subtitle = None Subtitle = None
NewerLink = newerLink NewerLink = newerLink
NewerName = newerPost |> Option.map (fun p -> p.title) NewerName = newerPost |> Option.map (fun p -> p.Title)
OlderLink = olderLink OlderLink = olderLink
OlderName = olderPost |> Option.map (fun p -> p.title) OlderName = olderPost |> Option.map (fun p -> p.Title)
} }
return Hash.FromAnonymousObject {| return Hash.FromAnonymousObject {|
model = model model = model
@ -98,17 +98,17 @@ open Giraffe
// GET /page/{pageNbr} // GET /page/{pageNbr}
let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task { let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
let count = ctx.WebLog.postsPerPage let count = ctx.WebLog.PostsPerPage
let data = ctx.Data let data = ctx.Data
let! posts = data.Post.FindPageOfPublishedPosts ctx.WebLog.id pageNbr count let! posts = data.Post.FindPageOfPublishedPosts ctx.WebLog.Id pageNbr count
let! hash = preparePostList ctx.WebLog posts PostList "" pageNbr count ctx data let! hash = preparePostList ctx.WebLog posts PostList "" pageNbr count ctx data
let title = let title =
match pageNbr, ctx.WebLog.defaultPage with match pageNbr, ctx.WebLog.DefaultPage with
| 1, "posts" -> None | 1, "posts" -> None
| _, "posts" -> Some $"Page {pageNbr}" | _, "posts" -> Some $"Page {pageNbr}"
| _, _ -> Some $"Page {pageNbr} &laquo; Posts" | _, _ -> Some $"Page {pageNbr} &laquo; Posts"
match title with Some ttl -> hash.Add ("page_title", ttl) | None -> () 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 return! themedView "index" next ctx hash
} }
@ -125,14 +125,14 @@ let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task {
| Some pageNbr, slug, isFeed -> | Some pageNbr, slug, isFeed ->
match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.Slug = slug) with match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.Slug = slug) with
| Some cat when isFeed -> | Some cat when isFeed ->
return! Feed.generate (Feed.CategoryFeed ((CategoryId cat.Id), $"category/{slug}/{webLog.rss.feedName}")) return! Feed.generate (Feed.CategoryFeed ((CategoryId cat.Id), $"category/{slug}/{webLog.Rss.FeedName}"))
(defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx (defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage) next ctx
| Some cat -> | Some cat ->
// Category pages include posts in subcategories // Category pages include posts in subcategories
match! data.Post.FindPageOfCategorizedPosts webLog.id (getCategoryIds slug ctx) pageNbr webLog.postsPerPage match! data.Post.FindPageOfCategorizedPosts webLog.Id (getCategoryIds slug ctx) pageNbr webLog.PostsPerPage
with with
| posts when List.length posts > 0 -> | posts when List.length posts > 0 ->
let! hash = preparePostList webLog posts CategoryList cat.Slug pageNbr webLog.postsPerPage ctx data let! hash = preparePostList webLog posts CategoryList cat.Slug pageNbr webLog.PostsPerPage ctx data
let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>""" let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
return! return!
addToHash "page_title" $"{cat.Name}: Category Archive{pgTitle}" hash 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 -> | Some pageNbr, rawTag, isFeed ->
let urlTag = HttpUtility.UrlDecode rawTag let urlTag = HttpUtility.UrlDecode rawTag
let! tag = backgroundTask { let! tag = backgroundTask {
match! data.TagMap.FindByUrlValue urlTag webLog.id with match! data.TagMap.FindByUrlValue urlTag webLog.Id with
| Some m -> return m.tag | Some m -> return m.Tag
| None -> return urlTag | None -> return urlTag
} }
if isFeed then if isFeed then
return! Feed.generate (Feed.TagFeed (tag, $"tag/{rawTag}/{webLog.rss.feedName}")) return! Feed.generate (Feed.TagFeed (tag, $"tag/{rawTag}/{webLog.Rss.FeedName}"))
(defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx (defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage) next ctx
else else
match! data.Post.FindPageOfTaggedPosts webLog.id tag pageNbr webLog.postsPerPage with match! data.Post.FindPageOfTaggedPosts webLog.Id tag pageNbr webLog.PostsPerPage with
| posts when List.length posts > 0 -> | posts when List.length posts > 0 ->
let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.postsPerPage ctx data let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.PostsPerPage ctx data
let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>""" let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
return! return!
addToHash "page_title" $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}" hash 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 // Other systems use hyphens for spaces; redirect if this is an old tag link
| _ -> | _ ->
let spacedTag = tag.Replace ("-", " ") let spacedTag = tag.Replace ("-", " ")
match! data.Post.FindPageOfTaggedPosts webLog.id spacedTag pageNbr 1 with match! data.Post.FindPageOfTaggedPosts webLog.Id spacedTag pageNbr 1 with
| posts when List.length posts > 0 -> | posts when List.length posts > 0 ->
let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}" let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}"
return! return!
@ -192,19 +192,19 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
// GET / // GET /
let home : HttpHandler = fun next ctx -> task { let home : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog let webLog = ctx.WebLog
match webLog.defaultPage with match webLog.DefaultPage with
| "posts" -> return! pageOfPosts 1 next ctx | "posts" -> return! pageOfPosts 1 next ctx
| pageId -> | pageId ->
match! ctx.Data.Page.FindById (PageId pageId) webLog.id with match! ctx.Data.Page.FindById (PageId pageId) webLog.Id with
| Some page -> | Some page ->
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
page_title = page.title page_title = page.Title
page = DisplayPage.fromPage webLog page page = DisplayPage.fromPage webLog page
categories = CategoryCache.get ctx categories = CategoryCache.get ctx
is_home = true 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 | None -> return! Error.notFound next ctx
} }
@ -212,12 +212,12 @@ let home : HttpHandler = fun next ctx -> task {
// GET /admin/posts/page/{pageNbr} // GET /admin/posts/page/{pageNbr}
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task { let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
let! posts = data.Post.FindPageOfPosts ctx.WebLog.id pageNbr 25 let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25
let! hash = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 ctx data let! hash = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 ctx data
return! return!
addToHash "page_title" "Posts" hash addToHash "page_title" "Posts" hash
|> addToHash "csrf" ctx.CsrfTokenSet |> addToHash "csrf" ctx.CsrfTokenSet
|> viewForTheme "admin" "post-list" next ctx |> adminView "post-list" next ctx
} }
// GET /admin/post/{id}/edit // GET /admin/post/{id}/edit
@ -225,15 +225,15 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
let! result = task { let! result = task {
match postId with match postId with
| "new" -> return Some ("Write a New Post", { Post.empty with id = PostId "new" }) | "new" -> return Some ("Write a New Post", { Post.empty with Id = PostId "new" })
| _ -> | _ ->
match! data.Post.FindFullById (PostId postId) ctx.WebLog.id with match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post -> return Some ("Edit Post", post) | Some post -> return Some ("Edit Post", post)
| None -> return None | None -> return None
} }
match result with match result with
| Some (title, post) when canEdit post.authorId ctx -> | Some (title, post) when canEdit post.AuthorId ctx ->
let! cats = data.Category.FindAllForView ctx.WebLog.id let! cats = data.Category.FindAllForView ctx.WebLog.Id
let! templates = templatesForTheme ctx "post" let! templates = templatesForTheme ctx "post"
let model = EditPostModel.fromPost ctx.WebLog post let model = EditPostModel.fromPost ctx.WebLog post
return! return!
@ -252,14 +252,14 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
KeyValuePair.Create (ExplicitRating.toString Clean, "Clean") KeyValuePair.Create (ExplicitRating.toString Clean, "Clean")
|] |]
|} |}
|> viewForTheme "admin" "post-edit" next ctx |> adminView "post-edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// POST /admin/post/{id}/delete // POST /admin/post/{id}/delete
let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { 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" } | true -> do! addMessage ctx { UserMessage.success with Message = "Post deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with Message = "Post not found; nothing deleted" } | false -> do! addMessage ctx { UserMessage.error with Message = "Post not found; nothing deleted" }
return! redirectToGet "admin/posts" next ctx return! redirectToGet "admin/posts" next ctx
@ -267,15 +267,15 @@ let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
// GET /admin/post/{id}/permalinks // GET /admin/post/{id}/permalinks
let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.id with match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.authorId ctx -> | Some post when canEdit post.AuthorId ctx ->
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
page_title = "Manage Prior Permalinks" page_title = "Manage Prior Permalinks"
csrf = ctx.CsrfTokenSet csrf = ctx.CsrfTokenSet
model = ManagePermalinksModel.fromPost post model = ManagePermalinksModel.fromPost post
|} |}
|> viewForTheme "admin" "permalinks" next ctx |> adminView "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -284,10 +284,10 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx
let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task { let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel> () let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let postId = PostId model.Id let postId = PostId model.Id
match! ctx.Data.Post.FindById postId ctx.WebLog.id with match! ctx.Data.Post.FindById postId ctx.WebLog.Id with
| Some post when canEdit post.authorId ctx -> | Some post when canEdit post.AuthorId ctx ->
let links = model.Prior |> Array.map Permalink |> List.ofArray 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 -> | true ->
do! addMessage ctx { UserMessage.success with Message = "Post permalinks saved successfully" } do! addMessage ctx { UserMessage.success with Message = "Post permalinks saved successfully" }
return! redirectToGet $"admin/post/{model.Id}/permalinks" next ctx 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 // GET /admin/post/{id}/revisions
let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.id with match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.authorId ctx -> | Some post when canEdit post.AuthorId ctx ->
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
page_title = "Manage Post Revisions" page_title = "Manage Post Revisions"
csrf = ctx.CsrfTokenSet csrf = ctx.CsrfTokenSet
model = ManageRevisionsModel.fromPost ctx.WebLog post model = ManageRevisionsModel.fromPost ctx.WebLog post
|} |}
|> viewForTheme "admin" "revisions" next ctx |> adminView "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -314,9 +314,9 @@ let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -
// GET /admin/post/{id}/revisions/purge // GET /admin/post/{id}/revisions/purge
let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
match! data.Post.FindFullById (PostId postId) ctx.WebLog.id with match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.authorId ctx -> | Some post when canEdit post.AuthorId ctx ->
do! data.Post.Update { post with revisions = [ List.head post.revisions ] } do! data.Post.Update { post with Revisions = [ List.head post.Revisions ] }
do! addMessage ctx { UserMessage.success with Message = "Prior revisions purged successfully" } do! addMessage ctx { UserMessage.success with Message = "Prior revisions purged successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
@ -327,22 +327,22 @@ open Microsoft.AspNetCore.Http
/// Find the post and the requested revision /// Find the post and the requested revision
let private findPostRevision postId revDate (ctx : HttpContext) = task { 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 -> | Some post ->
let asOf = parseToUtc revDate 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 | None -> return None, None
} }
// GET /admin/post/{id}/revision/{revision-date}/preview // GET /admin/post/{id}/revision/{revision-date}/preview
let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.authorId ctx -> | Some post, Some rev when canEdit post.AuthorId ctx ->
return! return!
Hash.FromAnonymousObject {| 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 | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | None, _
| _, None -> return! Error.notFound next ctx | _, 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 // POST /admin/post/{id}/revision/{revision-date}/restore
let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.authorId ctx -> | Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update do! ctx.Data.Post.Update
{ post with { post with
revisions = { rev with asOf = DateTime.UtcNow } Revisions = { rev with AsOf = DateTime.UtcNow }
:: (post.revisions |> List.filter (fun r -> r.asOf <> rev.asOf)) :: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
} }
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" } do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx 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 // POST /admin/post/{id}/revision/{revision-date}/delete
let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.authorId ctx -> | Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update { post with revisions = post.revisions |> List.filter (fun r -> r.asOf <> rev.asOf) } do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
do! addMessage ctx { UserMessage.success with Message = "Revision deleted successfully" } do! addMessage ctx { UserMessage.success with Message = "Revision deleted successfully" }
return! bareForTheme "admin" "" next ctx (Hash.FromAnonymousObject {| content = "" |}) return! adminBareView "" next ctx (Hash.FromAnonymousObject {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | None, _
| _, None -> return! Error.notFound next ctx | _, None -> return! Error.notFound next ctx
@ -388,43 +388,43 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
Task.FromResult ( Task.FromResult (
Some Some
{ Post.empty with { Post.empty with
id = PostId.create () Id = PostId.create ()
webLogId = ctx.WebLog.id WebLogId = ctx.WebLog.Id
authorId = ctx.UserId 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 match! tryPost with
| Some post when canEdit post.authorId ctx -> | Some post when canEdit post.AuthorId ctx ->
let priorCats = post.categoryIds let priorCats = post.CategoryIds
let revision = { asOf = now; text = MarkupText.parse $"{model.Source}: {model.Text}" } let revision = { AsOf = now; Text = MarkupText.parse $"{model.Source}: {model.Text}" }
// Detect a permalink change, and add the prior one to the prior list // Detect a permalink change, and add the prior one to the prior list
let post = let post =
match Permalink.toString post.permalink with match Permalink.toString post.Permalink with
| "" -> post | "" -> post
| link when link = model.Permalink -> post | link when link = model.Permalink -> post
| _ -> { post with priorPermalinks = post.permalink :: post.priorPermalinks } | _ -> { post with PriorPermalinks = post.Permalink :: post.PriorPermalinks }
let post = model.updatePost post revision now let post = model.UpdatePost post revision now
let post = let post =
if model.SetPublished then if model.SetPublished then
let dt = parseToUtc (model.PubOverride.Value.ToString "o") let dt = parseToUtc (model.PubOverride.Value.ToString "o")
if model.SetUpdated then if model.SetUpdated then
{ post with { post with
publishedOn = Some dt PublishedOn = Some dt
updatedOn = dt UpdatedOn = dt
revisions = [ { (List.head post.revisions) with asOf = dt } ] Revisions = [ { (List.head post.Revisions) with AsOf = dt } ]
} }
else { post with publishedOn = Some dt } else { post with PublishedOn = Some dt }
else post else post
do! (if model.PostId = "new" then data.Post.Add else data.Post.Update) 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 the post was published or its categories changed, refresh the category cache
if model.DoPublish if model.DoPublish
|| not (priorCats || not (priorCats
|> List.append post.categoryIds |> List.append post.CategoryIds
|> List.distinct |> List.distinct
|> List.length = List.length priorCats) then |> List.length = List.length priorCats) then
do! CategoryCache.update ctx do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Post saved successfully" } 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 | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound 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) if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.empty)
let permalink = Permalink (textLink.Substring 1) let permalink = Permalink (textLink.Substring 1)
// Current post // Current post
match data.Post.FindByPermalink permalink webLog.id |> await with match data.Post.FindByPermalink permalink webLog.Id |> await with
| Some post -> | Some post ->
debug (fun () -> "Found post by permalink") debug (fun () -> "Found post by permalink")
let model = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 ctx data |> await let model = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 ctx data |> await
model.Add ("page_title", post.title) model.Add ("page_title", post.Title)
yield fun next ctx -> themedView (defaultArg post.template "single-post") next ctx model yield fun next ctx -> themedView (defaultArg post.Template "single-post") next ctx model
| None -> () | None -> ()
// Current page // Current page
match data.Page.FindByPermalink permalink webLog.id |> await with match data.Page.FindByPermalink permalink webLog.Id |> await with
| Some page -> | Some page ->
debug (fun () -> "Found page by permalink") debug (fun () -> "Found page by permalink")
yield fun next ctx -> yield fun next ctx ->
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
page_title = page.title page_title = page.Title
page = DisplayPage.fromPage webLog page page = DisplayPage.fromPage webLog page
categories = CategoryCache.get ctx categories = CategoryCache.get ctx
is_page = true is_page = true
|} |}
|> themedView (defaultArg page.template "single-page") next ctx |> themedView (defaultArg page.Template "single-page") next ctx
| None -> () | None -> ()
// RSS feed // RSS feed
match Feed.deriveFeedType ctx textLink with match Feed.deriveFeedType ctx textLink with
@ -56,25 +56,25 @@ module CatchAll =
// Post differing only by trailing slash // Post differing only by trailing slash
let altLink = let altLink =
Permalink (if textLink.EndsWith "/" then textLink[1..textLink.Length - 2] else $"{textLink[1..]}/") Permalink (if textLink.EndsWith "/" then textLink[1..textLink.Length - 2] else $"{textLink[1..]}/")
match data.Post.FindByPermalink altLink webLog.id |> await with match data.Post.FindByPermalink altLink webLog.Id |> await with
| Some post -> | Some post ->
debug (fun () -> "Found post by trailing-slash-agnostic permalink") debug (fun () -> "Found post by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog post.permalink) yield redirectTo true (WebLog.relativeUrl webLog post.Permalink)
| None -> () | None -> ()
// Page differing only by trailing slash // Page differing only by trailing slash
match data.Page.FindByPermalink altLink webLog.id |> await with match data.Page.FindByPermalink altLink webLog.Id |> await with
| Some page -> | Some page ->
debug (fun () -> "Found page by trailing-slash-agnostic permalink") debug (fun () -> "Found page by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog page.permalink) yield redirectTo true (WebLog.relativeUrl webLog page.Permalink)
| None -> () | None -> ()
// Prior post // Prior post
match data.Post.FindCurrentPermalink [ permalink; altLink ] webLog.id |> await with match data.Post.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with
| Some link -> | Some link ->
debug (fun () -> "Found post by prior permalink") debug (fun () -> "Found post by prior permalink")
yield redirectTo true (WebLog.relativeUrl webLog link) yield redirectTo true (WebLog.relativeUrl webLog link)
| None -> () | None -> ()
// Prior page // Prior page
match data.Page.FindCurrentPermalink [ permalink; altLink ] webLog.id |> await with match data.Page.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with
| Some link -> | Some link ->
debug (fun () -> "Found page by prior permalink") debug (fun () -> "Found page by prior permalink")
yield redirectTo true (WebLog.relativeUrl webLog link) yield redirectTo true (WebLog.relativeUrl webLog link)
@ -95,9 +95,9 @@ module Asset =
let path = urlParts |> Seq.skip 1 |> Seq.head let path = urlParts |> Seq.skip 1 |> Seq.head
match! ctx.Data.ThemeAsset.FindById (ThemeAssetId.ofString path) with match! ctx.Data.ThemeAsset.FindById (ThemeAssetId.ofString path) with
| Some asset -> | Some asset ->
match Upload.checkModified asset.updatedOn ctx with match Upload.checkModified asset.UpdatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx | Some threeOhFour -> return! threeOhFour next ctx
| None -> return! Upload.sendFile asset.updatedOn path asset.data next ctx | None -> return! Upload.sendFile asset.UpdatedOn path asset.Data next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -148,7 +148,9 @@ let router : HttpHandler = choose [
route "s" >=> Upload.list route "s" >=> Upload.list
route "/new" >=> Upload.showNew route "/new" >=> Upload.showNew
]) ])
route "/user/edit" >=> User.edit subRoute "/user" (choose [
route "/my-info" >=> User.myInfo
])
] ]
POST >=> validateCsrf >=> choose [ POST >=> validateCsrf >=> choose [
subRoute "/category" (choose [ subRoute "/category" (choose [
@ -189,7 +191,9 @@ let router : HttpHandler = choose [
routexp "/delete/(.*)" Upload.deleteFromDisk routexp "/delete/(.*)" Upload.deleteFromDisk
routef "/%s/delete" Upload.deleteFromDb routef "/%s/delete" Upload.deleteFromDb
]) ])
route "/user/save" >=> User.save subRoute "/user" (choose [
route "/my-info" >=> User.saveMyInfo
])
] ]
]) ])
GET_HEAD >=> routexp "/category/(.*)" Post.pageOfCategorizedPosts 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 webLog = ctx.WebLog
let parts = (urlParts |> Seq.skip 1 |> Seq.head).Split '/' let parts = (urlParts |> Seq.skip 1 |> Seq.head).Split '/'
let slug = Array.head parts let slug = Array.head parts
if slug = webLog.slug then if slug = webLog.Slug then
// Static file middleware will not work in subdirectories; check for an actual file first // Static file middleware will not work in subdirectories; check for an actual file first
let fileName = Path.Combine ("wwwroot", (Seq.head urlParts)[1..]) let fileName = Path.Combine ("wwwroot", (Seq.head urlParts)[1..])
if File.Exists fileName then if File.Exists fileName then
return! streamFile true fileName None None next ctx return! streamFile true fileName None None next ctx
else else
let path = String.Join ('/', Array.skip 1 parts) let path = String.Join ('/', Array.skip 1 parts)
match! ctx.Data.Upload.FindByPath path webLog.id with match! ctx.Data.Upload.FindByPath path webLog.Id with
| Some upload -> | Some upload ->
match checkModified upload.updatedOn ctx with match checkModified upload.UpdatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx | Some threeOhFour -> return! threeOhFour next ctx
| None -> return! sendFile upload.updatedOn path upload.data next ctx | None -> return! sendFile upload.UpdatedOn path upload.Data next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
else else
return! Error.notFound next ctx return! Error.notFound next ctx
@ -87,9 +87,9 @@ let makeSlug it = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 ]").Replace (it,
// GET /admin/uploads // GET /admin/uploads
let list : HttpHandler = requireAccess Author >=> fun next ctx -> task { let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let webLog = ctx.WebLog let webLog = ctx.WebLog
let! dbUploads = ctx.Data.Upload.FindByWebLog webLog.id let! dbUploads = ctx.Data.Upload.FindByWebLog webLog.Id
let diskUploads = let diskUploads =
let path = Path.Combine (uploadDir, webLog.slug) let path = Path.Combine (uploadDir, webLog.Slug)
try try
Directory.EnumerateFiles (path, "*", SearchOption.AllDirectories) Directory.EnumerateFiles (path, "*", SearchOption.AllDirectories)
|> Seq.map (fun file -> |> Seq.map (fun file ->
@ -122,7 +122,7 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
csrf = ctx.CsrfTokenSet csrf = ctx.CsrfTokenSet
files = allFiles files = allFiles
|} |}
|> viewForTheme "admin" "upload-list" next ctx |> adminView "upload-list" next ctx
} }
// GET /admin/upload/new // GET /admin/upload/new
@ -130,9 +130,9 @@ let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
page_title = "Upload a File" page_title = "Upload a File"
csrf = ctx.CsrfTokenSet 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 /// Redirect to the upload list
@ -155,15 +155,15 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
use stream = new MemoryStream () use stream = new MemoryStream ()
do! upload.CopyToAsync stream do! upload.CopyToAsync stream
let file = let file =
{ id = UploadId.create () { Id = UploadId.create ()
webLogId = ctx.WebLog.id WebLogId = ctx.WebLog.Id
path = Permalink $"{year}/{month}/{fileName}" Path = Permalink $"{year}/{month}/{fileName}"
updatedOn = DateTime.UtcNow UpdatedOn = DateTime.UtcNow
data = stream.ToArray () Data = stream.ToArray ()
} }
do! ctx.Data.Upload.Add file do! ctx.Data.Upload.Add file
| Disk -> | Disk ->
let fullPath = Path.Combine (uploadDir, ctx.WebLog.slug, year, month) let fullPath = Path.Combine (uploadDir, ctx.WebLog.Slug, year, month)
let _ = Directory.CreateDirectory fullPath let _ = Directory.CreateDirectory fullPath
use stream = new FileStream (Path.Combine (fullPath, fileName), FileMode.Create) use stream = new FileStream (Path.Combine (fullPath, fileName), FileMode.Create)
do! upload.CopyToAsync stream do! upload.CopyToAsync stream
@ -176,7 +176,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
// POST /admin/upload/{id}/delete // POST /admin/upload/{id}/delete
let deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { 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 -> | Ok fileName ->
do! addMessage ctx { UserMessage.success with Message = $"{fileName} deleted successfully" } do! addMessage ctx { UserMessage.success with Message = $"{fileName} deleted successfully" }
return! showUploads next ctx return! showUploads next ctx
@ -188,7 +188,7 @@ let removeEmptyDirectories (webLog : WebLog) (filePath : string) =
let mutable path = Path.GetDirectoryName filePath let mutable path = Path.GetDirectoryName filePath
let mutable finished = false let mutable finished = false
while (not finished) && path > "" do while (not finished) && path > "" do
let fullPath = Path.Combine (uploadDir, webLog.slug, path) let fullPath = Path.Combine (uploadDir, webLog.Slug, path)
if Directory.EnumerateFileSystemEntries fullPath |> Seq.isEmpty then if Directory.EnumerateFileSystemEntries fullPath |> Seq.isEmpty then
Directory.Delete fullPath Directory.Delete fullPath
path <- String.Join(slash, path.Split slash |> Array.rev |> Array.skip 1 |> Array.rev) path <- String.Join(slash, path.Split slash |> Array.rev |> Array.skip 1 |> Array.rev)
@ -197,7 +197,7 @@ let removeEmptyDirectories (webLog : WebLog) (filePath : string) =
// POST /admin/upload/delete/{**path} // POST /admin/upload/delete/{**path}
let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let filePath = urlParts |> Seq.skip 1 |> Seq.head let filePath = urlParts |> Seq.skip 1 |> Seq.head
let path = Path.Combine (uploadDir, ctx.WebLog.slug, filePath) let path = Path.Combine (uploadDir, ctx.WebLog.Slug, filePath)
if File.Exists path then if File.Exists path then
File.Delete path File.Delete path
removeEmptyDirectories ctx.WebLog filePath removeEmptyDirectories ctx.WebLog filePath

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

@ -27,7 +27,7 @@ let logOn returnUrl : HttpHandler = fun next ctx ->
csrf = ctx.CsrfTokenSet csrf = ctx.CsrfTokenSet
model = { LogOnModel.empty with ReturnTo = returnTo } model = { LogOnModel.empty with ReturnTo = returnTo }
|} |}
|> viewForTheme "admin" "log-on" next ctx |> adminView "log-on" next ctx
open System.Security.Claims open System.Security.Claims
@ -38,21 +38,21 @@ open Microsoft.AspNetCore.Authentication.Cookies
let doLogOn : HttpHandler = fun next ctx -> task { let doLogOn : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel> () let! model = ctx.BindFormAsync<LogOnModel> ()
let data = ctx.Data let data = ctx.Data
match! data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.id with match! data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id with
| Some user when user.passwordHash = hashedPassword model.Password user.userName user.salt -> | Some user when user.PasswordHash = hashedPassword model.Password user.Email user.Salt ->
let claims = seq { let claims = seq {
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.id) Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id)
Claim (ClaimTypes.Name, $"{user.firstName} {user.lastName}") Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
Claim (ClaimTypes.GivenName, user.preferredName) Claim (ClaimTypes.GivenName, user.PreferredName)
Claim (ClaimTypes.Role, AccessLevel.toString user.accessLevel) Claim (ClaimTypes.Role, AccessLevel.toString user.AccessLevel)
} }
let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme) let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity, do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity,
AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow)) AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow))
do! data.WebLogUser.SetLastSeen user.id user.webLogId do! data.WebLogUser.SetLastSeen user.Id user.WebLogId
do! addMessage ctx 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! return!
match model.ReturnTo with match model.ReturnTo with
| Some url -> redirectTo false url next ctx | Some url -> redirectTo false url next ctx
@ -69,49 +69,52 @@ let logOff : HttpHandler = fun next ctx -> task {
return! redirectToGet "" next ctx return! redirectToGet "" next ctx
} }
/// Display the user edit page, with information possibly filled in /// Display the user "my info" page, with information possibly filled in
let private showEdit (hash : Hash) : HttpHandler = fun next ctx -> let private showMyInfo (user : WebLogUser) (hash : Hash) : HttpHandler = fun next ctx ->
addToHash "page_title" "Edit Your Information" hash addToHash "page_title" "Edit Your Information" hash
|> addToHash "csrf" ctx.CsrfTokenSet |> addToHash "csrf" ctx.CsrfTokenSet
|> viewForTheme "admin" "user-edit" next ctx |> addToHash "access_level" (AccessLevel.toString user.AccessLevel)
|> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn)
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog (defaultArg user.LastSeenOn DateTime.UnixEpoch))
|> adminView "my-info" next ctx
// GET /admin/user/edit // GET /admin/user/my-info
let edit : HttpHandler = requireAccess Author >=> fun next ctx -> task { let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.id with match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) next ctx | Some user -> return! showMyInfo user (Hash.FromAnonymousObject {| model = EditMyInfoModel.fromUser user |}) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// POST /admin/user/save // POST /admin/user/my-info
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel> () let! model = ctx.BindFormAsync<EditMyInfoModel> ()
if model.NewPassword = model.NewPasswordConfirm then
let data = ctx.Data let data = ctx.Data
match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.id with match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user -> | Some user ->
if model.NewPassword = model.NewPasswordConfirm then
let pw, salt = let pw, salt =
if model.NewPassword = "" then if model.NewPassword = "" then
user.passwordHash, user.salt user.PasswordHash, user.Salt
else else
let newSalt = Guid.NewGuid () let newSalt = Guid.NewGuid ()
hashedPassword model.NewPassword user.userName newSalt, newSalt hashedPassword model.NewPassword user.Email newSalt, newSalt
let user = let user =
{ user with { user with
firstName = model.FirstName FirstName = model.FirstName
lastName = model.LastName LastName = model.LastName
preferredName = model.PreferredName PreferredName = model.PreferredName
passwordHash = pw PasswordHash = pw
salt = salt Salt = salt
} }
do! data.WebLogUser.Update user do! data.WebLogUser.Update user
let pwMsg = if model.NewPassword = "" then "" else " and updated your password" let pwMsg = if model.NewPassword = "" then "" else " and updated your password"
do! addMessage ctx { UserMessage.success with Message = $"Saved your information{pwMsg} successfully" } do! addMessage ctx { UserMessage.success with Message = $"Saved your information{pwMsg} successfully" }
return! redirectToGet "admin/user/edit" next ctx return! redirectToGet "admin/user/my-info" next ctx
| None -> return! Error.notFound next ctx
else else
do! addMessage ctx { UserMessage.error with Message = "Passwords did not match; no updates made" } do! addMessage ctx { UserMessage.error with Message = "Passwords did not match; no updates made" }
return! showEdit (Hash.FromAnonymousObject {| return! showMyInfo user (Hash.FromAnonymousObject {|
model = { model with NewPassword = ""; NewPasswordConfirm = "" } model = { model with NewPassword = ""; NewPasswordConfirm = "" }
|}) next ctx |}) 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 do! data.WebLog.Add
{ WebLog.empty with { WebLog.empty with
id = webLogId Id = webLogId
name = args[2] Name = args[2]
slug = slug Slug = slug
urlBase = args[1] UrlBase = args[1]
defaultPage = PageId.toString homePageId DefaultPage = PageId.toString homePageId
timeZone = timeZone TimeZone = timeZone
} }
// Create the admin user // Create the admin user
@ -46,32 +46,32 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
do! data.WebLogUser.Add do! data.WebLogUser.Add
{ WebLogUser.empty with { WebLogUser.empty with
id = userId Id = userId
webLogId = webLogId WebLogId = webLogId
userName = args[3] Email = args[3]
firstName = "Admin" FirstName = "Admin"
lastName = "User" LastName = "User"
preferredName = "Admin" PreferredName = "Admin"
passwordHash = Handlers.User.hashedPassword args[4] args[3] salt PasswordHash = Handlers.User.hashedPassword args[4] args[3] salt
salt = salt Salt = salt
accessLevel = accessLevel AccessLevel = accessLevel
createdOn = now CreatedOn = now
} }
// Create the default home page // Create the default home page
do! data.Page.Add do! data.Page.Add
{ Page.empty with { Page.empty with
id = homePageId Id = homePageId
webLogId = webLogId WebLogId = webLogId
authorId = userId AuthorId = userId
title = "Welcome to myWebLog!" Title = "Welcome to myWebLog!"
permalink = Permalink "welcome-to-myweblog.html" Permalink = Permalink "welcome-to-myweblog.html"
publishedOn = now PublishedOn = now
updatedOn = now UpdatedOn = now
text = "<p>This is your default home page.</p>" Text = "<p>This is your default home page.</p>"
revisions = [ Revisions = [
{ asOf = now { AsOf = now
text = Html "<p>This is your default home page.</p>" 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]) Permalink parts[0], Permalink parts[1])
for old, current in mapping do for old, current in mapping do
match! data.Post.FindByPermalink current webLog.id with match! data.Post.FindByPermalink current webLog.Id with
| Some post -> | Some post ->
let! withLinks = data.Post.FindFullById post.id post.webLogId let! withLinks = data.Post.FindFullById post.Id post.WebLogId
let! _ = data.Post.UpdatePriorPermalinks post.id post.webLogId let! _ = data.Post.UpdatePriorPermalinks post.Id post.WebLogId
(old :: withLinks.Value.priorPermalinks) (old :: withLinks.Value.PriorPermalinks)
printfn $"{Permalink.toString old} -> {Permalink.toString current}" printfn $"{Permalink.toString old} -> {Permalink.toString current}"
| None -> eprintfn $"Cannot find current post for {Permalink.toString current}" | None -> eprintfn $"Cannot find current post for {Permalink.toString current}"
printfn "Done!" printfn "Done!"
@ -160,93 +160,93 @@ module Backup =
/// A theme asset, with the data base-64 encoded /// A theme asset, with the data base-64 encoded
type EncodedAsset = type EncodedAsset =
{ /// The ID of the theme asset { /// The ID of the theme asset
id : ThemeAssetId Id : ThemeAssetId
/// The updated date for this asset /// The updated date for this asset
updatedOn : DateTime UpdatedOn : DateTime
/// The data for this asset, base-64 encoded /// The data for this asset, base-64 encoded
data : string Data : string
} }
/// Create an encoded theme asset from the original theme asset /// Create an encoded theme asset from the original theme asset
static member fromAsset (asset : ThemeAsset) = static member fromAsset (asset : ThemeAsset) =
{ id = asset.id { Id = asset.Id
updatedOn = asset.updatedOn UpdatedOn = asset.UpdatedOn
data = Convert.ToBase64String asset.data Data = Convert.ToBase64String asset.Data
} }
/// Create a theme asset from an encoded theme asset /// Create a theme asset from an encoded theme asset
static member fromEncoded (encoded : EncodedAsset) : ThemeAsset = static member toAsset (encoded : EncodedAsset) : ThemeAsset =
{ id = encoded.id { Id = encoded.Id
updatedOn = encoded.updatedOn UpdatedOn = encoded.UpdatedOn
data = Convert.FromBase64String encoded.data Data = Convert.FromBase64String encoded.Data
} }
/// An uploaded file, with the data base-64 encoded /// An uploaded file, with the data base-64 encoded
type EncodedUpload = type EncodedUpload =
{ /// The ID of the upload { /// The ID of the upload
id : UploadId Id : UploadId
/// The ID of the web log to which the upload belongs /// The ID of the web log to which the upload belongs
webLogId : WebLogId WebLogId : WebLogId
/// The path at which this upload is served /// The path at which this upload is served
path : Permalink Path : Permalink
/// The date/time this upload was last updated (file time) /// The date/time this upload was last updated (file time)
updatedOn : DateTime UpdatedOn : DateTime
/// The data for the upload, base-64 encoded /// The data for the upload, base-64 encoded
data : string Data : string
} }
/// Create an encoded uploaded file from the original uploaded file /// Create an encoded uploaded file from the original uploaded file
static member fromUpload (upload : Upload) : EncodedUpload = static member fromUpload (upload : Upload) : EncodedUpload =
{ id = upload.id { Id = upload.Id
webLogId = upload.webLogId WebLogId = upload.WebLogId
path = upload.path Path = upload.Path
updatedOn = upload.updatedOn UpdatedOn = upload.UpdatedOn
data = Convert.ToBase64String upload.data Data = Convert.ToBase64String upload.Data
} }
/// Create an uploaded file from an encoded uploaded file /// Create an uploaded file from an encoded uploaded file
static member fromEncoded (encoded : EncodedUpload) : Upload = static member toUpload (encoded : EncodedUpload) : Upload =
{ id = encoded.id { Id = encoded.Id
webLogId = encoded.webLogId WebLogId = encoded.WebLogId
path = encoded.path Path = encoded.Path
updatedOn = encoded.updatedOn UpdatedOn = encoded.UpdatedOn
data = Convert.FromBase64String encoded.data Data = Convert.FromBase64String encoded.Data
} }
/// A unified archive for a web log /// A unified archive for a web log
type Archive = type Archive =
{ /// The web log to which this archive belongs { /// The web log to which this archive belongs
webLog : WebLog WebLog : WebLog
/// The users for this web log /// The users for this web log
users : WebLogUser list Users : WebLogUser list
/// The theme used by this web log at the time the archive was made /// The theme used by this web log at the time the archive was made
theme : Theme Theme : Theme
/// Assets for the theme used by this web log at the time the archive was made /// Assets for the theme used by this web log at the time the archive was made
assets : EncodedAsset list Assets : EncodedAsset list
/// The categories for this web log /// The categories for this web log
categories : Category list Categories : Category list
/// The tag mappings for this web log /// The tag mappings for this web log
tagMappings : TagMap list TagMappings : TagMap list
/// The pages for this web log (containing only the most recent revision) /// The pages for this web log (containing only the most recent revision)
pages : Page list Pages : Page list
/// The posts for this web log (containing only the most recent revision) /// The posts for this web log (containing only the most recent revision)
posts : Post list Posts : Post list
/// The uploaded files for this web log /// The uploaded files for this web log
uploads : EncodedUpload list Uploads : EncodedUpload list
} }
/// Create a JSON serializer (uses RethinkDB data implementation's JSON converters) /// Create a JSON serializer (uses RethinkDB data implementation's JSON converters)
@ -259,21 +259,21 @@ module Backup =
/// Display statistics for a backup archive /// Display statistics for a backup archive
let private displayStats (msg : string) (webLog : WebLog) archive = let private displayStats (msg : string) (webLog : WebLog) archive =
let userCount = List.length archive.users let userCount = List.length archive.Users
let assetCount = List.length archive.assets let assetCount = List.length archive.Assets
let categoryCount = List.length archive.categories let categoryCount = List.length archive.Categories
let tagMapCount = List.length archive.tagMappings let tagMapCount = List.length archive.TagMappings
let pageCount = List.length archive.pages let pageCount = List.length archive.Pages
let postCount = List.length archive.posts let postCount = List.length archive.Posts
let uploadCount = List.length archive.uploads let uploadCount = List.length archive.Uploads
// Create a pluralized output based on the count // Create a pluralized output based on the count
let plural count ifOne ifMany = let plural count ifOne ifMany =
if count = 1 then ifOne else ifMany if count = 1 then ifOne else ifMany
printfn "" printfn ""
printfn $"""{msg.Replace ("<>NAME<>", webLog.name)}""" printfn $"""{msg.Replace ("<>NAME<>", webLog.Name)}"""
printfn $""" - The theme "{archive.theme.name}" with {assetCount} asset{plural assetCount "" "s"}""" printfn $""" - The theme "{archive.Theme.Name}" with {assetCount} asset{plural assetCount "" "s"}"""
printfn $""" - {userCount} user{plural userCount "" "s"}""" printfn $""" - {userCount} user{plural userCount "" "s"}"""
printfn $""" - {categoryCount} categor{plural categoryCount "y" "ies"}""" printfn $""" - {categoryCount} categor{plural categoryCount "y" "ies"}"""
printfn $""" - {tagMapCount} tag mapping{plural tagMapCount "" "s"}""" printfn $""" - {tagMapCount} tag mapping{plural tagMapCount "" "s"}"""
@ -284,39 +284,37 @@ module Backup =
/// Create a backup archive /// Create a backup archive
let private createBackup webLog (fileName : string) prettyOutput (data : IData) = task { let private createBackup webLog (fileName : string) prettyOutput (data : IData) = task {
// Create the data structure // Create the data structure
let themeId = ThemeId webLog.themePath
printfn "- Exporting theme..." printfn "- Exporting theme..."
let! theme = data.Theme.FindById themeId let! theme = data.Theme.FindById webLog.ThemeId
let! assets = data.ThemeAsset.FindByThemeWithData themeId let! assets = data.ThemeAsset.FindByThemeWithData webLog.ThemeId
printfn "- Exporting users..." printfn "- Exporting users..."
let! users = data.WebLogUser.FindByWebLog webLog.id let! users = data.WebLogUser.FindByWebLog webLog.Id
printfn "- Exporting categories and tag mappings..." printfn "- Exporting categories and tag mappings..."
let! categories = data.Category.FindByWebLog webLog.id let! categories = data.Category.FindByWebLog webLog.Id
let! tagMaps = data.TagMap.FindByWebLog webLog.id let! tagMaps = data.TagMap.FindByWebLog webLog.Id
printfn "- Exporting pages..." printfn "- Exporting pages..."
let! pages = data.Page.FindFullByWebLog webLog.id let! pages = data.Page.FindFullByWebLog webLog.Id
printfn "- Exporting posts..." printfn "- Exporting posts..."
let! posts = data.Post.FindFullByWebLog webLog.id let! posts = data.Post.FindFullByWebLog webLog.Id
printfn "- Exporting uploads..." printfn "- Exporting uploads..."
let! uploads = data.Upload.FindByWebLogWithData webLog.id let! uploads = data.Upload.FindByWebLogWithData webLog.Id
printfn "- Writing archive..." printfn "- Writing archive..."
let archive = { let archive = {
webLog = webLog WebLog = webLog
users = users Users = users
theme = Option.get theme Theme = Option.get theme
assets = assets |> List.map EncodedAsset.fromAsset Assets = assets |> List.map EncodedAsset.fromAsset
categories = categories Categories = categories
tagMappings = tagMaps TagMappings = tagMaps
pages = pages |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions }) Pages = pages |> List.map (fun p -> { p with Revisions = List.truncate 1 p.Revisions })
posts = posts |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions }) Posts = posts |> List.map (fun p -> { p with Revisions = List.truncate 1 p.Revisions })
uploads = uploads |> List.map EncodedUpload.fromUpload Uploads = uploads |> List.map EncodedUpload.fromUpload
} }
// Write the structure to the backup file // Write the structure to the backup file
@ -331,83 +329,83 @@ module Backup =
let private doRestore archive newUrlBase (data : IData) = task { let private doRestore archive newUrlBase (data : IData) = task {
let! restore = task { let! restore = task {
match! data.WebLog.FindById archive.webLog.id with match! data.WebLog.FindById archive.WebLog.Id with
| Some webLog when defaultArg newUrlBase webLog.urlBase = webLog.urlBase -> | Some webLog when defaultArg newUrlBase webLog.UrlBase = webLog.UrlBase ->
do! data.WebLog.Delete webLog.id do! data.WebLog.Delete webLog.Id
return { archive with webLog = { archive.webLog with urlBase = defaultArg newUrlBase webLog.urlBase } } return { archive with WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase webLog.UrlBase } }
| Some _ -> | Some _ ->
// Err'body gets new IDs... // Err'body gets new IDs...
let newWebLogId = WebLogId.create () let newWebLogId = WebLogId.create ()
let newCatIds = archive.categories |> List.map (fun cat -> cat.id, CategoryId.create ()) |> dict let newCatIds = archive.Categories |> List.map (fun cat -> cat.Id, CategoryId.create ()) |> dict
let newMapIds = archive.tagMappings |> List.map (fun tm -> tm.id, TagMapId.create ()) |> dict let newMapIds = archive.TagMappings |> List.map (fun tm -> tm.Id, TagMapId.create ()) |> dict
let newPageIds = archive.pages |> List.map (fun page -> page.id, PageId.create ()) |> dict let newPageIds = archive.Pages |> List.map (fun page -> page.Id, PageId.create ()) |> dict
let newPostIds = archive.posts |> List.map (fun post -> post.id, PostId.create ()) |> dict let newPostIds = archive.Posts |> List.map (fun post -> post.Id, PostId.create ()) |> dict
let newUserIds = archive.users |> List.map (fun user -> user.id, WebLogUserId.create ()) |> dict let newUserIds = archive.Users |> List.map (fun user -> user.Id, WebLogUserId.create ()) |> dict
let newUpIds = archive.uploads |> List.map (fun up -> up.id, UploadId.create ()) |> dict let newUpIds = archive.Uploads |> List.map (fun up -> up.Id, UploadId.create ()) |> dict
return return
{ archive with { archive with
webLog = { archive.webLog with id = newWebLogId; urlBase = Option.get newUrlBase } WebLog = { archive.WebLog with Id = newWebLogId; UrlBase = Option.get newUrlBase }
users = archive.users Users = archive.Users
|> List.map (fun u -> { u with id = newUserIds[u.id]; webLogId = newWebLogId }) |> List.map (fun u -> { u with Id = newUserIds[u.Id]; WebLogId = newWebLogId })
categories = archive.categories Categories = archive.Categories
|> List.map (fun c -> { c with id = newCatIds[c.id]; webLogId = newWebLogId }) |> List.map (fun c -> { c with Id = newCatIds[c.Id]; WebLogId = newWebLogId })
tagMappings = archive.tagMappings TagMappings = archive.TagMappings
|> List.map (fun tm -> { tm with id = newMapIds[tm.id]; webLogId = newWebLogId }) |> List.map (fun tm -> { tm with Id = newMapIds[tm.Id]; WebLogId = newWebLogId })
pages = archive.pages Pages = archive.Pages
|> List.map (fun page -> |> List.map (fun page ->
{ page with { page with
id = newPageIds[page.id] Id = newPageIds[page.Id]
webLogId = newWebLogId WebLogId = newWebLogId
authorId = newUserIds[page.authorId] AuthorId = newUserIds[page.AuthorId]
}) })
posts = archive.posts Posts = archive.Posts
|> List.map (fun post -> |> List.map (fun post ->
{ post with { post with
id = newPostIds[post.id] Id = newPostIds[post.Id]
webLogId = newWebLogId WebLogId = newWebLogId
authorId = newUserIds[post.authorId] AuthorId = newUserIds[post.AuthorId]
categoryIds = post.categoryIds |> List.map (fun c -> newCatIds[c]) CategoryIds = post.CategoryIds |> List.map (fun c -> newCatIds[c])
}) })
uploads = archive.uploads Uploads = archive.Uploads
|> List.map (fun u -> { u with id = newUpIds[u.id]; webLogId = newWebLogId }) |> List.map (fun u -> { u with Id = newUpIds[u.Id]; WebLogId = newWebLogId })
} }
| None -> | None ->
return return
{ archive with { archive with
webLog = { archive.webLog with urlBase = defaultArg newUrlBase archive.webLog.urlBase } WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase archive.WebLog.UrlBase }
} }
} }
// Restore theme and assets (one at a time, as assets can be large) // Restore theme and assets (one at a time, as assets can be large)
printfn "" printfn ""
printfn "- Importing theme..." printfn "- Importing theme..."
do! data.Theme.Save restore.theme do! data.Theme.Save restore.Theme
let! _ = restore.assets |> List.map (EncodedAsset.fromEncoded >> data.ThemeAsset.Save) |> Task.WhenAll let! _ = restore.Assets |> List.map (EncodedAsset.toAsset >> data.ThemeAsset.Save) |> Task.WhenAll
// Restore web log data // Restore web log data
printfn "- Restoring web log..." printfn "- Restoring web log..."
do! data.WebLog.Add restore.webLog do! data.WebLog.Add restore.WebLog
printfn "- Restoring users..." printfn "- Restoring users..."
do! data.WebLogUser.Restore restore.users do! data.WebLogUser.Restore restore.Users
printfn "- Restoring categories and tag mappings..." printfn "- Restoring categories and tag mappings..."
do! data.TagMap.Restore restore.tagMappings do! data.TagMap.Restore restore.TagMappings
do! data.Category.Restore restore.categories do! data.Category.Restore restore.Categories
printfn "- Restoring pages..." printfn "- Restoring pages..."
do! data.Page.Restore restore.pages do! data.Page.Restore restore.Pages
printfn "- Restoring posts..." printfn "- Restoring posts..."
do! data.Post.Restore restore.posts do! data.Post.Restore restore.Posts
// TODO: comments not yet implemented // TODO: comments not yet implemented
printfn "- Restoring uploads..." printfn "- Restoring uploads..."
do! data.Upload.Restore (restore.uploads |> List.map EncodedUpload.fromEncoded) do! data.Upload.Restore (restore.Uploads |> List.map EncodedUpload.toUpload)
displayStats "Restored for <>NAME<>:" restore.webLog restore displayStats "Restored for <>NAME<>:" restore.WebLog restore
} }
/// Decide whether to restore a backup /// Decide whether to restore a backup
@ -431,7 +429,7 @@ module Backup =
if doOverwrite then if doOverwrite then
do! doRestore archive newUrlBase data do! doRestore archive newUrlBase data
else else
printfn $"{archive.webLog.name} backup restoration canceled" printfn $"{archive.WebLog.Name} backup restoration canceled"
} }
/// Generate a backup archive /// Generate a backup archive
@ -442,7 +440,7 @@ module Backup =
| Some webLog -> | Some webLog ->
let fileName = let fileName =
if args.Length = 2 || (args.Length = 3 && args[2] = "pretty") then if args.Length = 2 || (args.Length = 3 && args[2] = "pretty") then
$"{webLog.slug}.json" $"{webLog.Slug}.json"
elif args[2].EndsWith ".json" then elif args[2].EndsWith ".json" then
args[2] args[2]
else else
@ -473,11 +471,11 @@ module Backup =
let private doUserUpgrade urlBase email (data : IData) = task { let private doUserUpgrade urlBase email (data : IData) = task {
match! data.WebLog.FindByHost urlBase with match! data.WebLog.FindByHost urlBase with
| Some webLog -> | Some webLog ->
match! data.WebLogUser.FindByEmail email webLog.id with match! data.WebLogUser.FindByEmail email webLog.Id with
| Some user -> | Some user ->
match user.accessLevel with match user.AccessLevel with
| WebLogAdmin -> | WebLogAdmin ->
do! data.WebLogUser.Update { user with accessLevel = Administrator } do! data.WebLogUser.Update { user with AccessLevel = Administrator }
printfn $"{email} is now an Administrator user" printfn $"{email} is now an Administrator user"
| other -> eprintfn $"ERROR: {email} is an {AccessLevel.toString other}, not a WebLogAdmin" | other -> eprintfn $"ERROR: {email} is an {AccessLevel.toString other}, not a WebLogAdmin"
| None -> eprintfn $"ERROR: no user {email} found at {urlBase}" | None -> eprintfn $"ERROR: no 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}" let path = $"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{ctx.Request.Path.Value}"
match WebLogCache.tryGet path with match WebLogCache.tryGet path with
| Some webLog -> | Some webLog ->
if isDebug then log.LogDebug $"Resolved web log {WebLogId.toString webLog.id} for {path}" if isDebug then log.LogDebug $"Resolved web log {WebLogId.toString webLog.Id} for {path}"
ctx.Items["webLog"] <- webLog ctx.Items["webLog"] <- webLog
if PageListCache.exists ctx then () else do! PageListCache.update ctx if PageListCache.exists ctx then () else do! PageListCache.update ctx
if CategoryCache.exists ctx then () else do! CategoryCache.update ctx if CategoryCache.exists ctx then () else do! CategoryCache.update ctx

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

@ -23,7 +23,7 @@
{%- endif %} {%- endif %}
<ul class="navbar-nav flex-grow-1 justify-content-end"> <ul class="navbar-nav flex-grow-1 justify-content-end">
{% if is_logged_on -%} {% if is_logged_on -%}
{{ "admin/user/edit" | nav_link: "Edit User" }} {{ "admin/user/my-info" | nav_link: "My Info" }}
<li class="nav-item"> <li class="nav-item">
<a class="nav-link" href="{{ "user/log-off" | relative_link }}" hx-boost="false">Log Off</a> <a class="nav-link" href="{{ "user/log-off" | relative_link }}" hx-boost="false">Log Off</a>
</li> </li>

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

@ -111,9 +111,9 @@
<div class="row"> <div class="row">
<div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3"> <div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="iTunesCategory" id="itunesCategory" class="form-control" <input type="text" name="AppleCategory" id="appleCategory" class="form-control"
placeholder="iTunes Category" required value="{{ model.itunes_category }}"> placeholder="iTunes Category" required value="{{ model.apple_category }}">
<label for="itunesCategory">iTunes Category</label> <label for="appleCategory">iTunes Category</label>
<span class="form-text fst-italic"> <span class="form-text fst-italic">
<a href="https://www.thepodcasthost.com/planning/itunes-podcast-categories/" target="_blank" <a href="https://www.thepodcasthost.com/planning/itunes-podcast-categories/" target="_blank"
rel="noopener"> rel="noopener">
@ -124,9 +124,9 @@
</div> </div>
<div class="col-12 col-md-4 pb-3"> <div class="col-12 col-md-4 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="iTunesSubcategory" id="itunesSubcategory" class="form-control" <input type="text" name="AppleSubcategory" id="appleSubcategory" class="form-control"
placeholder="iTunes Subcategory" value="{{ model.itunes_subcategory }}"> placeholder="iTunes Subcategory" value="{{ model.apple_subcategory }}">
<label for="itunesSubcategory">iTunes Subcategory</label> <label for="appleSubcategory">iTunes Subcategory</label>
</div> </div>
</div> </div>
<div class="col-12 col-md-3 col-lg-2 pb-3"> <div class="col-12 col-md-3 col-lg-2 pb-3">

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> <h2 class="my-3">{{ page_title }}</h2>
<article> <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 }}"> <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="container">
<div class="row"><div class="col"><hr class="mt-0"></div></div>
<div class="row mb-3"> <div class="row mb-3">
<div class="col-12 col-md-6 col-lg-4 pb-3"> <div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating"> <div class="form-floating">
@ -28,8 +41,8 @@
</div> </div>
<div class="row mb-3"> <div class="row mb-3">
<div class="col"> <div class="col">
<fieldset class="container"> <fieldset class="p-2">
<legend>Change Password</legend> <legend class="ps-1">Change Password</legend>
<div class="row"> <div class="row">
<div class="col"> <div class="col">
<p class="form-text">Optional; leave blank to keep your current password</p> <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 }}"> <div class="{{ title_col }}">
{{ pg.title }} {{ pg.title }}
{%- if pg.is_default %} &nbsp; <span class="badge bg-success">HOME PAGE</span>{% endif -%} {%- if pg.is_default %} &nbsp; <span class="badge bg-success">HOME PAGE</span>{% endif -%}
{%- if pg.show_in_page_list %} &nbsp; <span class="badge bg-primary">IN PAGE LIST</span> {% endif -%}<br> {%- if pg.is_in_page_list %} &nbsp; <span class="badge bg-primary">IN PAGE LIST</span> {% endif -%}<br>
<small> <small>
{%- capture pg_link %}{% unless pg.is_default %}{{ pg.permalink }}{% endunless %}{% endcapture -%} {%- capture pg_link %}{% unless pg.is_default %}{{ pg.permalink }}{% endunless %}{% endcapture -%}
<a href="{{ pg_link | relative_link }}" target="_blank">View Page</a> <a href="{{ pg_link | relative_link }}" target="_blank">View Page</a>

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

@ -36,14 +36,14 @@
</div> </div>
<div class="col-12 col-md-6 col-xl-4 offset-xl-1 pb-3"> <div class="col-12 col-md-6 col-xl-4 offset-xl-1 pb-3">
<div class="form-floating"> <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 -%} {% 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] }} {{ theme[1] }}
</option> </option>
{%- endfor %} {%- endfor %}
</select> </select>
<label for="themePath">Theme</label> <label for="themeId">Theme</label>
</div> </div>
</div> </div>
<div class="col-12 col-md-6 offset-md-1 col-xl-4 offset-xl-0 pb-3"> <div class="col-12 col-md-6 offset-md-1 col-xl-4 offset-xl-0 pb-3">

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

@ -332,3 +332,15 @@ htmx.on("htmx:afterOnLoad", function (evt) {
Admin.dismissSuccesses() 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}`)
}
})