bit-badger/myWebLog
1
0
Fork 0
Code Issues 2 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() = type CategoryIdConverter() =
inherit JsonConverter<CategoryId>() inherit JsonConverter<CategoryId>()
override _.WriteJson(writer: JsonWriter, value: CategoryId, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: CategoryId, _: JsonSerializer) =
writer.WriteValue value.Value writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: CategoryId, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: CategoryId, _: bool, _: JsonSerializer) =
(string >> CategoryId) reader.Value (string >> CategoryId) reader.Value
type CommentIdConverter() = type CommentIdConverter() =
inherit JsonConverter<CommentId>() inherit JsonConverter<CommentId>()
override _.WriteJson(writer: JsonWriter, value: CommentId, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: CommentId, _: JsonSerializer) =
writer.WriteValue value.Value writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: CommentId, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: CommentId, _: bool, _: JsonSerializer) =
(string >> CommentId) reader.Value (string >> CommentId) reader.Value
type CommentStatusConverter() = type CommentStatusConverter() =
inherit JsonConverter<CommentStatus>() inherit JsonConverter<CommentStatus>()
override _.WriteJson(writer: JsonWriter, value: CommentStatus, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: CommentStatus, _: JsonSerializer) =
writer.WriteValue value.Value writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: CommentStatus, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: CommentStatus, _: bool, _: JsonSerializer) =
(string >> CommentStatus.Parse) reader.Value (string >> CommentStatus.Parse) reader.Value
type CustomFeedIdConverter () = type CustomFeedIdConverter() =
inherit JsonConverter<CustomFeedId> () inherit JsonConverter<CustomFeedId>()
override _.WriteJson (writer : JsonWriter, value : CustomFeedId, _ : JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: CustomFeedId, _: JsonSerializer) =
writer.WriteValue (CustomFeedId.toString value) writer.WriteValue(string value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : CustomFeedId, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: CustomFeedId, _: bool, _: JsonSerializer) =
(string >> CustomFeedId) reader.Value (string >> CustomFeedId) reader.Value
type CustomFeedSourceConverter () = type CustomFeedSourceConverter() =
inherit JsonConverter<CustomFeedSource> () inherit JsonConverter<CustomFeedSource>()
override _.WriteJson (writer : JsonWriter, value : CustomFeedSource, _ : JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: CustomFeedSource, _: JsonSerializer) =
writer.WriteValue (CustomFeedSource.toString value) writer.WriteValue(string value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : CustomFeedSource, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: CustomFeedSource, _: bool, _: JsonSerializer) =
(string >> CustomFeedSource.parse) reader.Value (string >> CustomFeedSource.Parse) reader.Value
type ExplicitRatingConverter() = type ExplicitRatingConverter() =
inherit JsonConverter<ExplicitRating>() inherit JsonConverter<ExplicitRating>()
override _.WriteJson(writer: JsonWriter, value: ExplicitRating, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: ExplicitRating, _: JsonSerializer) =
writer.WriteValue value.Value writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: ExplicitRating, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: ExplicitRating, _: bool, _: JsonSerializer) =
(string >> ExplicitRating.Parse) reader.Value (string >> ExplicitRating.Parse) reader.Value
type MarkupTextConverter() = type MarkupTextConverter() =
inherit JsonConverter<MarkupText>() inherit JsonConverter<MarkupText>()
override _.WriteJson(writer: JsonWriter, value: MarkupText, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: MarkupText, _: JsonSerializer) =
writer.WriteValue value.Value writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: MarkupText, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: MarkupText, _: bool, _: JsonSerializer) =
(string >> MarkupText.Parse) reader.Value (string >> MarkupText.Parse) reader.Value
type PermalinkConverter() = type PermalinkConverter() =
inherit JsonConverter<Permalink>() inherit JsonConverter<Permalink>()
override _.WriteJson(writer: JsonWriter, value: Permalink, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: Permalink, _: JsonSerializer) =
writer.WriteValue value.Value writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: Permalink, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: Permalink, _: bool, _: JsonSerializer) =
(string >> Permalink) reader.Value (string >> Permalink) reader.Value
type PageIdConverter() = type PageIdConverter() =
inherit JsonConverter<PageId>() inherit JsonConverter<PageId>()
override _.WriteJson(writer: JsonWriter, value: PageId, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: PageId, _: JsonSerializer) =
writer.WriteValue value.Value writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: PageId, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: PageId, _: bool, _: JsonSerializer) =
(string >> PageId) reader.Value (string >> PageId) reader.Value
type PodcastMediumConverter() = type PodcastMediumConverter() =
inherit JsonConverter<PodcastMedium>() inherit JsonConverter<PodcastMedium>()
override _.WriteJson(writer: JsonWriter, value: PodcastMedium, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: PodcastMedium, _: JsonSerializer) =
writer.WriteValue value.Value writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: PodcastMedium, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: PodcastMedium, _: bool, _: JsonSerializer) =
(string >> PodcastMedium.Parse) reader.Value (string >> PodcastMedium.Parse) reader.Value
type PostIdConverter() = type PostIdConverter() =
inherit JsonConverter<PostId>() inherit JsonConverter<PostId>()
override _.WriteJson(writer: JsonWriter, value: PostId, _: JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: PostId, _: JsonSerializer) =
writer.WriteValue value.Value writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: PostId, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: PostId, _: bool, _: JsonSerializer) =
(string >> PostId) reader.Value (string >> PostId) reader.Value
type TagMapIdConverter () = type TagMapIdConverter() =
inherit JsonConverter<TagMapId> () inherit JsonConverter<TagMapId>()
override _.WriteJson (writer : JsonWriter, value : TagMapId, _ : JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: TagMapId, _: JsonSerializer) =
writer.WriteValue (TagMapId.toString value) writer.WriteValue(string value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : TagMapId, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: TagMapId, _: bool, _: JsonSerializer) =
(string >> TagMapId) reader.Value (string >> TagMapId) reader.Value
type ThemeAssetIdConverter () = type ThemeAssetIdConverter() =
inherit JsonConverter<ThemeAssetId> () inherit JsonConverter<ThemeAssetId>()
override _.WriteJson (writer : JsonWriter, value : ThemeAssetId, _ : JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: ThemeAssetId, _: JsonSerializer) =
writer.WriteValue (ThemeAssetId.toString value) writer.WriteValue(string value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeAssetId, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: ThemeAssetId, _: bool, _: JsonSerializer) =
(string >> ThemeAssetId.ofString) reader.Value (string >> ThemeAssetId.Parse) reader.Value
type ThemeIdConverter () = type ThemeIdConverter() =
inherit JsonConverter<ThemeId> () inherit JsonConverter<ThemeId>()
override _.WriteJson (writer : JsonWriter, value : ThemeId, _ : JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: ThemeId, _: JsonSerializer) =
writer.WriteValue (ThemeId.toString value) writer.WriteValue(string value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: ThemeId, _: bool, _: JsonSerializer) =
(string >> ThemeId) reader.Value (string >> ThemeId) reader.Value
type UploadIdConverter () = type UploadIdConverter() =
inherit JsonConverter<UploadId> () inherit JsonConverter<UploadId>()
override _.WriteJson (writer : JsonWriter, value : UploadId, _ : JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: UploadId, _: JsonSerializer) =
writer.WriteValue (UploadId.toString value) writer.WriteValue(string value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadId, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: UploadId, _: bool, _: JsonSerializer) =
(string >> UploadId) reader.Value (string >> UploadId) reader.Value
type WebLogIdConverter () = type WebLogIdConverter() =
inherit JsonConverter<WebLogId> () inherit JsonConverter<WebLogId>()
override _.WriteJson (writer : JsonWriter, value : WebLogId, _ : JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: WebLogId, _: JsonSerializer) =
writer.WriteValue (WebLogId.toString value) writer.WriteValue(string value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : WebLogId, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: WebLogId, _: bool, _: JsonSerializer) =
(string >> WebLogId) reader.Value (string >> WebLogId) reader.Value
type WebLogUserIdConverter () = type WebLogUserIdConverter() =
inherit JsonConverter<WebLogUserId> () inherit JsonConverter<WebLogUserId> ()
override _.WriteJson (writer : JsonWriter, value : WebLogUserId, _ : JsonSerializer) = override _.WriteJson(writer: JsonWriter, value: WebLogUserId, _: JsonSerializer) =
writer.WriteValue (WebLogUserId.toString value) writer.WriteValue(string value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : WebLogUserId, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: WebLogUserId, _: bool, _: JsonSerializer) =
(string >> WebLogUserId) reader.Value (string >> WebLogUserId) reader.Value
open Microsoft.FSharpLu.Json open Microsoft.FSharpLu.Json

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

