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

WIP on module/member conversion

Browse Source 
Support types done
This commit is contained in:
Daniel J. Summers 2023-12-16 12:24:45 -05:00
parent 5fe2077974
commit d8ce59a6cd
37 changed files with 705 additions and 721 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -12,120 +12,120 @@ module Json =
type CategoryIdConverter() =
inherit JsonConverter<CategoryId>()
override _.WriteJson(writer: JsonWriter, value: CategoryId, _: JsonSerializer) =
writer.WriteValue value.Value
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: CategoryId, _: bool, _: JsonSerializer) =
(string >> CategoryId) reader.Value
type CommentIdConverter() =
inherit JsonConverter<CommentId>()
override _.WriteJson(writer: JsonWriter, value: CommentId, _: JsonSerializer) =
writer.WriteValue value.Value
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: CommentId, _: bool, _: JsonSerializer) =
(string >> CommentId) reader.Value
type CommentStatusConverter() =
inherit JsonConverter<CommentStatus>()
override _.WriteJson(writer: JsonWriter, value: CommentStatus, _: JsonSerializer) =
writer.WriteValue value.Value
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: CommentStatus, _: bool, _: JsonSerializer) =
(string >> CommentStatus.Parse) reader.Value
type CustomFeedIdConverter () =
inherit JsonConverter<CustomFeedId> ()
override _.WriteJson (writer : JsonWriter, value : CustomFeedId, _ : JsonSerializer) =
writer.WriteValue (CustomFeedId.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : CustomFeedId, _ : bool, _ : JsonSerializer) =
type CustomFeedIdConverter() =
inherit JsonConverter<CustomFeedId>()
override _.WriteJson(writer: JsonWriter, value: CustomFeedId, _: JsonSerializer) =
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: CustomFeedId, _: bool, _: JsonSerializer) =
(string >> CustomFeedId) reader.Value
type CustomFeedSourceConverter () =
inherit JsonConverter<CustomFeedSource> ()
override _.WriteJson (writer : JsonWriter, value : CustomFeedSource, _ : JsonSerializer) =
writer.WriteValue (CustomFeedSource.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : CustomFeedSource, _ : bool, _ : JsonSerializer) =
(string >> CustomFeedSource.parse) reader.Value
type CustomFeedSourceConverter() =
inherit JsonConverter<CustomFeedSource>()
override _.WriteJson(writer: JsonWriter, value: CustomFeedSource, _: JsonSerializer) =
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: CustomFeedSource, _: bool, _: JsonSerializer) =
(string >> CustomFeedSource.Parse) reader.Value
type ExplicitRatingConverter() =
inherit JsonConverter<ExplicitRating>()
override _.WriteJson(writer: JsonWriter, value: ExplicitRating, _: JsonSerializer) =
writer.WriteValue value.Value
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: ExplicitRating, _: bool, _: JsonSerializer) =
(string >> ExplicitRating.Parse) reader.Value
type MarkupTextConverter() =
inherit JsonConverter<MarkupText>()
override _.WriteJson(writer: JsonWriter, value: MarkupText, _: JsonSerializer) =
writer.WriteValue value.Value
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: MarkupText, _: bool, _: JsonSerializer) =
(string >> MarkupText.Parse) reader.Value
type PermalinkConverter() =
inherit JsonConverter<Permalink>()
override _.WriteJson(writer: JsonWriter, value: Permalink, _: JsonSerializer) =
writer.WriteValue value.Value
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: Permalink, _: bool, _: JsonSerializer) =
(string >> Permalink) reader.Value
type PageIdConverter() =
inherit JsonConverter<PageId>()
override _.WriteJson(writer: JsonWriter, value: PageId, _: JsonSerializer) =
writer.WriteValue value.Value
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: PageId, _: bool, _: JsonSerializer) =
(string >> PageId) reader.Value
type PodcastMediumConverter() =
inherit JsonConverter<PodcastMedium>()
override _.WriteJson(writer: JsonWriter, value: PodcastMedium, _: JsonSerializer) =
writer.WriteValue value.Value
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: PodcastMedium, _: bool, _: JsonSerializer) =
(string >> PodcastMedium.Parse) reader.Value
type PostIdConverter() =
inherit JsonConverter<PostId>()
override _.WriteJson(writer: JsonWriter, value: PostId, _: JsonSerializer) =
writer.WriteValue value.Value
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: PostId, _: bool, _: JsonSerializer) =
(string >> PostId) reader.Value
type TagMapIdConverter () =
inherit JsonConverter<TagMapId> ()
override _.WriteJson (writer : JsonWriter, value : TagMapId, _ : JsonSerializer) =
writer.WriteValue (TagMapId.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : TagMapId, _ : bool, _ : JsonSerializer) =
type TagMapIdConverter() =
inherit JsonConverter<TagMapId>()
override _.WriteJson(writer: JsonWriter, value: TagMapId, _: JsonSerializer) =
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: TagMapId, _: bool, _: JsonSerializer) =
(string >> TagMapId) reader.Value
type ThemeAssetIdConverter () =
inherit JsonConverter<ThemeAssetId> ()
override _.WriteJson (writer : JsonWriter, value : ThemeAssetId, _ : JsonSerializer) =
writer.WriteValue (ThemeAssetId.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeAssetId, _ : bool, _ : JsonSerializer) =
(string >> ThemeAssetId.ofString) reader.Value
type ThemeAssetIdConverter() =
inherit JsonConverter<ThemeAssetId>()
override _.WriteJson(writer: JsonWriter, value: ThemeAssetId, _: JsonSerializer) =
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: ThemeAssetId, _: bool, _: JsonSerializer) =
(string >> ThemeAssetId.Parse) reader.Value
type ThemeIdConverter () =
inherit JsonConverter<ThemeId> ()
override _.WriteJson (writer : JsonWriter, value : ThemeId, _ : JsonSerializer) =
writer.WriteValue (ThemeId.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) =
type ThemeIdConverter() =
inherit JsonConverter<ThemeId>()
override _.WriteJson(writer: JsonWriter, value: ThemeId, _: JsonSerializer) =
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: ThemeId, _: bool, _: JsonSerializer) =
(string >> ThemeId) reader.Value
type UploadIdConverter () =
inherit JsonConverter<UploadId> ()
override _.WriteJson (writer : JsonWriter, value : UploadId, _ : JsonSerializer) =
writer.WriteValue (UploadId.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadId, _ : bool, _ : JsonSerializer) =
type UploadIdConverter() =
inherit JsonConverter<UploadId>()
override _.WriteJson(writer: JsonWriter, value: UploadId, _: JsonSerializer) =
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: UploadId, _: bool, _: JsonSerializer) =
(string >> UploadId) reader.Value
type WebLogIdConverter () =
inherit JsonConverter<WebLogId> ()
override _.WriteJson (writer : JsonWriter, value : WebLogId, _ : JsonSerializer) =
writer.WriteValue (WebLogId.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : WebLogId, _ : bool, _ : JsonSerializer) =
type WebLogIdConverter() =
inherit JsonConverter<WebLogId>()
override _.WriteJson(writer: JsonWriter, value: WebLogId, _: JsonSerializer) =
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: WebLogId, _: bool, _: JsonSerializer) =
(string >> WebLogId) reader.Value
type WebLogUserIdConverter () =
type WebLogUserIdConverter() =
inherit JsonConverter<WebLogUserId> ()
override _.WriteJson (writer : JsonWriter, value : WebLogUserId, _ : JsonSerializer) =
writer.WriteValue (WebLogUserId.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : WebLogUserId, _ : bool, _ : JsonSerializer) =
override _.WriteJson(writer: JsonWriter, value: WebLogUserId, _: JsonSerializer) =
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: WebLogUserId, _: bool, _: JsonSerializer) =
(string >> WebLogUserId) reader.Value
open Microsoft.FSharpLu.Json

16
src/MyWebLog.Data/Postgres/PostgresCategoryData.fs
View File

@ -43,7 +43,7 @@ type PostgresCategoryData(log: ILogger) =
FROM {Table.Post}
WHERE {Query.whereDataContains "@criteria"}
AND {catIdSql}"""
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published.Value |}
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |}
catIdParams ]
Map.toCount
|> Async.AwaitTask
@ -64,7 +64,7 @@ type PostgresCategoryData(log: ILogger) =
/// Find a category by its ID for the given web log
let findById catId webLogId =
log.LogTrace "Category.findById"
Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId (_.Value) webLogId
Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId string webLogId
/// Find all categories for the given web log
let findByWebLog webLogId =
@ -73,7 +73,7 @@ type PostgresCategoryData(log: ILogger) =
/// Create parameters for a category insert / update
let catParameters (cat : Category) =
Query.docParameters cat.Id.Value cat
Query.docParameters (string cat.Id) cat
/// Delete a category
let delete catId webLogId = backgroundTask {
@ -81,7 +81,7 @@ type PostgresCategoryData(log: ILogger) =
match! findById catId webLogId with
| Some cat ->
// Reassign any children to the category's parent category
let! children = Find.byContains<Category> Table.Category {| ParentId = catId.Value |}
let! children = Find.byContains<Category> Table.Category {| ParentId = string catId |}
let hasChildren = not (List.isEmpty children)
if hasChildren then
let! _ =
@ -90,7 +90,7 @@ type PostgresCategoryData(log: ILogger) =
|> Sql.executeTransactionAsync [
Query.Update.partialById Table.Category,
children |> List.map (fun child -> [
"@id", Sql.string child.Id.Value
"@id", Sql.string (string child.Id)
"@data", Query.jsonbDocParam {| ParentId = cat.ParentId |}
])
]
@ -98,7 +98,7 @@ type PostgresCategoryData(log: ILogger) =
// Delete the category off all posts where it is assigned
let! posts =
Custom.list $"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.empty.CategoryIds}' @> @id"
[ "@id", Query.jsonbDocParam [| catId.Value |] ] fromData<Post>
[ "@id", Query.jsonbDocParam [| string catId |] ] fromData<Post>
if not (List.isEmpty posts) then
let! _ =
Configuration.dataSource ()
@ -106,14 +106,14 @@ type PostgresCategoryData(log: ILogger) =
|> Sql.executeTransactionAsync [
Query.Update.partialById Table.Post,
posts |> List.map (fun post -> [
"@id", Sql.string post.Id.Value
"@id", Sql.string (string post.Id)
"@data", Query.jsonbDocParam
{| CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId) |}
])
]
()
// Delete the category itself
do! Delete.byId Table.Category catId.Value
do! Delete.byId Table.Category (string catId)
return if hasChildren then ReassignedChildCategories else CategoryDeleted
| None -> return CategoryNotFound
}

4
src/MyWebLog.Data/Postgres/PostgresHelpers.fs
View File

@ -70,7 +70,7 @@ open Npgsql.FSharp
/// Create a SQL parameter for the web log ID
let webLogIdParam webLogId =
"@webLogId", Sql.string (WebLogId.toString webLogId)
"@webLogId", Sql.string (string webLogId)
/// Create an anonymous record with the given web log ID
let webLogDoc (webLogId : WebLogId) =
@ -206,7 +206,7 @@ module Revisions =
let revParams<'TKey> (key : 'TKey) (keyFunc : 'TKey -> string) rev = [
typedParam "asOf" rev.AsOf
"@id", Sql.string (keyFunc key)
"@text", Sql.string rev.Text.Value
"@text", Sql.string (string rev.Text)
]
/// The SQL statement to insert a revision

25
src/MyWebLog.Data/Postgres/PostgresPageData.fs
View File

@ -14,7 +14,7 @@ type PostgresPageData (log: ILogger) =
/// Append revisions to a page
let appendPageRevisions (page: Page) = backgroundTask {
log.LogTrace "Page.appendPageRevisions"
let! revisions = Revisions.findByEntityId Table.PageRevision Table.Page page.Id _.Value
let! revisions = Revisions.findByEntityId Table.PageRevision Table.Page page.Id string
return { page with Revisions = revisions }
}
@ -25,12 +25,12 @@ type PostgresPageData (log: ILogger) =
/// Update a page's revisions
let updatePageRevisions (pageId: PageId) oldRevs newRevs =
log.LogTrace "Page.updatePageRevisions"
Revisions.update Table.PageRevision Table.Page pageId (_.Value) oldRevs newRevs
Revisions.update Table.PageRevision Table.Page pageId string oldRevs newRevs
/// Does the given page exist?
let pageExists (pageId: PageId) webLogId =
log.LogTrace "Page.pageExists"
Document.existsByWebLog Table.Page pageId (_.Value) webLogId
Document.existsByWebLog Table.Page pageId string webLogId
// IMPLEMENTATION FUNCTIONS
@ -51,9 +51,9 @@ type PostgresPageData (log: ILogger) =
Count.byContains Table.Page {| webLogDoc webLogId with IsInPageList = true |}
/// Find a page by its ID (without revisions)
let findById (pageId: PageId) webLogId =
let findById pageId webLogId =
log.LogTrace "Page.findById"
Document.findByIdAndWebLog<PageId, Page> Table.Page pageId (_.Value) webLogId
Document.findByIdAndWebLog<PageId, Page> Table.Page pageId string webLogId
/// Find a complete page by its ID
let findFullById pageId webLogId = backgroundTask {
@ -70,7 +70,7 @@ type PostgresPageData (log: ILogger) =
log.LogTrace "Page.delete"
match! pageExists pageId webLogId with
| true ->
do! Delete.byId Table.Page pageId.Value
do! Delete.byId Table.Page (string pageId)
return true
| false -> return false
}
@ -78,16 +78,15 @@ type PostgresPageData (log: ILogger) =
/// Find a page by its permalink for the given web log
let findByPermalink (permalink: Permalink) webLogId =
log.LogTrace "Page.findByPermalink"
Find.byContains<Page> Table.Page {| webLogDoc webLogId with Permalink = permalink.Value |}
Find.byContains<Page> Table.Page {| webLogDoc webLogId with Permalink = string permalink |}
|> tryHead
/// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
log.LogTrace "Page.findCurrentPermalink"
if List.isEmpty permalinks then return None
else
let linkSql, linkParam =
arrayContains (nameof Page.empty.PriorPermalinks) (fun (it: Permalink) -> it.Value) permalinks
let linkSql, linkParam = arrayContains (nameof Page.empty.PriorPermalinks) string permalinks
return!
Custom.single
$"""SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink
@ -134,9 +133,9 @@ type PostgresPageData (log: ILogger) =
|> Sql.executeTransactionAsync [
Query.insert Table.Page,
pages
|> List.map (fun page -> Query.docParameters page.Id.Value { page with Revisions = [] })
|> List.map (fun page -> Query.docParameters (string page.Id) { page with Revisions = [] })
Revisions.insertSql Table.PageRevision,
revisions |> List.map (fun (pageId, rev) -> Revisions.revParams pageId (_.Value) rev)
revisions |> List.map (fun (pageId, rev) -> Revisions.revParams pageId string rev)
]
()
}
@ -155,7 +154,7 @@ type PostgresPageData (log: ILogger) =
log.LogTrace "Page.updatePriorPermalinks"
match! pageExists pageId webLogId with
| true ->
do! Update.partialById Table.Page pageId.Value {| PriorPermalinks = permalinks |}
do! Update.partialById Table.Page (string pageId) {| PriorPermalinks = permalinks |}
return true
| false -> return false
}

40
src/MyWebLog.Data/Postgres/PostgresPostData.fs
View File

