992 lines
43 KiB
Forth
992 lines
43 KiB
Forth
namespace MyWebLog.Data
|
|
|
|
open System.Threading.Tasks
|
|
open MyWebLog
|
|
open RethinkDb.Driver
|
|
|
|
/// Functions to assist with retrieving data
|
|
[<AutoOpen>]
|
|
module private RethinkHelpers =
|
|
|
|
/// Table names
|
|
[<RequireQualifiedAccess>]
|
|
module Table =
|
|
|
|
/// The category table
|
|
let Category = "Category"
|
|
|
|
/// The comment table
|
|
let Comment = "Comment"
|
|
|
|
/// The page table
|
|
let Page = "Page"
|
|
|
|
/// The post table
|
|
let Post = "Post"
|
|
|
|
/// The tag map table
|
|
let TagMap = "TagMap"
|
|
|
|
/// The theme table
|
|
let Theme = "Theme"
|
|
|
|
/// The theme asset table
|
|
let ThemeAsset = "ThemeAsset"
|
|
|
|
/// The uploaded file table
|
|
let Upload = "Upload"
|
|
|
|
/// The web log table
|
|
let WebLog = "WebLog"
|
|
|
|
/// The web log user table
|
|
let WebLogUser = "WebLogUser"
|
|
|
|
/// A list of all tables
|
|
let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ]
|
|
|
|
|
|
/// Shorthand for the ReQL starting point
|
|
let r = RethinkDB.R
|
|
|
|
/// Verify that the web log ID matches before returning an item
|
|
let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (f : Net.IConnection -> Task<'T option>) =
|
|
fun conn -> backgroundTask {
|
|
match! f conn with Some it when (prop it) = webLogId -> return Some it | _ -> return None
|
|
}
|
|
|
|
/// Get the first item from a list, or None if the list is empty
|
|
let tryFirst<'T> (f : Net.IConnection -> Task<'T list>) =
|
|
fun conn -> backgroundTask {
|
|
let! results = f conn
|
|
return results |> List.tryHead
|
|
}
|
|
|
|
/// Cast a strongly-typed list to an object list
|
|
let objList<'T> (objects : 'T list) = objects |> List.map (fun it -> it :> obj)
|
|
|
|
|
|
open Microsoft.Extensions.Logging
|
|
open MyWebLog.ViewModels
|
|
open RethinkDb.Driver.FSharp
|
|
|
|
/// RethinkDB implementation of data functions for myWebLog
|
|
type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<RethinkDbData>) =
|
|
|
|
/// Match theme asset IDs by their prefix (the theme ID)
|
|
let matchAssetByThemeId themeId =
|
|
let keyPrefix = $"^{ThemeId.toString themeId}/"
|
|
fun (row : Ast.ReqlExpr) -> row["id"].Match keyPrefix :> obj
|
|
|
|
/// Ensure field indexes exist, as well as special indexes for selected tables
|
|
let ensureIndexes table fields = backgroundTask {
|
|
let! indexes = rethink<string list> { withTable table; indexList; result; withRetryOnce conn }
|
|
for field in fields do
|
|
if not (indexes |> List.contains field) then
|
|
log.LogInformation $"Creating index {table}.{field}..."
|
|
do! rethink { withTable table; indexCreate field; write; withRetryOnce; ignoreResult conn }
|
|
// Post and page need index by web log ID and permalink
|
|
if [ Table.Page; Table.Post ] |> List.contains table then
|
|
if not (indexes |> List.contains "permalink") then
|
|
log.LogInformation $"Creating index {table}.permalink..."
|
|
do! rethink {
|
|
withTable table
|
|
indexCreate "permalink" (fun row -> r.Array (row["webLogId"], row["permalink"].Downcase ()) :> obj)
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
// Prior permalinks are searched when a post or page permalink do not match the current URL
|
|
if not (indexes |> List.contains "priorPermalinks") then
|
|
log.LogInformation $"Creating index {table}.priorPermalinks..."
|
|
do! rethink {
|
|
withTable table
|
|
indexCreate "priorPermalinks" (fun row -> row["priorPermalinks"].Downcase () :> obj) [ Multi ]
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
// Post needs indexes by category and tag (used for counting and retrieving posts)
|
|
if Table.Post = table then
|
|
for idx in [ "categoryIds"; "tags" ] do
|
|
if not (List.contains idx indexes) then
|
|
log.LogInformation $"Creating index {table}.{idx}..."
|
|
do! rethink {
|
|
withTable table
|
|
indexCreate idx [ Multi ]
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
// Tag mapping needs an index by web log ID and both tag and URL values
|
|
if Table.TagMap = table then
|
|
if not (indexes |> List.contains "webLogAndTag") then
|
|
log.LogInformation $"Creating index {table}.webLogAndTag..."
|
|
do! rethink {
|
|
withTable table
|
|
indexCreate "webLogAndTag" (fun row -> r.Array (row["webLogId"], row["tag"]) :> obj)
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
if not (indexes |> List.contains "webLogAndUrl") then
|
|
log.LogInformation $"Creating index {table}.webLogAndUrl..."
|
|
do! rethink {
|
|
withTable table
|
|
indexCreate "webLogAndUrl" (fun row -> r.Array (row["webLogId"], row["urlValue"]) :> obj)
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
// Uploaded files need an index by web log ID and path, as that is how they are retrieved
|
|
if Table.Upload = table then
|
|
if not (indexes |> List.contains "webLogAndPath") then
|
|
log.LogInformation $"Creating index {table}.webLogAndPath..."
|
|
do! rethink {
|
|
withTable table
|
|
indexCreate "webLogAndPath" (fun row -> r.Array (row["webLogId"], row["path"]) :> obj)
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
// Users log on with e-mail
|
|
if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then
|
|
log.LogInformation $"Creating index {table}.logOn..."
|
|
do! rethink {
|
|
withTable table
|
|
indexCreate "logOn" (fun row -> r.Array (row["webLogId"], row["userName"]) :> obj)
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
}
|
|
|
|
/// The batch size for restoration methods
|
|
let restoreBatchSize = 100
|
|
|
|
/// The connection for this instance
|
|
member _.Conn = conn
|
|
|
|
interface IData with
|
|
|
|
member _.Category = {
|
|
new ICategoryData with
|
|
|
|
member _.add cat = rethink {
|
|
withTable Table.Category
|
|
insert cat
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
|
|
member _.countAll webLogId = rethink<int> {
|
|
withTable Table.Category
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
count
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.countTopLevel webLogId = rethink<int> {
|
|
withTable Table.Category
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
filter "parentId" None
|
|
count
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.findAllForView webLogId = backgroundTask {
|
|
let! cats = rethink<Category list> {
|
|
withTable Table.Category
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
orderByFunc (fun it -> it["name"].Downcase () :> obj)
|
|
result; withRetryDefault conn
|
|
}
|
|
let ordered = Utils.orderByHierarchy cats None None []
|
|
let! counts =
|
|
ordered
|
|
|> Seq.map (fun it -> backgroundTask {
|
|
// Parent category post counts include posts in subcategories
|
|
let catIds =
|
|
ordered
|
|
|> Seq.filter (fun cat -> cat.parentNames |> Array.contains it.name)
|
|
|> Seq.map (fun cat -> cat.id :> obj)
|
|
|> Seq.append (Seq.singleton it.id)
|
|
|> List.ofSeq
|
|
let! count = rethink<int> {
|
|
withTable Table.Post
|
|
getAll catIds "categoryIds"
|
|
filter "status" Published
|
|
distinct
|
|
count
|
|
result; withRetryDefault conn
|
|
}
|
|
return it.id, count
|
|
})
|
|
|> Task.WhenAll
|
|
return
|
|
ordered
|
|
|> Seq.map (fun cat ->
|
|
{ cat with
|
|
postCount = counts
|
|
|> Array.tryFind (fun c -> fst c = cat.id)
|
|
|> Option.map snd
|
|
|> Option.defaultValue 0
|
|
})
|
|
|> Array.ofSeq
|
|
}
|
|
|
|
member _.findById catId webLogId =
|
|
rethink<Category> {
|
|
withTable Table.Category
|
|
get catId
|
|
resultOption; withRetryOptionDefault
|
|
}
|
|
|> verifyWebLog webLogId (fun c -> c.webLogId) <| conn
|
|
|
|
member _.findByWebLog webLogId = rethink<Category list> {
|
|
withTable Table.Category
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member this.delete catId webLogId = backgroundTask {
|
|
match! this.findById catId webLogId with
|
|
| Some _ ->
|
|
// Delete the category off all posts where it is assigned
|
|
do! rethink {
|
|
withTable Table.Post
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
filter (fun row -> row["categoryIds"].Contains catId :> obj)
|
|
update (fun row -> r.HashMap ("categoryIds", r.Array(row["categoryIds"]).Remove catId) :> obj)
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
// Delete the category itself
|
|
do! rethink {
|
|
withTable Table.Category
|
|
get catId
|
|
delete
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
return true
|
|
| None -> return false
|
|
}
|
|
|
|
member _.restore cats = backgroundTask {
|
|
for batch in cats |> List.chunkBySize restoreBatchSize do
|
|
do! rethink {
|
|
withTable Table.Category
|
|
insert batch
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
}
|
|
|
|
member _.update cat = rethink {
|
|
withTable Table.Category
|
|
get cat.id
|
|
update [ "name", cat.name :> obj
|
|
"slug", cat.slug
|
|
"description", cat.description
|
|
"parentId", cat.parentId
|
|
]
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
}
|
|
|
|
member _.Page = {
|
|
new IPageData with
|
|
|
|
member _.add page = rethink {
|
|
withTable Table.Page
|
|
insert page
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
|
|
member _.all webLogId = rethink<Page list> {
|
|
withTable Table.Page
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
without [ "text"; "metadata"; "revisions"; "priorPermalinks" ]
|
|
orderByFunc (fun row -> row["title"].Downcase () :> obj)
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.countAll webLogId = rethink<int> {
|
|
withTable Table.Page
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
count
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.countListed webLogId = rethink<int> {
|
|
withTable Table.Page
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
filter "showInPageList" true
|
|
count
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.delete pageId webLogId = backgroundTask {
|
|
let! result = rethink<Model.Result> {
|
|
withTable Table.Page
|
|
getAll [ pageId ]
|
|
filter (fun row -> row["webLogId"].Eq webLogId :> obj)
|
|
delete
|
|
write; withRetryDefault conn
|
|
}
|
|
return result.Deleted > 0UL
|
|
}
|
|
|
|
member _.findById pageId webLogId =
|
|
rethink<Page> {
|
|
withTable Table.Page
|
|
get pageId
|
|
without [ "priorPermalinks"; "revisions" ]
|
|
resultOption; withRetryOptionDefault
|
|
}
|
|
|> verifyWebLog webLogId (fun it -> it.webLogId) <| conn
|
|
|
|
member _.findByPermalink permalink webLogId =
|
|
rethink<Page list> {
|
|
withTable Table.Page
|
|
getAll [ r.Array (webLogId, permalink) ] (nameof permalink)
|
|
without [ "priorPermalinks"; "revisions" ]
|
|
limit 1
|
|
result; withRetryDefault
|
|
}
|
|
|> tryFirst <| conn
|
|
|
|
member _.findCurrentPermalink permalinks webLogId = backgroundTask {
|
|
let! result =
|
|
(rethink<Page list> {
|
|
withTable Table.Page
|
|
getAll (objList permalinks) "priorPermalinks"
|
|
filter "webLogId" webLogId
|
|
without [ "revisions"; "text" ]
|
|
limit 1
|
|
result; withRetryDefault
|
|
}
|
|
|> tryFirst) conn
|
|
return result |> Option.map (fun pg -> pg.permalink)
|
|
}
|
|
|
|
member _.findFullById pageId webLogId =
|
|
rethink<Page> {
|
|
withTable Table.Page
|
|
get pageId
|
|
resultOption; withRetryOptionDefault
|
|
}
|
|
|> verifyWebLog webLogId (fun it -> it.webLogId) <| conn
|
|
|
|
member _.findFullByWebLog webLogId = rethink<Page> {
|
|
withTable Table.Page
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
resultCursor; withRetryCursorDefault; toList conn
|
|
}
|
|
|
|
member _.findListed webLogId = rethink<Page list> {
|
|
withTable Table.Page
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
filter [ "showInPageList", true :> obj ]
|
|
without [ "text"; "priorPermalinks"; "revisions" ]
|
|
orderBy "title"
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.findPageOfPages webLogId pageNbr = rethink<Page list> {
|
|
withTable Table.Page
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
without [ "metadata"; "priorPermalinks"; "revisions" ]
|
|
orderByFunc (fun row -> row["title"].Downcase ())
|
|
skip ((pageNbr - 1) * 25)
|
|
limit 25
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.restore pages = backgroundTask {
|
|
for batch in pages |> List.chunkBySize restoreBatchSize do
|
|
do! rethink {
|
|
withTable Table.Page
|
|
insert batch
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
}
|
|
|
|
member _.update page = rethink {
|
|
withTable Table.Page
|
|
get page.id
|
|
update [
|
|
"title", page.title :> obj
|
|
"permalink", page.permalink
|
|
"updatedOn", page.updatedOn
|
|
"showInPageList", page.showInPageList
|
|
"template", page.template
|
|
"text", page.text
|
|
"priorPermalinks", page.priorPermalinks
|
|
"metadata", page.metadata
|
|
"revisions", page.revisions
|
|
]
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
|
|
member this.updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
|
|
match! this.findById pageId webLogId with
|
|
| Some _ ->
|
|
do! rethink {
|
|
withTable Table.Page
|
|
get pageId
|
|
update [ "priorPermalinks", permalinks :> obj ]
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
return true
|
|
| None -> return false
|
|
}
|
|
}
|
|
|
|
member _.Post = {
|
|
new IPostData with
|
|
|
|
member _.add post = rethink {
|
|
withTable Table.Post
|
|
insert post
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
|
|
member _.countByStatus status webLogId = rethink<int> {
|
|
withTable Table.Post
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
filter "status" status
|
|
count
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.delete postId webLogId = backgroundTask {
|
|
let! result = rethink<Model.Result> {
|
|
withTable Table.Post
|
|
getAll [ postId ]
|
|
filter (fun row -> row["webLogId"].Eq webLogId :> obj)
|
|
delete
|
|
write; withRetryDefault conn
|
|
}
|
|
return result.Deleted > 0UL
|
|
}
|
|
|
|
member _.findByPermalink permalink webLogId =
|
|
rethink<Post list> {
|
|
withTable Table.Post
|
|
getAll [ r.Array (webLogId, permalink) ] (nameof permalink)
|
|
without [ "priorPermalinks"; "revisions" ]
|
|
limit 1
|
|
result; withRetryDefault
|
|
}
|
|
|> tryFirst <| conn
|
|
|
|
member _.findFullById postId webLogId =
|
|
rethink<Post> {
|
|
withTable Table.Post
|
|
get postId
|
|
resultOption; withRetryOptionDefault
|
|
}
|
|
|> verifyWebLog webLogId (fun p -> p.webLogId) <| conn
|
|
|
|
member _.findCurrentPermalink permalinks webLogId = backgroundTask {
|
|
let! result =
|
|
(rethink<Post list> {
|
|
withTable Table.Post
|
|
getAll (objList permalinks) "priorPermalinks"
|
|
filter "webLogId" webLogId
|
|
without [ "revisions"; "text" ]
|
|
limit 1
|
|
result; withRetryDefault
|
|
}
|
|
|> tryFirst) conn
|
|
return result |> Option.map (fun post -> post.permalink)
|
|
}
|
|
|
|
member _.findFullByWebLog webLogId = rethink<Post> {
|
|
withTable Table.Post
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
resultCursor; withRetryCursorDefault; toList conn
|
|
}
|
|
|
|
member _.findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink<Post list> {
|
|
withTable Table.Post
|
|
getAll (objList categoryIds) "categoryIds"
|
|
filter "webLogId" webLogId
|
|
filter "status" Published
|
|
without [ "priorPermalinks"; "revisions" ]
|
|
distinct
|
|
orderByDescending "publishedOn"
|
|
skip ((pageNbr - 1) * postsPerPage)
|
|
limit (postsPerPage + 1)
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.findPageOfPosts webLogId pageNbr postsPerPage = rethink<Post list> {
|
|
withTable Table.Post
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
without [ "priorPermalinks"; "revisions" ]
|
|
orderByFuncDescending (fun row -> row["publishedOn"].Default_ "updatedOn" :> obj)
|
|
skip ((pageNbr - 1) * postsPerPage)
|
|
limit (postsPerPage + 1)
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.findPageOfPublishedPosts webLogId pageNbr postsPerPage = rethink<Post list> {
|
|
withTable Table.Post
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
filter "status" Published
|
|
without [ "priorPermalinks"; "revisions" ]
|
|
orderByDescending "publishedOn"
|
|
skip ((pageNbr - 1) * postsPerPage)
|
|
limit (postsPerPage + 1)
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.findPageOfTaggedPosts webLogId tag pageNbr postsPerPage = rethink<Post list> {
|
|
withTable Table.Post
|
|
getAll [ tag ] "tags"
|
|
filter "webLogId" webLogId
|
|
filter "status" Published
|
|
without [ "priorPermalinks"; "revisions" ]
|
|
orderByDescending "publishedOn"
|
|
skip ((pageNbr - 1) * postsPerPage)
|
|
limit (postsPerPage + 1)
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.findSurroundingPosts webLogId publishedOn = backgroundTask {
|
|
let! older =
|
|
rethink<Post list> {
|
|
withTable Table.Post
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
filter (fun row -> row["publishedOn"].Lt publishedOn :> obj)
|
|
without [ "priorPermalinks"; "revisions" ]
|
|
orderByDescending "publishedOn"
|
|
limit 1
|
|
result; withRetryDefault
|
|
}
|
|
|> tryFirst <| conn
|
|
let! newer =
|
|
rethink<Post list> {
|
|
withTable Table.Post
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
filter (fun row -> row["publishedOn"].Gt publishedOn :> obj)
|
|
without [ "priorPermalinks"; "revisions" ]
|
|
orderBy "publishedOn"
|
|
limit 1
|
|
result; withRetryDefault
|
|
}
|
|
|> tryFirst <| conn
|
|
return older, newer
|
|
}
|
|
|
|
member _.restore pages = backgroundTask {
|
|
for batch in pages |> List.chunkBySize restoreBatchSize do
|
|
do! rethink {
|
|
withTable Table.Post
|
|
insert batch
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
}
|
|
|
|
member _.update post = rethink {
|
|
withTable Table.Post
|
|
get post.id
|
|
replace post
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
|
|
member _.updatePriorPermalinks postId webLogId permalinks = backgroundTask {
|
|
match! (
|
|
rethink<Post> {
|
|
withTable Table.Post
|
|
get postId
|
|
without [ "revisions"; "priorPermalinks" ]
|
|
resultOption; withRetryOptionDefault
|
|
}
|
|
|> verifyWebLog webLogId (fun p -> p.webLogId)) conn with
|
|
| Some _ ->
|
|
do! rethink {
|
|
withTable Table.Post
|
|
get postId
|
|
update [ "priorPermalinks", permalinks :> obj ]
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
return true
|
|
| None -> return false
|
|
}
|
|
}
|
|
|
|
member _.TagMap = {
|
|
new ITagMapData with
|
|
|
|
member _.delete tagMapId webLogId = backgroundTask {
|
|
let! result = rethink<Model.Result> {
|
|
withTable Table.TagMap
|
|
getAll [ tagMapId ]
|
|
filter (fun row -> row["webLogId"].Eq webLogId :> obj)
|
|
delete
|
|
write; withRetryDefault conn
|
|
}
|
|
return result.Deleted > 0UL
|
|
}
|
|
|
|
member _.findById tagMapId webLogId =
|
|
rethink<TagMap> {
|
|
withTable Table.TagMap
|
|
get tagMapId
|
|
resultOption; withRetryOptionDefault
|
|
}
|
|
|> verifyWebLog webLogId (fun tm -> tm.webLogId) <| conn
|
|
|
|
member _.findByUrlValue urlValue webLogId =
|
|
rethink<TagMap list> {
|
|
withTable Table.TagMap
|
|
getAll [ r.Array (webLogId, urlValue) ] "webLogAndUrl"
|
|
limit 1
|
|
result; withRetryDefault
|
|
}
|
|
|> tryFirst <| conn
|
|
|
|
member _.findByWebLog webLogId = rethink<TagMap list> {
|
|
withTable Table.TagMap
|
|
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) [ Index "webLogAndTag" ]
|
|
orderBy "tag"
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.findMappingForTags tags webLogId = rethink<TagMap list> {
|
|
withTable Table.TagMap
|
|
getAll (tags |> List.map (fun tag -> r.Array (webLogId, tag) :> obj)) "webLogAndTag"
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.restore tagMaps = backgroundTask {
|
|
for batch in tagMaps |> List.chunkBySize restoreBatchSize do
|
|
do! rethink {
|
|
withTable Table.TagMap
|
|
insert batch
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
}
|
|
|
|
member _.save tagMap = rethink {
|
|
withTable Table.TagMap
|
|
get tagMap.id
|
|
replace tagMap
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
}
|
|
|
|
member _.Theme = {
|
|
new IThemeData with
|
|
|
|
member _.all () = rethink<Theme list> {
|
|
withTable Table.Theme
|
|
filter (fun row -> row["id"].Ne "admin" :> obj)
|
|
without [ "templates" ]
|
|
orderBy "id"
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.findById themeId = rethink<Theme> {
|
|
withTable Table.Theme
|
|
get themeId
|
|
resultOption; withRetryOptionDefault conn
|
|
}
|
|
|
|
member _.findByIdWithoutText themeId = rethink<Theme> {
|
|
withTable Table.Theme
|
|
get themeId
|
|
merge (fun row -> r.HashMap ("templates", row["templates"].Without [| "text" |]))
|
|
resultOption; withRetryOptionDefault conn
|
|
}
|
|
|
|
member _.save theme = rethink {
|
|
withTable Table.Theme
|
|
get theme.id
|
|
replace theme
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
}
|
|
|
|
member _.ThemeAsset = {
|
|
new IThemeAssetData with
|
|
|
|
member _.all () = rethink<ThemeAsset list> {
|
|
withTable Table.ThemeAsset
|
|
without [ "data" ]
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.deleteByTheme themeId = rethink {
|
|
withTable Table.ThemeAsset
|
|
filter (matchAssetByThemeId themeId)
|
|
delete
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
|
|
member _.findById assetId = rethink<ThemeAsset> {
|
|
withTable Table.ThemeAsset
|
|
get assetId
|
|
resultOption; withRetryOptionDefault conn
|
|
}
|
|
|
|
member _.findByTheme themeId = rethink<ThemeAsset list> {
|
|
withTable Table.ThemeAsset
|
|
filter (matchAssetByThemeId themeId)
|
|
without [ "data" ]
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.findByThemeWithData themeId = rethink<ThemeAsset> {
|
|
withTable Table.ThemeAsset
|
|
filter (matchAssetByThemeId themeId)
|
|
resultCursor; withRetryCursorDefault; toList conn
|
|
}
|
|
|
|
member _.save asset = rethink {
|
|
withTable Table.ThemeAsset
|
|
get asset.id
|
|
replace asset
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
}
|
|
|
|
member _.Upload = {
|
|
new IUploadData with
|
|
|
|
member _.add upload = rethink {
|
|
withTable Table.Upload
|
|
insert upload
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
|
|
member _.delete uploadId webLogId = backgroundTask {
|
|
let! upload =
|
|
rethink<Upload> {
|
|
withTable Table.Upload
|
|
get uploadId
|
|
resultOption; withRetryOptionDefault
|
|
}
|
|
|> verifyWebLog<Upload> webLogId (fun u -> u.webLogId) <| conn
|
|
match upload with
|
|
| Some up ->
|
|
do! rethink {
|
|
withTable Table.Upload
|
|
get uploadId
|
|
delete
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
return Ok (Permalink.toString up.path)
|
|
| None -> return Result.Error $"Upload ID {UploadId.toString uploadId} not found"
|
|
}
|
|
|
|
member _.findByPath path webLogId =
|
|
rethink<Upload> {
|
|
withTable Table.Upload
|
|
getAll [ r.Array (webLogId, path) ] "webLogAndPath"
|
|
resultCursor; withRetryCursorDefault; toList
|
|
}
|
|
|> tryFirst <| conn
|
|
|
|
member _.findByWebLog webLogId = rethink<Upload> {
|
|
withTable Table.Upload
|
|
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
|
|
[ Index "webLogAndPath" ]
|
|
without [ "data" ]
|
|
resultCursor; withRetryCursorDefault; toList conn
|
|
}
|
|
|
|
member _.findByWebLogWithData webLogId = rethink<Upload> {
|
|
withTable Table.Upload
|
|
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
|
|
[ Index "webLogAndPath" ]
|
|
resultCursor; withRetryCursorDefault; toList conn
|
|
}
|
|
|
|
member _.restore uploads = backgroundTask {
|
|
// Files can be large; we'll do 5 at a time
|
|
for batch in uploads |> List.chunkBySize 5 do
|
|
do! rethink {
|
|
withTable Table.TagMap
|
|
insert batch
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
}
|
|
}
|
|
|
|
member _.WebLog = {
|
|
new IWebLogData with
|
|
|
|
member _.add webLog = rethink {
|
|
withTable Table.WebLog
|
|
insert webLog
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
|
|
member _.all () = rethink<WebLog list> {
|
|
withTable Table.WebLog
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.delete webLogId = backgroundTask {
|
|
// Comments should be deleted by post IDs
|
|
let! thePostIds = rethink<{| id : string |} list> {
|
|
withTable Table.Post
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
pluck [ "id" ]
|
|
result; withRetryOnce conn
|
|
}
|
|
if not (List.isEmpty thePostIds) then
|
|
let postIds = thePostIds |> List.map (fun it -> it.id :> obj)
|
|
do! rethink {
|
|
withTable Table.Comment
|
|
getAll postIds "postId"
|
|
delete
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
// Tag mappings do not have a straightforward webLogId index
|
|
do! rethink {
|
|
withTable Table.TagMap
|
|
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
|
|
[ Index "webLogAndTag" ]
|
|
delete
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
// Uploaded files do not have a straightforward webLogId index
|
|
do! rethink {
|
|
withTable Table.Upload
|
|
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
|
|
[ Index "webLogAndPath" ]
|
|
delete
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
for table in [ Table.Post; Table.Category; Table.Page; Table.WebLogUser ] do
|
|
do! rethink {
|
|
withTable table
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
delete
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
do! rethink {
|
|
withTable Table.WebLog
|
|
get webLogId
|
|
delete
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
}
|
|
|
|
member _.findByHost url =
|
|
rethink<WebLog list> {
|
|
withTable Table.WebLog
|
|
getAll [ url ] "urlBase"
|
|
limit 1
|
|
result; withRetryDefault
|
|
}
|
|
|> tryFirst <| conn
|
|
|
|
member _.findById webLogId = rethink<WebLog> {
|
|
withTable Table.WebLog
|
|
get webLogId
|
|
resultOption; withRetryOptionDefault conn
|
|
}
|
|
|
|
member _.updateRssOptions webLog = rethink {
|
|
withTable Table.WebLog
|
|
get webLog.id
|
|
update [ "rss", webLog.rss :> obj ]
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
|
|
member _.updateSettings webLog = rethink {
|
|
withTable Table.WebLog
|
|
get webLog.id
|
|
update [
|
|
"name", webLog.name :> obj
|
|
"slug", webLog.slug
|
|
"subtitle", webLog.subtitle
|
|
"defaultPage", webLog.defaultPage
|
|
"postsPerPage", webLog.postsPerPage
|
|
"timeZone", webLog.timeZone
|
|
"themePath", webLog.themePath
|
|
"autoHtmx", webLog.autoHtmx
|
|
"uploads", webLog.uploads
|
|
]
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
}
|
|
|
|
member _.WebLogUser = {
|
|
new IWebLogUserData with
|
|
|
|
member _.add user = rethink {
|
|
withTable Table.WebLogUser
|
|
insert user
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
|
|
member _.findByEmail email webLogId =
|
|
rethink<WebLogUser list> {
|
|
withTable Table.WebLogUser
|
|
getAll [ r.Array (webLogId, email) ] "logOn"
|
|
limit 1
|
|
result; withRetryDefault
|
|
}
|
|
|> tryFirst <| conn
|
|
|
|
member _.findById userId webLogId =
|
|
rethink<WebLogUser> {
|
|
withTable Table.WebLogUser
|
|
get userId
|
|
resultOption; withRetryOptionDefault
|
|
}
|
|
|> verifyWebLog webLogId (fun u -> u.webLogId) <| conn
|
|
|
|
member _.findByWebLog webLogId = rethink<WebLogUser list> {
|
|
withTable Table.WebLogUser
|
|
getAll [ webLogId ] (nameof webLogId)
|
|
result; withRetryDefault conn
|
|
}
|
|
|
|
member _.findNames webLogId userIds = backgroundTask {
|
|
let! users = rethink<WebLogUser list> {
|
|
withTable Table.WebLogUser
|
|
getAll (objList userIds)
|
|
filter "webLogId" webLogId
|
|
result; withRetryDefault conn
|
|
}
|
|
return
|
|
users
|
|
|> List.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u })
|
|
}
|
|
|
|
member _.restore users = backgroundTask {
|
|
for batch in users |> List.chunkBySize restoreBatchSize do
|
|
do! rethink {
|
|
withTable Table.WebLogUser
|
|
insert batch
|
|
write; withRetryOnce; ignoreResult conn
|
|
}
|
|
}
|
|
|
|
member _.update user = rethink {
|
|
withTable Table.WebLogUser
|
|
get user.id
|
|
update [
|
|
"firstName", user.firstName :> obj
|
|
"lastName", user.lastName
|
|
"preferredName", user.preferredName
|
|
"passwordHash", user.passwordHash
|
|
"salt", user.salt
|
|
]
|
|
write; withRetryDefault; ignoreResult conn
|
|
}
|
|
}
|
|
|
|
member _.startUp () = backgroundTask {
|
|
let! dbs = rethink<string list> { dbList; result; withRetryOnce conn }
|
|
if not (dbs |> List.contains config.Database) then
|
|
log.LogInformation $"Creating database {config.Database}..."
|
|
do! rethink { dbCreate config.Database; write; withRetryOnce; ignoreResult conn }
|
|
|
|
let! tables = rethink<string list> { tableList; result; withRetryOnce conn }
|
|
for tbl in Table.all do
|
|
if not (tables |> List.contains tbl) then
|
|
log.LogInformation $"Creating table {tbl}..."
|
|
do! rethink { tableCreate tbl; write; withRetryOnce; ignoreResult conn }
|
|
|
|
do! ensureIndexes Table.Category [ "webLogId" ]
|
|
do! ensureIndexes Table.Comment [ "postId" ]
|
|
do! ensureIndexes Table.Page [ "webLogId"; "authorId" ]
|
|
do! ensureIndexes Table.Post [ "webLogId"; "authorId" ]
|
|
do! ensureIndexes Table.TagMap []
|
|
do! ensureIndexes Table.Upload []
|
|
do! ensureIndexes Table.WebLog [ "urlBase" ]
|
|
do! ensureIndexes Table.WebLogUser [ "webLogId" ]
|
|
}
|