@ -43,7 +43,7 @@ type PostgresCategoryData(log: ILogger) =
FROM {Table.Post} FROM {Table.Post}
WHERE {Query.whereDataContains "@criteria"} WHERE {Query.whereDataContains "@criteria"}
AND {catIdSql}""" AND {catIdSql}"""
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published.Value |} [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |}
catIdParams ] catIdParams ]
Map.toCount Map.toCount
|> Async.AwaitTask |> Async.AwaitTask
@ -64,7 +64,7 @@ type PostgresCategoryData(log: ILogger) =
/// Find a category by its ID for the given web log /// Find a category by its ID for the given web log
let findById catId webLogId = let findById catId webLogId =
log.LogTrace "Category.findById" 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 /// Find all categories for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
@ -73,7 +73,7 @@ type PostgresCategoryData(log: ILogger) =
/// Create parameters for a category insert / update /// Create parameters for a category insert / update
let catParameters (cat : Category) = let catParameters (cat : Category) =
Query.docParameters cat.Id.Value cat Query.docParameters (string cat.Id) cat
/// Delete a category /// Delete a category
let delete catId webLogId = backgroundTask { let delete catId webLogId = backgroundTask {
@ -81,7 +81,7 @@ type PostgresCategoryData(log: ILogger) =
match! findById catId webLogId with match! findById catId webLogId with
| Some cat -> | Some cat ->
// Reassign any children to the category's parent category // 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) let hasChildren = not (List.isEmpty children)
if hasChildren then if hasChildren then
let! _ = let! _ =
@ -90,7 +90,7 @@ type PostgresCategoryData(log: ILogger) =
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.Update.partialById Table.Category, Query.Update.partialById Table.Category,
children |> List.map (fun child -> [ children |> List.map (fun child -> [
"@id", Sql.string child.Id.Value "@id", Sql.string (string child.Id)
"@data", Query.jsonbDocParam {| ParentId = cat.ParentId |} "@data", Query.jsonbDocParam {| ParentId = cat.ParentId |}
]) ])
] ]
@ -98,7 +98,7 @@ type PostgresCategoryData(log: ILogger) =
// Delete the category off all posts where it is assigned // Delete the category off all posts where it is assigned
let! posts = let! posts =
Custom.list $"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.empty.CategoryIds}' @> @id" 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 if not (List.isEmpty posts) then
let! _ = let! _ =
Configuration.dataSource () Configuration.dataSource ()
@ -106,14 +106,14 @@ type PostgresCategoryData(log: ILogger) =
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.Update.partialById Table.Post, Query.Update.partialById Table.Post,
posts |> List.map (fun post -> [ posts |> List.map (fun post -> [
"@id", Sql.string post.Id.Value "@id", Sql.string (string post.Id)
"@data", Query.jsonbDocParam "@data", Query.jsonbDocParam
{| CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId) |} {| CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId) |}
]) ])
] ]
() ()
// Delete the category itself // 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 return if hasChildren then ReassignedChildCategories else CategoryDeleted
| None -> return CategoryNotFound | 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 /// Create a SQL parameter for the web log ID
let webLogIdParam webLogId = let webLogIdParam webLogId =
"@webLogId", Sql.string (WebLogId.toString webLogId) "@webLogId", Sql.string (string webLogId)
/// Create an anonymous record with the given web log ID /// Create an anonymous record with the given web log ID
let webLogDoc (webLogId : WebLogId) = let webLogDoc (webLogId : WebLogId) =
@ -206,7 +206,7 @@ module Revisions =
let revParams<'TKey> (key : 'TKey) (keyFunc : 'TKey -> string) rev = [ let revParams<'TKey> (key : 'TKey) (keyFunc : 'TKey -> string) rev = [
typedParam "asOf" rev.AsOf typedParam "asOf" rev.AsOf
"@id", Sql.string (keyFunc key) "@id", Sql.string (keyFunc key)
"@text", Sql.string rev.Text.Value "@text", Sql.string (string rev.Text)
] ]
/// The SQL statement to insert a revision /// 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 /// Append revisions to a page
let appendPageRevisions (page: Page) = backgroundTask { let appendPageRevisions (page: Page) = backgroundTask {
log.LogTrace "Page.appendPageRevisions" 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 } return { page with Revisions = revisions }
} }
@ -25,12 +25,12 @@ type PostgresPageData (log: ILogger) =
/// Update a page's revisions /// Update a page's revisions
let updatePageRevisions (pageId: PageId) oldRevs newRevs = let updatePageRevisions (pageId: PageId) oldRevs newRevs =
log.LogTrace "Page.updatePageRevisions" 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? /// Does the given page exist?
let pageExists (pageId: PageId) webLogId = let pageExists (pageId: PageId) webLogId =
log.LogTrace "Page.pageExists" log.LogTrace "Page.pageExists"
Document.existsByWebLog Table.Page pageId (_.Value) webLogId Document.existsByWebLog Table.Page pageId string webLogId
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
@ -51,9 +51,9 @@ type PostgresPageData (log: ILogger) =
Count.byContains Table.Page {| webLogDoc webLogId with IsInPageList = true |} Count.byContains Table.Page {| webLogDoc webLogId with IsInPageList = true |}
/// Find a page by its ID (without revisions) /// Find a page by its ID (without revisions)
let findById (pageId: PageId) webLogId = let findById pageId webLogId =
log.LogTrace "Page.findById" 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 /// Find a complete page by its ID
let findFullById pageId webLogId = backgroundTask { let findFullById pageId webLogId = backgroundTask {
@ -70,7 +70,7 @@ type PostgresPageData (log: ILogger) =
log.LogTrace "Page.delete" log.LogTrace "Page.delete"
match! pageExists pageId webLogId with match! pageExists pageId webLogId with
| true -> | true ->
do! Delete.byId Table.Page pageId.Value do! Delete.byId Table.Page (string pageId)
return true return true
| false -> return false | false -> return false
} }
@ -78,16 +78,15 @@ type PostgresPageData (log: ILogger) =
/// Find a page by its permalink for the given web log /// Find a page by its permalink for the given web log
let findByPermalink (permalink: Permalink) webLogId = let findByPermalink (permalink: Permalink) webLogId =
log.LogTrace "Page.findByPermalink" 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 |> tryHead
/// Find the current permalink within a set of potential prior permalinks for the given web log /// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask { let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
log.LogTrace "Page.findCurrentPermalink" log.LogTrace "Page.findCurrentPermalink"
if List.isEmpty permalinks then return None if List.isEmpty permalinks then return None
else else
let linkSql, linkParam = let linkSql, linkParam = arrayContains (nameof Page.empty.PriorPermalinks) string permalinks
arrayContains (nameof Page.empty.PriorPermalinks) (fun (it: Permalink) -> it.Value) permalinks
return! return!
Custom.single Custom.single
$"""SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink $"""SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink
@ -134,9 +133,9 @@ type PostgresPageData (log: ILogger) =
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.insert Table.Page, Query.insert Table.Page,
pages 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.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" log.LogTrace "Page.updatePriorPermalinks"
match! pageExists pageId webLogId with match! pageExists pageId webLogId with
| true -> | true ->
do! Update.partialById Table.Page pageId.Value {| PriorPermalinks = permalinks |} do! Update.partialById Table.Page (string pageId) {| PriorPermalinks = permalinks |}
return true return true
| false -> return false | 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 /// Append revisions to a post
let appendPostRevisions (post: Post) = backgroundTask { let appendPostRevisions (post: Post) = backgroundTask {
log.LogTrace "Post.appendPostRevisions" 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 } return { post with Revisions = revisions }
} }
@ -26,30 +26,30 @@ type PostgresPostData(log: ILogger) =
/// Update a post's revisions /// Update a post's revisions
let updatePostRevisions (postId: PostId) oldRevs newRevs = let updatePostRevisions (postId: PostId) oldRevs newRevs =
log.LogTrace "Post.updatePostRevisions" 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? /// Does the given post exist?
let postExists (postId: PostId) webLogId = let postExists (postId: PostId) webLogId =
log.LogTrace "Post.postExists" log.LogTrace "Post.postExists"
Document.existsByWebLog Table.Post postId (_.Value) webLogId Document.existsByWebLog Table.Post postId string webLogId
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Count posts in a status for the given web log /// Count posts in a status for the given web log
let countByStatus (status: PostStatus) webLogId = let countByStatus (status: PostStatus) webLogId =
log.LogTrace "Post.countByStatus" 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) /// Find a post by its ID for the given web log (excluding revisions)
let findById postId webLogId = let findById postId webLogId =
log.LogTrace "Post.findById" 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) /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink (permalink: Permalink) webLogId = let findByPermalink (permalink: Permalink) webLogId =
log.LogTrace "Post.findByPermalink" log.LogTrace "Post.findByPermalink"
Custom.single (selectWithCriteria Table.Post) 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> fromData<Post>
/// Find a complete post by its ID for the given web log /// Find a complete post by its ID for the given web log
@ -70,18 +70,17 @@ type PostgresPostData(log: ILogger) =
do! Custom.nonQuery do! Custom.nonQuery
$"""DELETE FROM {Table.PostComment} WHERE {Query.whereDataContains "@criteria"}; $"""DELETE FROM {Table.PostComment} WHERE {Query.whereDataContains "@criteria"};
DELETE FROM {Table.Post} WHERE id = @id""" 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 return true
| false -> return false | false -> return false
} }
/// Find the current permalink from a list of potential prior permalinks for the given web log /// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask { let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
log.LogTrace "Post.findCurrentPermalink" log.LogTrace "Post.findCurrentPermalink"
if List.isEmpty permalinks then return None if List.isEmpty permalinks then return None
else else
let linkSql, linkParam = let linkSql, linkParam = arrayContains (nameof Post.empty.PriorPermalinks) string permalinks
arrayContains (nameof Post.empty.PriorPermalinks) (fun (it: Permalink) -> it.Value) permalinks
return! return!
Custom.single Custom.single
$"""SELECT data ->> '{nameof Post.empty.Permalink}' AS permalink $"""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) /// 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" log.LogTrace "Post.findPageOfCategorizedPosts"
let catSql, catParam = let catSql, catParam = arrayContains (nameof Post.empty.CategoryIds) string categoryIds
arrayContains (nameof Post.empty.CategoryIds) (fun (it: CategoryId) -> it.Value) categoryIds
Custom.list Custom.list
$"{selectWithCriteria Table.Post} $"{selectWithCriteria Table.Post}
AND {catSql} AND {catSql}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" 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 catParam
] fromData<Post> ] fromData<Post>
@ -132,7 +130,7 @@ type PostgresPostData(log: ILogger) =
$"{selectWithCriteria Table.Post} $"{selectWithCriteria Table.Post}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" 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> fromData<Post>
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks) /// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
@ -143,7 +141,7 @@ type PostgresPostData(log: ILogger) =
AND data['{nameof Post.empty.Tags}'] @> @tag AND data['{nameof Post.empty.Tags}'] @> @tag
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" 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 |] "@tag", Query.jsonbDocParam [| tag |]
] fromData<Post> ] fromData<Post>
@ -151,8 +149,8 @@ type PostgresPostData(log: ILogger) =
let findSurroundingPosts webLogId publishedOn = backgroundTask { let findSurroundingPosts webLogId publishedOn = backgroundTask {
log.LogTrace "Post.findSurroundingPosts" log.LogTrace "Post.findSurroundingPosts"
let queryParams () = [ let queryParams () = [
"@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published.Value |} "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |}
"@publishedOn", Sql.string ((InstantPattern.General.Format publishedOn).Substring (0, 19)) "@publishedOn", Sql.string ((InstantPattern.General.Format publishedOn)[..19])
] ]
let pubField = nameof Post.empty.PublishedOn let pubField = nameof Post.empty.PublishedOn
let! older = let! older =
@ -187,9 +185,9 @@ type PostgresPostData(log: ILogger) =
|> Sql.fromDataSource |> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.insert Table.Post, 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.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" log.LogTrace "Post.updatePriorPermalinks"
match! postExists postId webLogId with match! postExists postId webLogId with
| true -> | true ->
do! Update.partialById Table.Post postId.Value {| PriorPermalinks = permalinks |} do! Update.partialById Table.Post (string postId) {| PriorPermalinks = permalinks |}
return true return true
| false -> return false | 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 /// Find a tag mapping by its ID for the given web log
let findById tagMapId webLogId = let findById tagMapId webLogId =
log.LogTrace "TagMap.findById" 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 /// Delete a tag mapping for the given web log
let delete tagMapId webLogId = backgroundTask { let delete (tagMapId: TagMapId) webLogId = backgroundTask {
log.LogTrace "TagMap.delete" 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 if exists then
do! Delete.byId Table.TagMap (TagMapId.toString tagMapId) do! Delete.byId Table.TagMap (string tagMapId)
return true return true
else return false else return false
} }
@ -55,7 +55,7 @@ type PostgresTagMapData (log : ILogger) =
|> Sql.fromDataSource |> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.insert Table.TagMap, 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 Custom.list $"{Query.selectFromTable Table.Theme} WHERE id <> 'admin' ORDER BY id" [] withoutTemplateText
/// Does a given theme exist? /// Does a given theme exist?
let exists themeId = let exists (themeId: ThemeId) =
log.LogTrace "Theme.exists" log.LogTrace "Theme.exists"
Exists.byId Table.Theme (ThemeId.toString themeId) Exists.byId Table.Theme (string themeId)
/// Find a theme by its ID /// Find a theme by its ID
let findById themeId = let findById (themeId: ThemeId) =
log.LogTrace "Theme.findById" 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) /// Find a theme by its ID (excludes the text of templates)
let findByIdWithoutText themeId = let findByIdWithoutText (themeId: ThemeId) =
log.LogTrace "Theme.findByIdWithoutText" 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 /// Delete a theme by its ID
let delete themeId = backgroundTask { let delete themeId = backgroundTask {
log.LogTrace "Theme.delete" log.LogTrace "Theme.delete"
match! exists themeId with match! exists themeId with
| true -> | true ->
do! Delete.byId Table.Theme (ThemeId.toString themeId) do! Delete.byId Table.Theme (string themeId)
return true return true
| false -> return false | 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) Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}" [] (Map.toThemeAsset false)
/// Delete all assets for the given theme /// Delete all assets for the given theme
let deleteByTheme themeId = let deleteByTheme (themeId: ThemeId) =
log.LogTrace "ThemeAsset.deleteByTheme" log.LogTrace "ThemeAsset.deleteByTheme"
Custom.nonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @themeId" 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 /// Find a theme asset by its ID
let findById assetId = let findById assetId =
@ -80,16 +80,16 @@ type PostgresThemeAssetData (log : ILogger) =
[ "@themeId", Sql.string themeId; "@path", Sql.string path ] (Map.toThemeAsset true) [ "@themeId", Sql.string themeId; "@path", Sql.string path ] (Map.toThemeAsset true)
/// Get theme assets for the given theme (excludes data) /// Get theme assets for the given theme (excludes data)
let findByTheme themeId = let findByTheme (themeId: ThemeId) =
log.LogTrace "ThemeAsset.findByTheme" log.LogTrace "ThemeAsset.findByTheme"
Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @themeId" 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 /// Get theme assets for the given theme
let findByThemeWithData themeId = let findByThemeWithData (themeId: ThemeId) =
log.LogTrace "ThemeAsset.findByThemeWithData" log.LogTrace "ThemeAsset.findByThemeWithData"
Custom.list $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId" 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 /// Save a theme asset
let save (asset : ThemeAsset) = 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) = [ let upParams (upload : Upload) = [
webLogIdParam upload.WebLogId webLogIdParam upload.WebLogId
typedParam "updatedOn" upload.UpdatedOn typedParam "updatedOn" upload.UpdatedOn
"@id", Sql.string (UploadId.toString upload.Id) "@id", Sql.string (string upload.Id)
"@path", Sql.string upload.Path.Value "@path", Sql.string (string upload.Path)
"@data", Sql.bytea upload.Data "@data", Sql.bytea upload.Data
] ]
@ -34,14 +34,14 @@ type PostgresUploadData (log : ILogger) =
/// Delete an uploaded file by its ID /// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask { let delete uploadId webLogId = backgroundTask {
log.LogTrace "Upload.delete" log.LogTrace "Upload.delete"
let idParam = [ "@id", Sql.string (UploadId.toString uploadId) ] let idParam = [ "@id", Sql.string (string uploadId) ]
let! path = let! path =
Custom.single $"SELECT path FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId" Custom.single $"SELECT path FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
(webLogIdParam webLogId :: idParam) (fun row -> row.string "path") (webLogIdParam webLogId :: idParam) (fun row -> row.string "path")
if Option.isSome path then if Option.isSome path then
do! Custom.nonQuery (Query.Delete.byId Table.Upload) idParam do! Custom.nonQuery (Query.Delete.byId Table.Upload) idParam
return Ok path.Value 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 /// 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> fromData<WebLog>
/// Find a web log by its ID /// Find a web log by its ID
let findById webLogId = let findById (webLogId: WebLogId) =
log.LogTrace "WebLog.findById" 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" log.LogTrace "WebLog.updateRedirectRules"
match! findById webLog.Id with match! findById webLog.Id with
| Some _ -> | 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 -> () | None -> ()
} }
/// Update RSS options for a web log /// Update RSS options for a web log
let updateRssOptions (webLog : WebLog) = backgroundTask { let updateRssOptions (webLog: WebLog) = backgroundTask {
log.LogTrace "WebLog.updateRssOptions" log.LogTrace "WebLog.updateRssOptions"
match! findById webLog.Id with 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 -> () | None -> ()
} }
/// Update settings for a web log /// Update settings for a web log
let updateSettings (webLog : WebLog) = let updateSettings (webLog: WebLog) =
log.LogTrace "WebLog.updateSettings" log.LogTrace "WebLog.updateSettings"
Update.full Table.WebLog (WebLogId.toString webLog.Id) webLog Update.full Table.WebLog (string webLog.Id) webLog
interface IWebLogData with interface IWebLogData with
member _.Add webLog = add webLog 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 /// Find a user by their ID for the given web log
let findById userId webLogId = let findById userId webLogId =
log.LogTrace "WebLogUser.findById" 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 /// Delete a user if they have no posts or pages
let delete userId webLogId = backgroundTask { let delete userId webLogId = backgroundTask {
@ -29,7 +29,7 @@ type PostgresWebLogUserData (log : ILogger) =
if isAuthor then if isAuthor then
return Error "User has pages or posts; cannot delete" return Error "User has pages or posts; cannot delete"
else else
do! Delete.byId Table.WebLogUser (WebLogUserId.toString userId) do! Delete.byId Table.WebLogUser (string userId)
return Ok true return Ok true
| None -> return Error "User does not exist" | None -> return Error "User does not exist"
} }
@ -49,41 +49,38 @@ type PostgresWebLogUserData (log : ILogger) =
[ webLogContains webLogId ] fromData<WebLogUser> [ webLogContains webLogId ] fromData<WebLogUser>
/// Find the names of users by their IDs for the given web log /// Find the names of users by their IDs for the given web log
let findNames webLogId userIds = backgroundTask { let findNames webLogId (userIds: WebLogUserId list) = backgroundTask {
log.LogTrace "WebLogUser.findNames" 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 = let! users =
Custom.list $"{selectWithCriteria Table.WebLogUser} {idSql}" (webLogContains webLogId :: idParams) Custom.list $"{selectWithCriteria Table.WebLogUser} {idSql}" (webLogContains webLogId :: idParams)
fromData<WebLogUser> fromData<WebLogUser>
return return users |> List.map (fun u -> { Name = string u.Id; Value = WebLogUser.displayName u })
users
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
} }
/// Restore users from a backup /// Restore users from a backup
let restore (users : WebLogUser list) = backgroundTask { let restore (users: WebLogUser list) = backgroundTask {
log.LogTrace "WebLogUser.restore" log.LogTrace "WebLogUser.restore"
let! _ = let! _ =
Configuration.dataSource () Configuration.dataSource ()
|> Sql.fromDataSource |> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.insert Table.WebLogUser, 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 /// 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" log.LogTrace "WebLogUser.setLastSeen"
match! Document.existsByWebLog Table.WebLogUser userId WebLogUserId.toString webLogId with match! Document.existsByWebLog Table.WebLogUser userId string webLogId with
| true -> | true -> do! Update.partialById Table.WebLogUser (string userId) {| LastSeenOn = Some (Noda.now ()) |}
do! Update.partialById Table.WebLogUser (WebLogUserId.toString userId) {| LastSeenOn = Some (Noda.now ()) |}
| false -> () | false -> ()
} }
/// Save a user /// Save a user
let save (user : WebLogUser) = let save (user: WebLogUser) =
log.LogTrace "WebLogUser.save" log.LogTrace "WebLogUser.save"
save Table.WebLogUser user 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) /// Match theme asset IDs by their prefix (the theme ID)
let matchAssetByThemeId themeId = let matchAssetByThemeId themeId =
let keyPrefix = $"^{ThemeId.toString themeId}/" let keyPrefix = $"^{themeId}/"
fun (row : Ast.ReqlExpr) -> row[nameof ThemeAsset.empty.Id].Match keyPrefix :> obj fun (row : Ast.ReqlExpr) -> row[nameof ThemeAsset.empty.Id].Match keyPrefix :> obj
/// Function to exclude template text from themes /// Function to exclude template text from themes
let withoutTemplateText (row : Ast.ReqlExpr) : obj = 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 /// Ensure field indexes exist, as well as special indexes for selected tables
let ensureIndexes table fields = backgroundTask { let ensureIndexes table fields = backgroundTask {
@ -917,8 +917,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
delete delete
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
return Ok up.Path.Value return Ok (string up.Path)
| None -> return Result.Error $"Upload ID {UploadId.toString uploadId} not found" | None -> return Result.Error $"Upload ID {uploadId} not found"
} }
member _.FindByPath path webLogId = member _.FindByPath path webLogId =
@ -1133,9 +1133,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
filter (nameof WebLogUser.empty.WebLogId) webLogId filter (nameof WebLogUser.empty.WebLogId) webLogId
result; withRetryDefault conn result; withRetryDefault conn
} }
return return users |> List.map (fun u -> { Name = string u.Id; Value = WebLogUser.displayName u })
users
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
} }
member _.Restore users = backgroundTask { 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 /// Create a custom feed from the current row in the given data reader
let toCustomFeed ser rdr : CustomFeed = let toCustomFeed ser rdr : CustomFeed =
{ Id = getString "id" rdr |> CustomFeedId { Id = getString "id" rdr |> CustomFeedId
Source = getString "source" rdr |> CustomFeedSource.parse Source = getString "source" rdr |> CustomFeedSource.Parse
Path = getString "path" rdr |> Permalink Path = getString "path" rdr |> Permalink
Podcast = tryString "podcast" rdr |> Option.map (Utils.deserialize ser) Podcast = tryString "podcast" rdr |> Option.map (Utils.deserialize ser)
} }
@ -339,7 +339,7 @@ module Map =
UrlBase = getString "url_base" rdr UrlBase = getString "url_base" rdr
TimeZone = getString "time_zone" rdr TimeZone = getString "time_zone" rdr
AutoHtmx = getBoolean "auto_htmx" rdr AutoHtmx = getBoolean "auto_htmx" rdr
Uploads = getString "uploads" rdr |> UploadDestination.parse Uploads = getString "uploads" rdr |> UploadDestination.Parse
Rss = { Rss = {
IsFeedEnabled = getBoolean "is_feed_enabled" rdr IsFeedEnabled = getBoolean "is_feed_enabled" rdr
FeedName = getString "feed_name" rdr FeedName = getString "feed_name" rdr
@ -368,5 +368,5 @@ module Map =
} }
/// Add a web log ID parameter /// Add a web log ID parameter
let addWebLogId (cmd : SqliteCommand) webLogId = let addWebLogId (cmd: SqliteCommand) (webLogId: WebLogId) =
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore 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
open MyWebLog.Data open MyWebLog.Data
/// SQLite myWebLog category data implementation /// SQLite myWebLog category data implementation
type SQLiteCategoryData (conn : SqliteConnection) = type SQLiteCategoryData(conn: SqliteConnection) =
/// Add parameters for category INSERT or UPDATE statements /// Add parameters for category INSERT or UPDATE statements
let addCategoryParameters (cmd : SqliteCommand) (cat : Category) = let addCategoryParameters (cmd: SqliteCommand) (cat: Category) =
[ cmd.Parameters.AddWithValue ("@id", cat.Id.Value) [ cmd.Parameters.AddWithValue ("@id", string cat.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId) cmd.Parameters.AddWithValue ("@webLogId", string cat.WebLogId)
cmd.Parameters.AddWithValue ("@name", cat.Name) cmd.Parameters.AddWithValue ("@name", cat.Name)
cmd.Parameters.AddWithValue ("@slug", cat.Slug) cmd.Parameters.AddWithValue ("@slug", cat.Slug)
cmd.Parameters.AddWithValue ("@description", maybe cat.Description) cmd.Parameters.AddWithValue ("@description", maybe cat.Description)
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map _.Value)) cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map string))
] |> ignore ] |> ignore
/// Add a category /// Add a category
@ -102,18 +102,18 @@ type SQLiteCategoryData (conn : SqliteConnection) =
} }
/// Find a category by its ID for the given web log /// Find a category by its ID for the given web log
let findById (catId: CategoryId) webLogId = backgroundTask { let findById (catId: CategoryId) webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand()
cmd.CommandText <- "SELECT * FROM category WHERE id = @id" cmd.CommandText <- "SELECT * FROM category WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", catId.Value) |> ignore cmd.Parameters.AddWithValue ("@id", string catId) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync()
return Helpers.verifyWebLog<Category> webLogId (fun c -> c.WebLogId) Map.toCategory rdr return verifyWebLog<Category> webLogId (_.WebLogId) Map.toCategory rdr
} }
/// Find all categories for the given web log /// Find all categories for the given web log
let findByWebLog webLogId = backgroundTask { let findByWebLog (webLogId: WebLogId) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM category WHERE web_log_id = @webLogId" 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 () use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toCategory rdr return toList Map.toCategory rdr
} }
@ -125,11 +125,11 @@ type SQLiteCategoryData (conn : SqliteConnection) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
// Reassign any children to the category's parent category // Reassign any children to the category's parent category
cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE parent_id = @parentId" 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 let! children = count cmd
if children > 0 then if children > 0 then
cmd.CommandText <- "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId" 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 |> ignore
do! write cmd do! write cmd
// Delete the category off all posts where it is assigned, and the category itself // 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); AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId);
DELETE FROM category WHERE id = @id" DELETE FROM category WHERE id = @id"
cmd.Parameters.Clear () cmd.Parameters.Clear ()
let _ = cmd.Parameters.AddWithValue ("@id", catId.Value) let _ = cmd.Parameters.AddWithValue ("@id", string catId)
addWebLogId cmd webLogId addWebLogId cmd webLogId
do! write cmd do! write cmd
return if children = 0 then CategoryDeleted else ReassignedChildCategories 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 /// Add parameters for page INSERT or UPDATE statements
let addPageParameters (cmd: SqliteCommand) (page: Page) = let addPageParameters (cmd: SqliteCommand) (page: Page) =
[ cmd.Parameters.AddWithValue ("@id", page.Id.Value) [ cmd.Parameters.AddWithValue ("@id", string page.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId) cmd.Parameters.AddWithValue ("@webLogId", string page.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId) cmd.Parameters.AddWithValue ("@authorId", string page.AuthorId)
cmd.Parameters.AddWithValue ("@title", page.Title) 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 ("@publishedOn", instantParam page.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam page.UpdatedOn) cmd.Parameters.AddWithValue ("@updatedOn", instantParam page.UpdatedOn)
cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList) cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
@ -30,7 +30,7 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
/// Append revisions and permalinks to a page /// Append revisions and permalinks to a page
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask { let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@pageId", page.Id.Value) |> ignore cmd.Parameters.AddWithValue ("@pageId", string page.Id) |> ignore
cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId" cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
@ -57,11 +57,11 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
return () return ()
else else
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@pageId", pageId.Value) [ cmd.Parameters.AddWithValue ("@pageId", string pageId)
cmd.Parameters.Add ("@link", SqliteType.Text) cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore ] |> ignore
let runCmd (link: Permalink) = backgroundTask { let runCmd (link: Permalink) = backgroundTask {
cmd.Parameters["@link"].Value <- link.Value cmd.Parameters["@link"].Value <- string link
do! write cmd do! write cmd
} }
cmd.CommandText <- "DELETE FROM page_permalink WHERE page_id = @pageId AND permalink = @link" 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 () use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask { let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear () cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", pageId.Value) [ cmd.Parameters.AddWithValue ("@pageId", string pageId)
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf) cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore ] |> 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 do! write cmd
} }
cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf" cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf"
@ -157,7 +157,7 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
let findById (pageId: PageId) webLogId = backgroundTask { let findById (pageId: PageId) webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE id = @id" 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 () use! rdr = cmd.ExecuteReaderAsync ()
return verifyWebLog<Page> webLogId (_.WebLogId) (Map.toPage ser) rdr return verifyWebLog<Page> webLogId (_.WebLogId) (Map.toPage ser) rdr
} }
@ -175,7 +175,7 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
match! findById pageId webLogId with match! findById pageId webLogId with
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", pageId.Value) |> ignore cmd.Parameters.AddWithValue ("@id", string pageId) |> ignore
cmd.CommandText <- cmd.CommandText <-
"DELETE FROM page_revision WHERE page_id = @id; "DELETE FROM page_revision WHERE page_id = @id;
DELETE FROM page_permalink WHERE page_id = @id; DELETE FROM page_permalink WHERE page_id = @id;
@ -190,15 +190,15 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link" cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", permalink.Value) |> ignore cmd.Parameters.AddWithValue ("@link", string permalink) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (toPage rdr) else None 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 /// 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 () 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 <- $" cmd.CommandText <- $"
SELECT p.permalink SELECT p.permalink
FROM page p 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 /// Add parameters for post INSERT or UPDATE statements
let addPostParameters (cmd: SqliteCommand) (post: Post) = let addPostParameters (cmd: SqliteCommand) (post: Post) =
[ cmd.Parameters.AddWithValue ("@id", post.Id.Value) [ cmd.Parameters.AddWithValue ("@id", string post.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId) cmd.Parameters.AddWithValue ("@webLogId", string post.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId) cmd.Parameters.AddWithValue ("@authorId", string post.AuthorId)
cmd.Parameters.AddWithValue ("@status", post.Status.Value) cmd.Parameters.AddWithValue ("@status", string post.Status)
cmd.Parameters.AddWithValue ("@title", post.Title) 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 ("@publishedOn", maybeInstant post.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn) cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn)
cmd.Parameters.AddWithValue ("@template", maybe post.Template) 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 /// Append category IDs and tags to a post
let appendPostCategoryAndTag (post: Post) = backgroundTask { let appendPostCategoryAndTag (post: Post) = backgroundTask {
use cmd = conn.CreateCommand () 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" cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
@ -49,7 +49,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
/// Append revisions and permalinks to a post /// Append revisions and permalinks to a post
let appendPostRevisionsAndPermalinks (post: Post) = backgroundTask { let appendPostRevisionsAndPermalinks (post: Post) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@postId", post.Id.Value) |> ignore cmd.Parameters.AddWithValue ("@postId", string post.Id) |> ignore
cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId" cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
@ -72,7 +72,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
let findPostById (postId: PostId) webLogId = backgroundTask { let findPostById (postId: PostId) webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.id = @id" 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 () use! rdr = cmd.ExecuteReaderAsync ()
return verifyWebLog<Post> webLogId (_.WebLogId) toPost rdr return verifyWebLog<Post> webLogId (_.WebLogId) toPost rdr
} }
@ -83,16 +83,16 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
/// Update a post's assigned categories /// Update a post's assigned categories
let updatePostCategories (postId: PostId) oldCats newCats = backgroundTask { 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 if List.isEmpty toDelete && List.isEmpty toAdd then
return () return ()
else else
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", postId.Value) [ cmd.Parameters.AddWithValue ("@postId", string postId)
cmd.Parameters.Add ("@categoryId", SqliteType.Text) cmd.Parameters.Add ("@categoryId", SqliteType.Text)
] |> ignore ] |> ignore
let runCmd (catId: CategoryId) = backgroundTask { let runCmd (catId: CategoryId) = backgroundTask {
cmd.Parameters["@categoryId"].Value <- catId.Value cmd.Parameters["@categoryId"].Value <- string catId
do! write cmd do! write cmd
} }
cmd.CommandText <- "DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId" 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 () return ()
else else
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", postId.Value) [ cmd.Parameters.AddWithValue ("@postId", string postId)
cmd.Parameters.Add ("@tag", SqliteType.Text) cmd.Parameters.Add ("@tag", SqliteType.Text)
] |> ignore ] |> ignore
let runCmd (tag: string) = backgroundTask { let runCmd (tag: string) = backgroundTask {
@ -140,11 +140,11 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
return () return ()
else else
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", postId.Value) [ cmd.Parameters.AddWithValue ("@postId", string postId)
cmd.Parameters.Add ("@link", SqliteType.Text) cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore ] |> ignore
let runCmd (link: Permalink) = backgroundTask { let runCmd (link: Permalink) = backgroundTask {
cmd.Parameters["@link"].Value <- link.Value cmd.Parameters["@link"].Value <- string link
do! write cmd do! write cmd
} }
cmd.CommandText <- "DELETE FROM post_permalink WHERE post_id = @postId AND permalink = @link" 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 () use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask { let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear () cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", postId.Value) [ cmd.Parameters.AddWithValue ("@postId", string postId)
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf) cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore ] |> 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 do! write cmd
} }
cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf" cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf"
@ -212,7 +212,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE web_log_id = @webLogId AND status = @status" cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE web_log_id = @webLogId AND status = @status"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", status.Value) |> ignore cmd.Parameters.AddWithValue ("@status", string status) |> ignore
return! count cmd return! count cmd
} }
@ -230,7 +230,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId AND p.permalink = @link" cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId AND p.permalink = @link"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", permalink.Value) |> ignore cmd.Parameters.AddWithValue ("@link", string permalink) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then if rdr.Read () then
let! post = appendPostCategoryAndTag (toPost rdr) let! post = appendPostCategoryAndTag (toPost rdr)
@ -253,7 +253,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
match! findFullById postId webLogId with match! findFullById postId webLogId with
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", postId.Value) |> ignore cmd.Parameters.AddWithValue ("@id", string postId) |> ignore
cmd.CommandText <- cmd.CommandText <-
"DELETE FROM post_revision WHERE post_id = @id; "DELETE FROM post_revision WHERE post_id = @id;
DELETE FROM post_permalink WHERE post_id = @id; DELETE FROM post_permalink WHERE post_id = @id;
@ -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 /// 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 () 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 <- $" cmd.CommandText <- $"
SELECT p.permalink SELECT p.permalink
FROM post p 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) /// 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 () 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 <- $" cmd.CommandText <- $"
{selectPost} {selectPost}
INNER JOIN post_category pc ON pc.post_id = p.id INNER JOIN post_category pc ON pc.post_id = p.id
@ -311,7 +311,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
ORDER BY published_on DESC ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", Published.Value) |> ignore cmd.Parameters.AddWithValue ("@status", string Published) |> ignore
cmd.Parameters.AddRange catParams cmd.Parameters.AddRange catParams
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! posts = let! posts =
@ -348,7 +348,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
ORDER BY p.published_on DESC ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", Published.Value) |> ignore cmd.Parameters.AddWithValue ("@status", string Published) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! posts = let! posts =
toList toPost rdr toList toPost rdr
@ -369,7 +369,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
ORDER BY p.published_on DESC ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", Published.Value) [ cmd.Parameters.AddWithValue ("@status", string Published)
cmd.Parameters.AddWithValue ("@tag", tag) cmd.Parameters.AddWithValue ("@tag", tag)
] |> ignore ] |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
@ -391,7 +391,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer) =
ORDER BY p.published_on DESC ORDER BY p.published_on DESC
LIMIT 1" LIMIT 1"
addWebLogId cmd webLogId addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", Published.Value) [ cmd.Parameters.AddWithValue ("@status", string Published)
cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn) cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn)
] |> ignore ] |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()

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

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

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

@ -27,19 +27,19 @@ type SQLiteThemeData (conn : SqliteConnection) =
} }
/// Does a given theme exist? /// Does a given theme exist?
let exists themeId = backgroundTask { let exists (themeId: ThemeId) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM theme WHERE id = @id" 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 let! count = count cmd
return count > 0 return count > 0
} }
/// Find a theme by its ID /// Find a theme by its ID
let findById themeId = backgroundTask { let findById (themeId: ThemeId) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM theme WHERE id = @id" 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 () use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then if rdr.Read () then
let theme = Map.toTheme rdr let theme = Map.toTheme rdr
@ -71,29 +71,28 @@ type SQLiteThemeData (conn : SqliteConnection) =
"DELETE FROM theme_asset WHERE theme_id = @id; "DELETE FROM theme_asset WHERE theme_id = @id;
DELETE FROM theme_template WHERE theme_id = @id; DELETE FROM theme_template WHERE theme_id = @id;
DELETE FROM theme WHERE 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 do! write cmd
return true return true
| None -> return false | None -> return false
} }
/// Save a theme /// Save a theme
let save (theme : Theme) = backgroundTask { let save (theme: Theme) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand()
let! oldTheme = findById theme.Id let! oldTheme = findById theme.Id
cmd.CommandText <- cmd.CommandText <-
match oldTheme with match oldTheme with
| Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id" | Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id"
| None -> "INSERT INTO theme VALUES (@id, @name, @version)" | None -> "INSERT INTO theme VALUES (@id, @name, @version)"
[ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.Id) [ cmd.Parameters.AddWithValue ("@id", string theme.Id)
cmd.Parameters.AddWithValue ("@name", theme.Name) cmd.Parameters.AddWithValue ("@name", theme.Name)
cmd.Parameters.AddWithValue ("@version", theme.Version) cmd.Parameters.AddWithValue ("@version", theme.Version)
] |> ignore ] |> ignore
do! write cmd do! write cmd
let toDelete, toAdd = let toDelete, toAdd =
Utils.diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue []) Utils.diffLists (oldTheme |> Option.map _.Templates |> Option.defaultValue []) theme.Templates _.Name
theme.Templates (fun t -> t.Name)
let toUpdate = let toUpdate =
theme.Templates theme.Templates
|> List.filter (fun t -> |> List.filter (fun t ->
@ -102,7 +101,7 @@ type SQLiteThemeData (conn : SqliteConnection) =
cmd.CommandText <- cmd.CommandText <-
"UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name" "UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name"
cmd.Parameters.Clear () cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.Id) [ cmd.Parameters.AddWithValue ("@themeId", string theme.Id)
cmd.Parameters.Add ("@name", SqliteType.Text) cmd.Parameters.Add ("@name", SqliteType.Text)
cmd.Parameters.Add ("@template", SqliteType.Text) cmd.Parameters.Add ("@template", SqliteType.Text)
] |> ignore ] |> ignore
@ -157,10 +156,10 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
} }
/// Delete all assets for the given theme /// Delete all assets for the given theme
let deleteByTheme themeId = backgroundTask { let deleteByTheme (themeId: ThemeId) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "DELETE FROM theme_asset WHERE theme_id = @themeId" 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 do! write cmd
} }
@ -177,19 +176,19 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
} }
/// Get theme assets for the given theme (excludes data) /// Get theme assets for the given theme (excludes data)
let findByTheme themeId = backgroundTask { let findByTheme (themeId: ThemeId) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId" 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 () use! rdr = cmd.ExecuteReaderAsync ()
return toList (Map.toThemeAsset false) rdr return toList (Map.toThemeAsset false) rdr
} }
/// Get theme assets for the given theme /// Get theme assets for the given theme
let findByThemeWithData themeId = backgroundTask { let findByThemeWithData (themeId: ThemeId) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId" 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 () use! rdr = cmd.ExecuteReaderAsync ()
return toList (Map.toThemeAsset true) rdr 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
open MyWebLog.Data open MyWebLog.Data
/// SQLite myWebLog web log data implementation /// SQLite myWebLog web log data implementation
type SQLiteUploadData (conn : SqliteConnection) = type SQLiteUploadData(conn: SqliteConnection) =
/// Add parameters for uploaded file INSERT and UPDATE statements /// Add parameters for uploaded file INSERT and UPDATE statements
let addUploadParameters (cmd : SqliteCommand) (upload : Upload) = let addUploadParameters (cmd: SqliteCommand) (upload: Upload) =
[ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id) [ cmd.Parameters.AddWithValue ("@id", string upload.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId) cmd.Parameters.AddWithValue ("@webLogId", string upload.WebLogId)
cmd.Parameters.AddWithValue ("@path", upload.Path.Value) cmd.Parameters.AddWithValue ("@path", string upload.Path)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam upload.UpdatedOn) cmd.Parameters.AddWithValue ("@updatedOn", instantParam upload.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length) cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length)
] |> ignore ] |> ignore
@ -46,14 +46,14 @@ type SQLiteUploadData (conn : SqliteConnection) =
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId" AND web_log_id = @webLogId"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@id", UploadId.toString uploadId) |> ignore cmd.Parameters.AddWithValue ("@id", string uploadId) |> ignore
let! rdr = cmd.ExecuteReaderAsync () let! rdr = cmd.ExecuteReaderAsync ()
if (rdr.Read ()) then if (rdr.Read ()) then
let upload = Map.toUpload false rdr let upload = Map.toUpload false rdr
do! rdr.CloseAsync () do! rdr.CloseAsync ()
cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId" cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
do! write cmd do! write cmd
return Ok upload.Path.Value return Ok (string upload.Path)
else else
return Error $"""Upload ID {cmd.Parameters["@id"]} not found""" 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 // The web log podcast insert loop is not statically compilable; this is OK
#nowarn "3511" #nowarn "3511"
/// SQLite myWebLog web log data implementation /// SQLite myWebLog web log data implementation
type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) = type SQLiteWebLogData(conn: SqliteConnection, ser: JsonSerializer) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
@ -25,28 +25,28 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
] |> ignore ] |> ignore
/// Add parameters for web log INSERT or UPDATE statements /// Add parameters for web log INSERT or UPDATE statements
let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) = let addWebLogParameters (cmd: SqliteCommand) (webLog: WebLog) =
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) [ cmd.Parameters.AddWithValue ("@id", string webLog.Id)
cmd.Parameters.AddWithValue ("@name", webLog.Name) cmd.Parameters.AddWithValue ("@name", webLog.Name)
cmd.Parameters.AddWithValue ("@slug", webLog.Slug) cmd.Parameters.AddWithValue ("@slug", webLog.Slug)
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle) cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle)
cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage) cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage)
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage) cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage)
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId) cmd.Parameters.AddWithValue ("@themeId", string webLog.ThemeId)
cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase) cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase)
cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone) cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone)
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx) cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx)
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads) cmd.Parameters.AddWithValue ("@uploads", string webLog.Uploads)
cmd.Parameters.AddWithValue ("@redirectRules", Utils.serialize ser webLog.RedirectRules) cmd.Parameters.AddWithValue ("@redirectRules", Utils.serialize ser webLog.RedirectRules)
] |> ignore ] |> ignore
addWebLogRssParameters cmd webLog addWebLogRssParameters cmd webLog
/// Add parameters for custom feed INSERT or UPDATE statements /// Add parameters for custom feed INSERT or UPDATE statements
let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) = let addCustomFeedParameters (cmd: SqliteCommand) (webLogId: WebLogId) (feed: CustomFeed) =
[ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.Id) [ cmd.Parameters.AddWithValue ("@id", string feed.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) cmd.Parameters.AddWithValue ("@webLogId", string webLogId)
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source) cmd.Parameters.AddWithValue ("@source", string feed.Source)
cmd.Parameters.AddWithValue ("@path", feed.Path.Value) cmd.Parameters.AddWithValue ("@path", string feed.Path)
cmd.Parameters.AddWithValue ("@podcast", maybe (if Option.isSome feed.Podcast then cmd.Parameters.AddWithValue ("@podcast", maybe (if Option.isSome feed.Podcast then
Some (Utils.serialize ser feed.Podcast) Some (Utils.serialize ser feed.Podcast)
else None)) else None))
@ -74,7 +74,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
/// Update the custom feeds for a web log /// Update the custom feeds for a web log
let updateCustomFeeds (webLog : WebLog) = backgroundTask { let updateCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog let! feeds = getCustomFeeds webLog
let toDelete, toAdd = 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 toId (feed : CustomFeed) = feed.Id
let toUpdate = let toUpdate =
webLog.Rss.CustomFeeds webLog.Rss.CustomFeeds
@ -85,7 +85,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
toDelete toDelete
|> List.map (fun it -> backgroundTask { |> List.map (fun it -> backgroundTask {
cmd.CommandText <- "DELETE FROM web_log_feed WHERE id = @id" 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 do! write cmd
}) })
|> Task.WhenAll |> Task.WhenAll
@ -211,7 +211,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "UPDATE web_log SET redirect_rules = @redirectRules WHERE id = @id" 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 ("@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 do! write cmd
} }
@ -228,7 +228,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
copyright = @copyright copyright = @copyright
WHERE id = @id" WHERE id = @id"
addWebLogRssParameters cmd webLog addWebLogRssParameters cmd webLog
cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) |> ignore cmd.Parameters.AddWithValue ("@id", string webLog.Id) |> ignore
do! write cmd do! write cmd
do! updateCustomFeeds webLog do! updateCustomFeeds webLog
} }

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

@ -4,22 +4,22 @@ open Microsoft.Data.Sqlite
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
/// SQLite myWebLog user data implementation /// SQLite myWebLog user data implementation
type SQLiteWebLogUserData (conn : SqliteConnection) = type SQLiteWebLogUserData(conn: SqliteConnection) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// Add parameters for web log user INSERT or UPDATE statements /// Add parameters for web log user INSERT or UPDATE statements
let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) = let addWebLogUserParameters (cmd: SqliteCommand) (user: WebLogUser) =
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.Id) [ cmd.Parameters.AddWithValue ("@id", string user.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.WebLogId) cmd.Parameters.AddWithValue ("@webLogId", string user.WebLogId)
cmd.Parameters.AddWithValue ("@email", user.Email) cmd.Parameters.AddWithValue ("@email", user.Email)
cmd.Parameters.AddWithValue ("@firstName", user.FirstName) cmd.Parameters.AddWithValue ("@firstName", user.FirstName)
cmd.Parameters.AddWithValue ("@lastName", user.LastName) cmd.Parameters.AddWithValue ("@lastName", user.LastName)
cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName) cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName)
cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash) cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash)
cmd.Parameters.AddWithValue ("@url", maybe user.Url) 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 ("@createdOn", instantParam user.CreatedOn)
cmd.Parameters.AddWithValue ("@lastSeenOn", maybeInstant user.LastSeenOn) cmd.Parameters.AddWithValue ("@lastSeenOn", maybeInstant user.LastSeenOn)
] |> ignore ] |> ignore
@ -42,12 +42,12 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
} }
/// Find a user by their ID for the given web log /// Find a user by their ID for the given web log
let findById userId webLogId = backgroundTask { let findById (userId: WebLogUserId) webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id" cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore cmd.Parameters.AddWithValue ("@id", string userId) |> ignore
use! rdr = cmd.ExecuteReaderAsync () 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 /// Delete a user if they have no posts or pages
@ -56,7 +56,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE author_id = @userId" 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 let! pageCount = count cmd
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE author_id = @userId" cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE author_id = @userId"
let! postCount = count cmd 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 /// 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 () 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}" cmd.CommandText <- $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {nameSql}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddRange nameParams cmd.Parameters.AddRange nameParams
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return return
toList Map.toWebLogUser rdr toList Map.toWebLogUser rdr |> List.map (fun u -> { Name = string u.Id; Value = WebLogUser.displayName u })
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
} }
/// Restore users from a backup /// Restore users from a backup
@ -108,7 +107,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
} }
/// Set a user's last seen date/time to now /// 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 () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <-
"UPDATE web_log_user "UPDATE web_log_user
@ -116,7 +115,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId" AND web_log_id = @webLogId"
addWebLogId cmd webLogId addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) [ cmd.Parameters.AddWithValue ("@id", string userId)
cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Noda.now ())) cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Noda.now ()))
] |> ignore ] |> ignore
let! _ = cmd.ExecuteNonQueryAsync () 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) -> |> List.iter (fun (feedId, podcast) ->
cmd.CommandText <- "UPDATE web_log_feed SET podcast = @podcast WHERE id = @id" cmd.CommandText <- "UPDATE web_log_feed SET podcast = @podcast WHERE id = @id"
[ cmd.Parameters.AddWithValue ("@podcast", Utils.serialize ser podcast) [ 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 () let _ = cmd.ExecuteNonQuery ()
cmd.Parameters.Clear ()) cmd.Parameters.Clear ())
cmd.CommandText <- "SELECT * FROM post_episode" cmd.CommandText <- "SELECT * FROM post_episode"
@ -241,7 +241,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
|> List.iter (fun (postId, episode) -> |> List.iter (fun (postId, episode) ->
cmd.CommandText <- "UPDATE post SET episode = @episode WHERE id = @id" cmd.CommandText <- "UPDATE post SET episode = @episode WHERE id = @id"
[ cmd.Parameters.AddWithValue ("@episode", Utils.serialize ser episode) [ 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 () let _ = cmd.ExecuteNonQuery ()
cmd.Parameters.Clear ()) 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 { let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq {
for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do
let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug
{ Id = cat.Id.Value { Id = string cat.Id
Slug = fullSlug Slug = fullSlug
Name = cat.Name Name = cat.Name
Description = cat.Description 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 List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems
/// Find meta items added and removed /// Find meta items added and removed
let diffMetaItems (oldItems : MetaItem list) newItems = let diffMetaItems (oldItems: MetaItem list) newItems =
diffLists oldItems newItems (fun item -> $"{item.Name}|{item.Value}") diffLists oldItems newItems (fun item -> $"{item.Name}|{item.Value}")
/// Find the permalinks added and removed /// Find the permalinks added and removed
let diffPermalinks oldLinks newLinks = let diffPermalinks (oldLinks: Permalink list) newLinks =
diffLists oldLinks newLinks (fun (it: Permalink) -> it.Value) diffLists oldLinks newLinks string
/// Find the revisions added and removed /// Find the revisions added and removed
let diffRevisions oldRevs newRevs = let diffRevisions (oldRevs: Revision list) newRevs =
diffLists oldRevs newRevs (fun (rev: Revision) -> $"{rev.AsOf.ToUnixTimeTicks()}|{rev.Text.Value}") diffLists oldRevs newRevs (fun rev -> $"{rev.AsOf.ToUnixTimeTicks()}|{rev.Text}")
open MyWebLog.Converters open MyWebLog.Converters
open Newtonsoft.Json open Newtonsoft.Json

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

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

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

@ -54,16 +54,16 @@ type AccessLevel =
| Administrator | Administrator
/// Parse an access level from its string representation /// Parse an access level from its string representation
static member Parse = static member Parse level =
function match level with
| "Author" -> Author | "Author" -> Author
| "Editor" -> Editor | "Editor" -> Editor
| "WebLogAdmin" -> WebLogAdmin | "WebLogAdmin" -> WebLogAdmin
| "Administrator" -> Administrator | "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 /// The string representation of this access level
member this.Value = override this.ToString() =
match this with match this with
| Author -> "Author" | Author -> "Author"
| Editor -> "Editor" | Editor -> "Editor"
@ -96,7 +96,7 @@ type CategoryId =
newId >> CategoryId newId >> CategoryId
/// The string representation of this category ID /// The string representation of this category ID
member this.Value = override this.ToString() =
match this with CategoryId it -> it match this with CategoryId it -> it
@ -113,7 +113,7 @@ type CommentId =
newId >> CommentId newId >> CommentId
/// The string representation of this comment ID /// The string representation of this comment ID
member this.Value = override this.ToString() =
match this with CommentId it -> it match this with CommentId it -> it
@ -128,15 +128,15 @@ type CommentStatus =
| Spam | Spam
/// Parse a string into a comment status /// Parse a string into a comment status
static member Parse = static member Parse status =
function match status with
| "Approved" -> Approved | "Approved" -> Approved
| "Pending" -> Pending | "Pending" -> Pending
| "Spam" -> Spam | "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 /// Convert a comment status to a string
member this.Value = override this.ToString() =
match this with Approved -> "Approved" | Pending -> "Pending" | Spam -> "Spam" match this with Approved -> "Approved" | Pending -> "Pending" | Spam -> "Spam"
@ -148,15 +148,15 @@ type ExplicitRating =
| Clean | Clean
/// Parse a string into an explicit rating /// Parse a string into an explicit rating
static member Parse = static member Parse rating =
function match rating with
| "yes" -> Yes | "yes" -> Yes
| "no" -> No | "no" -> No
| "clean" -> Clean | "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 /// The string value of this rating
member this.Value = override this.ToString() =
match this with Yes -> "yes" | No -> "no" | Clean -> "clean" match this with Yes -> "yes" | No -> "no" | Clean -> "clean"
@ -289,11 +289,11 @@ type MarkupText =
| Html of string | Html of string
/// Parse a string into a MarkupText instance /// Parse a string into a MarkupText instance
static member Parse(it: string) = static member Parse(text: string) =
match it with match text with
| text when text.StartsWith "Markdown: " -> Markdown text[10..] | _ when text.StartsWith "Markdown: " -> Markdown text[10..]
| text when text.StartsWith "HTML: " -> Html text[6..] | _ when text.StartsWith "HTML: " -> Html text[6..]
| text -> invalidOp $"Cannot derive type of text ({text})" | _ -> invalidArg (nameof text) $"Cannot derive type of text ({text})"
/// The source type for the markup text /// The source type for the markup text
member this.SourceType = member this.SourceType =
@ -304,7 +304,8 @@ type MarkupText =
match this with Markdown text -> text | Html text -> text match this with Markdown text -> text | Html text -> text
/// The string representation of the markup 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 /// The HTML representation of the markup text
member this.AsHtml() = member this.AsHtml() =
@ -315,10 +316,10 @@ type MarkupText =
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type MetaItem = { type MetaItem = {
/// The name of the metadata value /// The name of the metadata value
Name : string Name: string
/// The metadata value /// The metadata value
Value : string Value: string
} with } with
/// An empty metadata item /// An empty metadata item
@ -330,10 +331,10 @@ type MetaItem = {
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Revision = { type Revision = {
/// When this revision was saved /// When this revision was saved
AsOf : Instant AsOf: Instant
/// The text of the revision /// The text of the revision
Text : MarkupText Text: MarkupText
} with } with
/// An empty revision /// An empty revision
@ -350,7 +351,7 @@ type Permalink =
static member Empty = Permalink "" static member Empty = Permalink ""
/// The string value of this permalink /// The string value of this permalink
member this.Value = override this.ToString() =
match this with Permalink it -> it match this with Permalink it -> it
@ -367,7 +368,7 @@ type PageId =
newId >> PageId newId >> PageId
/// The string value of this page ID /// The string value of this page ID
member this.Value = override this.ToString() =
match this with PageId it -> it match this with PageId it -> it
@ -383,8 +384,8 @@ type PodcastMedium =
| Blog | Blog
/// Parse a string into a podcast medium /// Parse a string into a podcast medium
static member Parse = static member Parse medium =
function match medium with
| "podcast" -> Podcast | "podcast" -> Podcast
| "music" -> Music | "music" -> Music
| "video" -> Video | "video" -> Video
@ -392,10 +393,10 @@ type PodcastMedium =
| "audiobook" -> Audiobook | "audiobook" -> Audiobook
| "newsletter" -> Newsletter | "newsletter" -> Newsletter
| "blog" -> Blog | "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 /// The string value of this podcast medium
member this.Value = override this.ToString() =
match this with match this with
| Podcast -> "podcast" | Podcast -> "podcast"
| Music -> "music" | Music -> "music"
@ -415,14 +416,14 @@ type PostStatus =
| Published | Published
/// Parse a string into a post status /// Parse a string into a post status
static member Parse = static member Parse status =
function match status with
| "Draft" -> Draft | "Draft" -> Draft
| "Published" -> Published | "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 /// The string representation of this post status
member this.Value = override this.ToString() =
match this with Draft -> "Draft" | Published -> "Published" match this with Draft -> "Draft" | Published -> "Published"
@ -439,7 +440,7 @@ type PostId =
newId >> PostId newId >> PostId
/// Convert a post ID to a string /// Convert a post ID to a string
member this.Value = override this.ToString() =
match this with PostId it -> it match this with PostId it -> it
@ -465,19 +466,20 @@ type RedirectRule = {
/// An identifier for a custom feed /// 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 /// An empty custom feed ID
let empty = CustomFeedId "" static member Empty = CustomFeedId ""
/// Convert a custom feed ID to a string
let toString = function CustomFeedId pi -> pi
/// Create a new custom feed ID /// 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 /// The source for a custom feed
@ -486,99 +488,94 @@ type CustomFeedSource =
| Category of CategoryId | Category of CategoryId
/// A feed based on a particular tag /// A feed based on a particular tag
| Tag of string | 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 /// Parse a feed source from its string version
let parse : string -> CustomFeedSource = static member Parse(source: string) =
let value (it : string) = it.Split(":").[1] let value (it : string) = it.Split(":").[1]
function match source with
| source when source.StartsWith "category:" -> (value >> CategoryId >> Category) source | _ when source.StartsWith "category:" -> (value >> CategoryId >> Category) source
| source when source.StartsWith "tag:" -> (value >> Tag) source | _ when source.StartsWith "tag:" -> (value >> Tag) source
| source -> invalidArg "feedSource" $"{source} is not a valid feed 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 /// Options for a feed that describes a podcast
[<CLIMutable; NoComparison; NoEquality>]
type PodcastOptions = { type PodcastOptions = {
/// The title of the podcast /// The title of the podcast
Title : string Title: string
/// A subtitle for the podcast /// A subtitle for the podcast
Subtitle : string option Subtitle: string option
/// The number of items in the podcast feed /// The number of items in the podcast feed
ItemsInFeed : int ItemsInFeed: int
/// A summary of the podcast (iTunes field) /// A summary of the podcast (iTunes field)
Summary : string Summary: string
/// The display name of the podcast author (iTunes field) /// The display name of the podcast author (iTunes field)
DisplayedAuthor : string DisplayedAuthor: string
/// The e-mail address of the user who registered the podcast at iTunes /// The e-mail address of the user who registered the podcast at iTunes
Email : string Email: string
/// The link to the image for the podcast /// The link to the image for the podcast
ImageUrl : Permalink ImageUrl: Permalink
/// The category from Apple Podcasts (iTunes) under which this podcast is categorized /// 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) /// 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) /// The explictness rating (iTunes field)
Explicit : ExplicitRating Explicit: ExplicitRating
/// The default media type for files in this podcast /// The default media type for files in this podcast
DefaultMediaType : string option DefaultMediaType: string option
/// The base URL for relative URL media files for this podcast (optional; defaults to web log base) /// The base URL for relative URL media files for this podcast (optional; defaults to web log base)
MediaBaseUrl : string option MediaBaseUrl: string option
/// A GUID for this podcast /// A GUID for this podcast
PodcastGuid : Guid option PodcastGuid: Guid option
/// A URL at which information on supporting the podcast may be found (supports permalinks) /// A URL at which information on supporting the podcast may be found (supports permalinks)
FundingUrl : string option FundingUrl: string option
/// The text to be displayed in the funding item within the feed /// The text to be displayed in the funding item within the feed
FundingText : string option FundingText: string option
/// The medium (what the podcast IS, not what it is ABOUT) /// The medium (what the podcast IS, not what it is ABOUT)
Medium : PodcastMedium option Medium: PodcastMedium option
} }
/// A custom feed /// A custom feed
[<CLIMutable; NoComparison; NoEquality>]
type CustomFeed = { type CustomFeed = {
/// The ID of the custom feed /// The ID of the custom feed
Id : CustomFeedId Id: CustomFeedId
/// The source for the custom feed /// The source for the custom feed
Source : CustomFeedSource Source: CustomFeedSource
/// The path for the custom feed /// The path for the custom feed
Path : Permalink Path: Permalink
/// Podcast options, if the feed defines a podcast /// Podcast options, if the feed defines a podcast
Podcast : PodcastOptions option Podcast: PodcastOptions option
} } with
/// Functions to support custom feeds
module CustomFeed =
/// An empty custom feed /// An empty custom feed
let empty = { static member Empty = {
Id = CustomFeedId "" Id = CustomFeedId.Empty
Source = Category (CategoryId "") Source = Category CategoryId.Empty
Path = Permalink "" Path = Permalink.Empty
Podcast = None Podcast = None
} }
@ -587,32 +584,29 @@ module CustomFeed =
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type RssOptions = { type RssOptions = {
/// Whether the site feed of posts is enabled /// Whether the site feed of posts is enabled
IsFeedEnabled : bool IsFeedEnabled: bool
/// The name of the file generated for the site feed /// The name of the file generated for the site feed
FeedName : string FeedName: string
/// Override the "posts per page" setting for the site feed /// Override the "posts per page" setting for the site feed
ItemsInFeed : int option ItemsInFeed: int option
/// Whether feeds are enabled for all categories /// Whether feeds are enabled for all categories
IsCategoryEnabled : bool IsCategoryEnabled: bool
/// Whether feeds are enabled for all tags /// Whether feeds are enabled for all tags
IsTagEnabled : bool IsTagEnabled: bool
/// A copyright string to be placed in all feeds /// A copyright string to be placed in all feeds
Copyright : string option Copyright: string option
/// Custom feeds for this web log /// Custom feeds for this web log
CustomFeeds: CustomFeed list CustomFeeds: CustomFeed list
} } with
/// Functions to support RSS options
module RssOptions =
/// An empty set of RSS options /// An empty set of RSS options
let empty = { static member Empty = {
IsFeedEnabled = true IsFeedEnabled = true
FeedName = "feed.xml" FeedName = "feed.xml"
ItemsInFeed = None ItemsInFeed = None
@ -624,126 +618,126 @@ module RssOptions =
/// An identifier for a tag mapping /// 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 /// An empty tag mapping ID
let empty = TagMapId "" static member Empty = TagMapId ""
/// Convert a tag mapping ID to a string
let toString = function TagMapId tmi -> tmi
/// Create a new tag mapping ID /// 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) /// An identifier for a theme (represents its path)
type ThemeId = ThemeId of string [<Struct>]
type ThemeId =
/// Functions to support theme IDs | ThemeId of string
module ThemeId =
let toString = function ThemeId ti -> ti /// The string representation of a theme ID
override this.ToString() =
match this with ThemeId it -> it
/// An identifier for a theme asset /// 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 /// Convert a string into a theme asset ID
module ThemeAssetId = 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 /// Convert a theme asset ID into a path string
let toString = function ThemeAssetId (ThemeId theme, asset) -> $"{theme}/{asset}" override this.ToString() =
match this with 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)..])
/// A template for a theme /// A template for a theme
[<CLIMutable; NoComparison; NoEquality>]
type ThemeTemplate = { type ThemeTemplate = {
/// The name of the template /// The name of the template
Name : string Name: string
/// The text of the template /// The text of the template
Text : string Text: string
} } with
/// Functions to support theme templates
module ThemeTemplate =
/// An empty theme template /// An empty theme template
let empty = static member Empty =
{ Name = ""; Text = "" } { Name = ""; Text = "" }
/// Where uploads should be placed /// Where uploads should be placed
[<Struct>]
type UploadDestination = type UploadDestination =
| Database | Database
| Disk | 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 /// Parse an upload destination from its string representation
let parse value = static member Parse destination =
match value with match destination with
| "Database" -> Database | "Database" -> Database
| "Disk" -> Disk | "Disk" -> Disk
| it -> invalidArg "destination" $"{it} is not a valid upload destination" | _ -> 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 /// 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 /// An empty upload ID
let empty = UploadId "" static member Empty = UploadId ""
/// Convert an upload ID to a string
let toString = function UploadId ui -> ui
/// Create a new upload ID /// 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 /// 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 /// An empty web log ID
let empty = WebLogId "" static member Empty = WebLogId ""
/// Convert a web log ID to a string
let toString = function WebLogId wli -> wli
/// Create a new web log ID /// 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 /// An identifier for a web log user
type WebLogUserId = WebLogUserId of string [<Struct>]
type WebLogUserId =
/// Functions to support web log user IDs | WebLogUserId of string
module WebLogUserId =
/// An empty web log user ID /// An empty web log user ID
let empty = WebLogUserId "" static member Empty = WebLogUserId ""
/// Convert a web log user ID to a string
let toString = function WebLogUserId wli -> wli
/// Create a new web log user ID /// 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 /// A display version of a custom feed definition
type DisplayCustomFeed = { type DisplayCustomFeed = {
/// The ID of the custom feed /// The ID of the custom feed
Id : string Id: string
/// The source of the custom feed /// The source of the custom feed
Source : string Source: string
/// The relative path at which the custom feed is served /// The relative path at which the custom feed is served
Path : string Path: string
/// Whether this custom feed is for a podcast /// Whether this custom feed is for a podcast
IsPodcast : bool IsPodcast: bool
} }
/// Support functions for custom feed displays /// Support functions for custom feed displays
module DisplayCustomFeed = module DisplayCustomFeed =
/// Create a display version from a custom feed /// 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 = let source =
match feed.Source with match feed.Source with
| Category (CategoryId catId) -> $"Category: {(cats |> Array.find (fun cat -> cat.Id = catId)).Name}" | Category (CategoryId catId) -> $"Category: {(cats |> Array.find (fun cat -> cat.Id = catId)).Name}"
| Tag tag -> $"Tag: {tag}" | Tag tag -> $"Tag: {tag}"
{ Id = CustomFeedId.toString feed.Id { Id = string feed.Id
Source = source Source = source
Path = feed.Path.Value Path = string feed.Path
IsPodcast = Option.isSome feed.Podcast IsPodcast = Option.isSome feed.Podcast
} }
@ -137,14 +137,14 @@ type DisplayPage =
/// Create a minimal display page (no text or metadata) from a database page /// Create a minimal display page (no text or metadata) from a database page
static member FromPageMinimal webLog (page: Page) = { static member FromPageMinimal webLog (page: Page) = {
Id = page.Id.Value Id = string page.Id
AuthorId = WebLogUserId.toString page.AuthorId AuthorId = string page.AuthorId
Title = page.Title Title = page.Title
Permalink = page.Permalink.Value Permalink = string page.Permalink
PublishedOn = WebLog.localTime webLog page.PublishedOn PublishedOn = WebLog.localTime webLog page.PublishedOn
UpdatedOn = WebLog.localTime webLog page.UpdatedOn UpdatedOn = WebLog.localTime webLog page.UpdatedOn
IsInPageList = page.IsInPageList IsInPageList = page.IsInPageList
IsDefault = page.Id.Value = webLog.DefaultPage IsDefault = string page.Id = webLog.DefaultPage
Text = "" Text = ""
Metadata = [] Metadata = []
} }
@ -152,14 +152,14 @@ type DisplayPage =
/// Create a display page from a database page /// Create a display page from a database page
static member FromPage webLog (page : Page) = static member FromPage webLog (page : Page) =
let _, extra = WebLog.hostAndPath webLog let _, extra = WebLog.hostAndPath webLog
{ Id = page.Id.Value { Id = string page.Id
AuthorId = WebLogUserId.toString page.AuthorId AuthorId = string page.AuthorId
Title = page.Title Title = page.Title
Permalink = page.Permalink.Value Permalink = string page.Permalink
PublishedOn = WebLog.localTime webLog page.PublishedOn PublishedOn = WebLog.localTime webLog page.PublishedOn
UpdatedOn = WebLog.localTime webLog page.UpdatedOn UpdatedOn = WebLog.localTime webLog page.UpdatedOn
IsInPageList = page.IsInPageList IsInPageList = page.IsInPageList
IsDefault = page.Id.Value = webLog.DefaultPage IsDefault = string page.Id = webLog.DefaultPage
Text = addBaseToRelativeUrls extra page.Text Text = addBaseToRelativeUrls extra page.Text
Metadata = page.Metadata Metadata = page.Metadata
} }
@ -195,35 +195,35 @@ open System.IO
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type DisplayTheme = { type DisplayTheme = {
/// The ID / path slug of the theme /// The ID / path slug of the theme
Id : string Id: string
/// The name of the theme /// The name of the theme
Name : string Name: string
/// The version of the theme /// The version of the theme
Version : string Version: string
/// How many templates are contained in the theme /// How many templates are contained in the theme
TemplateCount : int TemplateCount: int
/// Whether the theme is in use by any web logs /// Whether the theme is in use by any web logs
IsInUse : bool IsInUse: bool
/// Whether the theme .zip file exists on the filesystem /// Whether the theme .zip file exists on the filesystem
IsOnDisk : bool IsOnDisk: bool
} }
/// Functions to support displaying themes /// Functions to support displaying themes
module DisplayTheme = module DisplayTheme =
/// Create a display theme from a theme /// Create a display theme from a theme
let fromTheme inUseFunc (theme : Theme) = let fromTheme inUseFunc (theme: Theme) =
{ Id = ThemeId.toString theme.Id { Id = string theme.Id
Name = theme.Name Name = theme.Name
Version = theme.Version Version = theme.Version
TemplateCount = List.length theme.Templates TemplateCount = List.length theme.Templates
IsInUse = inUseFunc theme.Id 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>] [<NoComparison; NoEquality>]
type DisplayUpload = { type DisplayUpload = {
/// The ID of the uploaded file /// The ID of the uploaded file
Id : string Id: string
/// The name of the uploaded file /// The name of the uploaded file
Name : string Name: string
/// The path at which the file is served /// The path at which the file is served
Path : string Path: string
/// The date/time the file was updated /// The date/time the file was updated
UpdatedOn : DateTime option UpdatedOn: DateTime option
/// The source for this file (created from UploadDestination DU) /// The source for this file (created from UploadDestination DU)
Source : string Source: string
} }
/// Functions to support displaying uploads /// Functions to support displaying uploads
module DisplayUpload = module DisplayUpload =
/// Create a display uploaded file /// Create a display uploaded file
let fromUpload webLog source (upload : Upload) = let fromUpload webLog (source: UploadDestination) (upload: Upload) =
let path = upload.Path.Value let path = string upload.Path
let name = Path.GetFileName path let name = Path.GetFileName path
{ Id = UploadId.toString upload.Id { Id = string upload.Id
Name = name Name = name
Path = path.Replace (name, "") Path = path.Replace(name, "")
UpdatedOn = Some (WebLog.localTime webLog upload.UpdatedOn) UpdatedOn = Some (WebLog.localTime webLog upload.UpdatedOn)
Source = UploadDestination.toString source Source = string source
} }
@ -265,45 +265,45 @@ module DisplayUpload =
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type DisplayUser = { type DisplayUser = {
/// The ID of the user /// The ID of the user
Id : string Id: string
/// The user name (e-mail address) /// The user name (e-mail address)
Email : string Email: string
/// The user's first name /// The user's first name
FirstName : string FirstName: string
/// The user's last name /// The user's last name
LastName : string LastName: string
/// The user's preferred name /// The user's preferred name
PreferredName : string PreferredName: string
/// The URL of the user's personal site /// The URL of the user's personal site
Url : string Url: string
/// The user's access level /// The user's access level
AccessLevel : string AccessLevel: string
/// When the user was created /// When the user was created
CreatedOn : DateTime CreatedOn: DateTime
/// When the user last logged on /// When the user last logged on
LastSeenOn : Nullable<DateTime> LastSeenOn: Nullable<DateTime>
} }
/// Functions to support displaying a user's information /// Functions to support displaying a user's information
module DisplayUser = module DisplayUser =
/// Construct a displayed user from a web log user /// Construct a displayed user from a web log user
let fromUser webLog (user : WebLogUser) = let fromUser webLog (user: WebLogUser) =
{ Id = WebLogUserId.toString user.Id { Id = string user.Id
Email = user.Email Email = user.Email
FirstName = user.FirstName FirstName = user.FirstName
LastName = user.LastName LastName = user.LastName
PreferredName = user.PreferredName PreferredName = user.PreferredName
Url = defaultArg user.Url "" Url = defaultArg user.Url ""
AccessLevel = user.AccessLevel.Value AccessLevel = string user.AccessLevel
CreatedOn = WebLog.localTime webLog user.CreatedOn CreatedOn = WebLog.localTime webLog user.CreatedOn
LastSeenOn = user.LastSeenOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable LastSeenOn = user.LastSeenOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable
} }
@ -311,30 +311,30 @@ module DisplayUser =
/// View model for editing categories /// View model for editing categories
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type EditCategoryModel = type EditCategoryModel = {
{ /// The ID of the category being edited /// The ID of the category being edited
CategoryId : string CategoryId: string
/// The name of the category /// The name of the category
Name : string Name: string
/// The category's URL slug /// The category's URL slug
Slug : string Slug: string
/// A description of the category (optional) /// A description of the category (optional)
Description : string Description: string
/// The ID of the category for which this is a subcategory (optional) /// The ID of the category for which this is a subcategory (optional)
ParentId : string ParentId: string
} } with
/// Create an edit model from an existing category /// Create an edit model from an existing category
static member fromCategory (cat : Category) = static member fromCategory (cat: Category) =
{ CategoryId = cat.Id.Value { CategoryId = string cat.Id
Name = cat.Name Name = cat.Name
Slug = cat.Slug Slug = cat.Slug
Description = defaultArg cat.Description "" Description = defaultArg cat.Description ""
ParentId = cat.ParentId |> Option.map _.Value |> Option.defaultValue "" ParentId = cat.ParentId |> Option.map string |> Option.defaultValue ""
} }
/// Is this a new category? /// Is this a new category?
@ -437,10 +437,10 @@ type EditCustomFeedModel =
static member fromFeed (feed: CustomFeed) = static member fromFeed (feed: CustomFeed) =
let rss = let rss =
{ EditCustomFeedModel.empty with { EditCustomFeedModel.empty with
Id = CustomFeedId.toString feed.Id Id = string feed.Id
SourceType = match feed.Source with Category _ -> "category" | Tag _ -> "tag" SourceType = match feed.Source with Category _ -> "category" | Tag _ -> "tag"
SourceValue = match feed.Source with Category (CategoryId catId) -> catId | Tag tag -> tag SourceValue = match feed.Source with Category (CategoryId catId) -> catId | Tag tag -> tag
Path = feed.Path.Value Path = string feed.Path
} }
match feed.Podcast with match feed.Podcast with
| Some p -> | Some p ->
@ -452,16 +452,16 @@ type EditCustomFeedModel =
Summary = p.Summary Summary = p.Summary
DisplayedAuthor = p.DisplayedAuthor DisplayedAuthor = p.DisplayedAuthor
Email = p.Email Email = p.Email
ImageUrl = p.ImageUrl.Value ImageUrl = string p.ImageUrl
AppleCategory = p.AppleCategory AppleCategory = p.AppleCategory
AppleSubcategory = defaultArg p.AppleSubcategory "" AppleSubcategory = defaultArg p.AppleSubcategory ""
Explicit = p.Explicit.Value Explicit = string p.Explicit
DefaultMediaType = defaultArg p.DefaultMediaType "" DefaultMediaType = defaultArg p.DefaultMediaType ""
MediaBaseUrl = defaultArg p.MediaBaseUrl "" MediaBaseUrl = defaultArg p.MediaBaseUrl ""
FundingUrl = defaultArg p.FundingUrl "" FundingUrl = defaultArg p.FundingUrl ""
FundingText = defaultArg p.FundingText "" FundingText = defaultArg p.FundingText ""
PodcastGuid = p.PodcastGuid |> Option.map _.ToString().ToLowerInvariant() |> Option.defaultValue "" 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 | None -> rss
@ -562,9 +562,9 @@ type EditPageModel = {
| Some rev -> rev | Some rev -> rev
| None -> Revision.Empty | None -> Revision.Empty
let page = if page.Metadata |> List.isEmpty then { page with Metadata = [ MetaItem.Empty ] } else page let page = if page.Metadata |> List.isEmpty then { page with Metadata = [ MetaItem.Empty ] } else page
{ PageId = page.Id.Value { PageId = string page.Id
Title = page.Title Title = page.Title
Permalink = page.Permalink.Value Permalink = string page.Permalink
Template = defaultArg page.Template "" Template = defaultArg page.Template ""
IsShownInPageList = page.IsInPageList IsShownInPageList = page.IsInPageList
Source = latest.Text.SourceType Source = latest.Text.SourceType
@ -580,7 +580,7 @@ type EditPageModel = {
member this.UpdatePage (page: Page) now = member this.UpdatePage (page: Page) now =
let revision = { AsOf = now; Text = MarkupText.Parse $"{this.Source}: {this.Text}" } let revision = { AsOf = now; Text = MarkupText.Parse $"{this.Source}: {this.Text}" }
// Detect a permalink change, and add the prior one to the prior list // Detect a permalink change, and add the prior one to the prior list
match page.Permalink.Value with match string page.Permalink with
| "" -> page | "" -> page
| link when link = this.Permalink -> page | link when link = this.Permalink -> page
| _ -> { page with PriorPermalinks = page.Permalink :: page.PriorPermalinks } | _ -> { page with PriorPermalinks = page.Permalink :: page.PriorPermalinks }
@ -715,15 +715,15 @@ type EditPostModel = {
| None -> Revision.Empty | None -> Revision.Empty
let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.Empty ] } else post let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.Empty ] } else post
let episode = defaultArg post.Episode Episode.Empty let episode = defaultArg post.Episode Episode.Empty
{ PostId = post.Id.Value { PostId = string post.Id
Title = post.Title Title = post.Title
Permalink = post.Permalink.Value Permalink = string post.Permalink
Source = latest.Text.SourceType Source = latest.Text.SourceType
Text = latest.Text.Text Text = latest.Text.Text
Tags = String.Join (", ", post.Tags) Tags = String.Join (", ", post.Tags)
Template = defaultArg post.Template "" Template = defaultArg post.Template ""
CategoryIds = post.CategoryIds |> List.map _.Value |> Array.ofList CategoryIds = post.CategoryIds |> List.map string |> Array.ofList
Status = post.Status.Value Status = string post.Status
DoPublish = false DoPublish = false
MetaNames = post.Metadata |> List.map _.Name |> Array.ofList MetaNames = post.Metadata |> List.map _.Name |> Array.ofList
MetaValues = post.Metadata |> List.map _.Value |> Array.ofList MetaValues = post.Metadata |> List.map _.Value |> Array.ofList
@ -737,7 +737,7 @@ type EditPostModel = {
MediaType = defaultArg episode.MediaType "" MediaType = defaultArg episode.MediaType ""
ImageUrl = defaultArg episode.ImageUrl "" ImageUrl = defaultArg episode.ImageUrl ""
Subtitle = defaultArg episode.Subtitle "" Subtitle = defaultArg episode.Subtitle ""
Explicit = defaultArg (episode.Explicit |> Option.map _.Value) "" Explicit = defaultArg (episode.Explicit |> Option.map string) ""
ChapterFile = defaultArg episode.ChapterFile "" ChapterFile = defaultArg episode.ChapterFile ""
ChapterType = defaultArg episode.ChapterType "" ChapterType = defaultArg episode.ChapterType ""
TranscriptUrl = defaultArg episode.TranscriptUrl "" TranscriptUrl = defaultArg episode.TranscriptUrl ""
@ -757,7 +757,7 @@ type EditPostModel = {
member this.UpdatePost (post: Post) now = member this.UpdatePost (post: Post) now =
let revision = { AsOf = now; Text = MarkupText.Parse $"{this.Source}: {this.Text}" } let revision = { AsOf = now; Text = MarkupText.Parse $"{this.Source}: {this.Text}" }
// Detect a permalink change, and add the prior one to the prior list // Detect a permalink change, and add the prior one to the prior list
match post.Permalink.Value with match string post.Permalink with
| "" -> post | "" -> post
| link when link = this.Permalink -> post | link when link = this.Permalink -> post
| _ -> { post with PriorPermalinks = post.Permalink :: post.PriorPermalinks } | _ -> { post with PriorPermalinks = post.Permalink :: post.PriorPermalinks }
@ -916,7 +916,7 @@ type EditTagMapModel =
/// Create an edit model from the tag mapping /// Create an edit model from the tag mapping
static member fromMapping (tagMap : TagMap) : EditTagMapModel = static member fromMapping (tagMap : TagMap) : EditTagMapModel =
{ Id = TagMapId.toString tagMap.Id { Id = string tagMap.Id
Tag = tagMap.Tag Tag = tagMap.Tag
UrlValue = tagMap.UrlValue UrlValue = tagMap.UrlValue
} }
@ -924,39 +924,39 @@ type EditTagMapModel =
/// View model to display a user's information /// View model to display a user's information
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type EditUserModel = type EditUserModel = {
{ /// The ID of the user /// The ID of the user
Id : string Id: string
/// The user's access level /// The user's access level
AccessLevel : string AccessLevel: string
/// The user name (e-mail address) /// The user name (e-mail address)
Email : string Email: string
/// The URL of the user's personal site /// The URL of the user's personal site
Url : string Url: string
/// The user's first name /// The user's first name
FirstName : string FirstName: string
/// The user's last name /// The user's last name
LastName : string LastName: string
/// The user's preferred name /// The user's preferred name
PreferredName : string PreferredName: string
/// The user's password /// The user's password
Password : string Password: string
/// Confirmation of the user's password /// Confirmation of the user's password
PasswordConfirm : string PasswordConfirm: string
} } with
/// Construct a displayed user from a web log user /// Construct a displayed user from a web log user
static member fromUser (user : WebLogUser) = static member fromUser (user: WebLogUser) =
{ Id = WebLogUserId.toString user.Id { Id = string user.Id
AccessLevel = user.AccessLevel.Value AccessLevel = string user.AccessLevel
Url = defaultArg user.Url "" Url = defaultArg user.Url ""
Email = user.Email Email = user.Email
FirstName = user.FirstName FirstName = user.FirstName
@ -1020,20 +1020,20 @@ type ManagePermalinksModel = {
/// Create a permalink model from a page /// Create a permalink model from a page
static member fromPage (pg: Page) = static member fromPage (pg: Page) =
{ Id = pg.Id.Value { Id = string pg.Id
Entity = "page" Entity = "page"
CurrentTitle = pg.Title CurrentTitle = pg.Title
CurrentPermalink = pg.Permalink.Value CurrentPermalink = string pg.Permalink
Prior = pg.PriorPermalinks |> List.map _.Value |> Array.ofList Prior = pg.PriorPermalinks |> List.map string |> Array.ofList
} }
/// Create a permalink model from a post /// Create a permalink model from a post
static member fromPost (post: Post) = static member fromPost (post: Post) =
{ Id = post.Id.Value { Id = string post.Id
Entity = "post" Entity = "post"
CurrentTitle = post.Title CurrentTitle = post.Title
CurrentPermalink = post.Permalink.Value CurrentPermalink = string post.Permalink
Prior = post.PriorPermalinks |> List.map _.Value |> Array.ofList Prior = post.PriorPermalinks |> List.map string |> Array.ofList
} }
@ -1055,7 +1055,7 @@ type ManageRevisionsModel =
/// Create a revision model from a page /// Create a revision model from a page
static member fromPage webLog (pg: Page) = static member fromPage webLog (pg: Page) =
{ Id = pg.Id.Value { Id = string pg.Id
Entity = "page" Entity = "page"
CurrentTitle = pg.Title CurrentTitle = pg.Title
Revisions = pg.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList Revisions = pg.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
@ -1063,7 +1063,7 @@ type ManageRevisionsModel =
/// Create a revision model from a post /// Create a revision model from a post
static member fromPost webLog (post: Post) = static member fromPost webLog (post: Post) =
{ Id = post.Id.Value { Id = string post.Id
Entity = "post" Entity = "post"
CurrentTitle = post.Title CurrentTitle = post.Title
Revisions = post.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList Revisions = post.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
@ -1114,15 +1114,15 @@ type PostListItem = {
static member fromPost (webLog: WebLog) (post: Post) = static member fromPost (webLog: WebLog) (post: Post) =
let _, extra = WebLog.hostAndPath webLog let _, extra = WebLog.hostAndPath webLog
let inTZ = WebLog.localTime webLog let inTZ = WebLog.localTime webLog
{ Id = post.Id.Value { Id = string post.Id
AuthorId = WebLogUserId.toString post.AuthorId AuthorId = string post.AuthorId
Status = post.Status.Value Status = string post.Status
Title = post.Title Title = post.Title
Permalink = post.Permalink.Value Permalink = string post.Permalink
PublishedOn = post.PublishedOn |> Option.map inTZ |> Option.toNullable PublishedOn = post.PublishedOn |> Option.map inTZ |> Option.toNullable
UpdatedOn = inTZ post.UpdatedOn UpdatedOn = inTZ post.UpdatedOn
Text = addBaseToRelativeUrls extra post.Text Text = addBaseToRelativeUrls extra post.Text
CategoryIds = post.CategoryIds |> List.map _.Value CategoryIds = post.CategoryIds |> List.map string
Tags = post.Tags Tags = post.Tags
Episode = post.Episode Episode = post.Episode
Metadata = post.Metadata Metadata = post.Metadata
@ -1156,46 +1156,46 @@ type PostDisplay =
/// View model for editing web log settings /// View model for editing web log settings
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type SettingsModel = type SettingsModel = {
{ /// The name of the web log /// The name of the web log
Name : string Name: string
/// The slug of the web log /// The slug of the web log
Slug : string Slug: string
/// The subtitle of the web log /// The subtitle of the web log
Subtitle : string Subtitle: string
/// The default page /// The default page
DefaultPage : string DefaultPage: string
/// How many posts should appear on index pages /// How many posts should appear on index pages
PostsPerPage : int PostsPerPage: int
/// The time zone in which dates/times should be displayed /// The time zone in which dates/times should be displayed
TimeZone : string TimeZone: string
/// The theme to use to display the web log /// The theme to use to display the web log
ThemeId : string ThemeId: string
/// Whether to automatically load htmx /// Whether to automatically load htmx
AutoHtmx : bool AutoHtmx: bool
/// The default location for uploads /// The default location for uploads
Uploads : string Uploads: string
} } with
/// Create a settings model from a web log /// Create a settings model from a web log
static member fromWebLog (webLog : WebLog) = static member fromWebLog (webLog: WebLog) =
{ Name = webLog.Name { Name = webLog.Name
Slug = webLog.Slug Slug = webLog.Slug
Subtitle = defaultArg webLog.Subtitle "" Subtitle = defaultArg webLog.Subtitle ""
DefaultPage = webLog.DefaultPage DefaultPage = webLog.DefaultPage
PostsPerPage = webLog.PostsPerPage PostsPerPage = webLog.PostsPerPage
TimeZone = webLog.TimeZone TimeZone = webLog.TimeZone
ThemeId = ThemeId.toString webLog.ThemeId ThemeId = string webLog.ThemeId
AutoHtmx = webLog.AutoHtmx AutoHtmx = webLog.AutoHtmx
Uploads = UploadDestination.toString webLog.Uploads Uploads = string webLog.Uploads
} }
/// Update a web log with settings from the form /// Update a web log with settings from the form
@ -1209,7 +1209,7 @@ type SettingsModel =
TimeZone = this.TimeZone TimeZone = this.TimeZone
ThemeId = ThemeId this.ThemeId ThemeId = ThemeId this.ThemeId
AutoHtmx = this.AutoHtmx 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) let private hasInclude = Regex ("""{% include_template \"(.*)\" %}""", RegexOptions.None, TimeSpan.FromSeconds 2)
/// Get a template for the given theme and template name /// Get a template for the given theme and template name
let get (themeId : ThemeId) (templateName : string) (data : IData) = backgroundTask { let get (themeId: ThemeId) (templateName: string) (data: IData) = backgroundTask {
let templatePath = $"{ThemeId.toString themeId}/{templateName}" let templatePath = $"{themeId}/{templateName}"
match _cache.ContainsKey templatePath with match _cache.ContainsKey templatePath with
| true -> return Ok _cache[templatePath] | true -> return Ok _cache[templatePath]
| false -> | false ->
@ -215,7 +215,7 @@ module TemplateCache =
if childNotFound = "" then child.Groups[1].Value if childNotFound = "" then child.Groups[1].Value
else $"{childNotFound}; {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 if childNotFound <> "" then
let s = if childNotFound.IndexOf ";" >= 0 then "s" else "" let s = if childNotFound.IndexOf ";" >= 0 then "s" else ""
return Error $"Could not find the child template{s} {childNotFound} required by {templateName}" 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) _cache[templatePath] <- Template.Parse (text, SyntaxCompatibility.DotLiquid22)
return Ok _cache[templatePath] return Ok _cache[templatePath]
| None -> | None ->
return Error $"Theme ID {ThemeId.toString themeId} does not have a template named {templateName}" return Error $"Theme ID {themeId} does not have a template named {templateName}"
| None -> return Result.Error $"Theme ID {ThemeId.toString themeId} does not exist" | None -> return Error $"Theme ID {themeId} does not exist"
} }
/// Get all theme/template names currently cached /// Get all theme/template names currently cached
@ -232,16 +232,16 @@ module TemplateCache =
_cache.Keys |> Seq.sort |> Seq.toList _cache.Keys |> Seq.sort |> Seq.toList
/// Invalidate all template cache entries for the given theme ID /// Invalidate all template cache entries for the given theme ID
let invalidateTheme (themeId : ThemeId) = let invalidateTheme (themeId: ThemeId) =
let keyPrefix = ThemeId.toString themeId let keyPrefix = string themeId
_cache.Keys _cache.Keys
|> Seq.filter (fun key -> key.StartsWith keyPrefix) |> Seq.filter _.StartsWith(keyPrefix)
|> List.ofSeq |> List.ofSeq
|> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ()) |> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ())
/// Remove all entries from the template cache /// Remove all entries from the template cache
let empty () = let empty () =
_cache.Clear () _cache.Clear()
/// A cache of asset names by themes /// 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.) /// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
type ThemeAssetFilter () = type ThemeAssetFilter() =
static member ThemeAsset (ctx : Context, asset : string) = static member ThemeAsset(ctx: Context, asset: string) =
WebLog.relativeUrl ctx.WebLog (Permalink $"themes/{ThemeId.toString ctx.WebLog.ThemeId}/{asset}") 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 /// 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 { let admin : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
match! TemplateCache.get adminTheme "theme-list-body" ctx.Data with match! TemplateCache.get adminTheme "theme-list-body" ctx.Data with
| Ok bodyTemplate -> | Ok bodyTemplate ->
let! themes = ctx.Data.Theme.All () let! themes = ctx.Data.Theme.All()
let cachedTemplates = TemplateCache.allNames () let cachedTemplates = TemplateCache.allNames ()
let! hash = let! hash =
hashForPage "myWebLog Administration" hashForPage "myWebLog Administration"
@ -50,10 +50,10 @@ module Dashboard =
themes themes
|> Seq.ofList |> Seq.ofList
|> Seq.map (fun it -> [| |> Seq.map (fun it -> [|
ThemeId.toString it.Id string it.Id
it.Name it.Name
cachedTemplates cachedTemplates
|> List.filter (fun n -> n.StartsWith (ThemeId.toString it.Id)) |> List.filter _.StartsWith(string it.Id)
|> List.length |> List.length
|> string |> string
|]) |])
@ -61,8 +61,8 @@ module Dashboard =
|> addToHash "web_logs" ( |> addToHash "web_logs" (
WebLogCache.all () WebLogCache.all ()
|> Seq.ofList |> Seq.ofList
|> Seq.sortBy (fun it -> it.Name) |> Seq.sortBy _.Name
|> Seq.map (fun it -> [| WebLogId.toString it.Id; it.Name; it.UrlBase |]) |> Seq.map (fun it -> [| string it.Id; it.Name; it.UrlBase |])
|> Array.ofSeq) |> Array.ofSeq)
|> addViewContext ctx |> addViewContext ctx
return! return!
@ -317,7 +317,7 @@ module TagMapping =
addToHash "mappings" mappings hash addToHash "mappings" mappings hash
|> addToHash "mapping_ids" ( |> addToHash "mapping_ids" (
mappings 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 // GET /admin/settings/tag-mappings
@ -348,13 +348,13 @@ module TagMapping =
// POST /admin/settings/tag-mapping/save // POST /admin/settings/tag-mapping/save
let save : HttpHandler = fun next ctx -> task { let save : HttpHandler = fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel> () let! model = ctx.BindFormAsync<EditTagMapModel>()
let tagMap = 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 else data.TagMap.FindById (TagMapId model.Id) ctx.WebLog.Id
match! tagMap with match! tagMap with
| Some tm -> | Some tm ->
do! data.TagMap.Save { tm with Tag = model.Tag.ToLower (); UrlValue = model.UrlValue.ToLower () } do! data.TagMap.Save { tm with Tag = model.Tag.ToLower(); UrlValue = model.UrlValue.ToLower() }
do! addMessage ctx { UserMessage.success with Message = "Tag mapping saved successfully" } do! addMessage ctx { UserMessage.success with Message = "Tag mapping saved successfully" }
return! all next ctx return! all next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@ -395,17 +395,17 @@ module Theme =
|> adminBareView "theme-upload" next ctx |> adminBareView "theme-upload" next ctx
/// Update the name and version for a theme based on the version.txt file, if present /// Update the name and version for a theme based on the version.txt file, if present
let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = backgroundTask { let private updateNameAndVersion (theme: Theme) (zip: ZipArchive) = backgroundTask {
let now () = DateTime.UtcNow.ToString "yyyyMMdd.HHmm" let now () = DateTime.UtcNow.ToString "yyyyMMdd.HHmm"
match zip.Entries |> Seq.filter (fun it -> it.FullName = "version.txt") |> Seq.tryHead with match zip.Entries |> Seq.filter (fun it -> it.FullName = "version.txt") |> Seq.tryHead with
| Some versionItem -> | Some versionItem ->
use versionFile = new StreamReader(versionItem.Open ()) use versionFile = new StreamReader(versionItem.Open())
let! versionText = versionFile.ReadToEndAsync () let! versionText = versionFile.ReadToEndAsync()
let parts = versionText.Trim().Replace("\r", "").Split "\n" let parts = versionText.Trim().Replace("\r", "").Split "\n"
let displayName = if parts[0] > "" then parts[0] else ThemeId.toString theme.Id let displayName = if parts[0] > "" then parts[0] else string theme.Id
let version = if parts.Length > 1 && parts[1] > "" then parts[1] else now () let version = if parts.Length > 1 && parts[1] > "" then parts[1] else now ()
return { theme with Name = displayName; Version = version } return { theme with Name = displayName; Version = version }
| None -> return { theme with Name = ThemeId.toString theme.Id; Version = now () } | None -> return { theme with Name = string theme.Id; Version = now () }
} }
/// Update the theme with all templates from the ZIP archive /// Update the theme with all templates from the ZIP archive
@ -476,16 +476,16 @@ module Theme =
let data = ctx.Data let data = ctx.Data
let! exists = data.Theme.Exists themeId let! exists = data.Theme.Exists themeId
let isNew = not exists let isNew = not exists
let! model = ctx.BindFormAsync<UploadThemeModel> () let! model = ctx.BindFormAsync<UploadThemeModel>()
if isNew || model.DoOverwrite then if isNew || model.DoOverwrite then
// Load the theme to the database // Load the theme to the database
use stream = new MemoryStream () use stream = new MemoryStream()
do! themeFile.CopyToAsync stream do! themeFile.CopyToAsync stream
let! _ = loadFromZip themeId stream data let! _ = loadFromZip themeId stream data
do! ThemeAssetCache.refreshTheme themeId data do! ThemeAssetCache.refreshTheme themeId data
TemplateCache.invalidateTheme themeId TemplateCache.invalidateTheme themeId
// Save the .zip file // 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! themeFile.CopyToAsync file
do! addMessage ctx do! addMessage ctx
{ UserMessage.success with { UserMessage.success with
@ -556,18 +556,18 @@ module WebLog =
KeyValuePair.Create("posts", "- First Page of Posts -") KeyValuePair.Create("posts", "- First Page of Posts -")
yield! allPages yield! allPages
|> List.sortBy _.Title.ToLower() |> 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) |> Array.ofSeq)
|> addToHash "themes" ( |> addToHash "themes" (
themes themes
|> Seq.ofList |> Seq.ofList
|> Seq.map (fun it -> |> 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) |> Array.ofSeq)
|> addToHash "upload_values" [| |> addToHash "upload_values" [|
KeyValuePair.Create (UploadDestination.toString Database, "Database") KeyValuePair.Create(string Database, "Database")
KeyValuePair.Create (UploadDestination.toString Disk, "Disk") KeyValuePair.Create(string Disk, "Disk")
|] |]
|> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList) |> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList)
|> addToHash "rss_model" (EditRssModel.fromRssOptions ctx.WebLog.Rss) |> 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 -> | false ->
// Category and tag feeds are handled by defined routes; check for custom feed // Category and tag feeds are handled by defined routes; check for custom feed
match webLog.Rss.CustomFeeds match webLog.Rss.CustomFeeds
|> List.tryFind (fun it -> feedPath.EndsWith it.Path.Value) with |> List.tryFind (fun it -> feedPath.EndsWith(string it.Path)) with
| Some feed -> | Some feed ->
debug (fun () -> "Found custom feed") debug (fun () -> "Found custom feed")
Some (Custom (feed, feedPath), feed.Podcast |> Option.map _.ItemsInFeed |> Option.defaultValue postCount) 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 /// Determine the function to retrieve posts for the given feed
let private getFeedPosts ctx feedType = let private getFeedPosts ctx feedType =
let childIds (catId: CategoryId) = 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 getCategoryIds cat.Slug ctx
let data = ctx.Data let data = ctx.Data
match feedType with match feedType with
@ -86,51 +86,50 @@ module private Namespace =
let rawVoice = "http://www.rawvoice.com/rawvoiceRssModule/" let rawVoice = "http://www.rawvoice.com/rawvoiceRssModule/"
/// Create a feed item from the given post /// Create a feed item from the given post
let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[]) (tagMaps : TagMap list) let private toFeedItem webLog (authors: MetaItem list) (cats: DisplayCategory array) (tagMaps: TagMap list)
(post : Post) = (post: Post) =
let plainText = let plainText =
let endingP = post.Text.IndexOf "</p>" let endingP = post.Text.IndexOf "</p>"
stripHtml <| if endingP >= 0 then post.Text[..(endingP - 1)] else post.Text stripHtml <| if endingP >= 0 then post.Text[..(endingP - 1)] else post.Text
let item = SyndicationItem ( let item = SyndicationItem(
Id = WebLog.absoluteUrl webLog post.Permalink, Id = WebLog.absoluteUrl webLog post.Permalink,
Title = TextSyndicationContent.CreateHtmlContent post.Title, Title = TextSyndicationContent.CreateHtmlContent post.Title,
PublishDate = post.PublishedOn.Value.ToDateTimeOffset (), PublishDate = post.PublishedOn.Value.ToDateTimeOffset(),
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset (), LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset(),
Content = TextSyndicationContent.CreatePlaintextContent plainText) Content = TextSyndicationContent.CreatePlaintextContent plainText)
item.AddPermalink (Uri item.Id) item.AddPermalink (Uri item.Id)
let xmlDoc = XmlDocument () let xmlDoc = XmlDocument()
let encoded = let encoded =
let txt = let txt =
post.Text post.Text
.Replace("src=\"/", $"src=\"{webLog.UrlBase}/") .Replace("src=\"/", $"src=\"{webLog.UrlBase}/")
.Replace ("href=\"/", $"href=\"{webLog.UrlBase}/") .Replace("href=\"/", $"href=\"{webLog.UrlBase}/")
let it = xmlDoc.CreateElement ("content", "encoded", Namespace.content) let it = xmlDoc.CreateElement("content", "encoded", Namespace.content)
let _ = it.AppendChild (xmlDoc.CreateCDataSection txt) let _ = it.AppendChild(xmlDoc.CreateCDataSection txt)
it it
item.ElementExtensions.Add encoded item.ElementExtensions.Add encoded
item.Authors.Add (SyndicationPerson ( item.Authors.Add(SyndicationPerson(Name = (authors |> List.find (fun a -> a.Name = string post.AuthorId)).Value))
Name = (authors |> List.find (fun a -> a.Name = WebLogUserId.toString post.AuthorId)).Value))
[ post.CategoryIds [ post.CategoryIds
|> List.map (fun catId -> |> List.map (fun catId ->
let cat = cats |> Array.find (fun c -> c.Id = catId.Value) let cat = cats |> Array.find (fun c -> c.Id = string catId)
SyndicationCategory (cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name)) SyndicationCategory(cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name))
post.Tags post.Tags
|> List.map (fun tag -> |> List.map (fun tag ->
let urlTag = let urlTag =
match tagMaps |> List.tryFind (fun tm -> tm.Tag = tag) with match tagMaps |> List.tryFind (fun tm -> tm.Tag = tag) with
| Some tm -> tm.UrlValue | Some tm -> tm.UrlValue
| None -> tag.Replace (" ", "+") | None -> tag.Replace (" ", "+")
SyndicationCategory (tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)")) SyndicationCategory(tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)"))
] ]
|> List.concat |> List.concat
|> List.iter item.Categories.Add |> List.iter item.Categories.Add
item item
/// Convert non-absolute URLs to an absolute URL for this web log /// 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) if link.StartsWith "http" then link else WebLog.absoluteUrl webLog (Permalink link)
/// Add episode information to a podcast feed item /// 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 when Option.isSome podcast.MediaBaseUrl -> $"{podcast.MediaBaseUrl.Value}{link}"
| link -> WebLog.absoluteUrl webLog (Permalink link) | link -> WebLog.absoluteUrl webLog (Permalink link)
let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
let epImageUrl = defaultArg episode.ImageUrl podcast.ImageUrl.Value |> toAbsolute webLog let epImageUrl = defaultArg episode.ImageUrl (string podcast.ImageUrl) |> toAbsolute webLog
let epExplicit = (defaultArg episode.Explicit podcast.Explicit).Value let epExplicit = string (defaultArg episode.Explicit podcast.Explicit)
let xmlDoc = XmlDocument() let xmlDoc = XmlDocument()
let enclosure = let enclosure =
@ -298,7 +297,7 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
rssFeed.ElementExtensions.Add rawVoice rssFeed.ElementExtensions.Add rawVoice
rssFeed.ElementExtensions.Add("summary", Namespace.iTunes, podcast.Summary) rssFeed.ElementExtensions.Add("summary", Namespace.iTunes, podcast.Summary)
rssFeed.ElementExtensions.Add("author", Namespace.iTunes, podcast.DisplayedAuthor) rssFeed.ElementExtensions.Add("author", Namespace.iTunes, podcast.DisplayedAuthor)
rssFeed.ElementExtensions.Add("explicit", Namespace.iTunes, 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.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub))
podcast.FundingUrl podcast.FundingUrl
|> Option.iter (fun url -> |> Option.iter (fun url ->
@ -309,7 +308,7 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
podcast.PodcastGuid podcast.PodcastGuid
|> Option.iter (fun guid -> |> Option.iter (fun guid ->
rssFeed.ElementExtensions.Add("guid", Namespace.podcast, guid.ToString().ToLowerInvariant())) rssFeed.ElementExtensions.Add("guid", Namespace.podcast, guid.ToString().ToLowerInvariant()))
podcast.Medium |> 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 /// Get the feed's self reference and non-feed link
let private selfAndLink webLog feedType ctx = 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 match podcast, post.Episode with
| Some feed, Some episode -> addEpisode webLog (Option.get feed.Podcast) episode post item | Some feed, Some episode -> addEpisode webLog (Option.get feed.Podcast) episode post item
| Some _, _ -> | Some _, _ ->
warn "Feed" ctx $"[{webLog.Name} {self.Value}] \"{stripHtml post.Title}\" has no media" warn "Feed" ctx $"[{webLog.Name} {self}] \"{stripHtml post.Title}\" has no media"
item item
| _ -> 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 editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let customFeed = let customFeed =
match feedId with match feedId with
| "new" -> Some { CustomFeed.empty with Id = CustomFeedId "new" } | "new" -> Some { CustomFeed.Empty with Id = CustomFeedId "new" }
| _ -> ctx.WebLog.Rss.CustomFeeds |> List.tryFind (fun f -> f.Id = CustomFeedId feedId) | _ -> ctx.WebLog.Rss.CustomFeeds |> List.tryFind (fun f -> f.Id = CustomFeedId feedId)
match customFeed with match customFeed with
| Some f -> | Some f ->
@ -436,13 +435,13 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
|> addToHash ViewContext.Model (EditCustomFeedModel.fromFeed f) |> addToHash ViewContext.Model (EditCustomFeedModel.fromFeed f)
|> addToHash "medium_values" [| |> addToHash "medium_values" [|
KeyValuePair.Create("", "&ndash; Unspecified &ndash;") KeyValuePair.Create("", "&ndash; Unspecified &ndash;")
KeyValuePair.Create(Podcast.Value, "Podcast") KeyValuePair.Create(string Podcast, "Podcast")
KeyValuePair.Create(Music.Value, "Music") KeyValuePair.Create(string Music, "Music")
KeyValuePair.Create(Video.Value, "Video") KeyValuePair.Create(string Video, "Video")
KeyValuePair.Create(Film.Value, "Film") KeyValuePair.Create(string Film, "Film")
KeyValuePair.Create(Audiobook.Value, "Audiobook") KeyValuePair.Create(string Audiobook, "Audiobook")
KeyValuePair.Create(Newsletter.Value, "Newsletter") KeyValuePair.Create(string Newsletter, "Newsletter")
KeyValuePair.Create(Blog.Value, "Blog") KeyValuePair.Create(string Blog, "Blog")
|] |]
|> adminView "custom-feed-edit" next ctx |> adminView "custom-feed-edit" next ctx
| None -> Error.notFound 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! model = ctx.BindFormAsync<EditCustomFeedModel> ()
let theFeed = let theFeed =
match model.Id with match model.Id with
| "new" -> Some { CustomFeed.empty with Id = CustomFeedId.create () } | "new" -> Some { CustomFeed.Empty with Id = CustomFeedId.Create() }
| _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> CustomFeedId.toString it.Id = model.Id) | _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> string it.Id = model.Id)
match theFeed with match theFeed with
| Some feed -> | Some feed ->
let feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun it -> it.Id <> feed.Id)) let feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun it -> it.Id <> feed.Id))
@ -467,7 +466,7 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
UserMessage.success with UserMessage.success with
Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed""" Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed"""
} }
return! redirectToGet $"admin/settings/rss/{CustomFeedId.toString feed.Id}/edit" next ctx return! redirectToGet $"admin/settings/rss/{feed.Id}/edit" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }

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

