First cut of SQLite data implementation
still untested; standard WIP cautions apply
This commit is contained in:
parent
4dcbffbf25
commit
07003fc463
|
|
@ -130,133 +130,3 @@ module Json =
|
|||
// Handles DUs with no associated data, as well as option fields
|
||||
CompactUnionJsonConverter ()
|
||||
}
|
||||
|
||||
|
||||
// We *like* the implicit conversion of string to BsonValue
|
||||
#nowarn "3391"
|
||||
|
||||
/// BSON converters for use with LiteDB
|
||||
module Bson =
|
||||
|
||||
open LiteDB
|
||||
|
||||
module AuthorizationLevelMapping =
|
||||
let fromBson (value : BsonValue) = AuthorizationLevel.parse value.AsString
|
||||
let toBson (value : AuthorizationLevel) : BsonValue = AuthorizationLevel.toString value
|
||||
|
||||
module CategoryIdMapping =
|
||||
let fromBson (value : BsonValue) = CategoryId value.AsString
|
||||
let toBson (value : CategoryId) : BsonValue = CategoryId.toString value
|
||||
|
||||
module CommentIdMapping =
|
||||
let fromBson (value : BsonValue) = CommentId value.AsString
|
||||
let toBson (value : CommentId) : BsonValue = CommentId.toString value
|
||||
|
||||
module CommentStatusMapping =
|
||||
let fromBson (value : BsonValue) = CommentStatus.parse value.AsString
|
||||
let toBson (value : CommentStatus) : BsonValue = CommentStatus.toString value
|
||||
|
||||
module CustomFeedIdMapping =
|
||||
let fromBson (value : BsonValue) = CustomFeedId value.AsString
|
||||
let toBson (value : CustomFeedId) : BsonValue = CustomFeedId.toString value
|
||||
|
||||
module CustomFeedSourceMapping =
|
||||
let fromBson (value : BsonValue) = CustomFeedSource.parse value.AsString
|
||||
let toBson (value : CustomFeedSource) : BsonValue = CustomFeedSource.toString value
|
||||
|
||||
module ExplicitRatingMapping =
|
||||
let fromBson (value : BsonValue) = ExplicitRating.parse value.AsString
|
||||
let toBson (value : ExplicitRating) : BsonValue = ExplicitRating.toString value
|
||||
|
||||
module MarkupTextMapping =
|
||||
let fromBson (value : BsonValue) = MarkupText.parse value.AsString
|
||||
let toBson (value : MarkupText) : BsonValue = MarkupText.toString value
|
||||
|
||||
module OptionMapping =
|
||||
let categoryIdFromBson (value : BsonValue) = if value.IsNull then None else Some (CategoryId value.AsString)
|
||||
let categoryIdToBson (value : CategoryId option) : BsonValue =
|
||||
match value with Some (CategoryId catId) -> catId | None -> BsonValue.Null
|
||||
|
||||
let commentIdFromBson (value : BsonValue) = if value.IsNull then None else Some (CommentId value.AsString)
|
||||
let commentIdToBson (value : CommentId option) : BsonValue =
|
||||
match value with Some (CommentId comId) -> comId | None -> BsonValue.Null
|
||||
|
||||
let dateTimeFromBson (value : BsonValue) = if value.IsNull then None else Some value.AsDateTime
|
||||
let dateTimeToBson (value : DateTime option) : BsonValue =
|
||||
match value with Some dateTime -> dateTime | None -> BsonValue.Null
|
||||
|
||||
let intFromBson (value : BsonValue) = if value.IsNull then None else Some value.AsInt32
|
||||
let intToBson (value : int option) : BsonValue = match value with Some nbr -> nbr | None -> BsonValue.Null
|
||||
|
||||
let podcastOptionsFromBson (value : BsonValue) =
|
||||
if value.IsNull then None else Some (BsonMapper.Global.ToObject<PodcastOptions> value.AsDocument)
|
||||
let podcastOptionsToBson (value : PodcastOptions option) : BsonValue =
|
||||
match value with Some opts -> BsonMapper.Global.ToDocument opts | None -> BsonValue.Null
|
||||
|
||||
let stringFromBson (value : BsonValue) = if value.IsNull then None else Some value.AsString
|
||||
let stringToBson (value : string option) : BsonValue = match value with Some str -> str | None -> BsonValue.Null
|
||||
|
||||
module PermalinkMapping =
|
||||
let fromBson (value : BsonValue) = Permalink value.AsString
|
||||
let toBson (value : Permalink) : BsonValue = Permalink.toString value
|
||||
|
||||
module PageIdMapping =
|
||||
let fromBson (value : BsonValue) = PageId value.AsString
|
||||
let toBson (value : PageId) : BsonValue = PageId.toString value
|
||||
|
||||
module PostIdMapping =
|
||||
let fromBson (value : BsonValue) = PostId value.AsString
|
||||
let toBson (value : PostId) : BsonValue = PostId.toString value
|
||||
|
||||
module PostStatusMapping =
|
||||
let fromBson (value : BsonValue) = PostStatus.parse value.AsString
|
||||
let toBson (value : PostStatus) : BsonValue = PostStatus.toString value
|
||||
|
||||
module TagMapIdMapping =
|
||||
let fromBson (value : BsonValue) = TagMapId value.AsString
|
||||
let toBson (value : TagMapId) : BsonValue = TagMapId.toString value
|
||||
|
||||
module ThemeAssetIdMapping =
|
||||
let fromBson (value : BsonValue) = ThemeAssetId.ofString value.AsString
|
||||
let toBson (value : ThemeAssetId) : BsonValue = ThemeAssetId.toString value
|
||||
|
||||
module ThemeIdMapping =
|
||||
let fromBson (value : BsonValue) = ThemeId value.AsString
|
||||
let toBson (value : ThemeId) : BsonValue = ThemeId.toString value
|
||||
|
||||
module WebLogIdMapping =
|
||||
let fromBson (value : BsonValue) = WebLogId value.AsString
|
||||
let toBson (value : WebLogId) : BsonValue = WebLogId.toString value
|
||||
|
||||
module WebLogUserIdMapping =
|
||||
let fromBson (value : BsonValue) = WebLogUserId value.AsString
|
||||
let toBson (value : WebLogUserId) : BsonValue = WebLogUserId.toString value
|
||||
|
||||
/// Register all BSON mappings
|
||||
let registerAll () =
|
||||
let g = BsonMapper.Global
|
||||
g.RegisterType<AuthorizationLevel> (AuthorizationLevelMapping.toBson, AuthorizationLevelMapping.fromBson)
|
||||
g.RegisterType<CategoryId> (CategoryIdMapping.toBson, CategoryIdMapping.fromBson)
|
||||
g.RegisterType<CommentId> (CommentIdMapping.toBson, CommentIdMapping.fromBson)
|
||||
g.RegisterType<CommentStatus> (CommentStatusMapping.toBson, CommentStatusMapping.fromBson)
|
||||
g.RegisterType<CustomFeedId> (CustomFeedIdMapping.toBson, CustomFeedIdMapping.fromBson)
|
||||
g.RegisterType<CustomFeedSource> (CustomFeedSourceMapping.toBson, CustomFeedSourceMapping.fromBson)
|
||||
g.RegisterType<ExplicitRating> (ExplicitRatingMapping.toBson, ExplicitRatingMapping.fromBson)
|
||||
g.RegisterType<MarkupText> (MarkupTextMapping.toBson, MarkupTextMapping.fromBson)
|
||||
g.RegisterType<Permalink> (PermalinkMapping.toBson, PermalinkMapping.fromBson)
|
||||
g.RegisterType<PageId> (PageIdMapping.toBson, PageIdMapping.fromBson)
|
||||
g.RegisterType<PostId> (PostIdMapping.toBson, PostIdMapping.fromBson)
|
||||
g.RegisterType<PostStatus> (PostStatusMapping.toBson, PostStatusMapping.fromBson)
|
||||
g.RegisterType<TagMapId> (TagMapIdMapping.toBson, TagMapIdMapping.fromBson)
|
||||
g.RegisterType<ThemeAssetId> (ThemeAssetIdMapping.toBson, ThemeAssetIdMapping.fromBson)
|
||||
g.RegisterType<ThemeId> (ThemeIdMapping.toBson, ThemeIdMapping.fromBson)
|
||||
g.RegisterType<WebLogId> (WebLogIdMapping.toBson, WebLogIdMapping.fromBson)
|
||||
g.RegisterType<WebLogUserId> (WebLogUserIdMapping.toBson, WebLogUserIdMapping.fromBson)
|
||||
|
||||
g.RegisterType<CategoryId option> (OptionMapping.categoryIdToBson, OptionMapping.categoryIdFromBson)
|
||||
g.RegisterType<CommentId option> (OptionMapping.commentIdToBson, OptionMapping.commentIdFromBson)
|
||||
g.RegisterType<DateTime option> (OptionMapping.dateTimeToBson, OptionMapping.dateTimeFromBson)
|
||||
g.RegisterType<int option> (OptionMapping.intToBson, OptionMapping.intFromBson)
|
||||
g.RegisterType<PodcastOptions option> (OptionMapping.podcastOptionsToBson, OptionMapping.podcastOptionsFromBson)
|
||||
g.RegisterType<string option> (OptionMapping.stringToBson, OptionMapping.stringFromBson)
|
||||
|
||||
|
|
@ -1,584 +0,0 @@
|
|||
namespace MyWebLog.Dataa
|
||||
|
||||
open LiteDB
|
||||
open MyWebLog
|
||||
open System.Threading.Tasks
|
||||
open MyWebLog.Data
|
||||
|
||||
/// Functions to assist with retrieving data
|
||||
[<AutoOpen>]
|
||||
module private LiteHelpers =
|
||||
|
||||
/// Convert a "can't be null" object to an option if it's null (thanks, CLIMutable!)
|
||||
let toOption<'T> (it : 'T) =
|
||||
match Option.ofObj (box it) with Some _ -> Some it | None -> None
|
||||
|> Task.FromResult
|
||||
|
||||
/// Verify that the web log ID matches before returning an item
|
||||
let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (it : 'T) = backgroundTask {
|
||||
match! toOption it with
|
||||
| Some item when prop item = webLogId -> return Some it
|
||||
| Some _
|
||||
| None -> return None
|
||||
}
|
||||
|
||||
/// Get the first item from a list, or None if the list is empty
|
||||
let tryFirst<'T> (items : 'T seq) =
|
||||
items |> Seq.tryHead |> Task.FromResult
|
||||
|
||||
/// Convert a sequence to a list, wrapped in a task
|
||||
let toList items =
|
||||
items |> List.ofSeq |> Task.FromResult
|
||||
|
||||
/// Convert a sequence to a paged list, wrapped in a task
|
||||
let toPagedList pageNbr postsPerPage items =
|
||||
items |> Seq.skip ((pageNbr - 1) * postsPerPage) |> Seq.truncate (postsPerPage + 1) |> toList
|
||||
|
||||
|
||||
open MyWebLog.Converters.Bson
|
||||
open MyWebLog.ViewModels
|
||||
|
||||
/// LiteDB implementation of data functions for myWebLog
|
||||
type LiteDbData (db : LiteDatabase) =
|
||||
|
||||
/// Shorthand for accessing the collections in the LiteDB database
|
||||
let Collection = {|
|
||||
Category = db.GetCollection<Category> "Category"
|
||||
Comment = db.GetCollection<Comment> "Comment"
|
||||
Page = db.GetCollection<Page> "Page"
|
||||
Post = db.GetCollection<Post> "Post"
|
||||
TagMap = db.GetCollection<TagMap> "TagMap"
|
||||
Theme = db.GetCollection<Theme> "Theme"
|
||||
ThemeAsset = db.GetCollection<ThemeAsset> "ThemeAsset"
|
||||
WebLog = db.GetCollection<WebLog> "WebLog"
|
||||
WebLogUser = db.GetCollection<WebLogUser> "WebLogUser"
|
||||
|}
|
||||
|
||||
/// Create a category hierarchy from the given list of categories
|
||||
let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq {
|
||||
for cat in cats |> List.filter (fun c -> c.parentId = parentId) do
|
||||
let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.slug
|
||||
{ id = CategoryId.toString cat.id
|
||||
slug = fullSlug
|
||||
name = cat.name
|
||||
description = cat.description
|
||||
parentNames = Array.ofList parentNames
|
||||
// Post counts are filled on a second pass
|
||||
postCount = 0
|
||||
}
|
||||
yield! orderByHierarchy cats (Some cat.id) (Some fullSlug) ([ cat.name ] |> List.append parentNames)
|
||||
}
|
||||
|
||||
/// Async wrapper on LiteDB's checkpoint operation
|
||||
let checkpoint () = backgroundTask {
|
||||
db.Checkpoint ()
|
||||
}
|
||||
|
||||
/// Return a page with no revisions or prior permalinks
|
||||
let pageWithoutRevisions (page : Page) =
|
||||
{ page with revisions = []; priorPermalinks = [] }
|
||||
|
||||
/// Return a page with no revisions, prior permalinks, or text
|
||||
let pageWithoutText page =
|
||||
{ pageWithoutRevisions page with text = "" }
|
||||
|
||||
/// Sort function for pages
|
||||
let pageSort (page : Page) =
|
||||
page.title.ToLowerInvariant ()
|
||||
|
||||
/// Return a post with no revisions or prior permalinks
|
||||
let postWithoutRevisions (post : Post) =
|
||||
{ post with revisions = []; priorPermalinks = [] }
|
||||
|
||||
/// Return a post with no revisions, prior permalinks, or text
|
||||
let postWithoutText post =
|
||||
{ postWithoutRevisions post with text = "" }
|
||||
|
||||
/// The database for this instance
|
||||
member _.Db = db
|
||||
|
||||
interface IData with
|
||||
|
||||
member _.Category = {
|
||||
new ICategoryData with
|
||||
|
||||
member _.add cat = backgroundTask {
|
||||
let _ = Collection.Category.Insert cat
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
||||
member _.countAll webLogId =
|
||||
Collection.Category.Count(fun cat -> cat.webLogId = webLogId)
|
||||
|> Task.FromResult
|
||||
|
||||
member _.countTopLevel webLogId =
|
||||
Collection.Category.Count(fun cat -> cat.webLogId = webLogId && Option.isNone cat.parentId)
|
||||
|> Task.FromResult
|
||||
|
||||
member _.findAllForView webLogId = backgroundTask {
|
||||
let cats =
|
||||
Collection.Category.Find (fun cat -> cat.webLogId = webLogId)
|
||||
|> Seq.sortBy (fun cat -> cat.name.ToLowerInvariant ())
|
||||
|> List.ofSeq
|
||||
let ordered = 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 =
|
||||
Collection.Post.Count (fun p ->
|
||||
p.webLogId = webLogId
|
||||
&& p.status = Published
|
||||
&& p.categoryIds |> List.exists (fun cId -> catIds |> List.contains cId))
|
||||
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 =
|
||||
Collection.Category.FindById (CategoryIdMapping.toBson catId)
|
||||
|> verifyWebLog webLogId (fun c -> c.webLogId)
|
||||
|
||||
member _.findByWebLog webLogId =
|
||||
Collection.Category.Find (fun c -> c.webLogId = webLogId)
|
||||
|> toList
|
||||
|
||||
member this.delete catId webLogId = backgroundTask {
|
||||
match! this.findById catId webLogId with
|
||||
| Some _ ->
|
||||
// Delete the category off all posts where it is assigned
|
||||
Collection.Post.Find (fun p -> p.webLogId = webLogId && p.categoryIds |> List.contains catId)
|
||||
|> Seq.map (fun p ->
|
||||
{ p with categoryIds = p.categoryIds |> List.filter (fun cId -> cId <> catId) })
|
||||
|> Collection.Post.Update
|
||||
|> ignore
|
||||
// Delete the category itself
|
||||
let _ = Collection.Category.Delete (CategoryIdMapping.toBson catId)
|
||||
do! checkpoint ()
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
member _.restore cats = backgroundTask {
|
||||
let _ = Collection.Category.InsertBulk cats
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
||||
member _.update cat = backgroundTask {
|
||||
let _ = Collection.Category.Update cat
|
||||
do! checkpoint ()
|
||||
}
|
||||
}
|
||||
|
||||
member _.Page = {
|
||||
new IPageData with
|
||||
|
||||
member _.add page = backgroundTask {
|
||||
let _ = Collection.Page.Insert page
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
||||
member _.all webLogId =
|
||||
Collection.Page.Find (fun p -> p.webLogId = webLogId)
|
||||
|> Seq.map pageWithoutText
|
||||
|> Seq.sortBy pageSort
|
||||
|> toList
|
||||
|
||||
member _.countAll webLogId =
|
||||
Collection.Page.Count (fun p -> p.webLogId = webLogId)
|
||||
|> Task.FromResult
|
||||
|
||||
member _.countListed webLogId =
|
||||
Collection.Page.Count (fun p -> p.webLogId = webLogId && p.showInPageList)
|
||||
|> Task.FromResult
|
||||
|
||||
member _.findFullById pageId webLogId =
|
||||
Collection.Page.FindById (PageIdMapping.toBson pageId)
|
||||
|> verifyWebLog webLogId (fun it -> it.webLogId)
|
||||
|
||||
member this.findById pageId webLogId = backgroundTask {
|
||||
let! page = this.findFullById pageId webLogId
|
||||
return page |> Option.map pageWithoutRevisions
|
||||
}
|
||||
|
||||
member this.delete pageId webLogId = backgroundTask {
|
||||
match! this.findById pageId webLogId with
|
||||
| Some _ ->
|
||||
let _ = Collection.Page.Delete (PageIdMapping.toBson pageId)
|
||||
do! checkpoint ()
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
member _.findByPermalink permalink webLogId = backgroundTask {
|
||||
let! page =
|
||||
Collection.Page.Find (fun p -> p.webLogId = webLogId && p.permalink = permalink)
|
||||
|> tryFirst
|
||||
return page |> Option.map pageWithoutRevisions
|
||||
}
|
||||
|
||||
member _.findCurrentPermalink permalinks webLogId = backgroundTask {
|
||||
let! result =
|
||||
Collection.Page.Find (fun p ->
|
||||
p.webLogId = webLogId
|
||||
&& p.priorPermalinks |> List.exists (fun link -> permalinks |> List.contains link))
|
||||
|> tryFirst
|
||||
return result |> Option.map (fun pg -> pg.permalink)
|
||||
}
|
||||
|
||||
member _.findFullByWebLog webLogId =
|
||||
Collection.Page.Find (fun p -> p.webLogId = webLogId)
|
||||
|> toList
|
||||
|
||||
member _.findListed webLogId =
|
||||
Collection.Page.Find (fun p -> p.webLogId = webLogId && p.showInPageList)
|
||||
|> Seq.map pageWithoutText
|
||||
|> Seq.sortBy pageSort
|
||||
|> toList
|
||||
|
||||
member _.findPageOfPages webLogId pageNbr =
|
||||
Collection.Page.Find (fun p -> p.webLogId = webLogId)
|
||||
|> Seq.map pageWithoutRevisions
|
||||
|> Seq.sortBy pageSort
|
||||
|> toPagedList pageNbr 25
|
||||
|
||||
member _.restore pages = backgroundTask {
|
||||
let _ = Collection.Page.InsertBulk pages
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
||||
member _.update page = backgroundTask {
|
||||
let _ = Collection.Page.Update page
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
||||
member this.updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
|
||||
match! this.findFullById pageId webLogId with
|
||||
| Some page ->
|
||||
do! this.update { page with priorPermalinks = permalinks }
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
}
|
||||
|
||||
member _.Post = {
|
||||
new IPostData with
|
||||
|
||||
member _.add post = backgroundTask {
|
||||
let _ = Collection.Post.Insert post
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
||||
member _.countByStatus status webLogId =
|
||||
Collection.Post.Count (fun p -> p.webLogId = webLogId && p.status = status)
|
||||
|> Task.FromResult
|
||||
|
||||
member _.findByPermalink permalink webLogId =
|
||||
Collection.Post.Find (fun p -> p.webLogId = webLogId && p.permalink = permalink)
|
||||
|> tryFirst
|
||||
|
||||
member _.findFullById postId webLogId =
|
||||
Collection.Post.FindById (PostIdMapping.toBson postId)
|
||||
|> verifyWebLog webLogId (fun p -> p.webLogId)
|
||||
|
||||
member this.delete postId webLogId = backgroundTask {
|
||||
match! this.findFullById postId webLogId with
|
||||
| Some _ ->
|
||||
let _ = Collection.Post.Delete (PostIdMapping.toBson postId)
|
||||
do! checkpoint ()
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
member _.findCurrentPermalink permalinks webLogId = backgroundTask {
|
||||
let! result =
|
||||
Collection.Post.Find (fun p ->
|
||||
p.webLogId = webLogId
|
||||
&& p.priorPermalinks |> List.exists (fun link -> permalinks |> List.contains link))
|
||||
|> tryFirst
|
||||
return result |> Option.map (fun post -> post.permalink)
|
||||
}
|
||||
|
||||
member _.findFullByWebLog webLogId =
|
||||
Collection.Post.Find (fun p -> p.webLogId = webLogId)
|
||||
|> toList
|
||||
|
||||
member _.findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
|
||||
Collection.Post.Find (fun p ->
|
||||
p.webLogId = webLogId
|
||||
&& p.status = Published
|
||||
&& p.categoryIds |> List.exists (fun cId -> categoryIds |> List.contains cId))
|
||||
|> Seq.map postWithoutRevisions
|
||||
|> Seq.sortByDescending (fun p -> p.publishedOn)
|
||||
|> toPagedList pageNbr postsPerPage
|
||||
|
||||
member _.findPageOfPosts webLogId pageNbr postsPerPage =
|
||||
Collection.Post.Find (fun p -> p.webLogId = webLogId)
|
||||
|> Seq.map postWithoutText
|
||||
|> Seq.sortByDescending (fun p -> defaultArg p.publishedOn p.updatedOn)
|
||||
|> toPagedList pageNbr postsPerPage
|
||||
|
||||
member _.findPageOfPublishedPosts webLogId pageNbr postsPerPage =
|
||||
Collection.Post.Find (fun p -> p.webLogId = webLogId && p.status = Published)
|
||||
|> Seq.map postWithoutRevisions
|
||||
|> Seq.sortByDescending (fun p -> p.publishedOn)
|
||||
|> toPagedList pageNbr postsPerPage
|
||||
|
||||
member _.findPageOfTaggedPosts webLogId tag pageNbr postsPerPage =
|
||||
Collection.Post.Find (fun p ->
|
||||
p.webLogId = webLogId && p.status = Published && p.tags |> List.contains tag)
|
||||
|> Seq.map postWithoutRevisions
|
||||
|> Seq.sortByDescending (fun p -> p.publishedOn)
|
||||
|> toPagedList pageNbr postsPerPage
|
||||
|
||||
member _.findSurroundingPosts webLogId publishedOn = backgroundTask {
|
||||
let! older =
|
||||
Collection.Post.Find (fun p ->
|
||||
p.webLogId = webLogId && p.status = Published && p.publishedOn.Value < publishedOn)
|
||||
|> Seq.map postWithoutText
|
||||
|> Seq.sortByDescending (fun p -> p.publishedOn)
|
||||
|> tryFirst
|
||||
let! newer =
|
||||
Collection.Post.Find (fun p ->
|
||||
p.webLogId = webLogId && p.status = Published && p.publishedOn.Value > publishedOn)
|
||||
|> Seq.map postWithoutText
|
||||
|> Seq.sortBy (fun p -> p.publishedOn)
|
||||
|> tryFirst
|
||||
return older, newer
|
||||
}
|
||||
|
||||
member _.restore posts = backgroundTask {
|
||||
let _ = Collection.Post.InsertBulk posts
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
||||
member _.update post = backgroundTask {
|
||||
let _ = Collection.Post.Update post
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
||||
member this.updatePriorPermalinks postId webLogId permalinks = backgroundTask {
|
||||
match! this.findFullById postId webLogId with
|
||||
| Some post ->
|
||||
do! this.update { post with priorPermalinks = permalinks }
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
}
|
||||
|
||||
member _.TagMap = {
|
||||
new ITagMapData with
|
||||
|
||||
member _.findById tagMapId webLogId =
|
||||
Collection.TagMap.FindById (TagMapIdMapping.toBson tagMapId)
|
||||
|> verifyWebLog webLogId (fun tm -> tm.webLogId)
|
||||
|
||||
member this.delete tagMapId webLogId = backgroundTask {
|
||||
match! this.findById tagMapId webLogId with
|
||||
| Some _ ->
|
||||
let _ = Collection.TagMap.Delete (TagMapIdMapping.toBson tagMapId)
|
||||
do! checkpoint ()
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
member _.findByUrlValue urlValue webLogId =
|
||||
Collection.TagMap.Find (fun tm -> tm.webLogId = webLogId && tm.urlValue = urlValue)
|
||||
|> tryFirst
|
||||
|
||||
member _.findByWebLog webLogId =
|
||||
Collection.TagMap.Find (fun tm -> tm.webLogId = webLogId)
|
||||
|> Seq.sortBy (fun tm -> tm.tag)
|
||||
|> toList
|
||||
|
||||
member _.findMappingForTags tags webLogId =
|
||||
Collection.TagMap.Find (fun tm -> tm.webLogId = webLogId && tags |> List.contains tm.tag)
|
||||
|> toList
|
||||
|
||||
member _.restore tagMaps = backgroundTask {
|
||||
let _ = Collection.TagMap.InsertBulk tagMaps
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
||||
member _.save tagMap = backgroundTask {
|
||||
let _ = Collection.TagMap.Upsert tagMap
|
||||
do! checkpoint ()
|
||||
}
|
||||
}
|
||||
|
||||
member _.Theme = {
|
||||
new IThemeData with
|
||||
|
||||
member _.all () =
|
||||
Collection.Theme.Find (fun t -> t.id <> ThemeId "admin")
|
||||
|> Seq.map (fun t -> { t with templates = [] })
|
||||
|> Seq.sortBy (fun t -> t.id)
|
||||
|> toList
|
||||
|
||||
member _.findById themeId =
|
||||
Collection.Theme.FindById (ThemeIdMapping.toBson themeId)
|
||||
|> toOption
|
||||
|
||||
member this.findByIdWithoutText themeId = backgroundTask {
|
||||
match! this.findById themeId with
|
||||
| Some theme ->
|
||||
return Some {
|
||||
theme with templates = theme.templates |> List.map (fun t -> { t with text = "" })
|
||||
}
|
||||
| None -> return None
|
||||
}
|
||||
|
||||
member _.save theme = backgroundTask {
|
||||
let _ = Collection.Theme.Upsert theme
|
||||
do! checkpoint ()
|
||||
}
|
||||
}
|
||||
|
||||
member _.ThemeAsset = {
|
||||
new IThemeAssetData with
|
||||
|
||||
member _.all () =
|
||||
Collection.ThemeAsset.FindAll ()
|
||||
|> Seq.map (fun ta -> { ta with data = [||] })
|
||||
|> toList
|
||||
|
||||
member _.deleteByTheme themeId = backgroundTask {
|
||||
(ThemeId.toString
|
||||
>> sprintf "$.id LIKE '%s%%'"
|
||||
>> BsonExpression.Create
|
||||
>> Collection.ThemeAsset.DeleteMany) themeId
|
||||
|> ignore
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
||||
member _.findById assetId =
|
||||
Collection.ThemeAsset.FindById (ThemeAssetIdMapping.toBson assetId)
|
||||
|> toOption
|
||||
|
||||
member _.findByTheme themeId =
|
||||
Collection.ThemeAsset.Find (fun ta ->
|
||||
(ThemeAssetId.toString ta.id).StartsWith (ThemeId.toString themeId))
|
||||
|> Seq.map (fun ta -> { ta with data = [||] })
|
||||
|> toList
|
||||
|
||||
member _.findByThemeWithData themeId =
|
||||
Collection.ThemeAsset.Find (fun ta ->
|
||||
(ThemeAssetId.toString ta.id).StartsWith (ThemeId.toString themeId))
|
||||
|> toList
|
||||
|
||||
member _.save asset = backgroundTask {
|
||||
let _ = Collection.ThemeAsset.Upsert asset
|
||||
do! checkpoint ()
|
||||
}
|
||||
}
|
||||
|
||||
member _.WebLog = {
|
||||
new IWebLogData with
|
||||
|
||||
member _.add webLog = backgroundTask {
|
||||
let _ = Collection.WebLog.Insert webLog
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
||||
member _.all () =
|
||||
Collection.WebLog.FindAll ()
|
||||
|> toList
|
||||
|
||||
member _.delete webLogId = backgroundTask {
|
||||
let forWebLog = BsonExpression.Create $"$.webLogId = '{WebLogId.toString webLogId}'"
|
||||
let _ = Collection.Comment.DeleteMany forWebLog
|
||||
let _ = Collection.Post.DeleteMany forWebLog
|
||||
let _ = Collection.Page.DeleteMany forWebLog
|
||||
let _ = Collection.Category.DeleteMany forWebLog
|
||||
let _ = Collection.TagMap.DeleteMany forWebLog
|
||||
let _ = Collection.WebLogUser.DeleteMany forWebLog
|
||||
let _ = Collection.WebLog.Delete (WebLogIdMapping.toBson webLogId)
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
||||
member _.findByHost url =
|
||||
Collection.WebLog.Find (fun wl -> wl.urlBase = url)
|
||||
|> tryFirst
|
||||
|
||||
member _.findById webLogId =
|
||||
Collection.WebLog.FindById (WebLogIdMapping.toBson webLogId)
|
||||
|> toOption
|
||||
|
||||
member _.updateSettings webLog = backgroundTask {
|
||||
let _ = Collection.WebLog.Update webLog
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
||||
member this.updateRssOptions webLog = backgroundTask {
|
||||
match! this.findById webLog.id with
|
||||
| Some wl -> do! this.updateSettings { wl with rss = webLog.rss }
|
||||
| None -> ()
|
||||
}
|
||||
}
|
||||
|
||||
member _.WebLogUser = {
|
||||
new IWebLogUserData with
|
||||
|
||||
member _.add user = backgroundTask {
|
||||
let _ = Collection.WebLogUser.Insert user
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
||||
member _.findByEmail email webLogId =
|
||||
Collection.WebLogUser.Find (fun wlu -> wlu.webLogId = webLogId && wlu.userName = email)
|
||||
|> tryFirst
|
||||
|
||||
member _.findById userId webLogId =
|
||||
Collection.WebLogUser.FindById (WebLogUserIdMapping.toBson userId)
|
||||
|> verifyWebLog webLogId (fun u -> u.webLogId)
|
||||
|
||||
member _.findByWebLog webLogId =
|
||||
Collection.WebLogUser.Find (fun wlu -> wlu.webLogId = webLogId)
|
||||
|> toList
|
||||
|
||||
member _.findNames webLogId userIds =
|
||||
Collection.WebLogUser.Find (fun wlu -> userIds |> List.contains wlu.id)
|
||||
|> Seq.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u })
|
||||
|> toList
|
||||
|
||||
member _.restore users = backgroundTask {
|
||||
let _ = Collection.WebLogUser.InsertBulk users
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
||||
member _.update user = backgroundTask {
|
||||
let _ = Collection.WebLogUser.Update user
|
||||
do! checkpoint ()
|
||||
}
|
||||
}
|
||||
|
||||
member _.startUp () = backgroundTask {
|
||||
|
||||
let _ = Collection.Category.EnsureIndex (fun c -> c.webLogId)
|
||||
let _ = Collection.Comment.EnsureIndex (fun c -> c.postId)
|
||||
let _ = Collection.Page.EnsureIndex (fun p -> p.webLogId)
|
||||
let _ = Collection.Page.EnsureIndex (fun p -> p.authorId)
|
||||
let _ = Collection.Post.EnsureIndex (fun p -> p.webLogId)
|
||||
let _ = Collection.Post.EnsureIndex (fun p -> p.authorId)
|
||||
let _ = Collection.TagMap.EnsureIndex (fun tm -> tm.webLogId)
|
||||
let _ = Collection.WebLog.EnsureIndex (fun wl -> wl.urlBase)
|
||||
let _ = Collection.WebLogUser.EnsureIndex (fun wlu -> wlu.webLogId)
|
||||
|
||||
do! checkpoint ()
|
||||
}
|
||||
|
|
@ -10,7 +10,6 @@
|
|||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="LiteDB" Version="5.0.12" />
|
||||
<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.6" />
|
||||
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" />
|
||||
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
|
||||
|
|
@ -25,7 +24,6 @@
|
|||
<Compile Include="Interfaces.fs" />
|
||||
<Compile Include="Utils.fs" />
|
||||
<Compile Include="RethinkDbData.fs" />
|
||||
<Compile Include="LiteDbData.fs" />
|
||||
<Compile Include="SQLiteData.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
|
|
|
|||
|
|
@ -50,6 +50,9 @@ module private SqliteHelpers =
|
|||
/// Get a date/time value from a data reader
|
||||
let getDateTime col (rdr : SqliteDataReader) = rdr.GetDateTime (rdr.GetOrdinal col)
|
||||
|
||||
/// Get a Guid value from a data reader
|
||||
let getGuid col (rdr : SqliteDataReader) = rdr.GetGuid (rdr.GetOrdinal col)
|
||||
|
||||
/// Get an int value from a data reader
|
||||
let getInt col (rdr : SqliteDataReader) = rdr.GetInt32 (rdr.GetOrdinal col)
|
||||
|
||||
|
|
@ -213,6 +216,20 @@ module private SqliteHelpers =
|
|||
}
|
||||
}
|
||||
|
||||
/// Create a web log user from the current row in the given data reader
|
||||
let toWebLogUser (rdr : SqliteDataReader) : WebLogUser =
|
||||
{ id = WebLogUserId (getString "id" rdr)
|
||||
webLogId = WebLogId (getString "webLogId" rdr)
|
||||
userName = getString "user_name" rdr
|
||||
firstName = getString "first_name" rdr
|
||||
lastName = getString "last_name" rdr
|
||||
preferredName = getString "preferred_name" rdr
|
||||
passwordHash = getString "password_hash" rdr
|
||||
salt = getGuid "salt" rdr
|
||||
url = tryString "url" rdr
|
||||
authorizationLevel = AuthorizationLevel.parse (getString "authorization_level" rdr)
|
||||
}
|
||||
|
||||
|
||||
/// SQLite myWebLog data implementation
|
||||
type SQLiteData (conn : SqliteConnection) =
|
||||
|
|
@ -287,6 +304,20 @@ type SQLiteData (conn : SqliteConnection) =
|
|||
] |> ignore
|
||||
addWebLogRssParameters cmd webLog
|
||||
|
||||
/// Add parameters for web log user INSERT or UPDATE statements
|
||||
let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) =
|
||||
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.id)
|
||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.webLogId)
|
||||
cmd.Parameters.AddWithValue ("@userName", user.userName)
|
||||
cmd.Parameters.AddWithValue ("@firstName", user.firstName)
|
||||
cmd.Parameters.AddWithValue ("@lastName", user.lastName)
|
||||
cmd.Parameters.AddWithValue ("@preferredName", user.preferredName)
|
||||
cmd.Parameters.AddWithValue ("@passwordHash", user.passwordHash)
|
||||
cmd.Parameters.AddWithValue ("@salt", user.salt)
|
||||
cmd.Parameters.AddWithValue ("@url", match user.url with Some u -> u :> obj | None -> DBNull.Value)
|
||||
cmd.Parameters.AddWithValue ("@authorizationLevel", AuthorizationLevel.toString user.authorizationLevel)
|
||||
] |> ignore
|
||||
|
||||
/// Add a web log ID parameter
|
||||
let addWebLogId (cmd : SqliteCommand) webLogId =
|
||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
|
||||
|
|
@ -473,28 +504,30 @@ type SQLiteData (conn : SqliteConnection) =
|
|||
|> ignore
|
||||
}
|
||||
|
||||
/// Update a post's assigned categories
|
||||
let updatePostTags postId oldTags newTags = backgroundTask {
|
||||
let toDelete, toAdd = diffLists oldTags newTags id
|
||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
||||
return ()
|
||||
else
|
||||
use cmd = conn.CreateCommand ()
|
||||
let runCmd tag = backgroundTask {
|
||||
/// Run a command for the given post and tag
|
||||
let runPostCategoryCommand postId (cmd : SqliteCommand) (tag : string) = backgroundTask {
|
||||
cmd.Parameters.Clear ()
|
||||
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
|
||||
cmd.Parameters.AddWithValue ("@tag", tag)
|
||||
] |> ignore
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
/// Update a post's assigned categories
|
||||
let updatePostTags postId (oldTags : string list) newTags = backgroundTask {
|
||||
let toDelete, toAdd = diffLists oldTags newTags id
|
||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
||||
return ()
|
||||
else
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "DELETE FROM post_tag WHERE post_id = @postId AND tag = @tag"
|
||||
toDelete
|
||||
|> List.map runCmd
|
||||
|> List.map (runPostCategoryCommand postId cmd)
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
cmd.CommandText <- "INSERT INTO post_tag VALUES (@postId, @tag)"
|
||||
toAdd
|
||||
|> List.map runCmd
|
||||
|> List.map (runPostCategoryCommand postId cmd)
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
}
|
||||
|
|
@ -592,6 +625,15 @@ type SQLiteData (conn : SqliteConnection) =
|
|||
return { webLog with rss = { webLog.rss with customFeeds = toList Map.toCustomFeed rdr } }
|
||||
}
|
||||
|
||||
/// Determine if the given table exists
|
||||
let tableExists (table : string) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT COUNT(*) FROM sqlite_master WHERE type = 'table' AND name = @table"
|
||||
cmd.Parameters.AddWithValue ("@table", table) |> ignore
|
||||
let! count = cmd.ExecuteScalarAsync ()
|
||||
return (count :?> int) = 1
|
||||
}
|
||||
|
||||
|
||||
/// The connection for this instance
|
||||
member _.Conn = conn
|
||||
|
|
@ -1597,48 +1639,83 @@ type SQLiteData (conn : SqliteConnection) =
|
|||
new IWebLogUserData with
|
||||
|
||||
member _.add user = backgroundTask {
|
||||
let _ = Collection.WebLogUser.Insert user
|
||||
do! checkpoint ()
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO web_log_user
|
||||
VALUES (@id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash,
|
||||
@salt, @url, @authorizationLevel)"""
|
||||
addWebLogUserParameters cmd user
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
member _.findByEmail email webLogId =
|
||||
Collection.WebLogUser.Find (fun wlu -> wlu.webLogId = webLogId && wlu.userName = email)
|
||||
|> tryFirst
|
||||
member _.findByEmail email webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND user_name = @userName"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@userName", email) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return if rdr.Read () then Some (Map.toWebLogUser rdr) else None
|
||||
}
|
||||
|
||||
member _.findById userId webLogId =
|
||||
Collection.WebLogUser.FindById (WebLogUserIdMapping.toBson userId)
|
||||
// |> verifyWebLog webLogId (fun u -> u.webLogId)
|
||||
member _.findById userId webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return verifyWebLog<WebLogUser> webLogId (fun u -> u.webLogId) Map.toWebLogUser rdr
|
||||
}
|
||||
|
||||
member _.findByWebLog webLogId =
|
||||
Collection.WebLogUser.Find (fun wlu -> wlu.webLogId = webLogId)
|
||||
|> toList
|
||||
member _.findByWebLog webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList Map.toWebLogUser rdr
|
||||
}
|
||||
|
||||
member _.findNames webLogId userIds =
|
||||
Collection.WebLogUser.Find (fun wlu -> userIds |> List.contains wlu.id)
|
||||
|> Seq.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u })
|
||||
|> toList
|
||||
member _.findNames webLogId userIds = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND id IN ("
|
||||
userIds
|
||||
|> List.iteri (fun idx userId ->
|
||||
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
|
||||
cmd.CommandText <- $"{cmd.CommandText}@id{idx}"
|
||||
cmd.Parameters.AddWithValue ($"@id{idx}", WebLogUserId.toString userId) |> ignore)
|
||||
cmd.CommandText <- $"{cmd.CommandText})"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return
|
||||
toList Map.toWebLogUser rdr
|
||||
|> List.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u })
|
||||
}
|
||||
|
||||
member _.restore users = backgroundTask {
|
||||
let _ = Collection.WebLogUser.InsertBulk users
|
||||
do! checkpoint ()
|
||||
member this.restore users = backgroundTask {
|
||||
for user in users do
|
||||
do! this.add user
|
||||
}
|
||||
|
||||
member _.update user = backgroundTask {
|
||||
let _ = Collection.WebLogUser.Update user
|
||||
do! checkpoint ()
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""UPDATE web_log_user
|
||||
SET user_name = @userName,
|
||||
first_name = @firstName,
|
||||
last_name = @lastName,
|
||||
preferred_name = @preferredName,
|
||||
password_hash = @passwordHash,
|
||||
salt = @salt,
|
||||
url = @url,
|
||||
authorization_level = @authorizationLevel
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
addWebLogUserParameters cmd user
|
||||
do! write cmd
|
||||
}
|
||||
}
|
||||
|
||||
member _.startUp () = backgroundTask {
|
||||
|
||||
let tableExists table = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT COUNT(*) FROM sqlite_master WHERE type = 'table' AND name = @table"
|
||||
cmd.Parameters.AddWithValue ("@table", table) |> ignore
|
||||
let! count = cmd.ExecuteScalarAsync ()
|
||||
return (count :?> int) = 1
|
||||
}
|
||||
|
||||
let! exists = tableExists "theme"
|
||||
if not exists then
|
||||
use cmd = conn.CreateCommand ()
|
||||
|
|
@ -1846,4 +1923,3 @@ type SQLiteData (conn : SqliteConnection) =
|
|||
url_value TEXT NOT NULL)"""
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,6 @@
|
|||
open Microsoft.AspNetCore.Http
|
||||
open Microsoft.Data.Sqlite
|
||||
open Microsoft.Extensions.Configuration
|
||||
open Microsoft.Extensions.Logging
|
||||
open MyWebLog
|
||||
|
||||
|
|
@ -31,8 +33,6 @@ open MyWebLog.Data
|
|||
/// Logic to obtain a data connection and implementation based on configured values
|
||||
module DataImplementation =
|
||||
|
||||
open LiteDB
|
||||
open Microsoft.Extensions.Configuration
|
||||
open MyWebLog.Converters
|
||||
open RethinkDb.Driver.FSharp
|
||||
open RethinkDb.Driver.Net
|
||||
|
|
@ -46,10 +46,9 @@ module DataImplementation =
|
|||
let rethinkCfg = DataConfig.FromConfiguration (config.GetSection "RethinkDB")
|
||||
let conn = rethinkCfg.CreateConnectionAsync () |> Async.AwaitTask |> Async.RunSynchronously
|
||||
Some (upcast RethinkDbData (conn, rethinkCfg, sp.GetRequiredService<ILogger<RethinkDbData>> ()))
|
||||
elif isNotNull (config.GetConnectionString "LiteDB") then
|
||||
Bson.registerAll ()
|
||||
let db = new LiteDatabase (config.GetConnectionString "LiteDB")
|
||||
Some (upcast LiteDbData db)
|
||||
elif isNotNull (config.GetConnectionString "SQLite") then
|
||||
let conn = new SqliteConnection (config.GetConnectionString "SQLite")
|
||||
Some (upcast SQLiteData conn)
|
||||
else
|
||||
None
|
||||
|
||||
|
|
@ -86,19 +85,26 @@ let rec main args =
|
|||
do! WebLogCache.fill data
|
||||
do! ThemeAssetCache.fill data
|
||||
} |> Async.AwaitTask |> Async.RunSynchronously
|
||||
builder.Services.AddSingleton<IData> data |> ignore
|
||||
|
||||
// Define distributed cache implementation based on data implementation
|
||||
match data with
|
||||
| :? RethinkDbData as rethink ->
|
||||
// A RethinkDB connection is designed to work as a singleton
|
||||
builder.Services.AddSingleton<IData> data |> ignore
|
||||
builder.Services.AddDistributedRethinkDBCache (fun opts ->
|
||||
opts.TableName <- "Session"
|
||||
opts.Connection <- rethink.Conn)
|
||||
|> ignore
|
||||
| :? LiteDbData ->
|
||||
| :? SQLiteData ->
|
||||
// ADO.NET connections are designed to work as per-request instantiation
|
||||
builder.Services.AddScoped<SqliteConnection> (fun sp ->
|
||||
let cfg = sp.GetRequiredService<IConfiguration> ()
|
||||
new SqliteConnection (cfg.GetConnectionString "SQLite"))
|
||||
|> ignore
|
||||
builder.Services.AddScoped<IData, SQLiteData> () |> ignore
|
||||
let log = sp.GetRequiredService<ILoggerFactory> ()
|
||||
let logger = log.CreateLogger "MyWebLog.StartUp"
|
||||
logger.LogWarning "Session caching is not yet implemented via LiteDB; using memory cache for sessions"
|
||||
logger.LogWarning "Session caching is not yet implemented via SQLite; using memory cache for sessions"
|
||||
builder.Services.AddDistributedMemoryCache () |> ignore
|
||||
| _ -> ()
|
||||
| None ->
|
||||
|
|
@ -108,8 +114,6 @@ let rec main args =
|
|||
opts.IdleTimeout <- TimeSpan.FromMinutes 60
|
||||
opts.Cookie.HttpOnly <- true
|
||||
opts.Cookie.IsEssential <- true)
|
||||
|
||||
// this needs to be after the session... maybe?
|
||||
let _ = builder.Services.AddGiraffe ()
|
||||
|
||||
// Set up DotLiquid
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user