@ -15,7 +15,7 @@ type PostgresPostData(log: ILogger) =
/// Append revisions to a post
let appendPostRevisions (post: Post) = backgroundTask {
log.LogTrace "Post.appendPostRevisions"
let! revisions = Revisions.findByEntityId Table.PostRevision Table.Post post.Id _.Value
let! revisions = Revisions.findByEntityId Table.PostRevision Table.Post post.Id string
return { post with Revisions = revisions }
}
@ -26,30 +26,30 @@ type PostgresPostData(log: ILogger) =
/// Update a post's revisions
let updatePostRevisions (postId: PostId) oldRevs newRevs =
log.LogTrace "Post.updatePostRevisions"
Revisions.update Table.PostRevision Table.Post postId (_.Value) oldRevs newRevs
Revisions.update Table.PostRevision Table.Post postId string oldRevs newRevs
/// Does the given post exist?
let postExists (postId: PostId) webLogId =
log.LogTrace "Post.postExists"
Document.existsByWebLog Table.Post postId (_.Value) webLogId
Document.existsByWebLog Table.Post postId string webLogId
// IMPLEMENTATION FUNCTIONS
/// Count posts in a status for the given web log
let countByStatus (status: PostStatus) webLogId =
log.LogTrace "Post.countByStatus"
Count.byContains Table.Post {| webLogDoc webLogId with Status = status.Value |}
Count.byContains Table.Post {| webLogDoc webLogId with Status = status |}
/// Find a post by its ID for the given web log (excluding revisions)
let findById postId webLogId =
log.LogTrace "Post.findById"
Document.findByIdAndWebLog<PostId, Post> Table.Post postId (_.Value) webLogId
Document.findByIdAndWebLog<PostId, Post> Table.Post postId string webLogId
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink (permalink: Permalink) webLogId =
log.LogTrace "Post.findByPermalink"
Custom.single (selectWithCriteria Table.Post)
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Permalink = permalink.Value |} ]
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Permalink = string permalink |} ]
fromData<Post>
/// Find a complete post by its ID for the given web log
@ -70,18 +70,17 @@ type PostgresPostData(log: ILogger) =
do! Custom.nonQuery
$"""DELETE FROM {Table.PostComment} WHERE {Query.whereDataContains "@criteria"};
DELETE FROM {Table.Post} WHERE id = @id"""
[ "@id", Sql.string postId.Value; "@criteria", Query.jsonbDocParam {| PostId = postId.Value |} ]
[ "@id", Sql.string (string postId); "@criteria", Query.jsonbDocParam {| PostId = postId |} ]
return true
| false -> return false
}
/// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
log.LogTrace "Post.findCurrentPermalink"
if List.isEmpty permalinks then return None
else
let linkSql, linkParam =
arrayContains (nameof Post.empty.PriorPermalinks) (fun (it: Permalink) -> it.Value) permalinks
let linkSql, linkParam = arrayContains (nameof Post.empty.PriorPermalinks) string permalinks
return!
Custom.single
$"""SELECT data ->> '{nameof Post.empty.Permalink}' AS permalink
@ -102,16 +101,15 @@ type PostgresPostData(log: ILogger) =
}
/// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage =
log.LogTrace "Post.findPageOfCategorizedPosts"
let catSql, catParam =
arrayContains (nameof Post.empty.CategoryIds) (fun (it: CategoryId) -> it.Value) categoryIds
let catSql, catParam = arrayContains (nameof Post.empty.CategoryIds) string categoryIds
Custom.list
$"{selectWithCriteria Table.Post}
AND {catSql}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published.Value |}
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |}
catParam
] fromData<Post>
@ -132,7 +130,7 @@ type PostgresPostData(log: ILogger) =
$"{selectWithCriteria Table.Post}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published.Value |} ]
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |} ]
fromData<Post>
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
@ -143,7 +141,7 @@ type PostgresPostData(log: ILogger) =
AND data['{nameof Post.empty.Tags}'] @> @tag
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published.Value |}
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |}
"@tag", Query.jsonbDocParam [| tag |]
] fromData<Post>
@ -151,8 +149,8 @@ type PostgresPostData(log: ILogger) =
let findSurroundingPosts webLogId publishedOn = backgroundTask {
log.LogTrace "Post.findSurroundingPosts"
let queryParams () = [
"@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published.Value |}
"@publishedOn", Sql.string ((InstantPattern.General.Format publishedOn).Substring (0, 19))
"@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |}
"@publishedOn", Sql.string ((InstantPattern.General.Format publishedOn)[..19])
]
let pubField = nameof Post.empty.PublishedOn
let! older =
@ -187,9 +185,9 @@ type PostgresPostData(log: ILogger) =
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.insert Table.Post,
posts |> List.map (fun post -> Query.docParameters post.Id.Value { post with Revisions = [] })
posts |> List.map (fun post -> Query.docParameters (string post.Id) { post with Revisions = [] })
Revisions.insertSql Table.PostRevision,
revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId (_.Value) rev)
revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId string rev)
]
()
}
@ -199,7 +197,7 @@ type PostgresPostData(log: ILogger) =
log.LogTrace "Post.updatePriorPermalinks"
match! postExists postId webLogId with
| true ->
do! Update.partialById Table.Post postId.Value {| PriorPermalinks = permalinks |}
do! Update.partialById Table.Post (string postId) {| PriorPermalinks = permalinks |}
return true
| false -> return false
}

10
src/MyWebLog.Data/Postgres/PostgresTagMapData.fs
View File

@ -12,14 +12,14 @@ type PostgresTagMapData (log : ILogger) =
/// Find a tag mapping by its ID for the given web log
let findById tagMapId webLogId =
log.LogTrace "TagMap.findById"
Document.findByIdAndWebLog<TagMapId, TagMap> Table.TagMap tagMapId TagMapId.toString webLogId
Document.findByIdAndWebLog<TagMapId, TagMap> Table.TagMap tagMapId string webLogId
/// Delete a tag mapping for the given web log
let delete tagMapId webLogId = backgroundTask {
let delete (tagMapId: TagMapId) webLogId = backgroundTask {
log.LogTrace "TagMap.delete"
let! exists = Document.existsByWebLog Table.TagMap tagMapId TagMapId.toString webLogId
let! exists = Document.existsByWebLog Table.TagMap tagMapId string webLogId
if exists then
do! Delete.byId Table.TagMap (TagMapId.toString tagMapId)
do! Delete.byId Table.TagMap (string tagMapId)
return true
else return false
}
@ -55,7 +55,7 @@ type PostgresTagMapData (log : ILogger) =
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.insert Table.TagMap,
tagMaps |> List.map (fun tagMap -> Query.docParameters (TagMapId.toString tagMap.Id) tagMap)
tagMaps |> List.map (fun tagMap -> Query.docParameters (string tagMap.Id) tagMap)
]
()
}

26
src/MyWebLog.Data/Postgres/PostgresThemeData.fs
View File

@ -20,26 +20,26 @@ type PostgresThemeData (log : ILogger) =
Custom.list $"{Query.selectFromTable Table.Theme} WHERE id <> 'admin' ORDER BY id" [] withoutTemplateText
/// Does a given theme exist?
let exists themeId =
let exists (themeId: ThemeId) =
log.LogTrace "Theme.exists"
Exists.byId Table.Theme (ThemeId.toString themeId)
Exists.byId Table.Theme (string themeId)
/// Find a theme by its ID
let findById themeId =
let findById (themeId: ThemeId) =
log.LogTrace "Theme.findById"
Find.byId<Theme> Table.Theme (ThemeId.toString themeId)
Find.byId<Theme> Table.Theme (string themeId)
/// Find a theme by its ID (excludes the text of templates)
let findByIdWithoutText themeId =
let findByIdWithoutText (themeId: ThemeId) =
log.LogTrace "Theme.findByIdWithoutText"
Custom.single (Query.Find.byId Table.Theme) [ "@id", Sql.string (ThemeId.toString themeId) ] withoutTemplateText
Custom.single (Query.Find.byId Table.Theme) [ "@id", Sql.string (string themeId) ] withoutTemplateText
/// Delete a theme by its ID
let delete themeId = backgroundTask {
log.LogTrace "Theme.delete"
match! exists themeId with
| true ->
do! Delete.byId Table.Theme (ThemeId.toString themeId)
do! Delete.byId Table.Theme (string themeId)
return true
| false -> return false
}
@ -67,10 +67,10 @@ type PostgresThemeAssetData (log : ILogger) =
Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}" [] (Map.toThemeAsset false)
/// Delete all assets for the given theme
let deleteByTheme themeId =
let deleteByTheme (themeId: ThemeId) =
log.LogTrace "ThemeAsset.deleteByTheme"
Custom.nonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
[ "@themeId", Sql.string (ThemeId.toString themeId) ]
[ "@themeId", Sql.string (string themeId) ]
/// Find a theme asset by its ID
let findById assetId =
@ -80,16 +80,16 @@ type PostgresThemeAssetData (log : ILogger) =
[ "@themeId", Sql.string themeId; "@path", Sql.string path ] (Map.toThemeAsset true)
/// Get theme assets for the given theme (excludes data)
let findByTheme themeId =
let findByTheme (themeId: ThemeId) =
log.LogTrace "ThemeAsset.findByTheme"
Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
[ "@themeId", Sql.string (ThemeId.toString themeId) ] (Map.toThemeAsset false)
[ "@themeId", Sql.string (string themeId) ] (Map.toThemeAsset false)
/// Get theme assets for the given theme
let findByThemeWithData themeId =
let findByThemeWithData (themeId: ThemeId) =
log.LogTrace "ThemeAsset.findByThemeWithData"
Custom.list $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
[ "@themeId", Sql.string (ThemeId.toString themeId) ] (Map.toThemeAsset true)
[ "@themeId", Sql.string (string themeId) ] (Map.toThemeAsset true)
/// Save a theme asset
let save (asset : ThemeAsset) =

8
src/MyWebLog.Data/Postgres/PostgresUploadData.fs
View File

@ -21,8 +21,8 @@ type PostgresUploadData (log : ILogger) =
let upParams (upload : Upload) = [
webLogIdParam upload.WebLogId
typedParam "updatedOn" upload.UpdatedOn
"@id", Sql.string (UploadId.toString upload.Id)
"@path", Sql.string upload.Path.Value
"@id", Sql.string (string upload.Id)
"@path", Sql.string (string upload.Path)
"@data", Sql.bytea upload.Data
]
@ -34,14 +34,14 @@ type PostgresUploadData (log : ILogger) =
/// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask {
log.LogTrace "Upload.delete"
let idParam = [ "@id", Sql.string (UploadId.toString uploadId) ]
let idParam = [ "@id", Sql.string (string uploadId) ]
let! path =
Custom.single $"SELECT path FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
(webLogIdParam webLogId :: idParam) (fun row -> row.string "path")
if Option.isSome path then
do! Custom.nonQuery (Query.Delete.byId Table.Upload) idParam
return Ok path.Value
else return Error $"""Upload ID {UploadId.toString uploadId} not found"""
else return Error $"""Upload ID {uploadId} not found"""
}
/// Find an uploaded file by its path for the given web log

17
src/MyWebLog.Data/Postgres/PostgresWebLogData.fs
View File

@ -41,29 +41,30 @@ type PostgresWebLogData (log : ILogger) =
fromData<WebLog>
/// Find a web log by its ID
let findById webLogId =
let findById (webLogId: WebLogId) =
log.LogTrace "WebLog.findById"
Find.byId<WebLog> Table.WebLog (WebLogId.toString webLogId)
Find.byId<WebLog> Table.WebLog (string webLogId)
let updateRedirectRules (webLog : WebLog) = backgroundTask {
let updateRedirectRules (webLog: WebLog) = backgroundTask {
log.LogTrace "WebLog.updateRedirectRules"
match! findById webLog.Id with
| Some _ ->
do! Update.partialById Table.WebLog (WebLogId.toString webLog.Id) {| RedirectRules = webLog.RedirectRules |}
do! Update.partialById Table.WebLog (string webLog.Id) {| RedirectRules = webLog.RedirectRules |}
| None -> ()
}
/// Update RSS options for a web log
let updateRssOptions (webLog : WebLog) = backgroundTask {
let updateRssOptions (webLog: WebLog) = backgroundTask {
log.LogTrace "WebLog.updateRssOptions"
match! findById webLog.Id with
| Some _ -> do! Update.partialById Table.WebLog (WebLogId.toString webLog.Id) {| Rss = webLog.Rss |}
| Some _ -> do! Update.partialById Table.WebLog (string webLog.Id) {| Rss = webLog.Rss |}
| None -> ()
}
/// Update settings for a web log
let updateSettings (webLog : WebLog) =
let updateSettings (webLog: WebLog) =
log.LogTrace "WebLog.updateSettings"
Update.full Table.WebLog (WebLogId.toString webLog.Id) webLog
Update.full Table.WebLog (string webLog.Id) webLog
interface IWebLogData with
member _.Add webLog = add webLog

25
src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs
View File

@ -12,7 +12,7 @@ type PostgresWebLogUserData (log : ILogger) =
/// Find a user by their ID for the given web log
let findById userId webLogId =
log.LogTrace "WebLogUser.findById"
Document.findByIdAndWebLog<WebLogUserId, WebLogUser> Table.WebLogUser userId WebLogUserId.toString webLogId
Document.findByIdAndWebLog<WebLogUserId, WebLogUser> Table.WebLogUser userId string webLogId
/// Delete a user if they have no posts or pages
let delete userId webLogId = backgroundTask {
@ -29,7 +29,7 @@ type PostgresWebLogUserData (log : ILogger) =
if isAuthor then
return Error "User has pages or posts; cannot delete"
else
do! Delete.byId Table.WebLogUser (WebLogUserId.toString userId)
do! Delete.byId Table.WebLogUser (string userId)
return Ok true
| None -> return Error "User does not exist"
}
@ -49,41 +49,38 @@ type PostgresWebLogUserData (log : ILogger) =
[ webLogContains webLogId ] fromData<WebLogUser>
/// Find the names of users by their IDs for the given web log
let findNames webLogId userIds = backgroundTask {
let findNames webLogId (userIds: WebLogUserId list) = backgroundTask {
log.LogTrace "WebLogUser.findNames"
let idSql, idParams = inClause "AND id" "id" WebLogUserId.toString userIds
let idSql, idParams = inClause "AND id" "id" string userIds
let! users =
Custom.list $"{selectWithCriteria Table.WebLogUser} {idSql}" (webLogContains webLogId :: idParams)
fromData<WebLogUser>
return
users
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
return users |> List.map (fun u -> { Name = string u.Id; Value = WebLogUser.displayName u })
}
/// Restore users from a backup
let restore (users : WebLogUser list) = backgroundTask {
let restore (users: WebLogUser list) = backgroundTask {
log.LogTrace "WebLogUser.restore"
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.insert Table.WebLogUser,
users |> List.map (fun user -> Query.docParameters (WebLogUserId.toString user.Id) user)
users |> List.map (fun user -> Query.docParameters (string user.Id) user)
]
()
}
/// Set a user's last seen date/time to now
let setLastSeen userId webLogId = backgroundTask {
let setLastSeen (userId: WebLogUserId) webLogId = backgroundTask {
log.LogTrace "WebLogUser.setLastSeen"
match! Document.existsByWebLog Table.WebLogUser userId WebLogUserId.toString webLogId with
| true ->
do! Update.partialById Table.WebLogUser (WebLogUserId.toString userId) {| LastSeenOn = Some (Noda.now ()) |}
match! Document.existsByWebLog Table.WebLogUser userId string webLogId with
| true -> do! Update.partialById Table.WebLogUser (string userId) {| LastSeenOn = Some (Noda.now ()) |}
| false -> ()
}
/// Save a user
let save (user : WebLogUser) =
let save (user: WebLogUser) =
log.LogTrace "WebLogUser.save"
save Table.WebLogUser user

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

@ -96,12 +96,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
/// Match theme asset IDs by their prefix (the theme ID)
let matchAssetByThemeId themeId =
let keyPrefix = $"^{ThemeId.toString themeId}/"
let keyPrefix = $"^{themeId}/"
fun (row : Ast.ReqlExpr) -> row[nameof ThemeAsset.empty.Id].Match keyPrefix :> obj
/// Function to exclude template text from themes
let withoutTemplateText (row : Ast.ReqlExpr) : obj =
{| Templates = row[nameof Theme.empty.Templates].Without [| nameof ThemeTemplate.empty.Text |] |}
{| Templates = row[nameof Theme.empty.Templates].Without [| nameof ThemeTemplate.Empty.Text |] |}
/// Ensure field indexes exist, as well as special indexes for selected tables
let ensureIndexes table fields = backgroundTask {
@ -917,8 +917,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
delete
write; withRetryDefault; ignoreResult conn
}
return Ok up.Path.Value
| None -> return Result.Error $"Upload ID {UploadId.toString uploadId} not found"
return Ok (string up.Path)
| None -> return Result.Error $"Upload ID {uploadId} not found"
}
member _.FindByPath path webLogId =
@ -1133,9 +1133,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
filter (nameof WebLogUser.empty.WebLogId) webLogId
result; withRetryDefault conn
}
return
users
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
return users |> List.map (fun u -> { Name = string u.Id; Value = WebLogUser.displayName u })
}
member _.Restore users = backgroundTask {

8
src/MyWebLog.Data/SQLite/Helpers.fs
View File

@ -222,7 +222,7 @@ module Map =
/// Create a custom feed from the current row in the given data reader
let toCustomFeed ser rdr : CustomFeed =
{ Id = getString "id" rdr |> CustomFeedId
Source = getString "source" rdr |> CustomFeedSource.parse
Source = getString "source" rdr |> CustomFeedSource.Parse
Path = getString "path" rdr |> Permalink
Podcast = tryString "podcast" rdr |> Option.map (Utils.deserialize ser)
}
@ -339,7 +339,7 @@ module Map =
UrlBase = getString "url_base" rdr
TimeZone = getString "time_zone" rdr
AutoHtmx = getBoolean "auto_htmx" rdr
Uploads = getString "uploads" rdr |> UploadDestination.parse
Uploads = getString "uploads" rdr |> UploadDestination.Parse
Rss = {
IsFeedEnabled = getBoolean "is_feed_enabled" rdr
FeedName = getString "feed_name" rdr
@ -368,5 +368,5 @@ module Map =
}
/// Add a web log ID parameter
let addWebLogId (cmd : SqliteCommand) webLogId =
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
let addWebLogId (cmd: SqliteCommand) (webLogId: WebLogId) =
cmd.Parameters.AddWithValue ("@webLogId", string webLogId) |> ignore

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

@ -5,17 +5,17 @@ open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
/// SQLite myWebLog category data implementation
type SQLiteCategoryData (conn : SqliteConnection) =
/// SQLite myWebLog category data implementation
type SQLiteCategoryData(conn: SqliteConnection) =
/// Add parameters for category INSERT or UPDATE statements
let addCategoryParameters (cmd : SqliteCommand) (cat : Category) =
[ cmd.Parameters.AddWithValue ("@id", cat.Id.Value)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId)
let addCategoryParameters (cmd: SqliteCommand) (cat: Category) =
[ cmd.Parameters.AddWithValue ("@id", string cat.Id)
cmd.Parameters.AddWithValue ("@webLogId", string cat.WebLogId)
cmd.Parameters.AddWithValue ("@name", cat.Name)
cmd.Parameters.AddWithValue ("@slug", cat.Slug)
cmd.Parameters.AddWithValue ("@description", maybe cat.Description)
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map _.Value))
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map string))
] |> ignore
/// Add a category
@ -102,18 +102,18 @@ type SQLiteCategoryData (conn : SqliteConnection) =
}
/// Find a category by its ID for the given web log
let findById (catId: CategoryId) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
use cmd = conn.CreateCommand()
cmd.CommandText <- "SELECT * FROM category WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", catId.Value) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<Category> webLogId (fun c -> c.WebLogId) Map.toCategory rdr
cmd.Parameters.AddWithValue ("@id", string catId) |> ignore
use! rdr = cmd.ExecuteReaderAsync()
return verifyWebLog<Category> webLogId (_.WebLogId) Map.toCategory rdr
}
/// Find all categories for the given web log
let findByWebLog webLogId = backgroundTask {
let findByWebLog (webLogId: WebLogId) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM category WHERE web_log_id = @webLogId"
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
cmd.Parameters.AddWithValue ("@webLogId", string webLogId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toCategory rdr
}
@ -125,11 +125,11 @@ type SQLiteCategoryData (conn : SqliteConnection) =
use cmd = conn.CreateCommand ()
// Reassign any children to the category's parent category
cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE parent_id = @parentId"
cmd.Parameters.AddWithValue ("@parentId", catId.Value) |> ignore
cmd.Parameters.AddWithValue ("@parentId", string catId) |> ignore
let! children = count cmd
if children > 0 then
cmd.CommandText <- "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId"
cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map _.Value))
cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map string))
|> ignore
do! write cmd
// Delete the category off all posts where it is assigned, and the category itself
@ -139,7 +139,7 @@ type SQLiteCategoryData (conn : SqliteConnection) =
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId);
DELETE FROM category WHERE id = @id"
cmd.Parameters.Clear ()
let _ = cmd.Parameters.AddWithValue ("@id", catId.Value)
let _ = cmd.Parameters.AddWithValue ("@id", string catId)
addWebLogId cmd webLogId
do! write cmd
return if children = 0 then CategoryDeleted else ReassignedChildCategories

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

@ -13,11 +13,11 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
/// Add parameters for page INSERT or UPDATE statements
let addPageParameters (cmd: SqliteCommand) (page: Page) =
[ cmd.Parameters.AddWithValue ("@id", page.Id.Value)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId)
[ cmd.Parameters.AddWithValue ("@id", string page.Id)
cmd.Parameters.AddWithValue ("@webLogId", string page.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", string page.AuthorId)
cmd.Parameters.AddWithValue ("@title", page.Title)
cmd.Parameters.AddWithValue ("@permalink", page.Permalink.Value)
cmd.Parameters.AddWithValue ("@permalink", string page.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", instantParam page.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam page.UpdatedOn)
cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
@ -30,7 +30,7 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
/// Append revisions and permalinks to a page
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@pageId", page.Id.Value) |> ignore
cmd.Parameters.AddWithValue ("@pageId", string page.Id) |> ignore
cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId"
use! rdr = cmd.ExecuteReaderAsync ()
@ -57,11 +57,11 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@pageId", pageId.Value)
[ cmd.Parameters.AddWithValue ("@pageId", string pageId)
cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore
let runCmd (link: Permalink) = backgroundTask {
cmd.Parameters["@link"].Value <- link.Value
cmd.Parameters["@link"].Value <- string link
do! write cmd
}
cmd.CommandText <- "DELETE FROM page_permalink WHERE page_id = @pageId AND permalink = @link"
@ -85,10 +85,10 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", pageId.Value)
[ cmd.Parameters.AddWithValue ("@pageId", string pageId)
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", rev.Text.Value) |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", string rev.Text) |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf"
@ -157,7 +157,7 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
let findById (pageId: PageId) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", pageId.Value) |> ignore
cmd.Parameters.AddWithValue ("@id", string pageId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return verifyWebLog<Page> webLogId (_.WebLogId) (Map.toPage ser) rdr
}
@ -175,7 +175,7 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
match! findById pageId webLogId with
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", pageId.Value) |> ignore
cmd.Parameters.AddWithValue ("@id", string pageId) |> ignore
cmd.CommandText <-
"DELETE FROM page_revision WHERE page_id = @id;
DELETE FROM page_permalink WHERE page_id = @id;
@ -190,15 +190,15 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", permalink.Value) |> ignore
cmd.Parameters.AddWithValue ("@link", string permalink) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (toPage rdr) else None
}
/// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
let linkSql, linkParams = inClause "AND pp.permalink" "link" (fun (it: Permalink) -> it.Value) permalinks
let linkSql, linkParams = inClause "AND pp.permalink" "link" string permalinks
cmd.CommandText <- $"
SELECT p.permalink
FROM page p

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

@ -14,12 +14,12 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
/// Add parameters for post INSERT or UPDATE statements
let addPostParameters (cmd: SqliteCommand) (post: Post) =
[ cmd.Parameters.AddWithValue ("@id", post.Id.Value)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId)
cmd.Parameters.AddWithValue ("@status", post.Status.Value)
[ cmd.Parameters.AddWithValue ("@id", string post.Id)
cmd.Parameters.AddWithValue ("@webLogId", string post.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", string post.AuthorId)
cmd.Parameters.AddWithValue ("@status", string post.Status)
cmd.Parameters.AddWithValue ("@title", post.Title)
cmd.Parameters.AddWithValue ("@permalink", post.Permalink.Value)
cmd.Parameters.AddWithValue ("@permalink", string post.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", maybeInstant post.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn)
cmd.Parameters.AddWithValue ("@template", maybe post.Template)
@ -34,7 +34,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
/// Append category IDs and tags to a post
let appendPostCategoryAndTag (post: Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", post.Id.Value) |> ignore
cmd.Parameters.AddWithValue ("@id", string post.Id) |> ignore
cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync ()
@ -49,7 +49,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
/// Append revisions and permalinks to a post
let appendPostRevisionsAndPermalinks (post: Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@postId", post.Id.Value) |> ignore
cmd.Parameters.AddWithValue ("@postId", string post.Id) |> ignore
cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId"
use! rdr = cmd.ExecuteReaderAsync ()
@ -72,7 +72,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
let findPostById (postId: PostId) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
cmd.Parameters.AddWithValue ("@id", postId.Value) |> ignore
cmd.Parameters.AddWithValue ("@id", string postId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return verifyWebLog<Post> webLogId (_.WebLogId) toPost rdr
}
@ -83,16 +83,16 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
/// Update a post's assigned categories
let updatePostCategories (postId: PostId) oldCats newCats = backgroundTask {
let toDelete, toAdd = Utils.diffLists<CategoryId, string> oldCats newCats _.Value
let toDelete, toAdd = Utils.diffLists<CategoryId, string> oldCats newCats string
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", postId.Value)
[ cmd.Parameters.AddWithValue ("@postId", string postId)
cmd.Parameters.Add ("@categoryId", SqliteType.Text)
] |> ignore
let runCmd (catId: CategoryId) = backgroundTask {
cmd.Parameters["@categoryId"].Value <- catId.Value
cmd.Parameters["@categoryId"].Value <- string catId
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId"
@ -114,7 +114,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", postId.Value)
[ cmd.Parameters.AddWithValue ("@postId", string postId)
cmd.Parameters.Add ("@tag", SqliteType.Text)
] |> ignore
let runCmd (tag: string) = backgroundTask {
@ -140,11 +140,11 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", postId.Value)
[ cmd.Parameters.AddWithValue ("@postId", string postId)
cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore
let runCmd (link: Permalink) = backgroundTask {
cmd.Parameters["@link"].Value <- link.Value
cmd.Parameters["@link"].Value <- string link
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_permalink WHERE post_id = @postId AND permalink = @link"
@ -168,10 +168,10 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", postId.Value)
[ cmd.Parameters.AddWithValue ("@postId", string postId)
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", rev.Text.Value) |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", string rev.Text) |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf"
@ -212,7 +212,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE web_log_id = @webLogId AND status = @status"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", status.Value) |> ignore
cmd.Parameters.AddWithValue ("@status", string status) |> ignore
return! count cmd
}
@ -230,7 +230,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId AND p.permalink = @link"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", permalink.Value) |> ignore
cmd.Parameters.AddWithValue ("@link", string permalink) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
let! post = appendPostCategoryAndTag (toPost rdr)
@ -253,7 +253,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
match! findFullById postId webLogId with
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", postId.Value) |> ignore
cmd.Parameters.AddWithValue ("@id", string postId) |> ignore
cmd.CommandText <-
"DELETE FROM post_revision WHERE post_id = @id;
DELETE FROM post_permalink WHERE post_id = @id;
@ -267,9 +267,9 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
}
/// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
let linkSql, linkParams = inClause "AND pp.permalink" "link" (fun (it: Permalink) -> it.Value) permalinks
let linkSql, linkParams = inClause "AND pp.permalink" "link" string permalinks
cmd.CommandText <- $"
SELECT p.permalink
FROM post p
@ -299,9 +299,9 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
}
/// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
let catSql, catParams = inClause "AND pc.category_id" "catId" (fun (it: CategoryId) -> it.Value) categoryIds
let catSql, catParams = inClause "AND pc.category_id" "catId" string categoryIds
cmd.CommandText <- $"
{selectPost}
INNER JOIN post_category pc ON pc.post_id = p.id
@ -311,7 +311,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", Published.Value) |> ignore
cmd.Parameters.AddWithValue ("@status", string Published) |> ignore
cmd.Parameters.AddRange catParams
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
@ -348,7 +348,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", Published.Value) |> ignore
cmd.Parameters.AddWithValue ("@status", string Published) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList toPost rdr
@ -369,7 +369,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", Published.Value)
[ cmd.Parameters.AddWithValue ("@status", string Published)
cmd.Parameters.AddWithValue ("@tag", tag)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
@ -391,7 +391,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
ORDER BY p.published_on DESC
LIMIT 1"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", Published.Value)
[ cmd.Parameters.AddWithValue ("@status", string Published)
cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()

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

@ -8,12 +8,12 @@ open MyWebLog.Data
type SQLiteTagMapData (conn : SqliteConnection) =
/// Find a tag mapping by its ID for the given web log
let findById tagMapId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
let findById (tagMapId: TagMapId) webLogId = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- "SELECT * FROM tag_map WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<TagMap> webLogId (fun tm -> tm.WebLogId) Map.toTagMap rdr
cmd.Parameters.AddWithValue ("@id", string tagMapId) |> ignore
use! rdr = cmd.ExecuteReaderAsync()
return verifyWebLog<TagMap> webLogId (_.WebLogId) Map.toTagMap rdr
}
/// Delete a tag mapping for the given web log
@ -22,7 +22,7 @@ type SQLiteTagMapData (conn : SqliteConnection) =
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.CommandText <- "DELETE FROM tag_map WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore
cmd.Parameters.AddWithValue ("@id", string tagMapId) |> ignore
do! write cmd
return true
| None -> return false
@ -81,7 +81,7 @@ type SQLiteTagMapData (conn : SqliteConnection) =
@id, @webLogId, @tag, @urlValue
)"
addWebLogId cmd tagMap.WebLogId
[ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id)
[ cmd.Parameters.AddWithValue ("@id", string tagMap.Id)
cmd.Parameters.AddWithValue ("@tag", tagMap.Tag)
cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue)
] |> ignore

33
src/MyWebLog.Data/SQLite/SQLiteThemeData.fs
View File

@ -27,19 +27,19 @@ type SQLiteThemeData (conn : SqliteConnection) =
}
/// Does a given theme exist?
let exists themeId = backgroundTask {
let exists (themeId: ThemeId) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM theme WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
cmd.Parameters.AddWithValue ("@id", string themeId) |> ignore
let! count = count cmd
return count > 0
}
/// Find a theme by its ID
let findById themeId = backgroundTask {
let findById (themeId: ThemeId) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM theme WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
cmd.Parameters.AddWithValue ("@id", string themeId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
let theme = Map.toTheme rdr
@ -71,29 +71,28 @@ type SQLiteThemeData (conn : SqliteConnection) =
"DELETE FROM theme_asset WHERE theme_id = @id;
DELETE FROM theme_template WHERE theme_id = @id;
DELETE FROM theme WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
cmd.Parameters.AddWithValue ("@id", string themeId) |> ignore
do! write cmd
return true
| None -> return false
}
/// Save a theme
let save (theme : Theme) = backgroundTask {
use cmd = conn.CreateCommand ()
let save (theme: Theme) = backgroundTask {
use cmd = conn.CreateCommand()
let! oldTheme = findById theme.Id
cmd.CommandText <-
match oldTheme with
| Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id"
| None -> "INSERT INTO theme VALUES (@id, @name, @version)"
[ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.Id)
[ cmd.Parameters.AddWithValue ("@id", string theme.Id)
cmd.Parameters.AddWithValue ("@name", theme.Name)
cmd.Parameters.AddWithValue ("@version", theme.Version)
] |> ignore
do! write cmd
let toDelete, toAdd =
Utils.diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue [])
theme.Templates (fun t -> t.Name)
Utils.diffLists (oldTheme |> Option.map _.Templates |> Option.defaultValue []) theme.Templates _.Name
let toUpdate =
theme.Templates
|> List.filter (fun t ->
@ -102,7 +101,7 @@ type SQLiteThemeData (conn : SqliteConnection) =
cmd.CommandText <-
"UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name"
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.Id)
[ cmd.Parameters.AddWithValue ("@themeId", string theme.Id)
cmd.Parameters.Add ("@name", SqliteType.Text)
cmd.Parameters.Add ("@template", SqliteType.Text)
] |> ignore
@ -157,10 +156,10 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
}
/// Delete all assets for the given theme
let deleteByTheme themeId = backgroundTask {
let deleteByTheme (themeId: ThemeId) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "DELETE FROM theme_asset WHERE theme_id = @themeId"
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString themeId) |> ignore
cmd.Parameters.AddWithValue ("@themeId", string themeId) |> ignore
do! write cmd
}
@ -177,19 +176,19 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
}
/// Get theme assets for the given theme (excludes data)
let findByTheme themeId = backgroundTask {
let findByTheme (themeId: ThemeId) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId"
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString themeId) |> ignore
cmd.Parameters.AddWithValue ("@themeId", string themeId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return toList (Map.toThemeAsset false) rdr
}
/// Get theme assets for the given theme
let findByThemeWithData themeId = backgroundTask {
let findByThemeWithData (themeId: ThemeId) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId"
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString themeId) |> ignore
cmd.Parameters.AddWithValue ("@themeId", string themeId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return toList (Map.toThemeAsset true) rdr
}

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

@ -5,14 +5,14 @@ open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
/// SQLite myWebLog web log data implementation
type SQLiteUploadData (conn : SqliteConnection) =
/// SQLite myWebLog web log data implementation
type SQLiteUploadData(conn: SqliteConnection) =
/// Add parameters for uploaded file INSERT and UPDATE statements
let addUploadParameters (cmd : SqliteCommand) (upload : Upload) =
[ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId)
cmd.Parameters.AddWithValue ("@path", upload.Path.Value)
let addUploadParameters (cmd: SqliteCommand) (upload: Upload) =
[ cmd.Parameters.AddWithValue ("@id", string upload.Id)
cmd.Parameters.AddWithValue ("@webLogId", string upload.WebLogId)
cmd.Parameters.AddWithValue ("@path", string upload.Path)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam upload.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length)
] |> ignore
@ -46,14 +46,14 @@ type SQLiteUploadData (conn : SqliteConnection) =
WHERE id = @id
AND web_log_id = @webLogId"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@id", UploadId.toString uploadId) |> ignore
cmd.Parameters.AddWithValue ("@id", string uploadId) |> ignore
let! rdr = cmd.ExecuteReaderAsync ()
if (rdr.Read ()) then
let upload = Map.toUpload false rdr
do! rdr.CloseAsync ()
cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
do! write cmd
return Ok upload.Path.Value
return Ok (string upload.Path)
else
return Error $"""Upload ID {cmd.Parameters["@id"]} not found"""
}

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

@ -9,8 +9,8 @@ open Newtonsoft.Json
// The web log podcast insert loop is not statically compilable; this is OK
#nowarn "3511"
/// SQLite myWebLog web log data implementation
type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
/// SQLite myWebLog web log data implementation
type SQLiteWebLogData(conn: SqliteConnection, ser: JsonSerializer) =
// SUPPORT FUNCTIONS
@ -25,28 +25,28 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
] |> ignore
/// Add parameters for web log INSERT or UPDATE statements
let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id)
let addWebLogParameters (cmd: SqliteCommand) (webLog: WebLog) =
[ cmd.Parameters.AddWithValue ("@id", string webLog.Id)
cmd.Parameters.AddWithValue ("@name", webLog.Name)
cmd.Parameters.AddWithValue ("@slug", webLog.Slug)
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle)
cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage)
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage)
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId)
cmd.Parameters.AddWithValue ("@themeId", string webLog.ThemeId)
cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase)
cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone)
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx)
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads)
cmd.Parameters.AddWithValue ("@uploads", string webLog.Uploads)
cmd.Parameters.AddWithValue ("@redirectRules", Utils.serialize ser webLog.RedirectRules)
] |> ignore
addWebLogRssParameters cmd webLog
/// Add parameters for custom feed INSERT or UPDATE statements
let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) =
[ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId)
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source)
cmd.Parameters.AddWithValue ("@path", feed.Path.Value)
let addCustomFeedParameters (cmd: SqliteCommand) (webLogId: WebLogId) (feed: CustomFeed) =
[ cmd.Parameters.AddWithValue ("@id", string feed.Id)
cmd.Parameters.AddWithValue ("@webLogId", string webLogId)
cmd.Parameters.AddWithValue ("@source", string feed.Source)
cmd.Parameters.AddWithValue ("@path", string feed.Path)
cmd.Parameters.AddWithValue ("@podcast", maybe (if Option.isSome feed.Podcast then
Some (Utils.serialize ser feed.Podcast)
else None))
@ -74,7 +74,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
/// Update the custom feeds for a web log
let updateCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog
let toDelete, toAdd = Utils.diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
let toDelete, toAdd = Utils.diffLists feeds webLog.Rss.CustomFeeds string
let toId (feed : CustomFeed) = feed.Id
let toUpdate =
webLog.Rss.CustomFeeds
@ -85,7 +85,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
toDelete
|> List.map (fun it -> backgroundTask {
cmd.CommandText <- "DELETE FROM web_log_feed WHERE id = @id"
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id
cmd.Parameters["@id"].Value <- string it.Id
do! write cmd
})
|> Task.WhenAll
@ -211,7 +211,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
use cmd = conn.CreateCommand ()
cmd.CommandText <- "UPDATE web_log SET redirect_rules = @redirectRules WHERE id = @id"
cmd.Parameters.AddWithValue ("@redirectRules", Utils.serialize ser webLog.RedirectRules) |> ignore
cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) |> ignore
cmd.Parameters.AddWithValue ("@id", string webLog.Id) |> ignore
do! write cmd
}
@ -228,7 +228,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
copyright = @copyright
WHERE id = @id"
addWebLogRssParameters cmd webLog
cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) |> ignore
cmd.Parameters.AddWithValue ("@id", string webLog.Id) |> ignore
do! write cmd
do! updateCustomFeeds webLog
}

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

@ -4,22 +4,22 @@ open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
/// SQLite myWebLog user data implementation
type SQLiteWebLogUserData (conn : SqliteConnection) =
/// SQLite myWebLog user data implementation
type SQLiteWebLogUserData(conn: SqliteConnection) =
// SUPPORT FUNCTIONS
/// Add parameters for web log user INSERT or UPDATE statements
let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) =
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.WebLogId)
let addWebLogUserParameters (cmd: SqliteCommand) (user: WebLogUser) =
[ cmd.Parameters.AddWithValue ("@id", string user.Id)
cmd.Parameters.AddWithValue ("@webLogId", string user.WebLogId)
cmd.Parameters.AddWithValue ("@email", user.Email)
cmd.Parameters.AddWithValue ("@firstName", user.FirstName)
cmd.Parameters.AddWithValue ("@lastName", user.LastName)
cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName)
cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash)
cmd.Parameters.AddWithValue ("@url", maybe user.Url)
cmd.Parameters.AddWithValue ("@accessLevel", user.AccessLevel.Value)
cmd.Parameters.AddWithValue ("@accessLevel", string user.AccessLevel)
cmd.Parameters.AddWithValue ("@createdOn", instantParam user.CreatedOn)
cmd.Parameters.AddWithValue ("@lastSeenOn", maybeInstant user.LastSeenOn)
] |> ignore
@ -42,12 +42,12 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
}
/// Find a user by their ID for the given web log
let findById userId webLogId = backgroundTask {
let findById (userId: WebLogUserId) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore
cmd.Parameters.AddWithValue ("@id", string userId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<WebLogUser> webLogId (fun u -> u.WebLogId) Map.toWebLogUser rdr
return verifyWebLog<WebLogUser> webLogId (_.WebLogId) Map.toWebLogUser rdr
}
/// Delete a user if they have no posts or pages
@ -56,7 +56,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE author_id = @userId"
cmd.Parameters.AddWithValue ("@userId", WebLogUserId.toString userId) |> ignore
cmd.Parameters.AddWithValue ("@userId", string userId) |> ignore
let! pageCount = count cmd
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE author_id = @userId"
let! postCount = count cmd
@ -89,16 +89,15 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
}
/// Find the names of users by their IDs for the given web log
let findNames webLogId userIds = backgroundTask {
let findNames webLogId (userIds: WebLogUserId list) = backgroundTask {
use cmd = conn.CreateCommand ()
let nameSql, nameParams = inClause "AND id" "id" WebLogUserId.toString userIds
let nameSql, nameParams = inClause "AND id" "id" string userIds
cmd.CommandText <- $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {nameSql}"
addWebLogId cmd webLogId
cmd.Parameters.AddRange nameParams
use! rdr = cmd.ExecuteReaderAsync ()
return
toList Map.toWebLogUser rdr
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
toList Map.toWebLogUser rdr |> List.map (fun u -> { Name = string u.Id; Value = WebLogUser.displayName u })
}
/// Restore users from a backup
@ -108,7 +107,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
}
/// Set a user's last seen date/time to now
let setLastSeen userId webLogId = backgroundTask {
let setLastSeen (userId: WebLogUserId) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"UPDATE web_log_user
@ -116,7 +115,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
WHERE id = @id
AND web_log_id = @webLogId"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId)
[ cmd.Parameters.AddWithValue ("@id", string userId)
cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Noda.now ()))
] |> ignore
let! _ = cmd.ExecuteNonQueryAsync ()

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

@ -203,7 +203,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
|> List.iter (fun (feedId, podcast) ->
cmd.CommandText <- "UPDATE web_log_feed SET podcast = @podcast WHERE id = @id"
[ cmd.Parameters.AddWithValue ("@podcast", Utils.serialize ser podcast)
cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feedId) ] |> ignore
cmd.Parameters.AddWithValue ("@id", string feedId) ] |> ignore
let _ = cmd.ExecuteNonQuery ()
cmd.Parameters.Clear ())
cmd.CommandText <- "SELECT * FROM post_episode"
@ -241,7 +241,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
|> List.iter (fun (postId, episode) ->
cmd.CommandText <- "UPDATE post SET episode = @episode WHERE id = @id"
[ cmd.Parameters.AddWithValue ("@episode", Utils.serialize ser episode)
cmd.Parameters.AddWithValue ("@id", postId.Value) ] |> ignore
cmd.Parameters.AddWithValue ("@id", string postId) ] |> ignore
let _ = cmd.ExecuteNonQuery ()
cmd.Parameters.Clear ())

12
src/MyWebLog.Data/Utils.fs
View File

@ -12,7 +12,7 @@ let currentDbVersion = "v2.1"
let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq {
for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do
let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug
{ Id = cat.Id.Value
{ Id = string cat.Id
Slug = fullSlug
Name = cat.Name
Description = cat.Description
@ -29,16 +29,16 @@ let diffLists<'T, 'U when 'U: equality> oldItems newItems (f: 'T -> 'U) =
List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems
/// 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}")
/// Find the permalinks added and removed
let diffPermalinks oldLinks newLinks =
diffLists oldLinks newLinks (fun (it: Permalink) -> it.Value)
let diffPermalinks (oldLinks: Permalink list) newLinks =
diffLists oldLinks newLinks string
/// Find the revisions added and removed
let diffRevisions oldRevs newRevs =
diffLists oldRevs newRevs (fun (rev: Revision) -> $"{rev.AsOf.ToUnixTimeTicks()}|{rev.Text.Value}")
let diffRevisions (oldRevs: Revision list) newRevs =
diffLists oldRevs newRevs (fun rev -> $"{rev.AsOf.ToUnixTimeTicks()}|{rev.Text}")
open MyWebLog.Converters
open Newtonsoft.Json

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

@ -32,7 +32,7 @@ module Category =
/// An empty category
let empty = {
Id = CategoryId.Empty
WebLogId = WebLogId.empty
WebLogId = WebLogId.Empty
Name = ""
Slug = ""
Description = None
@ -137,8 +137,8 @@ module Page =
/// An empty page
let empty = {
Id = PageId.Empty
WebLogId = WebLogId.empty
AuthorId = WebLogUserId.empty
WebLogId = WebLogId.Empty
AuthorId = WebLogUserId.Empty
Title = ""
Permalink = Permalink.Empty
PublishedOn = Noda.epoch
@ -210,8 +210,8 @@ module Post =
/// An empty post
let empty = {
Id = PostId.Empty
WebLogId = WebLogId.empty
AuthorId = WebLogUserId.empty
WebLogId = WebLogId.Empty
AuthorId = WebLogUserId.Empty
Status = Draft
Title = ""
Permalink = Permalink.Empty
@ -248,8 +248,8 @@ module TagMap =
/// An empty tag mapping
let empty = {
Id = TagMapId.empty
WebLogId = WebLogId.empty
Id = TagMapId.Empty
WebLogId = WebLogId.Empty
Tag = ""
UrlValue = ""
}
@ -328,8 +328,8 @@ module Upload =
/// An empty upload
let empty = {
Id = UploadId.empty
WebLogId = WebLogId.empty
Id = UploadId.Empty
WebLogId = WebLogId.Empty
Path = Permalink.Empty
UpdatedOn = Noda.epoch
Data = [||]
@ -384,7 +384,7 @@ module WebLog =
/// An empty web log
let empty = {
Id = WebLogId.empty
Id = WebLogId.Empty
Name = ""
Slug = ""
Subtitle = None
@ -393,7 +393,7 @@ module WebLog =
ThemeId = ThemeId "default"
UrlBase = ""
TimeZone = ""
Rss = RssOptions.empty
Rss = RssOptions.Empty
AutoHtmx = false
Uploads = Database
RedirectRules = []
@ -407,12 +407,12 @@ module WebLog =
/// Generate an absolute URL for the given link
let absoluteUrl webLog (permalink: Permalink) =
$"{webLog.UrlBase}/{permalink.Value}"
$"{webLog.UrlBase}/{permalink}"
/// Generate a relative URL for the given link
let relativeUrl webLog (permalink: Permalink) =
let _, leadPath = hostAndPath webLog
$"{leadPath}/{permalink.Value}"
$"{leadPath}/{permalink}"
/// Convert an Instant (UTC reference) to the web log's local date/time
let localTime webLog (date: Instant) =
@ -463,8 +463,8 @@ module WebLogUser =
/// An empty web log user
let empty = {
Id = WebLogUserId.empty
WebLogId = WebLogId.empty
Id = WebLogUserId.Empty
WebLogId = WebLogId.Empty
Email = ""
FirstName = ""
LastName = ""

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

@ -54,16 +54,16 @@ type AccessLevel =
| Administrator
/// Parse an access level from its string representation
static member Parse =
function
static member Parse level =
match level with
| "Author" -> Author
| "Editor" -> Editor
| "WebLogAdmin" -> WebLogAdmin
| "Administrator" -> Administrator
| it -> invalidArg "level" $"{it} is not a valid access level"
| _ -> invalidArg (nameof level) $"{level} is not a valid access level"
/// The string representation of this access level
member this.Value =
override this.ToString() =
match this with
| Author -> "Author"
| Editor -> "Editor"
@ -96,7 +96,7 @@ type CategoryId =
newId >> CategoryId
/// The string representation of this category ID
member this.Value =
override this.ToString() =
match this with CategoryId it -> it
@ -113,7 +113,7 @@ type CommentId =
newId >> CommentId
/// The string representation of this comment ID
member this.Value =
override this.ToString() =
match this with CommentId it -> it
@ -128,15 +128,15 @@ type CommentStatus =
| Spam
/// Parse a string into a comment status
static member Parse =
function
static member Parse status =
match status with
| "Approved" -> Approved
| "Pending" -> Pending
| "Spam" -> Spam
| it -> invalidArg "status" $"{it} is not a valid comment status"
| _ -> invalidArg (nameof status) $"{status} is not a valid comment status"
/// Convert a comment status to a string
member this.Value =
override this.ToString() =
match this with Approved -> "Approved" | Pending -> "Pending" | Spam -> "Spam"
@ -148,15 +148,15 @@ type ExplicitRating =
| Clean
/// Parse a string into an explicit rating
static member Parse =
function
static member Parse rating =
match rating with
| "yes" -> Yes
| "no" -> No
| "clean" -> Clean
| it -> invalidArg "rating" $"{it} is not a valid explicit rating"
| _ -> invalidArg (nameof rating) $"{rating} is not a valid explicit rating"
/// The string value of this rating
member this.Value =
override this.ToString() =
match this with Yes -> "yes" | No -> "no" | Clean -> "clean"
@ -289,11 +289,11 @@ type MarkupText =
| Html of string
/// Parse a string into a MarkupText instance
static member Parse(it: string) =
match it with
| text when text.StartsWith "Markdown: " -> Markdown text[10..]
| text when text.StartsWith "HTML: " -> Html text[6..]
| text -> invalidOp $"Cannot derive type of text ({text})"
static member Parse(text: string) =
match text with
| _ when text.StartsWith "Markdown: " -> Markdown text[10..]
| _ when text.StartsWith "HTML: " -> Html text[6..]
| _ -> invalidArg (nameof text) $"Cannot derive type of text ({text})"
/// The source type for the markup text
member this.SourceType =
@ -304,7 +304,8 @@ type MarkupText =
match this with Markdown text -> text | Html text -> text
/// The string representation of the markup text
member this.Value = $"{this.SourceType}: {this.Text}"
override this.ToString() =
$"{this.SourceType}: {this.Text}"
/// The HTML representation of the markup text
member this.AsHtml() =
@ -315,10 +316,10 @@ type MarkupText =
[<CLIMutable; NoComparison; NoEquality>]
type MetaItem = {
/// The name of the metadata value
Name : string
Name: string
/// The metadata value
Value : string
Value: string
} with
/// An empty metadata item
@ -330,10 +331,10 @@ type MetaItem = {
[<CLIMutable; NoComparison; NoEquality>]
type Revision = {
/// When this revision was saved
AsOf : Instant
AsOf: Instant
/// The text of the revision
Text : MarkupText
Text: MarkupText
} with
/// An empty revision
@ -350,7 +351,7 @@ type Permalink =
static member Empty = Permalink ""
/// The string value of this permalink
member this.Value =
override this.ToString() =
match this with Permalink it -> it
@ -367,7 +368,7 @@ type PageId =
newId >> PageId
/// The string value of this page ID
member this.Value =
override this.ToString() =
match this with PageId it -> it
@ -383,8 +384,8 @@ type PodcastMedium =
| Blog
/// Parse a string into a podcast medium
static member Parse =
function
static member Parse medium =
match medium with
| "podcast" -> Podcast
| "music" -> Music
| "video" -> Video
@ -392,10 +393,10 @@ type PodcastMedium =
| "audiobook" -> Audiobook
| "newsletter" -> Newsletter
| "blog" -> Blog
| it -> invalidArg "medium" $"{it} is not a valid podcast medium"
| _ -> invalidArg (nameof medium) $"{medium} is not a valid podcast medium"
/// The string value of this podcast medium
member this.Value =
override this.ToString() =
match this with
| Podcast -> "podcast"
| Music -> "music"
@ -415,14 +416,14 @@ type PostStatus =
| Published
/// Parse a string into a post status
static member Parse =
function
static member Parse status =
match status with
| "Draft" -> Draft
| "Published" -> Published
| it -> invalidArg "status" $"{it} is not a valid post status"
| _ -> invalidArg (nameof status) $"{status} is not a valid post status"
/// The string representation of this post status
member this.Value =
override this.ToString() =
match this with Draft -> "Draft" | Published -> "Published"
@ -439,7 +440,7 @@ type PostId =
newId >> PostId
/// Convert a post ID to a string
member this.Value =
override this.ToString() =
match this with PostId it -> it
@ -465,19 +466,20 @@ type RedirectRule = {
/// An identifier for a custom feed
type CustomFeedId = CustomFeedId of string
[<Struct>]
type CustomFeedId =
| CustomFeedId of string
/// Functions to support custom feed IDs
module CustomFeedId =
/// An empty custom feed ID
let empty = CustomFeedId ""
/// Convert a custom feed ID to a string
let toString = function CustomFeedId pi -> pi
static member Empty = CustomFeedId ""
/// Create a new custom feed ID
let create = newId >> CustomFeedId
static member Create =
newId >> CustomFeedId
/// Convert a custom feed ID to a string
override this.ToString() =
match this with CustomFeedId it -> it
/// The source for a custom feed
@ -486,99 +488,94 @@ type CustomFeedSource =
| Category of CategoryId
/// A feed based on a particular tag
| Tag of string
/// Functions to support feed sources
module CustomFeedSource =
/// Create a string version of a feed source
let toString : CustomFeedSource -> string =
function
| Category (CategoryId catId) -> $"category:{catId}"
| Tag tag -> $"tag:{tag}"
/// Parse a feed source from its string version
let parse : string -> CustomFeedSource =
static member Parse(source: string) =
let value (it : string) = it.Split(":").[1]
function
| source when source.StartsWith "category:" -> (value >> CategoryId >> Category) source
| source when source.StartsWith "tag:" -> (value >> Tag) source
| source -> invalidArg "feedSource" $"{source} is not a valid feed source"
match source with
| _ when source.StartsWith "category:" -> (value >> CategoryId >> Category) source
| _ when source.StartsWith "tag:" -> (value >> Tag) source
| _ -> invalidArg (nameof source) $"{source} is not a valid feed source"
/// Create a string version of a feed source
override this.ToString() =
match this with | Category (CategoryId catId) -> $"category:{catId}" | Tag tag -> $"tag:{tag}"
/// Options for a feed that describes a podcast
[<CLIMutable; NoComparison; NoEquality>]
type PodcastOptions = {
/// The title of the podcast
Title : string
Title: string
/// A subtitle for the podcast
Subtitle : string option
Subtitle: string option
/// The number of items in the podcast feed
ItemsInFeed : int
ItemsInFeed: int
/// A summary of the podcast (iTunes field)
Summary : string
Summary: string
/// The display name of the podcast author (iTunes field)
DisplayedAuthor : string
DisplayedAuthor: string
/// The e-mail address of the user who registered the podcast at iTunes
Email : string
Email: string
/// The link to the image for the podcast
ImageUrl : Permalink
ImageUrl: Permalink
/// The category from Apple Podcasts (iTunes) under which this podcast is categorized
AppleCategory : string
AppleCategory: string
/// A further refinement of the categorization of this podcast (Apple Podcasts/iTunes field / values)
AppleSubcategory : string option
AppleSubcategory: string option
/// The explictness rating (iTunes field)
Explicit : ExplicitRating
Explicit: ExplicitRating
/// The default media type for files in this podcast
DefaultMediaType : string option
DefaultMediaType: string option
/// The base URL for relative URL media files for this podcast (optional; defaults to web log base)
MediaBaseUrl : string option
MediaBaseUrl: string option
/// A GUID for this podcast
PodcastGuid : Guid option
PodcastGuid: Guid option
/// A URL at which information on supporting the podcast may be found (supports permalinks)
FundingUrl : string option
FundingUrl: string option
/// The text to be displayed in the funding item within the feed
FundingText : string option
FundingText: string option
/// The medium (what the podcast IS, not what it is ABOUT)
Medium : PodcastMedium option
Medium: PodcastMedium option
}
/// A custom feed
[<CLIMutable; NoComparison; NoEquality>]
type CustomFeed = {
/// The ID of the custom feed
Id : CustomFeedId
Id: CustomFeedId
/// The source for the custom feed
Source : CustomFeedSource
Source: CustomFeedSource
/// The path for the custom feed
Path : Permalink
Path: Permalink
/// Podcast options, if the feed defines a podcast
Podcast : PodcastOptions option
}
/// Functions to support custom feeds
module CustomFeed =
Podcast: PodcastOptions option
} with
/// An empty custom feed
let empty = {
Id = CustomFeedId ""
Source = Category (CategoryId "")
Path = Permalink ""
static member Empty = {
Id = CustomFeedId.Empty
Source = Category CategoryId.Empty
Path = Permalink.Empty
Podcast = None
}
@ -587,32 +584,29 @@ module CustomFeed =
[<CLIMutable; NoComparison; NoEquality>]
type RssOptions = {
/// Whether the site feed of posts is enabled
IsFeedEnabled : bool
IsFeedEnabled: bool
/// The name of the file generated for the site feed
FeedName : string
FeedName: string
/// Override the "posts per page" setting for the site feed
ItemsInFeed : int option
ItemsInFeed: int option
/// Whether feeds are enabled for all categories
IsCategoryEnabled : bool
IsCategoryEnabled: bool
/// Whether feeds are enabled for all tags
IsTagEnabled : bool
IsTagEnabled: bool
/// A copyright string to be placed in all feeds
Copyright : string option
Copyright: string option
/// Custom feeds for this web log
CustomFeeds: CustomFeed list
}
/// Functions to support RSS options
module RssOptions =
} with
/// An empty set of RSS options
let empty = {
static member Empty = {
IsFeedEnabled = true
FeedName = "feed.xml"
ItemsInFeed = None
@ -624,126 +618,126 @@ module RssOptions =
/// An identifier for a tag mapping
type TagMapId = TagMapId of string
[<Struct>]
type TagMapId =
| TagMapId of string
/// Functions to support tag mapping IDs
module TagMapId =
/// An empty tag mapping ID
let empty = TagMapId ""
/// Convert a tag mapping ID to a string
let toString = function TagMapId tmi -> tmi
static member Empty = TagMapId ""
/// Create a new tag mapping ID
let create = newId >> TagMapId
static member Create =
newId >> TagMapId
/// Convert a tag mapping ID to a string
override this.ToString() =
match this with TagMapId it -> it
/// An identifier for a theme (represents its path)
type ThemeId = ThemeId of string
/// Functions to support theme IDs
module ThemeId =
let toString = function ThemeId ti -> ti
[<Struct>]
type ThemeId =
| ThemeId of string
/// The string representation of a theme ID
override this.ToString() =
match this with ThemeId it -> it
/// An identifier for a theme asset
type ThemeAssetId = ThemeAssetId of ThemeId * string
[<Struct>]
type ThemeAssetId =
| ThemeAssetId of ThemeId * string
/// Functions to support theme asset IDs
module ThemeAssetId =
/// Convert a string into a theme asset ID
static member Parse(it : string) =
let themeIdx = it.IndexOf "/"
ThemeAssetId(ThemeId it[..(themeIdx - 1)], it[(themeIdx + 1)..])
/// Convert a theme asset ID into a path string
let toString = function ThemeAssetId (ThemeId theme, asset) -> $"{theme}/{asset}"
/// Convert a string into a theme asset ID
let ofString (it : string) =
let themeIdx = it.IndexOf "/"
ThemeAssetId (ThemeId it[..(themeIdx - 1)], it[(themeIdx + 1)..])
override this.ToString() =
match this with ThemeAssetId (ThemeId theme, asset) -> $"{theme}/{asset}"
/// A template for a theme
[<CLIMutable; NoComparison; NoEquality>]
type ThemeTemplate = {
/// The name of the template
Name : string
Name: string
/// The text of the template
Text : string
}
/// Functions to support theme templates
module ThemeTemplate =
Text: string
} with
/// An empty theme template
let empty =
static member Empty =
{ Name = ""; Text = "" }
/// Where uploads should be placed
[<Struct>]
type UploadDestination =
| Database
| Disk
/// Functions to support upload destinations
module UploadDestination =
/// Convert an upload destination to its string representation
let toString = function Database -> "Database" | Disk -> "Disk"
/// Parse an upload destination from its string representation
let parse value =
match value with
static member Parse destination =
match destination with
| "Database" -> Database
| "Disk" -> Disk
| it -> invalidArg "destination" $"{it} is not a valid upload destination"
| "Disk" -> Disk
| _ -> invalidArg (nameof destination) $"{destination} is not a valid upload destination"
/// The string representation of an upload destination
override this.ToString() =
match this with Database -> "Database" | Disk -> "Disk"
/// An identifier for an upload
type UploadId = UploadId of string
[<Struct>]
type UploadId =
| UploadId of string
/// Functions to support upload IDs
module UploadId =
/// An empty upload ID
let empty = UploadId ""
/// Convert an upload ID to a string
let toString = function UploadId ui -> ui
static member Empty = UploadId ""
/// Create a new upload ID
let create = newId >> UploadId
static member Create =
newId >> UploadId
/// The string representation of an upload ID
override this.ToString() =
match this with UploadId it -> it
/// An identifier for a web log
type WebLogId = WebLogId of string
[<Struct>]
type WebLogId =
| WebLogId of string
/// Functions to support web log IDs
module WebLogId =
/// An empty web log ID
let empty = WebLogId ""
/// Convert a web log ID to a string
let toString = function WebLogId wli -> wli
static member Empty = WebLogId ""
/// Create a new web log ID
let create = newId >> WebLogId
static member Create =
newId >> WebLogId
/// Convert a web log ID to a string
override this.ToString() =
match this with WebLogId it -> it
/// An identifier for a web log user
type WebLogUserId = WebLogUserId of string
/// Functions to support web log user IDs
module WebLogUserId =
[<Struct>]
type WebLogUserId =
| WebLogUserId of string
/// An empty web log user ID
let empty = WebLogUserId ""
/// Convert a web log user ID to a string
let toString = function WebLogUserId wli -> wli
static member Empty = WebLogUserId ""
/// Create a new web log user ID
let create = newId >> WebLogUserId
static member Create =
newId >> WebLogUserId
/// The string representation of a web log user ID
override this.ToString() =
match this with WebLogUserId it -> it

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

@ -73,30 +73,30 @@ type DisplayCategory = {
/// A display version of a custom feed definition
type DisplayCustomFeed = {
/// The ID of the custom feed
Id : string
Id: string
/// The source of the custom feed
Source : string
Source: string
/// The relative path at which the custom feed is served
Path : string
Path: string
/// Whether this custom feed is for a podcast
IsPodcast : bool
IsPodcast: bool
}
/// Support functions for custom feed displays
module DisplayCustomFeed =
/// Create a display version from a custom feed
let fromFeed (cats: DisplayCategory[]) (feed: CustomFeed) : DisplayCustomFeed =
let fromFeed (cats: DisplayCategory array) (feed: CustomFeed) : DisplayCustomFeed =
let source =
match feed.Source with
| Category (CategoryId catId) -> $"Category: {(cats |> Array.find (fun cat -> cat.Id = catId)).Name}"
| Tag tag -> $"Tag: {tag}"
{ Id = CustomFeedId.toString feed.Id
{ Id = string feed.Id
Source = source
Path = feed.Path.Value
Path = string feed.Path
IsPodcast = Option.isSome feed.Podcast
}
@ -137,14 +137,14 @@ type DisplayPage =
/// Create a minimal display page (no text or metadata) from a database page
static member FromPageMinimal webLog (page: Page) = {
Id = page.Id.Value
AuthorId = WebLogUserId.toString page.AuthorId
Id = string page.Id
AuthorId = string page.AuthorId
Title = page.Title
Permalink = page.Permalink.Value
Permalink = string page.Permalink
PublishedOn = WebLog.localTime webLog page.PublishedOn
UpdatedOn = WebLog.localTime webLog page.UpdatedOn
IsInPageList = page.IsInPageList
IsDefault = page.Id.Value = webLog.DefaultPage
IsDefault = string page.Id = webLog.DefaultPage
Text = ""
Metadata = []
}
@ -152,14 +152,14 @@ type DisplayPage =
/// Create a display page from a database page
static member FromPage webLog (page : Page) =
let _, extra = WebLog.hostAndPath webLog
{ Id = page.Id.Value
AuthorId = WebLogUserId.toString page.AuthorId
{ Id = string page.Id
AuthorId = string page.AuthorId
Title = page.Title
Permalink = page.Permalink.Value
Permalink = string page.Permalink
PublishedOn = WebLog.localTime webLog page.PublishedOn
UpdatedOn = WebLog.localTime webLog page.UpdatedOn
IsInPageList = page.IsInPageList
IsDefault = page.Id.Value = webLog.DefaultPage
IsDefault = string page.Id = webLog.DefaultPage
Text = addBaseToRelativeUrls extra page.Text
Metadata = page.Metadata
}
@ -195,35 +195,35 @@ open System.IO
[<NoComparison; NoEquality>]
type DisplayTheme = {
/// The ID / path slug of the theme
Id : string
Id: string
/// The name of the theme
Name : string
Name: string
/// The version of the theme
Version : string
Version: string
/// How many templates are contained in the theme
TemplateCount : int
TemplateCount: int
/// Whether the theme is in use by any web logs
IsInUse : bool
IsInUse: bool
/// Whether the theme .zip file exists on the filesystem
IsOnDisk : bool
IsOnDisk: bool
}
/// Functions to support displaying themes
module DisplayTheme =
/// Create a display theme from a theme
let fromTheme inUseFunc (theme : Theme) =
{ Id = ThemeId.toString theme.Id
let fromTheme inUseFunc (theme: Theme) =
{ Id = string theme.Id
Name = theme.Name
Version = theme.Version
TemplateCount = List.length theme.Templates
IsInUse = inUseFunc theme.Id
IsOnDisk = File.Exists $"{ThemeId.toString theme.Id}-theme.zip"
IsOnDisk = File.Exists $"{theme.Id}-theme.zip"
}
@ -231,33 +231,33 @@ module DisplayTheme =
[<NoComparison; NoEquality>]
type DisplayUpload = {
/// The ID of the uploaded file
Id : string
Id: string
/// The name of the uploaded file
Name : string
Name: string
/// The path at which the file is served
Path : string
Path: string
/// The date/time the file was updated
UpdatedOn : DateTime option
UpdatedOn: DateTime option
/// The source for this file (created from UploadDestination DU)
Source : string
Source: string
}
/// Functions to support displaying uploads
module DisplayUpload =
/// Create a display uploaded file
let fromUpload webLog source (upload : Upload) =
let path = upload.Path.Value
let fromUpload webLog (source: UploadDestination) (upload: Upload) =
let path = string upload.Path
let name = Path.GetFileName path
{ Id = UploadId.toString upload.Id
{ Id = string upload.Id
Name = name
Path = path.Replace (name, "")
Path = path.Replace(name, "")
UpdatedOn = Some (WebLog.localTime webLog upload.UpdatedOn)
Source = UploadDestination.toString source
Source = string source
}
@ -265,45 +265,45 @@ module DisplayUpload =
[<NoComparison; NoEquality>]
type DisplayUser = {
/// The ID of the user
Id : string
Id: string
/// The user name (e-mail address)
Email : string
Email: string
/// The user's first name
FirstName : string
FirstName: string
/// The user's last name
LastName : string
LastName: string
/// The user's preferred name
PreferredName : string
PreferredName: string
/// The URL of the user's personal site
Url : string
Url: string
/// The user's access level
AccessLevel : string
AccessLevel: string
/// When the user was created
CreatedOn : DateTime
CreatedOn: DateTime
/// When the user last logged on
LastSeenOn : Nullable<DateTime>
LastSeenOn: Nullable<DateTime>
}
/// Functions to support displaying a user's information
module DisplayUser =
/// Construct a displayed user from a web log user
let fromUser webLog (user : WebLogUser) =
{ Id = WebLogUserId.toString user.Id
let fromUser webLog (user: WebLogUser) =
{ Id = string user.Id
Email = user.Email
FirstName = user.FirstName
LastName = user.LastName
PreferredName = user.PreferredName
Url = defaultArg user.Url ""
AccessLevel = user.AccessLevel.Value
AccessLevel = string user.AccessLevel
CreatedOn = WebLog.localTime webLog user.CreatedOn
LastSeenOn = user.LastSeenOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable
}
@ -311,30 +311,30 @@ module DisplayUser =
/// View model for editing categories
[<CLIMutable; NoComparison; NoEquality>]
type EditCategoryModel =
{ /// The ID of the category being edited
CategoryId : string
/// The name of the category
Name : string
/// The category's URL slug
Slug : string
/// A description of the category (optional)
Description : string
/// The ID of the category for which this is a subcategory (optional)
ParentId : string
}
type EditCategoryModel = {
/// The ID of the category being edited
CategoryId: string
/// The name of the category
Name: string
/// The category's URL slug
Slug: string
/// A description of the category (optional)
Description: string
/// The ID of the category for which this is a subcategory (optional)
ParentId: string
} with
/// Create an edit model from an existing category
static member fromCategory (cat : Category) =
{ CategoryId = cat.Id.Value
static member fromCategory (cat: Category) =
{ CategoryId = string cat.Id
Name = cat.Name
Slug = cat.Slug
Description = defaultArg cat.Description ""
ParentId = cat.ParentId |> Option.map _.Value |> Option.defaultValue ""
ParentId = cat.ParentId |> Option.map string |> Option.defaultValue ""
}
/// Is this a new category?
@ -437,10 +437,10 @@ type EditCustomFeedModel =
static member fromFeed (feed: CustomFeed) =
let rss =
{ EditCustomFeedModel.empty with
Id = CustomFeedId.toString feed.Id
Id = string feed.Id
SourceType = match feed.Source with Category _ -> "category" | Tag _ -> "tag"
SourceValue = match feed.Source with Category (CategoryId catId) -> catId | Tag tag -> tag
Path = feed.Path.Value
Path = string feed.Path
}
match feed.Podcast with
| Some p ->
@ -452,16 +452,16 @@ type EditCustomFeedModel =
Summary = p.Summary
DisplayedAuthor = p.DisplayedAuthor
Email = p.Email
ImageUrl = p.ImageUrl.Value
ImageUrl = string p.ImageUrl
AppleCategory = p.AppleCategory
AppleSubcategory = defaultArg p.AppleSubcategory ""
Explicit = p.Explicit.Value
Explicit = string p.Explicit
DefaultMediaType = defaultArg p.DefaultMediaType ""
MediaBaseUrl = defaultArg p.MediaBaseUrl ""
FundingUrl = defaultArg p.FundingUrl ""
FundingText = defaultArg p.FundingText ""
PodcastGuid = p.PodcastGuid |> Option.map _.ToString().ToLowerInvariant() |> Option.defaultValue ""
Medium = p.Medium |> Option.map _.Value |> Option.defaultValue ""
Medium = p.Medium |> Option.map string |> Option.defaultValue ""
}
| None -> rss
@ -562,9 +562,9 @@ type EditPageModel = {
| Some rev -> rev
| None -> Revision.Empty
let page = if page.Metadata |> List.isEmpty then { page with Metadata = [ MetaItem.Empty ] } else page
{ PageId = page.Id.Value
{ PageId = string page.Id
Title = page.Title
Permalink = page.Permalink.Value
Permalink = string page.Permalink
Template = defaultArg page.Template ""
IsShownInPageList = page.IsInPageList
Source = latest.Text.SourceType
@ -580,7 +580,7 @@ type EditPageModel = {
member this.UpdatePage (page: Page) now =
let revision = { AsOf = now; Text = MarkupText.Parse $"{this.Source}: {this.Text}" }
// Detect a permalink change, and add the prior one to the prior list
match page.Permalink.Value with
match string page.Permalink with
| "" -> page
| link when link = this.Permalink -> page
| _ -> { page with PriorPermalinks = page.Permalink :: page.PriorPermalinks }
@ -715,15 +715,15 @@ type EditPostModel = {
| None -> Revision.Empty
let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.Empty ] } else post
let episode = defaultArg post.Episode Episode.Empty
{ PostId = post.Id.Value
{ PostId = string post.Id
Title = post.Title
Permalink = post.Permalink.Value
Permalink = string post.Permalink
Source = latest.Text.SourceType
Text = latest.Text.Text
Tags = String.Join (", ", post.Tags)
Template = defaultArg post.Template ""
CategoryIds = post.CategoryIds |> List.map _.Value |> Array.ofList
Status = post.Status.Value
CategoryIds = post.CategoryIds |> List.map string |> Array.ofList
Status = string post.Status
DoPublish = false
MetaNames = post.Metadata |> List.map _.Name |> Array.ofList
MetaValues = post.Metadata |> List.map _.Value |> Array.ofList
@ -737,7 +737,7 @@ type EditPostModel = {
MediaType = defaultArg episode.MediaType ""
ImageUrl = defaultArg episode.ImageUrl ""
Subtitle = defaultArg episode.Subtitle ""
Explicit = defaultArg (episode.Explicit |> Option.map _.Value) ""
Explicit = defaultArg (episode.Explicit |> Option.map string) ""
ChapterFile = defaultArg episode.ChapterFile ""
ChapterType = defaultArg episode.ChapterType ""
TranscriptUrl = defaultArg episode.TranscriptUrl ""
@ -757,7 +757,7 @@ type EditPostModel = {
member this.UpdatePost (post: Post) now =
let revision = { AsOf = now; Text = MarkupText.Parse $"{this.Source}: {this.Text}" }
// Detect a permalink change, and add the prior one to the prior list
match post.Permalink.Value with
match string post.Permalink with
| "" -> post
| link when link = this.Permalink -> post
| _ -> { post with PriorPermalinks = post.Permalink :: post.PriorPermalinks }
@ -916,7 +916,7 @@ type EditTagMapModel =
/// Create an edit model from the tag mapping
static member fromMapping (tagMap : TagMap) : EditTagMapModel =
{ Id = TagMapId.toString tagMap.Id
{ Id = string tagMap.Id
Tag = tagMap.Tag
UrlValue = tagMap.UrlValue
}
@ -924,39 +924,39 @@ type EditTagMapModel =
/// View model to display a user's information
[<CLIMutable; NoComparison; NoEquality>]
type EditUserModel =
{ /// The ID of the user
Id : string
type EditUserModel = {
/// The ID of the user
Id: string
/// The user's access level
AccessLevel : string
/// The user name (e-mail address)
Email : string
/// The user's access level
AccessLevel: string
/// The user name (e-mail address)
Email: string
/// The URL of the user's personal site
Url : string
/// The URL of the user's personal site
Url: string
/// The user's first name
FirstName : string
/// The user's first name
FirstName: string
/// The user's last name
LastName : string
/// The user's last name
LastName: string
/// The user's preferred name
PreferredName : string
/// The user's password
Password : string
/// Confirmation of the user's password
PasswordConfirm : string
}
/// The user's preferred name
PreferredName: string
/// The user's password
Password: string
/// Confirmation of the user's password
PasswordConfirm: string
} with
/// Construct a displayed user from a web log user
static member fromUser (user : WebLogUser) =
{ Id = WebLogUserId.toString user.Id
AccessLevel = user.AccessLevel.Value
static member fromUser (user: WebLogUser) =
{ Id = string user.Id
AccessLevel = string user.AccessLevel
Url = defaultArg user.Url ""
Email = user.Email
FirstName = user.FirstName
@ -1020,20 +1020,20 @@ type ManagePermalinksModel = {
/// Create a permalink model from a page
static member fromPage (pg: Page) =
{ Id = pg.Id.Value
{ Id = string pg.Id
Entity = "page"
CurrentTitle = pg.Title
CurrentPermalink = pg.Permalink.Value
Prior = pg.PriorPermalinks |> List.map _.Value |> Array.ofList
CurrentPermalink = string pg.Permalink
Prior = pg.PriorPermalinks |> List.map string |> Array.ofList
}
/// Create a permalink model from a post
static member fromPost (post: Post) =
{ Id = post.Id.Value
{ Id = string post.Id
Entity = "post"
CurrentTitle = post.Title
CurrentPermalink = post.Permalink.Value
Prior = post.PriorPermalinks |> List.map _.Value |> Array.ofList
CurrentPermalink = string post.Permalink
Prior = post.PriorPermalinks |> List.map string |> Array.ofList
}
@ -1055,7 +1055,7 @@ type ManageRevisionsModel =
/// Create a revision model from a page
static member fromPage webLog (pg: Page) =
{ Id = pg.Id.Value
{ Id = string pg.Id
Entity = "page"
CurrentTitle = pg.Title
Revisions = pg.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
@ -1063,7 +1063,7 @@ type ManageRevisionsModel =
/// Create a revision model from a post
static member fromPost webLog (post: Post) =
{ Id = post.Id.Value
{ Id = string post.Id
Entity = "post"
CurrentTitle = post.Title
Revisions = post.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
@ -1114,15 +1114,15 @@ type PostListItem = {
static member fromPost (webLog: WebLog) (post: Post) =
let _, extra = WebLog.hostAndPath webLog
let inTZ = WebLog.localTime webLog
{ Id = post.Id.Value
AuthorId = WebLogUserId.toString post.AuthorId
Status = post.Status.Value
{ Id = string post.Id
AuthorId = string post.AuthorId
Status = string post.Status
Title = post.Title
Permalink = post.Permalink.Value
Permalink = string post.Permalink
PublishedOn = post.PublishedOn |> Option.map inTZ |> Option.toNullable
UpdatedOn = inTZ post.UpdatedOn
Text = addBaseToRelativeUrls extra post.Text
CategoryIds = post.CategoryIds |> List.map _.Value
CategoryIds = post.CategoryIds |> List.map string
Tags = post.Tags
Episode = post.Episode
Metadata = post.Metadata
@ -1156,46 +1156,46 @@ type PostDisplay =
/// View model for editing web log settings
[<CLIMutable; NoComparison; NoEquality>]
type SettingsModel =
{ /// The name of the web log
Name : string
type SettingsModel = {
/// The name of the web log
Name: string
/// The slug of the web log
Slug : string
/// The subtitle of the web log
Subtitle : string
/// The slug of the web log
Slug: string
/// The subtitle of the web log
Subtitle: string
/// The default page
DefaultPage : string
/// The default page
DefaultPage: string
/// How many posts should appear on index pages
PostsPerPage : int
/// How many posts should appear on index pages
PostsPerPage: int
/// The time zone in which dates/times should be displayed
TimeZone : string
/// The theme to use to display the web log
ThemeId : string
/// Whether to automatically load htmx
AutoHtmx : bool
/// The default location for uploads
Uploads : string
}
/// The time zone in which dates/times should be displayed
TimeZone: string
/// The theme to use to display the web log
ThemeId: string
/// Whether to automatically load htmx
AutoHtmx: bool
/// The default location for uploads
Uploads: string
} with
/// Create a settings model from a web log
static member fromWebLog (webLog : WebLog) =
static member fromWebLog (webLog: WebLog) =
{ Name = webLog.Name
Slug = webLog.Slug
Subtitle = defaultArg webLog.Subtitle ""
DefaultPage = webLog.DefaultPage
PostsPerPage = webLog.PostsPerPage
TimeZone = webLog.TimeZone
ThemeId = ThemeId.toString webLog.ThemeId
ThemeId = string webLog.ThemeId
AutoHtmx = webLog.AutoHtmx
Uploads = UploadDestination.toString webLog.Uploads
Uploads = string webLog.Uploads
}
/// Update a web log with settings from the form
@ -1209,7 +1209,7 @@ type SettingsModel =
TimeZone = this.TimeZone
ThemeId = ThemeId this.ThemeId
AutoHtmx = this.AutoHtmx
Uploads = UploadDestination.parse this.Uploads
Uploads = UploadDestination.Parse this.Uploads
}

18
src/MyWebLog/Caches.fs
View File

@ -194,8 +194,8 @@ module TemplateCache =
let private hasInclude = Regex ("""{% include_template \"(.*)\" %}""", RegexOptions.None, TimeSpan.FromSeconds 2)
/// Get a template for the given theme and template name
let get (themeId : ThemeId) (templateName : string) (data : IData) = backgroundTask {
let templatePath = $"{ThemeId.toString themeId}/{templateName}"
let get (themeId: ThemeId) (templateName: string) (data: IData) = backgroundTask {
let templatePath = $"{themeId}/{templateName}"
match _cache.ContainsKey templatePath with
| true -> return Ok _cache[templatePath]
| false ->
@ -215,7 +215,7 @@ module TemplateCache =
if childNotFound = "" then child.Groups[1].Value
else $"{childNotFound}; {child.Groups[1].Value}"
""
text <- text.Replace (child.Value, childText)
text <- text.Replace(child.Value, childText)
if childNotFound <> "" then
let s = if childNotFound.IndexOf ";" >= 0 then "s" else ""
return Error $"Could not find the child template{s} {childNotFound} required by {templateName}"
@ -223,8 +223,8 @@ module TemplateCache =
_cache[templatePath] <- Template.Parse (text, SyntaxCompatibility.DotLiquid22)
return Ok _cache[templatePath]
| None ->
return Error $"Theme ID {ThemeId.toString themeId} does not have a template named {templateName}"
| None -> return Result.Error $"Theme ID {ThemeId.toString themeId} does not exist"
return Error $"Theme ID {themeId} does not have a template named {templateName}"
| None -> return Error $"Theme ID {themeId} does not exist"
}
/// Get all theme/template names currently cached
@ -232,16 +232,16 @@ module TemplateCache =
_cache.Keys |> Seq.sort |> Seq.toList
/// Invalidate all template cache entries for the given theme ID
let invalidateTheme (themeId : ThemeId) =
let keyPrefix = ThemeId.toString themeId
let invalidateTheme (themeId: ThemeId) =
let keyPrefix = string themeId
_cache.Keys
|> Seq.filter (fun key -> key.StartsWith keyPrefix)
|> Seq.filter _.StartsWith(keyPrefix)
|> List.ofSeq
|> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ())
/// Remove all entries from the template cache
let empty () =
_cache.Clear ()
_cache.Clear()
/// A cache of asset names by themes