@ -352,8 +352,8 @@ let requireAccess level : HttpHandler = fun next ctx -> task {
| Some userLevel -> | Some userLevel ->
do! addMessage ctx do! addMessage ctx
{ UserMessage.warning with { UserMessage.warning with
Message = $"The page you tried to access requires {level.Value} privileges" Message = $"The page you tried to access requires {level} privileges"
Detail = Some $"Your account only has {userLevel.Value} privileges" Detail = Some $"Your account only has {userLevel} privileges"
} }
return! Error.notAuthorized next ctx return! Error.notAuthorized next ctx
| None -> | 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 do! (if model.IsNew then data.Page.Add else data.Page.Update) updatedPage
if updateList then do! PageListCache.update ctx if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Page saved successfully" } do! addMessage ctx { UserMessage.success with Message = "Page saved successfully" }
return! redirectToGet $"admin/page/{page.Id.Value}/edit" next ctx return! redirectToGet $"admin/page/{page.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }

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

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

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

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

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

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

@ -48,22 +48,22 @@ open Microsoft.AspNetCore.Authentication.Cookies
// POST /user/log-on // POST /user/log-on
let doLogOn : HttpHandler = fun next ctx -> task { let doLogOn : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel> () let! model = ctx.BindFormAsync<LogOnModel>()
let data = ctx.Data let data = ctx.Data
let! tryUser = data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id let! tryUser = data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id
match! verifyPassword tryUser model.Password ctx with match! verifyPassword tryUser model.Password ctx with
| Ok _ -> | Ok _ ->
let user = tryUser.Value let user = tryUser.Value
let claims = seq { let claims = seq {
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id) Claim(ClaimTypes.NameIdentifier, string user.Id)
Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}") Claim(ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
Claim (ClaimTypes.GivenName, user.PreferredName) Claim(ClaimTypes.GivenName, user.PreferredName)
Claim (ClaimTypes.Role, user.AccessLevel.Value) 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, do! ctx.SignInAsync(identity.AuthenticationType, ClaimsPrincipal identity,
AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow)) AuthenticationProperties(IssuedUtc = DateTimeOffset.UtcNow))
do! data.WebLogUser.SetLastSeen user.Id user.WebLogId do! data.WebLogUser.SetLastSeen user.Id user.WebLogId
do! addMessage ctx do! addMessage ctx
{ UserMessage.success with { UserMessage.success with
@ -110,10 +110,10 @@ let private showEdit (model : EditUserModel) : HttpHandler = fun next ctx ->
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash ViewContext.Model model |> addToHash ViewContext.Model model
|> addToHash "access_levels" [| |> addToHash "access_levels" [|
KeyValuePair.Create(Author.Value, "Author") KeyValuePair.Create(string Author, "Author")
KeyValuePair.Create(Editor.Value, "Editor") KeyValuePair.Create(string Editor, "Editor")
KeyValuePair.Create(WebLogAdmin.Value, "Web Log Admin") KeyValuePair.Create(string WebLogAdmin, "Web Log Admin")
if ctx.HasAccessLevel Administrator then KeyValuePair.Create(Administrator.Value, "Administrator") if ctx.HasAccessLevel Administrator then KeyValuePair.Create(string Administrator, "Administrator")
|] |]
|> adminBareView "user-edit" next ctx |> adminBareView "user-edit" next ctx
@ -159,7 +159,7 @@ let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandl
hashForPage "Edit Your Information" hashForPage "Edit Your Information"
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash ViewContext.Model model |> 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 "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn)
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog |> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog
(defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0))) (defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
@ -208,7 +208,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let tryUser = let tryUser =
if model.IsNew then if model.IsNew then
{ WebLogUser.empty with { WebLogUser.empty with
Id = WebLogUserId.create () Id = WebLogUserId.Create()
WebLogId = ctx.WebLog.Id WebLogId = ctx.WebLog.Id
CreatedOn = Noda.now () CreatedOn = Noda.now ()
} |> someTask } |> 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}" | false, _ -> raise <| TimeZoneNotFoundException $"Cannot find IANA timezone for {local}"
// Create the web log // Create the web log
let webLogId = WebLogId.create () let webLogId = WebLogId.Create()
let userId = WebLogUserId.create () let userId = WebLogUserId.Create()
let homePageId = PageId.Create() let homePageId = PageId.Create()
let slug = Handlers.Upload.makeSlug args[2] let slug = Handlers.Upload.makeSlug args[2]
@ -37,7 +37,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
Name = args[2] Name = args[2]
Slug = slug Slug = slug
UrlBase = args[1] UrlBase = args[1]
DefaultPage = homePageId.Value DefaultPage = string homePageId
TimeZone = timeZone TimeZone = timeZone
} }
@ -110,8 +110,8 @@ let private importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
let! withLinks = data.Post.FindFullById post.Id post.WebLogId let! withLinks = data.Post.FindFullById post.Id post.WebLogId
let! _ = data.Post.UpdatePriorPermalinks post.Id post.WebLogId let! _ = data.Post.UpdatePriorPermalinks post.Id post.WebLogId
(old :: withLinks.Value.PriorPermalinks) (old :: withLinks.Value.PriorPermalinks)
printfn $"{old.Value} -> {current.Value}" printfn $"{old} -> {current}"
| None -> eprintfn $"Cannot find current post for {current.Value}" | None -> eprintfn $"Cannot find current post for {current}"
printfn "Done!" printfn "Done!"
| None -> eprintfn $"No web log found at {urlBase}" | 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! theme = Handlers.Admin.Theme.loadFromZip themeId copy data
let fac = sp.GetRequiredService<ILoggerFactory> () let fac = sp.GetRequiredService<ILoggerFactory> ()
let log = fac.CreateLogger "MyWebLog.Themes" 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}" | Error message -> eprintfn $"{message}"
else else
eprintfn "Usage: myWebLog load-theme [theme-zip-file-name]" 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 } } return { archive with WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase webLog.UrlBase } }
| Some _ -> | Some _ ->
// Err'body gets new IDs... // Err'body gets new IDs...
let newWebLogId = WebLogId.create () let newWebLogId = WebLogId.Create()
let newCatIds = archive.Categories |> List.map (fun cat -> cat.Id, CategoryId.Create ()) |> dict let newCatIds = archive.Categories |> List.map (fun cat -> cat.Id, CategoryId.Create() ) |> dict
let newMapIds = archive.TagMappings |> List.map (fun tm -> tm.Id, TagMapId.create ()) |> dict let newMapIds = archive.TagMappings |> List.map (fun tm -> tm.Id, TagMapId.Create() ) |> dict
let newPageIds = archive.Pages |> List.map (fun page -> page.Id, PageId.Create ()) |> dict let newPageIds = archive.Pages |> List.map (fun page -> page.Id, PageId.Create() ) |> dict
let newPostIds = archive.Posts |> List.map (fun post -> post.Id, PostId.Create ()) |> dict let newPostIds = archive.Posts |> List.map (fun post -> post.Id, PostId.Create() ) |> dict
let newUserIds = archive.Users |> List.map (fun user -> user.Id, WebLogUserId.create ()) |> dict let newUserIds = archive.Users |> List.map (fun user -> user.Id, WebLogUserId.Create()) |> dict
let newUpIds = archive.Uploads |> List.map (fun up -> up.Id, UploadId.create ()) |> dict let newUpIds = archive.Uploads |> List.map (fun up -> up.Id, UploadId.Create() ) |> dict
return return
{ archive with { archive with
WebLog = { archive.WebLog with Id = newWebLogId; UrlBase = Option.get newUrlBase } WebLog = { archive.WebLog with Id = newWebLogId; UrlBase = Option.get newUrlBase }
@ -481,7 +481,7 @@ let private doUserUpgrade urlBase email (data : IData) = task {
| WebLogAdmin -> | WebLogAdmin ->
do! data.WebLogUser.Update { user with AccessLevel = Administrator } do! data.WebLogUser.Update { user with AccessLevel = Administrator }
printfn $"{email} is now an Administrator user" printfn $"{email} is now an Administrator user"
| other -> eprintfn $"ERROR: {email} is an {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 user {email} found at {urlBase}"
| None -> eprintfn $"ERROR: no web log found for {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}" let path = $"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{ctx.Request.Path.Value}"
match WebLogCache.tryGet path with match WebLogCache.tryGet path with
| Some webLog -> | Some webLog ->
if isDebug then log.LogDebug $"Resolved web log {WebLogId.toString webLog.Id} for {path}" if isDebug then log.LogDebug $"Resolved web log {webLog.Id} for {path}"
ctx.Items["webLog"] <- webLog ctx.Items["webLog"] <- webLog
if PageListCache.exists ctx then () else do! PageListCache.update ctx if PageListCache.exists ctx then () else do! PageListCache.update ctx
if CategoryCache.exists ctx then () else do! CategoryCache.update ctx if CategoryCache.exists ctx then () else do! CategoryCache.update ctx