6
src/MyWebLog/DotLiquidBespoke.fs
View File

@ -95,9 +95,9 @@ type NavLinkFilter () =
/// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
type ThemeAssetFilter () =
static member ThemeAsset (ctx : Context, asset : string) =
WebLog.relativeUrl ctx.WebLog (Permalink $"themes/{ThemeId.toString ctx.WebLog.ThemeId}/{asset}")
type ThemeAssetFilter() =
static member ThemeAsset(ctx: Context, asset: string) =
WebLog.relativeUrl ctx.WebLog (Permalink $"themes/{ctx.WebLog.ThemeId}/{asset}")
/// Create various items in the page header based on the state of the page being generated

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

@ -37,7 +37,7 @@ module Dashboard =
let admin : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
match! TemplateCache.get adminTheme "theme-list-body" ctx.Data with
| Ok bodyTemplate ->
let! themes = ctx.Data.Theme.All ()
let! themes = ctx.Data.Theme.All()
let cachedTemplates = TemplateCache.allNames ()
let! hash =
hashForPage "myWebLog Administration"
@ -50,10 +50,10 @@ module Dashboard =
themes
|> Seq.ofList
|> Seq.map (fun it -> [|
ThemeId.toString it.Id
string it.Id
it.Name
cachedTemplates
|> List.filter (fun n -> n.StartsWith (ThemeId.toString it.Id))
|> List.filter _.StartsWith(string it.Id)
|> List.length
|> string
|])
@ -61,8 +61,8 @@ module Dashboard =
|> addToHash "web_logs" (
WebLogCache.all ()
|> Seq.ofList
|> Seq.sortBy (fun it -> it.Name)
|> Seq.map (fun it -> [| WebLogId.toString it.Id; it.Name; it.UrlBase |])
|> Seq.sortBy _.Name
|> Seq.map (fun it -> [| string it.Id; it.Name; it.UrlBase |])
|> Array.ofSeq)
|> addViewContext ctx
return!
@ -317,7 +317,7 @@ module TagMapping =
addToHash "mappings" mappings hash
|> addToHash "mapping_ids" (
mappings
|> List.map (fun it -> { Name = it.Tag; Value = TagMapId.toString it.Id }))
|> List.map (fun it -> { Name = it.Tag; Value = string it.Id }))
}
// GET /admin/settings/tag-mappings
@ -348,13 +348,13 @@ module TagMapping =
// POST /admin/settings/tag-mapping/save
let save : HttpHandler = fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel> ()
let! model = ctx.BindFormAsync<EditTagMapModel>()
let tagMap =
if model.IsNew then someTask { TagMap.empty with Id = TagMapId.create (); WebLogId = ctx.WebLog.Id }
if model.IsNew then someTask { TagMap.empty with Id = TagMapId.Create(); WebLogId = ctx.WebLog.Id }
else data.TagMap.FindById (TagMapId model.Id) ctx.WebLog.Id
match! tagMap with
| Some tm ->
do! data.TagMap.Save { tm with Tag = model.Tag.ToLower (); UrlValue = model.UrlValue.ToLower () }
do! data.TagMap.Save { tm with Tag = model.Tag.ToLower(); UrlValue = model.UrlValue.ToLower() }
do! addMessage ctx { UserMessage.success with Message = "Tag mapping saved successfully" }
return! all next ctx
| None -> return! Error.notFound next ctx
@ -395,17 +395,17 @@ module Theme =
|> adminBareView "theme-upload" next ctx
/// Update the name and version for a theme based on the version.txt file, if present
let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = backgroundTask {
let private updateNameAndVersion (theme: Theme) (zip: ZipArchive) = backgroundTask {
let now () = DateTime.UtcNow.ToString "yyyyMMdd.HHmm"
match zip.Entries |> Seq.filter (fun it -> it.FullName = "version.txt") |> Seq.tryHead with
| Some versionItem ->
use versionFile = new StreamReader(versionItem.Open ())
let! versionText = versionFile.ReadToEndAsync ()
use versionFile = new StreamReader(versionItem.Open())
let! versionText = versionFile.ReadToEndAsync()
let parts = versionText.Trim().Replace("\r", "").Split "\n"
let displayName = if parts[0] > "" then parts[0] else ThemeId.toString theme.Id
let displayName = if parts[0] > "" then parts[0] else string theme.Id
let version = if parts.Length > 1 && parts[1] > "" then parts[1] else now ()
return { theme with Name = displayName; Version = version }
| None -> return { theme with Name = ThemeId.toString theme.Id; Version = now () }
| None -> return { theme with Name = string theme.Id; Version = now () }
}
/// Update the theme with all templates from the ZIP archive
@ -476,16 +476,16 @@ module Theme =
let data = ctx.Data
let! exists = data.Theme.Exists themeId
let isNew = not exists
let! model = ctx.BindFormAsync<UploadThemeModel> ()
let! model = ctx.BindFormAsync<UploadThemeModel>()
if isNew || model.DoOverwrite then
// Load the theme to the database
use stream = new MemoryStream ()
use stream = new MemoryStream()
do! themeFile.CopyToAsync stream
let! _ = loadFromZip themeId stream data
do! ThemeAssetCache.refreshTheme themeId data
TemplateCache.invalidateTheme themeId
// Save the .zip file
use file = new FileStream ($"{ThemeId.toString themeId}-theme.zip", FileMode.Create)
use file = new FileStream($"{themeId}-theme.zip", FileMode.Create)
do! themeFile.CopyToAsync file
do! addMessage ctx
{ UserMessage.success with
@ -556,18 +556,18 @@ module WebLog =
KeyValuePair.Create("posts", "- First Page of Posts -")
yield! allPages
|> List.sortBy _.Title.ToLower()
|> List.map (fun p -> KeyValuePair.Create(p.Id.Value, p.Title))
|> List.map (fun p -> KeyValuePair.Create(string p.Id, p.Title))
}
|> Array.ofSeq)
|> addToHash "themes" (
themes
|> Seq.ofList
|> Seq.map (fun it ->
KeyValuePair.Create (ThemeId.toString it.Id, $"{it.Name} (v{it.Version})"))
KeyValuePair.Create(string it.Id, $"{it.Name} (v{it.Version})"))
|> Array.ofSeq)
|> addToHash "upload_values" [|
KeyValuePair.Create (UploadDestination.toString Database, "Database")
KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
KeyValuePair.Create(string Database, "Database")
KeyValuePair.Create(string Disk, "Disk")
|]
|> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList)
|> addToHash "rss_model" (EditRssModel.fromRssOptions ctx.WebLog.Rss)

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

@ -37,7 +37,7 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
| false ->
// Category and tag feeds are handled by defined routes; check for custom feed
match webLog.Rss.CustomFeeds
|> List.tryFind (fun it -> feedPath.EndsWith it.Path.Value) with
|> List.tryFind (fun it -> feedPath.EndsWith(string it.Path)) with
| Some feed ->
debug (fun () -> "Found custom feed")
Some (Custom (feed, feedPath), feed.Podcast |> Option.map _.ItemsInFeed |> Option.defaultValue postCount)
@ -48,7 +48,7 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
/// Determine the function to retrieve posts for the given feed
let private getFeedPosts ctx feedType =
let childIds (catId: CategoryId) =
let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = catId.Value)
let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = string catId)
getCategoryIds cat.Slug ctx
let data = ctx.Data
match feedType with
@ -86,51 +86,50 @@ module private Namespace =
let rawVoice = "http://www.rawvoice.com/rawvoiceRssModule/"
/// Create a feed item from the given post
let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[]) (tagMaps : TagMap list)
(post : Post) =
let private toFeedItem webLog (authors: MetaItem list) (cats: DisplayCategory array) (tagMaps: TagMap list)
(post: Post) =
let plainText =
let endingP = post.Text.IndexOf "</p>"
stripHtml <| if endingP >= 0 then post.Text[..(endingP - 1)] else post.Text
let item = SyndicationItem (
let item = SyndicationItem(
Id = WebLog.absoluteUrl webLog post.Permalink,
Title = TextSyndicationContent.CreateHtmlContent post.Title,
PublishDate = post.PublishedOn.Value.ToDateTimeOffset (),
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset (),
PublishDate = post.PublishedOn.Value.ToDateTimeOffset(),
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset(),
Content = TextSyndicationContent.CreatePlaintextContent plainText)
item.AddPermalink (Uri item.Id)
let xmlDoc = XmlDocument ()
let xmlDoc = XmlDocument()
let encoded =
let txt =
post.Text
.Replace("src=\"/", $"src=\"{webLog.UrlBase}/")
.Replace ("href=\"/", $"href=\"{webLog.UrlBase}/")
let it = xmlDoc.CreateElement ("content", "encoded", Namespace.content)
let _ = it.AppendChild (xmlDoc.CreateCDataSection txt)
.Replace("href=\"/", $"href=\"{webLog.UrlBase}/")
let it = xmlDoc.CreateElement("content", "encoded", Namespace.content)
let _ = it.AppendChild(xmlDoc.CreateCDataSection txt)
it
item.ElementExtensions.Add encoded
item.Authors.Add (SyndicationPerson (
Name = (authors |> List.find (fun a -> a.Name = WebLogUserId.toString post.AuthorId)).Value))
item.Authors.Add(SyndicationPerson(Name = (authors |> List.find (fun a -> a.Name = string post.AuthorId)).Value))
[ post.CategoryIds
|> List.map (fun catId ->
let cat = cats |> Array.find (fun c -> c.Id = catId.Value)
SyndicationCategory (cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name))
let cat = cats |> Array.find (fun c -> c.Id = string catId)
SyndicationCategory(cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name))
post.Tags
|> List.map (fun tag ->
let urlTag =
match tagMaps |> List.tryFind (fun tm -> tm.Tag = tag) with
| Some tm -> tm.UrlValue
| None -> tag.Replace (" ", "+")
SyndicationCategory (tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)"))
SyndicationCategory(tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)"))
]
|> List.concat
|> List.iter item.Categories.Add
item
/// Convert non-absolute URLs to an absolute URL for this web log
let toAbsolute webLog (link : string) =
let toAbsolute webLog (link: string) =
if link.StartsWith "http" then link else WebLog.absoluteUrl webLog (Permalink link)
/// Add episode information to a podcast feed item
@ -141,8 +140,8 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
| link when Option.isSome podcast.MediaBaseUrl -> $"{podcast.MediaBaseUrl.Value}{link}"
| link -> WebLog.absoluteUrl webLog (Permalink link)
let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
let epImageUrl = defaultArg episode.ImageUrl podcast.ImageUrl.Value |> toAbsolute webLog
let epExplicit = (defaultArg episode.Explicit podcast.Explicit).Value
let epImageUrl = defaultArg episode.ImageUrl (string podcast.ImageUrl) |> toAbsolute webLog
let epExplicit = string (defaultArg episode.Explicit podcast.Explicit)
let xmlDoc = XmlDocument()
let enclosure =
@ -298,7 +297,7 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
rssFeed.ElementExtensions.Add rawVoice
rssFeed.ElementExtensions.Add("summary", Namespace.iTunes, podcast.Summary)
rssFeed.ElementExtensions.Add("author", Namespace.iTunes, podcast.DisplayedAuthor)
rssFeed.ElementExtensions.Add("explicit", Namespace.iTunes, podcast.Explicit.Value)
rssFeed.ElementExtensions.Add("explicit", Namespace.iTunes, string podcast.Explicit)
podcast.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub))
podcast.FundingUrl
|> Option.iter (fun url ->
@ -309,7 +308,7 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
podcast.PodcastGuid
|> Option.iter (fun guid ->
rssFeed.ElementExtensions.Add("guid", Namespace.podcast, guid.ToString().ToLowerInvariant()))
podcast.Medium |> Option.iter (fun med -> rssFeed.ElementExtensions.Add("medium", Namespace.podcast, med.Value))
podcast.Medium |> Option.iter (fun med -> rssFeed.ElementExtensions.Add("medium", Namespace.podcast, string med))
/// Get the feed's self reference and non-feed link
let private selfAndLink webLog feedType ctx =
@ -368,7 +367,7 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
match podcast, post.Episode with
| Some feed, Some episode -> addEpisode webLog (Option.get feed.Podcast) episode post item
| Some _, _ ->
warn "Feed" ctx $"[{webLog.Name} {self.Value}] \"{stripHtml post.Title}\" has no media"
warn "Feed" ctx $"[{webLog.Name} {self}] \"{stripHtml post.Title}\" has no media"
item
| _ -> item
@ -427,7 +426,7 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let customFeed =
match feedId with
| "new" -> Some { CustomFeed.empty with Id = CustomFeedId "new" }
| "new" -> Some { CustomFeed.Empty with Id = CustomFeedId "new" }
| _ -> ctx.WebLog.Rss.CustomFeeds |> List.tryFind (fun f -> f.Id = CustomFeedId feedId)
match customFeed with
| Some f ->
@ -436,13 +435,13 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
|> addToHash ViewContext.Model (EditCustomFeedModel.fromFeed f)
|> addToHash "medium_values" [|
KeyValuePair.Create("", "&ndash; Unspecified &ndash;")
KeyValuePair.Create(Podcast.Value, "Podcast")
KeyValuePair.Create(Music.Value, "Music")
KeyValuePair.Create(Video.Value, "Video")
KeyValuePair.Create(Film.Value, "Film")
KeyValuePair.Create(Audiobook.Value, "Audiobook")
KeyValuePair.Create(Newsletter.Value, "Newsletter")
KeyValuePair.Create(Blog.Value, "Blog")
KeyValuePair.Create(string Podcast, "Podcast")
KeyValuePair.Create(string Music, "Music")
KeyValuePair.Create(string Video, "Video")
KeyValuePair.Create(string Film, "Film")
KeyValuePair.Create(string Audiobook, "Audiobook")
KeyValuePair.Create(string Newsletter, "Newsletter")
KeyValuePair.Create(string Blog, "Blog")
|]
|> adminView "custom-feed-edit" next ctx
| None -> Error.notFound next ctx
@ -455,8 +454,8 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let! model = ctx.BindFormAsync<EditCustomFeedModel> ()
let theFeed =
match model.Id with
| "new" -> Some { CustomFeed.empty with Id = CustomFeedId.create () }
| _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> CustomFeedId.toString it.Id = model.Id)
| "new" -> Some { CustomFeed.Empty with Id = CustomFeedId.Create() }
| _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> string it.Id = model.Id)
match theFeed with
| Some feed ->
let feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun it -> it.Id <> feed.Id))
@ -467,7 +466,7 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
UserMessage.success with
Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed"""
}
return! redirectToGet $"admin/settings/rss/{CustomFeedId.toString feed.Id}/edit" next ctx
return! redirectToGet $"admin/settings/rss/{feed.Id}/edit" next ctx
| None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx
}

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

@ -352,8 +352,8 @@ let requireAccess level : HttpHandler = fun next ctx -> task {
| Some userLevel ->
do! addMessage ctx
{ UserMessage.warning with
Message = $"The page you tried to access requires {level.Value} privileges"
Detail = Some $"Your account only has {userLevel.Value} privileges"
Message = $"The page you tried to access requires {level} privileges"
Detail = Some $"Your account only has {userLevel} privileges"
}
return! Error.notAuthorized next ctx
| None ->

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

@ -193,7 +193,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
do! (if model.IsNew then data.Page.Add else data.Page.Update) updatedPage
if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Page saved successfully" }
return! redirectToGet $"admin/page/{page.Id.Value}/edit" next ctx
return! redirectToGet $"admin/page/{page.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}

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

@ -58,7 +58,7 @@ let preparePostList webLog posts listType (url: string) pageNbr perPage (data: I
| _ -> Task.FromResult (None, None)
let newerLink =
match listType, pageNbr with
| SinglePost, _ -> newerPost |> Option.map _.Permalink.Value
| SinglePost, _ -> newerPost |> Option.map (fun it -> string it.Permalink)
| _, 1 -> None
| PostList, 2 when webLog.DefaultPage = "posts" -> Some ""
| PostList, _ -> relUrl $"page/{pageNbr - 1}"
@ -70,7 +70,7 @@ let preparePostList webLog posts listType (url: string) pageNbr perPage (data: I
| AdminList, _ -> relUrl $"admin/posts/page/{pageNbr - 1}"
let olderLink =
match listType, List.length posts > perPage with
| SinglePost, _ -> olderPost |> Option.map _.Permalink.Value
| SinglePost, _ -> olderPost |> Option.map (fun it -> string it.Permalink)
| _, false -> None
| PostList, true -> relUrl $"page/{pageNbr + 1}"
| CategoryList, true -> relUrl $"category/{url}/page/{pageNbr + 1}"
@ -243,9 +243,9 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> addToHash "templates" templates
|> addToHash "explicit_values" [|
KeyValuePair.Create("", "&ndash; Default &ndash;")
KeyValuePair.Create(Yes.Value, "Yes")
KeyValuePair.Create(No.Value, "No")
KeyValuePair.Create(Clean.Value, "Clean")
KeyValuePair.Create(string Yes, "Yes")
KeyValuePair.Create(string No, "No")
KeyValuePair.Create(string Clean, "Clean")
|]
|> adminView "post-edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
@ -410,7 +410,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> List.length = List.length priorCats) then
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Post saved successfully" }
return! redirectToGet $"admin/post/{post.Id.Value}/edit" next ctx
return! redirectToGet $"admin/post/{post.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}

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

@ -88,13 +88,13 @@ module CatchAll =
module Asset =
// GET /theme/{theme}/{**path}
let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
let serve (urlParts: string seq) : HttpHandler = fun next ctx -> task {
let path = urlParts |> Seq.skip 1 |> Seq.head
match! ctx.Data.ThemeAsset.FindById (ThemeAssetId.ofString path) with
match! ctx.Data.ThemeAsset.FindById(ThemeAssetId.Parse path) with
| Some asset ->
match Upload.checkModified asset.UpdatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx
| None -> return! Upload.sendFile (asset.UpdatedOn.ToDateTimeUtc ()) path asset.Data next ctx
| None -> return! Upload.sendFile (asset.UpdatedOn.ToDateTimeUtc()) path asset.Data next ctx
| None -> return! Error.notFound next ctx
}

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

@ -107,7 +107,7 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
Name = name
Path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace (slash, '/')
UpdatedOn = create
Source = UploadDestination.toString Disk
Source = string Disk
})
|> List.ofSeq
with
@ -131,7 +131,7 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
hashForPage "Upload a File"
|> withAntiCsrf ctx
|> addToHash "destination" (UploadDestination.toString ctx.WebLog.Uploads)
|> addToHash "destination" (string ctx.WebLog.Uploads)
|> adminView "upload-new" next ctx
@ -144,29 +144,29 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let upload = Seq.head ctx.Request.Form.Files
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
Path.GetExtension(upload.FileName).ToLowerInvariant ())
Path.GetExtension(upload.FileName).ToLowerInvariant())
let now = Noda.now ()
let localNow = WebLog.localTime ctx.WebLog now
let year = localNow.ToString "yyyy"
let month = localNow.ToString "MM"
let! form = ctx.BindFormAsync<UploadFileModel> ()
let! form = ctx.BindFormAsync<UploadFileModel>()
match UploadDestination.parse form.Destination with
match UploadDestination.Parse form.Destination with
| Database ->
use stream = new MemoryStream ()
use stream = new MemoryStream()
do! upload.CopyToAsync stream
let file =
{ Id = UploadId.create ()
{ Id = UploadId.Create()
WebLogId = ctx.WebLog.Id
Path = Permalink $"{year}/{month}/{fileName}"
UpdatedOn = now
Data = stream.ToArray ()
Data = stream.ToArray()
}
do! ctx.Data.Upload.Add file
| Disk ->
let fullPath = Path.Combine (uploadDir, ctx.WebLog.Slug, year, month)
let fullPath = Path.Combine(uploadDir, ctx.WebLog.Slug, year, month)
let _ = Directory.CreateDirectory fullPath
use stream = new FileStream (Path.Combine (fullPath, fileName), FileMode.Create)
use stream = new FileStream(Path.Combine(fullPath, fileName), FileMode.Create)
do! upload.CopyToAsync stream
do! addMessage ctx { UserMessage.success with Message = $"File uploaded to {form.Destination} successfully" }

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

@ -48,22 +48,22 @@ open Microsoft.AspNetCore.Authentication.Cookies
// POST /user/log-on
let doLogOn : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel> ()
let! model = ctx.BindFormAsync<LogOnModel>()
let data = ctx.Data
let! tryUser = data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id
match! verifyPassword tryUser model.Password ctx with
| Ok _ ->
let user = tryUser.Value
let claims = seq {
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id)
Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
Claim (ClaimTypes.GivenName, user.PreferredName)
Claim (ClaimTypes.Role, user.AccessLevel.Value)
Claim(ClaimTypes.NameIdentifier, string user.Id)
Claim(ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
Claim(ClaimTypes.GivenName, user.PreferredName)
Claim(ClaimTypes.Role, string user.AccessLevel)
}
let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
let identity = ClaimsIdentity(claims, CookieAuthenticationDefaults.AuthenticationScheme)
do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity,
AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow))
do! ctx.SignInAsync(identity.AuthenticationType, ClaimsPrincipal identity,
AuthenticationProperties(IssuedUtc = DateTimeOffset.UtcNow))
do! data.WebLogUser.SetLastSeen user.Id user.WebLogId
do! addMessage ctx
{ UserMessage.success with
@ -110,10 +110,10 @@ let private showEdit (model : EditUserModel) : HttpHandler = fun next ctx ->
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "access_levels" [|
KeyValuePair.Create(Author.Value, "Author")
KeyValuePair.Create(Editor.Value, "Editor")
KeyValuePair.Create(WebLogAdmin.Value, "Web Log Admin")
if ctx.HasAccessLevel Administrator then KeyValuePair.Create(Administrator.Value, "Administrator")
KeyValuePair.Create(string Author, "Author")
KeyValuePair.Create(string Editor, "Editor")
KeyValuePair.Create(string WebLogAdmin, "Web Log Admin")
if ctx.HasAccessLevel Administrator then KeyValuePair.Create(string Administrator, "Administrator")
|]
|> adminBareView "user-edit" next ctx
@ -159,7 +159,7 @@ let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandl
hashForPage "Edit Your Information"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "access_level" (user.AccessLevel.Value)
|> addToHash "access_level" (string user.AccessLevel)
|> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn)
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog
(defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
@ -208,7 +208,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let tryUser =
if model.IsNew then
{ WebLogUser.empty with
Id = WebLogUserId.create ()
Id = WebLogUserId.Create()
WebLogId = ctx.WebLog.Id
CreatedOn = Noda.now ()
} |> someTask

28
src/MyWebLog/Maintenance.fs
View File

@ -21,8 +21,8 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
| false, _ -> raise <| TimeZoneNotFoundException $"Cannot find IANA timezone for {local}"
// Create the web log
let webLogId = WebLogId.create ()
let userId = WebLogUserId.create ()
let webLogId = WebLogId.Create()
let userId = WebLogUserId.Create()
let homePageId = PageId.Create()
let slug = Handlers.Upload.makeSlug args[2]
@ -37,7 +37,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
Name = args[2]
Slug = slug
UrlBase = args[1]
DefaultPage = homePageId.Value
DefaultPage = string homePageId
TimeZone = timeZone
}
@ -110,8 +110,8 @@ let private importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
let! withLinks = data.Post.FindFullById post.Id post.WebLogId
let! _ = data.Post.UpdatePriorPermalinks post.Id post.WebLogId
(old :: withLinks.Value.PriorPermalinks)
printfn $"{old.Value} -> {current.Value}"
| None -> eprintfn $"Cannot find current post for {current.Value}"
printfn $"{old} -> {current}"
| None -> eprintfn $"Cannot find current post for {current}"
printfn "Done!"
| None -> eprintfn $"No web log found at {urlBase}"
}
@ -144,7 +144,7 @@ let loadTheme (args : string[]) (sp : IServiceProvider) = task {
let! theme = Handlers.Admin.Theme.loadFromZip themeId copy data
let fac = sp.GetRequiredService<ILoggerFactory> ()
let log = fac.CreateLogger "MyWebLog.Themes"
log.LogInformation $"{theme.Name} v{theme.Version} ({ThemeId.toString theme.Id}) loaded"
log.LogInformation $"{theme.Name} v{theme.Version} ({theme.Id}) loaded"
| Error message -> eprintfn $"{message}"
else
eprintfn "Usage: myWebLog load-theme [theme-zip-file-name]"
@ -333,13 +333,13 @@ module Backup =
return { archive with WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase webLog.UrlBase } }
| Some _ ->
// Err'body gets new IDs...
let newWebLogId = WebLogId.create ()
let newCatIds = archive.Categories |> List.map (fun cat -> cat.Id, CategoryId.Create ()) |> dict
let newMapIds = archive.TagMappings |> List.map (fun tm -> tm.Id, TagMapId.create ()) |> dict
let newPageIds = archive.Pages |> List.map (fun page -> page.Id, PageId.Create ()) |> dict
let newPostIds = archive.Posts |> List.map (fun post -> post.Id, PostId.Create ()) |> dict
let newUserIds = archive.Users |> List.map (fun user -> user.Id, WebLogUserId.create ()) |> dict
let newUpIds = archive.Uploads |> List.map (fun up -> up.Id, UploadId.create ()) |> dict
let newWebLogId = WebLogId.Create()
let newCatIds = archive.Categories |> List.map (fun cat -> cat.Id, CategoryId.Create() ) |> dict
let newMapIds = archive.TagMappings |> List.map (fun tm -> tm.Id, TagMapId.Create() ) |> dict
let newPageIds = archive.Pages |> List.map (fun page -> page.Id, PageId.Create() ) |> dict
let newPostIds = archive.Posts |> List.map (fun post -> post.Id, PostId.Create() ) |> dict
let newUserIds = archive.Users |> List.map (fun user -> user.Id, WebLogUserId.Create()) |> dict
let newUpIds = archive.Uploads |> List.map (fun up -> up.Id, UploadId.Create() ) |> dict
return
{ archive with
WebLog = { archive.WebLog with Id = newWebLogId; UrlBase = Option.get newUrlBase }
@ -481,7 +481,7 @@ let private doUserUpgrade urlBase email (data : IData) = task {
| WebLogAdmin ->
do! data.WebLogUser.Update { user with AccessLevel = Administrator }
printfn $"{email} is now an Administrator user"
| other -> eprintfn $"ERROR: {email} is an {other.Value}, not a WebLogAdmin"
| other -> eprintfn $"ERROR: {email} is an {other}, not a WebLogAdmin"
| None -> eprintfn $"ERROR: no user {email} found at {urlBase}"
| None -> eprintfn $"ERROR: no web log found for {urlBase}"
}

2
src/MyWebLog/Program.fs
View File

@ -15,7 +15,7 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>)
let path = $"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{ctx.Request.Path.Value}"
match WebLogCache.tryGet path with
| Some webLog ->
if isDebug then log.LogDebug $"Resolved web log {WebLogId.toString webLog.Id} for {path}"
if isDebug then log.LogDebug $"Resolved web log {webLog.Id} for {path}"
ctx.Items["webLog"] <- webLog
if PageListCache.exists ctx then () else do! PageListCache.update ctx
if CategoryCache.exists ctx then () else do! CategoryCache.update ctx