Version 2.1 #41

Merged
danieljsummers merged 123 commits from version-2.1 into main 2024-03-27 00:13:28 +00:00
11 changed files with 321 additions and 282 deletions
Showing only changes of commit a439430cc5 - Show all commits

View File

@ -5,35 +5,34 @@ open System.Threading.Tasks
open BitBadger.Npgsql.FSharp.Documents open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Caching.Distributed open Microsoft.Extensions.Caching.Distributed
open NodaTime open NodaTime
open Npgsql.FSharp
/// Helper types and functions for the cache /// Helper types and functions for the cache
[<AutoOpen>] [<AutoOpen>]
module private Helpers = module private Helpers =
/// The cache entry /// The cache entry
type Entry = type Entry = {
{ /// The ID of the cache entry /// The ID of the cache entry
Id : string Id: string
/// The value to be cached /// The value to be cached
Payload : byte[] Payload: byte array
/// When this entry will expire /// When this entry will expire
ExpireAt : Instant ExpireAt: Instant
/// The duration by which the expiration should be pushed out when being refreshed /// The duration by which the expiration should be pushed out when being refreshed
SlidingExpiration : Duration option SlidingExpiration: Duration option
/// The must-expire-by date/time for the cache entry /// The must-expire-by date/time for the cache entry
AbsoluteExpiration : Instant option AbsoluteExpiration: Instant option
} }
/// Run a task synchronously /// Run a task synchronously
let sync<'T> (it : Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously) let sync<'T> (it: Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously)
/// Get the current instant /// Get the current instant
let getNow () = SystemClock.Instance.GetCurrentInstant () let getNow () = SystemClock.Instance.GetCurrentInstant()
/// Create a parameter for the expire-at time /// Create a parameter for the expire-at time
let expireParam = let expireParam =
@ -69,13 +68,15 @@ type DistributedCache () =
let getEntry key = backgroundTask { let getEntry key = backgroundTask {
let idParam = "@id", Sql.string key let idParam = "@id", Sql.string key
let! tryEntry = let! tryEntry =
Custom.single "SELECT * FROM session WHERE id = @id" [ idParam ] Custom.single
(fun row -> "SELECT * FROM session WHERE id = @id"
{ Id = row.string "id" [ idParam ]
Payload = row.bytea "payload" (fun row ->
ExpireAt = row.fieldValue<Instant> "expire_at" { Id = row.string "id"
SlidingExpiration = row.fieldValueOrNone<Duration> "sliding_expiration" Payload = row.bytea "payload"
AbsoluteExpiration = row.fieldValueOrNone<Instant> "absolute_expiration" }) ExpireAt = row.fieldValue<Instant> "expire_at"
SlidingExpiration = row.fieldValueOrNone<Duration> "sliding_expiration"
AbsoluteExpiration = row.fieldValueOrNone<Instant> "absolute_expiration" })
match tryEntry with match tryEntry with
| Some entry -> | Some entry ->
let now = getNow () let now = getNow ()
@ -88,8 +89,9 @@ type DistributedCache () =
true, { entry with ExpireAt = absExp } true, { entry with ExpireAt = absExp }
else true, { entry with ExpireAt = now.Plus slideExp } else true, { entry with ExpireAt = now.Plus slideExp }
if needsRefresh then if needsRefresh then
do! Custom.nonQuery "UPDATE session SET expire_at = @expireAt WHERE id = @id" do! Custom.nonQuery
[ expireParam item.ExpireAt; idParam ] "UPDATE session SET expire_at = @expireAt WHERE id = @id"
[ expireParam item.ExpireAt; idParam ]
() ()
return if item.ExpireAt > now then Some entry else None return if item.ExpireAt > now then Some entry else None
| None -> return None | None -> return None
@ -101,17 +103,17 @@ type DistributedCache () =
/// Purge expired entries every 30 minutes /// Purge expired entries every 30 minutes
let purge () = backgroundTask { let purge () = backgroundTask {
let now = getNow () let now = getNow ()
if lastPurge.Plus (Duration.FromMinutes 30L) < now then if lastPurge.Plus(Duration.FromMinutes 30L) < now then
do! Custom.nonQuery "DELETE FROM session WHERE expire_at < @expireAt" [ expireParam now ] do! Custom.nonQuery "DELETE FROM session WHERE expire_at < @expireAt" [ expireParam now ]
lastPurge <- now lastPurge <- now
} }
/// Remove a cache entry /// Remove a cache entry
let removeEntry key = let removeEntry key =
Delete.byId "session" key Custom.nonQuery "DELETE FROM session WHERE id = @id" [ "@id", Sql.string key ]
/// Save an entry /// Save an entry
let saveEntry (opts : DistributedCacheEntryOptions) key payload = let saveEntry (opts: DistributedCacheEntryOptions) key payload =
let now = getNow () let now = getNow ()
let expireAt, slideExp, absExp = let expireAt, slideExp, absExp =
if opts.SlidingExpiration.HasValue then if opts.SlidingExpiration.HasValue then
@ -121,7 +123,7 @@ type DistributedCache () =
let exp = Instant.FromDateTimeOffset opts.AbsoluteExpiration.Value let exp = Instant.FromDateTimeOffset opts.AbsoluteExpiration.Value
exp, None, Some exp exp, None, Some exp
elif opts.AbsoluteExpirationRelativeToNow.HasValue then elif opts.AbsoluteExpirationRelativeToNow.HasValue then
let exp = now.Plus (Duration.FromTimeSpan opts.AbsoluteExpirationRelativeToNow.Value) let exp = now.Plus(Duration.FromTimeSpan opts.AbsoluteExpirationRelativeToNow.Value)
exp, None, Some exp exp, None, Some exp
else else
// Default to 1 hour sliding expiration // Default to 1 hour sliding expiration
@ -146,7 +148,7 @@ type DistributedCache () =
// ~~~ IMPLEMENTATION FUNCTIONS ~~~ // ~~~ IMPLEMENTATION FUNCTIONS ~~~
/// Retrieve the data for a cache entry /// Retrieve the data for a cache entry
let get key (_ : CancellationToken) = backgroundTask { let get key (_: CancellationToken) = backgroundTask {
match! getEntry key with match! getEntry key with
| Some entry -> | Some entry ->
do! purge () do! purge ()
@ -155,29 +157,29 @@ type DistributedCache () =
} }
/// Refresh an entry /// Refresh an entry
let refresh key (cancelToken : CancellationToken) = backgroundTask { let refresh key (cancelToken: CancellationToken) = backgroundTask {
let! _ = get key cancelToken let! _ = get key cancelToken
() ()
} }
/// Remove an entry /// Remove an entry
let remove key (_ : CancellationToken) = backgroundTask { let remove key (_: CancellationToken) = backgroundTask {
do! removeEntry key do! removeEntry key
do! purge () do! purge ()
} }
/// Set an entry /// Set an entry
let set key value options (_ : CancellationToken) = backgroundTask { let set key value options (_: CancellationToken) = backgroundTask {
do! saveEntry options key value do! saveEntry options key value
do! purge () do! purge ()
} }
interface IDistributedCache with interface IDistributedCache with
member _.Get key = get key CancellationToken.None |> sync member _.Get key = get key CancellationToken.None |> sync
member _.GetAsync (key, token) = get key token member _.GetAsync(key, token) = get key token
member _.Refresh key = refresh key CancellationToken.None |> sync member _.Refresh key = refresh key CancellationToken.None |> sync
member _.RefreshAsync (key, token) = refresh key token member _.RefreshAsync(key, token) = refresh key token
member _.Remove key = remove key CancellationToken.None |> sync member _.Remove key = remove key CancellationToken.None |> sync
member _.RemoveAsync (key, token) = remove key token member _.RemoveAsync(key, token) = remove key token
member _.Set (key, value, options) = set key value options CancellationToken.None |> sync member _.Set(key, value, options) = set key value options CancellationToken.None |> sync
member _.SetAsync (key, value, options, token) = set key value options token member _.SetAsync(key, value, options, token) = set key value options token

View File

@ -23,8 +23,10 @@ type PostgresCategoryData(log: ILogger) =
let findAllForView webLogId = backgroundTask { let findAllForView webLogId = backgroundTask {
log.LogTrace "Category.findAllForView" log.LogTrace "Category.findAllForView"
let! cats = let! cats =
Custom.list $"{selectWithCriteria Table.Category} ORDER BY LOWER(data ->> '{nameof Category.Empty.Name}')" Custom.list
[ webLogContains webLogId ] fromData<Category> $"{selectWithCriteria Table.Category} ORDER BY LOWER(data ->> '{nameof Category.Empty.Name}')"
[ webLogContains webLogId ]
fromData<Category>
let ordered = Utils.orderByHierarchy cats None None [] let ordered = Utils.orderByHierarchy cats None None []
let counts = let counts =
ordered ordered
@ -39,12 +41,12 @@ type PostgresCategoryData(log: ILogger) =
|> arrayContains (nameof Post.Empty.CategoryIds) id |> arrayContains (nameof Post.Empty.CategoryIds) id
let postCount = let postCount =
Custom.scalar Custom.scalar
$"""SELECT COUNT(DISTINCT id) AS {countName} $"""SELECT COUNT(DISTINCT data ->> '{nameof Post.Empty.Id}') AS {countName}
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 |} [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |}
catIdParams ] catIdParams ]
Map.toCount Map.toCount
|> Async.AwaitTask |> Async.AwaitTask
|> Async.RunSynchronously |> Async.RunSynchronously
@ -57,60 +59,56 @@ type PostgresCategoryData(log: ILogger) =
PostCount = counts PostCount = counts
|> List.tryFind (fun c -> fst c = cat.Id) |> List.tryFind (fun c -> fst c = cat.Id)
|> Option.map snd |> Option.map snd
|> Option.defaultValue 0 |> Option.defaultValue 0 })
})
|> Array.ofSeq |> Array.ofSeq
} }
/// 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 string webLogId Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId webLogId
/// Find all categories for the given web log /// Find all categories for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
log.LogTrace "Category.findByWebLog" log.LogTrace "Category.findByWebLog"
Document.findByWebLog<Category> Table.Category webLogId Document.findByWebLog<Category> Table.Category webLogId
/// Create parameters for a category insert / update
let catParameters (cat : Category) =
Query.docParameters (string cat.Id) cat
/// Delete a category /// Delete a category
let delete catId webLogId = backgroundTask { let delete catId webLogId = backgroundTask {
log.LogTrace "Category.delete" log.LogTrace "Category.delete"
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 = string catId |} let! children = Find.byContains<Category> Table.Category {| ParentId = catId |}
let hasChildren = not (List.isEmpty children) let hasChildren = not (List.isEmpty children)
if hasChildren then if hasChildren then
let! _ = let! _ =
Configuration.dataSource () Configuration.dataSource ()
|> Sql.fromDataSource |> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync
Query.Update.partialById Table.Category, [ Query.Update.partialById Table.Category,
children |> List.map (fun child -> [ children
"@id", Sql.string (string child.Id) |> List.map (fun child ->
"@data", Query.jsonbDocParam {| ParentId = cat.ParentId |} [ "@id", Sql.string (string child.Id)
]) "@data", Query.jsonbDocParam {| ParentId = cat.ParentId |} ]) ]
]
() ()
// 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
[ "@id", Query.jsonbDocParam [| string catId |] ] fromData<Post> $"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.Empty.CategoryIds}' @> @id"
[ "@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 ()
|> Sql.fromDataSource |> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync
Query.Update.partialById Table.Post, [ Query.Update.partialById Table.Post,
posts |> List.map (fun post -> [ posts
"@id", Sql.string (string post.Id) |> List.map (fun post ->
"@data", Query.jsonbDocParam [ "@id", Sql.string (string post.Id)
{| CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId) |} "@data", Query.jsonbDocParam
]) {| CategoryIds = post.CategoryIds
] |> List.filter (fun cat -> cat <> catId) |} ]) ]
() ()
// Delete the category itself // Delete the category itself
do! Delete.byId Table.Category (string catId) do! Delete.byId Table.Category (string catId)
@ -119,7 +117,7 @@ type PostgresCategoryData(log: ILogger) =
} }
/// Save a category /// Save a category
let save (cat : Category) = backgroundTask { let save (cat: Category) = backgroundTask {
log.LogTrace "Category.save" log.LogTrace "Category.save"
do! save Table.Category cat do! save Table.Category cat
} }
@ -131,7 +129,7 @@ type PostgresCategoryData(log: ILogger) =
Configuration.dataSource () Configuration.dataSource ()
|> Sql.fromDataSource |> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.insert Table.Category, cats |> List.map catParameters Query.insert Table.Category, cats |> List.map (fun c -> [ "@data", Query.jsonbDocParam c ])
] ]
() ()
} }

View File

@ -69,11 +69,11 @@ open Npgsql
open Npgsql.FSharp 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) =
"@webLogId", Sql.string (string 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) =
{| WebLogId = webLogId |} {| WebLogId = webLogId |}
/// Create a parameter for a web log document-contains query /// Create a parameter for a web log document-contains query
@ -91,7 +91,7 @@ let selectWithCriteria tableName =
$"""{Query.selectFromTable tableName} WHERE {Query.whereDataContains "@criteria"}""" $"""{Query.selectFromTable tableName} WHERE {Query.whereDataContains "@criteria"}"""
/// Create the SQL and parameters for an IN clause /// Create the SQL and parameters for an IN clause
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) = let inClause<'T> colNameAndPrefix paramName (items: 'T list) =
if List.isEmpty items then "", [] if List.isEmpty items then "", []
else else
let mutable idx = 0 let mutable idx = 0
@ -99,87 +99,87 @@ let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : '
|> List.skip 1 |> List.skip 1
|> List.fold (fun (itemS, itemP) it -> |> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1 idx <- idx + 1
$"{itemS}, @%s{paramName}{idx}", ($"@%s{paramName}{idx}", Sql.string (valueFunc it)) :: itemP) $"{itemS}, @%s{paramName}{idx}", ($"@%s{paramName}{idx}", Sql.string (string it)) :: itemP)
(Seq.ofList items (Seq.ofList items
|> Seq.map (fun it -> |> Seq.map (fun it ->
$"%s{colNameAndPrefix} IN (@%s{paramName}0", [ $"@%s{paramName}0", Sql.string (valueFunc it) ]) $"%s{colNameAndPrefix} IN (@%s{paramName}0", [ $"@%s{paramName}0", Sql.string (string it) ])
|> Seq.head) |> Seq.head)
|> function sql, ps -> $"{sql})", ps |> function sql, ps -> $"{sql})", ps
/// Create the SQL and parameters for match-any array query /// Create the SQL and parameters for match-any array query
let arrayContains<'T> name (valueFunc : 'T -> string) (items : 'T list) = let arrayContains<'T> name (valueFunc: 'T -> string) (items: 'T list) =
$"data['{name}'] ?| @{name}Values", $"data['{name}'] ?| @{name}Values",
($"@{name}Values", Sql.stringArray (items |> List.map valueFunc |> Array.ofList)) ($"@{name}Values", Sql.stringArray (items |> List.map valueFunc |> Array.ofList))
/// Get the first result of the given query /// Get the first result of the given query
let tryHead<'T> (query : Task<'T list>) = backgroundTask { let tryHead<'T> (query: Task<'T list>) = backgroundTask {
let! results = query let! results = query
return List.tryHead results return List.tryHead results
} }
/// Create a parameter for a non-standard type /// Create a parameter for a non-standard type
let typedParam<'T> name (it : 'T) = let typedParam<'T> name (it: 'T) =
$"@%s{name}", Sql.parameter (NpgsqlParameter ($"@{name}", it)) $"@%s{name}", Sql.parameter (NpgsqlParameter($"@{name}", it))
/// Create a parameter for a possibly-missing non-standard type /// Create a parameter for a possibly-missing non-standard type
let optParam<'T> name (it : 'T option) = let optParam<'T> name (it: 'T option) =
let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value) let p = NpgsqlParameter($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value)
p.ParameterName, Sql.parameter p p.ParameterName, Sql.parameter p
/// Mapping functions for SQL queries /// Mapping functions for SQL queries
module Map = module Map =
/// Get a count from a row /// Get a count from a row
let toCount (row : RowReader) = let toCount (row: RowReader) =
row.int countName row.int countName
/// Get a true/false value as to whether an item exists /// Get a true/false value as to whether an item exists
let toExists (row : RowReader) = let toExists (row: RowReader) =
row.bool existsName row.bool existsName
/// Create a permalink from the current row /// Create a permalink from the current row
let toPermalink (row : RowReader) = let toPermalink (row: RowReader) =
Permalink (row.string "permalink") Permalink (row.string "permalink")
/// Create a revision from the current row /// Create a revision from the current row
let toRevision (row : RowReader) : Revision = let toRevision (row: RowReader) : Revision =
{ AsOf = row.fieldValue<Instant> "as_of" { AsOf = row.fieldValue<Instant> "as_of"
Text = row.string "revision_text" |> MarkupText.Parse Text = row.string "revision_text" |> MarkupText.Parse }
}
/// Create a theme asset from the current row /// Create a theme asset from the current row
let toThemeAsset includeData (row : RowReader) : ThemeAsset = let toThemeAsset includeData (row: RowReader) : ThemeAsset =
{ Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path") { Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
UpdatedOn = row.fieldValue<Instant> "updated_on" UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||] Data = if includeData then row.bytea "data" else [||] }
}
/// Create an uploaded file from the current row /// Create an uploaded file from the current row
let toUpload includeData (row : RowReader) : Upload = let toUpload includeData (row: RowReader) : Upload =
{ Id = row.string "id" |> UploadId { Id = row.string "id" |> UploadId
WebLogId = row.string "web_log_id" |> WebLogId WebLogId = row.string "web_log_id" |> WebLogId
Path = row.string "path" |> Permalink Path = row.string "path" |> Permalink
UpdatedOn = row.fieldValue<Instant> "updated_on" UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||] Data = if includeData then row.bytea "data" else [||] }
}
/// Document manipulation functions /// Document manipulation functions
module Document = module Document =
/// Determine whether a document exists with the given key for the given web log /// Determine whether a document exists with the given key for the given web log
let existsByWebLog<'TKey> table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId = let existsByWebLog<'TKey> table (key: 'TKey) webLogId =
Custom.scalar Custom.scalar
$""" SELECT EXISTS ( $"""SELECT EXISTS (
SELECT 1 FROM %s{table} WHERE id = @id AND {Query.whereDataContains "@criteria"} SELECT 1 FROM %s{table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"}
) AS {existsName}""" ) AS {existsName}"""
[ "@id", Sql.string (keyFunc key); webLogContains webLogId ] Map.toExists [ "@id", Sql.string (string key); webLogContains webLogId ]
Map.toExists
/// Find a document by its ID for the given web log /// Find a document by its ID for the given web log
let findByIdAndWebLog<'TKey, 'TDoc> table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId = let findByIdAndWebLog<'TKey, 'TDoc> table (key: 'TKey) webLogId =
Custom.single $"""{Query.selectFromTable table} WHERE id = @id AND {Query.whereDataContains "@criteria"}""" Custom.single
[ "@id", Sql.string (keyFunc key); webLogContains webLogId ] fromData<'TDoc> $"""{Query.selectFromTable table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"}"""
[ "@id", Sql.string (string key); webLogContains webLogId ]
fromData<'TDoc>
/// Find a document by its ID for the given web log /// Find documents for the given web log
let findByWebLog<'TDoc> table webLogId : Task<'TDoc list> = let findByWebLog<'TDoc> table webLogId : Task<'TDoc list> =
Find.byContains table (webLogDoc webLogId) Find.byContains table (webLogDoc webLogId)
@ -188,24 +188,27 @@ module Document =
module Revisions = module Revisions =
/// Find all revisions for the given entity /// Find all revisions for the given entity
let findByEntityId<'TKey> revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) = let findByEntityId<'TKey> revTable entityTable (key: 'TKey) =
Custom.list $"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC" Custom.list
[ "@id", Sql.string (keyFunc key) ] Map.toRevision $"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC"
[ "@id", Sql.string (string key) ]
Map.toRevision
/// Find all revisions for all posts for the given web log /// Find all revisions for all posts for the given web log
let findByWebLog<'TKey> revTable entityTable (keyFunc : string -> 'TKey) webLogId = let findByWebLog<'TKey> revTable entityTable (keyFunc: string -> 'TKey) webLogId =
Custom.list Custom.list
$"""SELECT pr.* $"""SELECT pr.*
FROM %s{revTable} pr FROM %s{revTable} pr
INNER JOIN %s{entityTable} p ON p.id = pr.{entityTable}_id INNER JOIN %s{entityTable} p ON p.data ->> '{nameof Post.Empty.Id}' = pr.{entityTable}_id
WHERE p.{Query.whereDataContains "@criteria"} WHERE p.{Query.whereDataContains "@criteria"}
ORDER BY as_of DESC""" ORDER BY as_of DESC"""
[ webLogContains webLogId ] (fun row -> keyFunc (row.string $"{entityTable}_id"), Map.toRevision row) [ webLogContains webLogId ]
(fun row -> keyFunc (row.string $"{entityTable}_id"), Map.toRevision row)
/// Parameters for a revision INSERT statement /// Parameters for a revision INSERT statement
let revParams<'TKey> (key : 'TKey) (keyFunc : 'TKey -> string) rev = [ let revParams<'TKey> (key: 'TKey) rev = [
typedParam "asOf" rev.AsOf typedParam "asOf" rev.AsOf
"@id", Sql.string (keyFunc key) "@id", Sql.string (string key)
"@text", Sql.string (string rev.Text) "@text", Sql.string (string rev.Text)
] ]
@ -214,23 +217,20 @@ module Revisions =
$"INSERT INTO %s{table} VALUES (@id, @asOf, @text)" $"INSERT INTO %s{table} VALUES (@id, @asOf, @text)"
/// Update a page's revisions /// Update a page's revisions
let update<'TKey> revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) oldRevs newRevs = backgroundTask { let update<'TKey> revTable entityTable (key: 'TKey) oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
let! _ = let! _ =
Configuration.dataSource () Configuration.dataSource ()
|> Sql.fromDataSource |> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync
if not (List.isEmpty toDelete) then [ if not (List.isEmpty toDelete) then
$"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf", $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf",
toDelete toDelete
|> List.map (fun it -> [ |> List.map (fun it ->
"@id", Sql.string (keyFunc key) [ "@id", Sql.string (string key)
typedParam "asOf" it.AsOf typedParam "asOf" it.AsOf ])
]) if not (List.isEmpty toAdd) then
if not (List.isEmpty toAdd) then insertSql revTable, toAdd |> List.map (revParams key) ]
insertSql revTable, toAdd |> List.map (revParams key keyFunc)
]
() ()
} }

View File

@ -7,14 +7,14 @@ open MyWebLog.Data
open Npgsql.FSharp open Npgsql.FSharp
/// PostgreSQL myWebLog page data implementation /// PostgreSQL myWebLog page data implementation
type PostgresPageData (log: ILogger) = type PostgresPageData(log: ILogger) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// 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 string let! revisions = Revisions.findByEntityId Table.PageRevision Table.Page page.Id
return { page with Revisions = revisions } return { page with Revisions = revisions }
} }
@ -25,20 +25,22 @@ 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 string oldRevs newRevs Revisions.update Table.PageRevision Table.Page pageId 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 string webLogId Document.existsByWebLog Table.Page pageId webLogId
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Get all pages for a web log (without text or revisions) /// Get all pages for a web log (without text or revisions)
let all webLogId = let all webLogId =
log.LogTrace "Page.all" log.LogTrace "Page.all"
Custom.list $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.Empty.Title}')" Custom.list
[ webLogContains webLogId ] fromData<Page> $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.Empty.Title}')"
[ webLogContains webLogId ]
fromData<Page>
/// Count all pages for the given web log /// Count all pages for the given web log
let countAll webLogId = let countAll webLogId =
@ -53,7 +55,7 @@ type PostgresPageData (log: ILogger) =
/// Find a page by its ID (without revisions) /// Find a page by its ID (without revisions)
let findById pageId webLogId = let findById pageId webLogId =
log.LogTrace "Page.findById" log.LogTrace "Page.findById"
Document.findByIdAndWebLog<PageId, Page> Table.Page pageId string webLogId Document.findByIdAndWebLog<PageId, Page> Table.Page pageId 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 {
@ -65,12 +67,16 @@ type PostgresPageData (log: ILogger) =
| None -> return None | None -> return None
} }
// TODO: need to handle when the page being deleted is the home page
/// Delete a page by its ID /// Delete a page by its ID
let delete pageId webLogId = backgroundTask { let delete pageId webLogId = backgroundTask {
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 (string pageId) do! Custom.nonQuery
$"""DELETE FROM {Table.PageRevision} WHERE page_id = @id;
DELETE FROM {Table.Page} WHERE {Query.whereById "@id"}"""
[ "@id", Sql.string (string pageId) ]
return true return true
| false -> return false | false -> return false
} }
@ -78,7 +84,7 @@ 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 = string permalink |} Find.byContains<Page> Table.Page {| webLogDoc webLogId with Permalink = 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
@ -92,7 +98,9 @@ type PostgresPageData (log: ILogger) =
$"""SELECT data ->> '{nameof Page.Empty.Permalink}' AS permalink $"""SELECT data ->> '{nameof Page.Empty.Permalink}' AS permalink
FROM page FROM page
WHERE {Query.whereDataContains "@criteria"} WHERE {Query.whereDataContains "@criteria"}
AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink AND {linkSql}"""
[ webLogContains webLogId; linkParam ]
Map.toPermalink
} }
/// Get all complete pages for the given web log /// Get all complete pages for the given web log
@ -109,9 +117,10 @@ type PostgresPageData (log: ILogger) =
/// Get all listed pages for the given web log (without revisions or text) /// Get all listed pages for the given web log (without revisions or text)
let findListed webLogId = let findListed webLogId =
log.LogTrace "Page.findListed" log.LogTrace "Page.findListed"
Custom.list $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.Empty.Title}')" Custom.list
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with IsInPageList = true |} ] $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.Empty.Title}')"
pageWithoutText [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with IsInPageList = true |} ]
pageWithoutText
/// Get a page of pages for the given web log (without revisions) /// Get a page of pages for the given web log (without revisions)
let findPageOfPages webLogId pageNbr = let findPageOfPages webLogId pageNbr =
@ -130,13 +139,11 @@ type PostgresPageData (log: ILogger) =
let! _ = let! _ =
Configuration.dataSource () Configuration.dataSource ()
|> Sql.fromDataSource |> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync
Query.insert Table.Page, [ Query.insert Table.Page,
pages pages |> List.map (fun page -> [ "@data", Query.jsonbDocParam { 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 rev) ]
revisions |> List.map (fun (pageId, rev) -> Revisions.revParams pageId string rev)
]
() ()
} }
@ -150,7 +157,7 @@ type PostgresPageData (log: ILogger) =
} }
/// Update a page's prior permalinks /// Update a page's prior permalinks
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask { let updatePriorPermalinks pageId webLogId (permalinks: Permalink list) = backgroundTask {
log.LogTrace "Page.updatePriorPermalinks" log.LogTrace "Page.updatePriorPermalinks"
match! pageExists pageId webLogId with match! pageExists pageId webLogId with
| true -> | true ->

View File

@ -15,23 +15,23 @@ 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 string let! revisions = Revisions.findByEntityId Table.PostRevision Table.Post post.Id
return { post with Revisions = revisions } return { post with Revisions = revisions }
} }
/// Return a post with no revisions, prior permalinks, or text /// Return a post with no revisions or text
let postWithoutText row = let postWithoutText row =
{ fromData<Post> row with Text = "" } { fromData<Post> row with Text = "" }
/// 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 string oldRevs newRevs Revisions.update Table.PostRevision Table.Post postId 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 string webLogId Document.existsByWebLog Table.Post postId webLogId
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
@ -43,14 +43,15 @@ type PostgresPostData(log: ILogger) =
/// 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 string webLogId Document.findByIdAndWebLog<PostId, Post> Table.Post postId 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)
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
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Permalink = string permalink |} ] (selectWithCriteria Table.Post)
fromData<Post> [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Permalink = permalink |} ]
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
let findFullById postId webLogId = backgroundTask { let findFullById postId webLogId = backgroundTask {
@ -68,8 +69,9 @@ type PostgresPostData(log: ILogger) =
match! postExists postId webLogId with match! postExists postId webLogId with
| true -> | true ->
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.PostRevision} WHERE post_id = @id;
DELETE FROM {Table.Post} WHERE {Query.whereById "@id"}"""
[ "@id", Sql.string (string postId); "@criteria", Query.jsonbDocParam {| PostId = postId |} ] [ "@id", Sql.string (string postId); "@criteria", Query.jsonbDocParam {| PostId = postId |} ]
return true return true
| false -> return false | false -> return false
@ -86,7 +88,9 @@ type PostgresPostData(log: ILogger) =
$"""SELECT data ->> '{nameof Post.Empty.Permalink}' AS permalink $"""SELECT data ->> '{nameof Post.Empty.Permalink}' AS permalink
FROM {Table.Post} FROM {Table.Post}
WHERE {Query.whereDataContains "@criteria"} WHERE {Query.whereDataContains "@criteria"}
AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink AND {linkSql}"""
[ webLogContains webLogId; linkParam ]
Map.toPermalink
} }
/// Get all complete posts for the given web log /// Get all complete posts for the given web log
@ -109,9 +113,8 @@ type PostgresPostData(log: ILogger) =
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 |} [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |}; catParam ]
catParam fromData<Post>
] fromData<Post>
/// Get a page of posts for the given web log (excludes text and revisions) /// Get a page of posts for the given web log (excludes text and revisions)
let findPageOfPosts webLogId pageNbr postsPerPage = let findPageOfPosts webLogId pageNbr postsPerPage =
@ -121,7 +124,8 @@ type PostgresPostData(log: ILogger) =
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC NULLS FIRST, ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC NULLS FIRST,
data ->> '{nameof Post.Empty.UpdatedOn}' data ->> '{nameof Post.Empty.UpdatedOn}'
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ webLogContains webLogId ] postWithoutText [ webLogContains webLogId ]
postWithoutText
/// Get a page of published posts for the given web log (excludes revisions) /// Get a page of published posts for the given web log (excludes revisions)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
@ -134,37 +138,40 @@ type PostgresPostData(log: ILogger) =
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)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = let findPageOfTaggedPosts webLogId (tag: string) pageNbr postsPerPage =
log.LogTrace "Post.findPageOfTaggedPosts" log.LogTrace "Post.findPageOfTaggedPosts"
Custom.list Custom.list
$"{selectWithCriteria Table.Post} $"{selectWithCriteria Table.Post}
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 |} [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |}
"@tag", Query.jsonbDocParam [| tag |] "@tag", Query.jsonbDocParam [| tag |] ]
] fromData<Post> fromData<Post>
/// Find the next newest and oldest post from a publish date for the given web log /// Find the next newest and oldest post from a publish date for the given web log
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 |} [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published |}
"@publishedOn", Sql.string ((InstantPattern.General.Format publishedOn)[..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 =
Custom.list Custom.list
$"{selectWithCriteria Table.Post} $"{selectWithCriteria Table.Post}
AND SUBSTR(data ->> '{pubField}', 1, 19) < @publishedOn AND SUBSTR(data ->> '{pubField}', 1, 19) < @publishedOn
ORDER BY data ->> '{pubField}' DESC ORDER BY data ->> '{pubField}' DESC
LIMIT 1" (queryParams ()) fromData<Post> LIMIT 1"
(queryParams ())
fromData<Post>
let! newer = let! newer =
Custom.list Custom.list
$"{selectWithCriteria Table.Post} $"{selectWithCriteria Table.Post}
AND SUBSTR(data ->> '{pubField}', 1, 19) > @publishedOn AND SUBSTR(data ->> '{pubField}', 1, 19) > @publishedOn
ORDER BY data ->> '{pubField}' ORDER BY data ->> '{pubField}'
LIMIT 1" (queryParams ()) fromData<Post> LIMIT 1"
(queryParams ())
fromData<Post>
return List.tryHead older, List.tryHead newer return List.tryHead older, List.tryHead newer
} }
@ -183,17 +190,16 @@ type PostgresPostData(log: ILogger) =
let! _ = let! _ =
Configuration.dataSource () Configuration.dataSource ()
|> Sql.fromDataSource |> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync
Query.insert Table.Post, [ Query.insert Table.Post,
posts |> List.map (fun post -> Query.docParameters (string post.Id) { post with Revisions = [] }) posts |> List.map (fun post -> [ "@data", Query.jsonbDocParam { post with Revisions = [] } ])
Revisions.insertSql Table.PostRevision, Revisions.insertSql Table.PostRevision,
revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId string rev) revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId rev) ]
]
() ()
} }
/// Update prior permalinks for a post /// Update prior permalinks for a post
let updatePriorPermalinks postId webLogId permalinks = backgroundTask { let updatePriorPermalinks postId webLogId (permalinks: Permalink list) = backgroundTask {
log.LogTrace "Post.updatePriorPermalinks" log.LogTrace "Post.updatePriorPermalinks"
match! postExists postId webLogId with match! postExists postId webLogId with
| true -> | true ->

View File

@ -7,17 +7,17 @@ open MyWebLog.Data
open Npgsql.FSharp open Npgsql.FSharp
/// PostgreSQL myWebLog tag mapping data implementation /// PostgreSQL myWebLog tag mapping data implementation
type PostgresTagMapData (log : ILogger) = 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 string webLogId Document.findByIdAndWebLog<TagMapId, TagMap> Table.TagMap tagMapId webLogId
/// Delete a tag mapping for the given web log /// Delete a tag mapping for the given web log
let delete (tagMapId: TagMapId) webLogId = backgroundTask { let delete (tagMapId: TagMapId) webLogId = backgroundTask {
log.LogTrace "TagMap.delete" log.LogTrace "TagMap.delete"
let! exists = Document.existsByWebLog Table.TagMap tagMapId string webLogId let! exists = Document.existsByWebLog Table.TagMap tagMapId webLogId
if exists then if exists then
do! Delete.byId Table.TagMap (string tagMapId) do! Delete.byId Table.TagMap (string tagMapId)
return true return true
@ -25,38 +25,39 @@ type PostgresTagMapData (log : ILogger) =
} }
/// Find a tag mapping by its URL value for the given web log /// Find a tag mapping by its URL value for the given web log
let findByUrlValue (urlValue : string) webLogId = let findByUrlValue (urlValue: string) webLogId =
log.LogTrace "TagMap.findByUrlValue" log.LogTrace "TagMap.findByUrlValue"
Custom.single (selectWithCriteria Table.TagMap) Find.firstByContains<TagMap> Table.TagMap {| webLogDoc webLogId with UrlValue = urlValue |}
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with UrlValue = urlValue |} ]
fromData<TagMap>
/// Get all tag mappings for the given web log /// Get all tag mappings for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
log.LogTrace "TagMap.findByWebLog" log.LogTrace "TagMap.findByWebLog"
Custom.list $"{selectWithCriteria Table.TagMap} ORDER BY data ->> 'tag'" [ webLogContains webLogId ] Custom.list
fromData<TagMap> $"{selectWithCriteria Table.TagMap} ORDER BY data ->> 'tag'"
[ webLogContains webLogId ]
fromData<TagMap>
/// Find any tag mappings in a list of tags for the given web log /// Find any tag mappings in a list of tags for the given web log
let findMappingForTags tags webLogId = let findMappingForTags tags webLogId =
log.LogTrace "TagMap.findMappingForTags" log.LogTrace "TagMap.findMappingForTags"
let tagSql, tagParam = arrayContains (nameof TagMap.Empty.Tag) id tags let tagSql, tagParam = arrayContains (nameof TagMap.Empty.Tag) id tags
Custom.list $"{selectWithCriteria Table.TagMap} AND {tagSql}" [ webLogContains webLogId; tagParam ] Custom.list
fromData<TagMap> $"{selectWithCriteria Table.TagMap} AND {tagSql}"
[ webLogContains webLogId; tagParam ]
fromData<TagMap>
/// Save a tag mapping /// Save a tag mapping
let save (tagMap : TagMap) = let save (tagMap: TagMap) =
save Table.TagMap tagMap save Table.TagMap tagMap
/// Restore tag mappings from a backup /// Restore tag mappings from a backup
let restore (tagMaps : TagMap list) = backgroundTask { let restore (tagMaps: TagMap list) = backgroundTask {
let! _ = let! _ =
Configuration.dataSource () Configuration.dataSource ()
|> Sql.fromDataSource |> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync
Query.insert Table.TagMap, [ Query.insert Table.TagMap,
tagMaps |> List.map (fun tagMap -> Query.docParameters (string tagMap.Id) tagMap) tagMaps |> List.map (fun tagMap -> [ "@data", Query.jsonbDocParam tagMap ]) ]
]
() ()
} }

View File

@ -7,7 +7,7 @@ open MyWebLog.Data
open Npgsql.FSharp open Npgsql.FSharp
/// PostreSQL myWebLog theme data implementation /// PostreSQL myWebLog theme data implementation
type PostgresThemeData (log : ILogger) = type PostgresThemeData(log: ILogger) =
/// Clear out the template text from a theme /// Clear out the template text from a theme
let withoutTemplateText row = let withoutTemplateText row =
@ -17,7 +17,10 @@ type PostgresThemeData (log : ILogger) =
/// Retrieve all themes (except 'admin'; excludes template text) /// Retrieve all themes (except 'admin'; excludes template text)
let all () = let all () =
log.LogTrace "Theme.all" log.LogTrace "Theme.all"
Custom.list $"{Query.selectFromTable Table.Theme} WHERE id <> 'admin' ORDER BY id" [] withoutTemplateText Custom.list
$"{Query.selectFromTable Table.Theme} WHERE data ->> '{nameof Theme.Empty.Id}' <> 'admin' ORDER BY id"
[]
withoutTemplateText
/// Does a given theme exist? /// Does a given theme exist?
let exists (themeId: ThemeId) = let exists (themeId: ThemeId) =
@ -39,18 +42,21 @@ type PostgresThemeData (log : ILogger) =
log.LogTrace "Theme.delete" log.LogTrace "Theme.delete"
match! exists themeId with match! exists themeId with
| true -> | true ->
do! Delete.byId Table.Theme (string themeId) do! Custom.nonQuery
$"""DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id;
DELETE FROM {Table.Theme} WHERE {Query.whereById "@id"}"""
[ "@id", Sql.string (string themeId) ]
return true return true
| false -> return false | false -> return false
} }
/// Save a theme /// Save a theme
let save (theme : Theme) = let save (theme: Theme) =
log.LogTrace "Theme.save" log.LogTrace "Theme.save"
save Table.Theme theme save Table.Theme theme
interface IThemeData with interface IThemeData with
member _.All () = all () member _.All() = all ()
member _.Delete themeId = delete themeId member _.Delete themeId = delete themeId
member _.Exists themeId = exists themeId member _.Exists themeId = exists themeId
member _.FindById themeId = findById themeId member _.FindById themeId = findById themeId
@ -59,7 +65,7 @@ type PostgresThemeData (log : ILogger) =
/// PostreSQL myWebLog theme data implementation /// PostreSQL myWebLog theme data implementation
type PostgresThemeAssetData (log : ILogger) = type PostgresThemeAssetData(log: ILogger) =
/// Get all theme assets (excludes data) /// Get all theme assets (excludes data)
let all () = let all () =
@ -69,30 +75,35 @@ type PostgresThemeAssetData (log : ILogger) =
/// Delete all assets for the given theme /// Delete all assets for the given theme
let deleteByTheme (themeId: 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 = @id" [ "@id", Sql.string (string 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 =
log.LogTrace "ThemeAsset.findById" log.LogTrace "ThemeAsset.findById"
let (ThemeAssetId (ThemeId themeId, path)) = assetId let (ThemeAssetId (ThemeId themeId, path)) = assetId
Custom.single $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path" Custom.single
[ "@themeId", Sql.string themeId; "@path", Sql.string path ] (Map.toThemeAsset true) $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path"
[ "@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: 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
[ "@themeId", Sql.string (string themeId) ] (Map.toThemeAsset false) $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
[ "@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: 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
[ "@themeId", Sql.string (string themeId) ] (Map.toThemeAsset true) $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
[ "@themeId", Sql.string (string themeId) ]
(Map.toThemeAsset true)
/// Save a theme asset /// Save a theme asset
let save (asset : ThemeAsset) = let save (asset: ThemeAsset) =
log.LogTrace "ThemeAsset.save" log.LogTrace "ThemeAsset.save"
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
Custom.nonQuery Custom.nonQuery
@ -103,13 +114,13 @@ type PostgresThemeAssetData (log : ILogger) =
) ON CONFLICT (theme_id, path) DO UPDATE ) ON CONFLICT (theme_id, path) DO UPDATE
SET updated_on = EXCLUDED.updated_on, SET updated_on = EXCLUDED.updated_on,
data = EXCLUDED.data" data = EXCLUDED.data"
[ "@themeId", Sql.string themeId [ "@themeId", Sql.string themeId
"@path", Sql.string path "@path", Sql.string path
"@data", Sql.bytea asset.Data "@data", Sql.bytea asset.Data
typedParam "updatedOn" asset.UpdatedOn ] typedParam "updatedOn" asset.UpdatedOn ]
interface IThemeAssetData with interface IThemeAssetData with
member _.All () = all () member _.All() = all ()
member _.DeleteByTheme themeId = deleteByTheme themeId member _.DeleteByTheme themeId = deleteByTheme themeId
member _.FindById assetId = findById assetId member _.FindById assetId = findById assetId
member _.FindByTheme themeId = findByTheme themeId member _.FindByTheme themeId = findByTheme themeId

View File

@ -7,7 +7,7 @@ open MyWebLog.Data
open Npgsql.FSharp open Npgsql.FSharp
/// PostgreSQL myWebLog uploaded file data implementation /// PostgreSQL myWebLog uploaded file data implementation
type PostgresUploadData (log : ILogger) = type PostgresUploadData(log: ILogger) =
/// The INSERT statement for an uploaded file /// The INSERT statement for an uploaded file
let upInsert = $" let upInsert = $"
@ -18,13 +18,12 @@ type PostgresUploadData (log : ILogger) =
)" )"
/// Parameters for adding an uploaded file /// Parameters for adding an uploaded file
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 (string upload.Id) "@id", Sql.string (string upload.Id)
"@path", Sql.string (string upload.Path) "@path", Sql.string (string upload.Path)
"@data", Sql.bytea upload.Data "@data", Sql.bytea upload.Data ]
]
/// Save an uploaded file /// Save an uploaded file
let add upload = let add upload =
@ -36,31 +35,39 @@ type PostgresUploadData (log : ILogger) =
log.LogTrace "Upload.delete" log.LogTrace "Upload.delete"
let idParam = [ "@id", Sql.string (string 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
(webLogIdParam webLogId :: idParam) (fun row -> row.string "path") $"SELECT path FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
(webLogIdParam webLogId :: idParam)
(fun row -> row.string "path")
if Option.isSome path then 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} 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
let findByPath path webLogId = let findByPath path webLogId =
log.LogTrace "Upload.findByPath" log.LogTrace "Upload.findByPath"
Custom.single $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path" Custom.single
[ webLogIdParam webLogId; "@path", Sql.string path ] (Map.toUpload true) $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path"
[ webLogIdParam webLogId; "@path", Sql.string path ]
(Map.toUpload true)
/// Find all uploaded files for the given web log (excludes data) /// Find all uploaded files for the given web log (excludes data)
let findByWebLog webLogId = let findByWebLog webLogId =
log.LogTrace "Upload.findByWebLog" log.LogTrace "Upload.findByWebLog"
Custom.list $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId" Custom.list
[ webLogIdParam webLogId ] (Map.toUpload false) $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId"
[ webLogIdParam webLogId ]
(Map.toUpload false)
/// Find all uploaded files for the given web log /// Find all uploaded files for the given web log
let findByWebLogWithData webLogId = let findByWebLogWithData webLogId =
log.LogTrace "Upload.findByWebLogWithData" log.LogTrace "Upload.findByWebLogWithData"
Custom.list $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId" [ webLogIdParam webLogId ] Custom.list
(Map.toUpload true) $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId"
[ webLogIdParam webLogId ]
(Map.toUpload true)
/// Restore uploads from a backup /// Restore uploads from a backup
let restore uploads = backgroundTask { let restore uploads = backgroundTask {

View File

@ -6,10 +6,10 @@ open MyWebLog
open MyWebLog.Data open MyWebLog.Data
/// PostgreSQL myWebLog web log data implementation /// PostgreSQL myWebLog web log data implementation
type PostgresWebLogData (log : ILogger) = type PostgresWebLogData(log: ILogger) =
/// Add a web log /// Add a web log
let add (webLog : WebLog) = let add (webLog: WebLog) =
log.LogTrace "WebLog.add" log.LogTrace "WebLog.add"
insert Table.WebLog webLog insert Table.WebLog webLog
@ -31,25 +31,24 @@ type PostgresWebLogData (log : ILogger) =
{Query.Delete.byContains Table.TagMap}; {Query.Delete.byContains Table.TagMap};
{Query.Delete.byContains Table.WebLogUser}; {Query.Delete.byContains Table.WebLogUser};
DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId; DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId;
DELETE FROM {Table.WebLog} WHERE id = @webLogId""" DELETE FROM {Table.WebLog} WHERE {Query.whereById "@webLogId"}"""
[ webLogIdParam webLogId; webLogContains webLogId ] [ webLogIdParam webLogId; webLogContains webLogId ]
/// Find a web log by its host (URL base) /// Find a web log by its host (URL base)
let findByHost (url : string) = let findByHost (url: string) =
log.LogTrace "WebLog.findByHost" log.LogTrace "WebLog.findByHost"
Custom.single (selectWithCriteria Table.WebLog) [ "@criteria", Query.jsonbDocParam {| UrlBase = url |} ] Find.firstByContains<WebLog> Table.WebLog {| UrlBase = url |}
fromData<WebLog>
/// Find a web log by its ID /// Find a web log by its ID
let findById (webLogId: WebLogId) = let findById (webLogId: WebLogId) =
log.LogTrace "WebLog.findById" log.LogTrace "WebLog.findById"
Find.byId<WebLog> Table.WebLog (string webLogId) Find.byId<WebLog> Table.WebLog (string webLogId)
/// Update redirect rules for a web log
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 (string webLog.Id) {| RedirectRules = webLog.RedirectRules |}
do! Update.partialById Table.WebLog (string webLog.Id) {| RedirectRules = webLog.RedirectRules |}
| None -> () | None -> ()
} }
@ -68,7 +67,7 @@ type PostgresWebLogData (log : ILogger) =
interface IWebLogData with interface IWebLogData with
member _.Add webLog = add webLog member _.Add webLog = add webLog
member _.All () = all () member _.All() = all ()
member _.Delete webLogId = delete webLogId member _.Delete webLogId = delete webLogId
member _.FindByHost url = findByHost url member _.FindByHost url = findByHost url
member _.FindById webLogId = findById webLogId member _.FindById webLogId = findById webLogId

View File

@ -7,12 +7,12 @@ open MyWebLog.Data
open Npgsql.FSharp open Npgsql.FSharp
/// PostgreSQL myWebLog user data implementation /// PostgreSQL myWebLog user data implementation
type PostgresWebLogUserData (log : ILogger) = 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 string webLogId Document.findByIdAndWebLog<WebLogUserId, WebLogUser> Table.WebLogUser userId 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 {
@ -22,10 +22,11 @@ type PostgresWebLogUserData (log : ILogger) =
let criteria = Query.whereDataContains "@criteria" let criteria = Query.whereDataContains "@criteria"
let! isAuthor = let! isAuthor =
Custom.scalar Custom.scalar
$" SELECT ( EXISTS (SELECT 1 FROM {Table.Page} WHERE {criteria} $" SELECT ( EXISTS (SELECT 1 FROM {Table.Page} WHERE {criteria})
OR EXISTS (SELECT 1 FROM {Table.Post} WHERE {criteria}) OR EXISTS (SELECT 1 FROM {Table.Post} WHERE {criteria})
) AS {existsName}" ) AS {existsName}"
[ "@criteria", Query.jsonbDocParam {| AuthorId = userId |} ] Map.toExists [ "@criteria", Query.jsonbDocParam {| AuthorId = userId |} ]
Map.toExists
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
@ -35,26 +36,27 @@ type PostgresWebLogUserData (log : ILogger) =
} }
/// Find a user by their e-mail address for the given web log /// Find a user by their e-mail address for the given web log
let findByEmail (email : string) webLogId = let findByEmail (email: string) webLogId =
log.LogTrace "WebLogUser.findByEmail" log.LogTrace "WebLogUser.findByEmail"
Custom.single (selectWithCriteria Table.WebLogUser) Find.firstByContains<WebLogUser> Table.WebLogUser {| webLogDoc webLogId with Email = email |}
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Email = email |} ]
fromData<WebLogUser>
/// Get all users for the given web log /// Get all users for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
log.LogTrace "WebLogUser.findByWebLog" log.LogTrace "WebLogUser.findByWebLog"
Custom.list Custom.list
$"{selectWithCriteria Table.WebLogUser} ORDER BY LOWER(data->>'{nameof WebLogUser.Empty.PreferredName}')" $"{selectWithCriteria Table.WebLogUser} ORDER BY LOWER(data ->> '{nameof WebLogUser.Empty.PreferredName}')"
[ 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: WebLogUserId list) = backgroundTask { let findNames webLogId (userIds: WebLogUserId list) = backgroundTask {
log.LogTrace "WebLogUser.findNames" log.LogTrace "WebLogUser.findNames"
let idSql, idParams = inClause "AND id" "id" string userIds let idSql, idParams = inClause "AND id" "id" userIds
let! users = let! users =
Custom.list $"{selectWithCriteria Table.WebLogUser} {idSql}" (webLogContains webLogId :: idParams) Custom.list
fromData<WebLogUser> $"{selectWithCriteria Table.WebLogUser} {idSql}"
(webLogContains webLogId :: idParams)
fromData<WebLogUser>
return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName }) return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName })
} }
@ -64,17 +66,16 @@ type PostgresWebLogUserData (log : ILogger) =
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 (string 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: WebLogUserId) webLogId = backgroundTask { let setLastSeen (userId: WebLogUserId) webLogId = backgroundTask {
log.LogTrace "WebLogUser.setLastSeen" log.LogTrace "WebLogUser.setLastSeen"
match! Document.existsByWebLog Table.WebLogUser userId string webLogId with match! Document.existsByWebLog Table.WebLogUser userId webLogId with
| true -> do! Update.partialById Table.WebLogUser (string userId) {| LastSeenOn = Some (Noda.now ()) |} | true -> do! Update.partialById Table.WebLogUser (string userId) {| LastSeenOn = Some (Noda.now ()) |}
| false -> () | false -> ()
} }
@ -94,4 +95,3 @@ type PostgresWebLogUserData (log : ILogger) =
member _.Restore users = restore users member _.Restore users = restore users
member _.SetLastSeen userId webLogId = setLastSeen userId webLogId member _.SetLastSeen userId webLogId = setLastSeen userId webLogId
member _.Update user = save user member _.Update user = save user

View File

@ -32,9 +32,10 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
if needsTable Table.Theme then if needsTable Table.Theme then
isNew <- true isNew <- true
Definition.createTable Table.Theme Definition.createTable Table.Theme
Definition.createKey Table.Theme
if needsTable Table.ThemeAsset then if needsTable Table.ThemeAsset then
$"CREATE TABLE {Table.ThemeAsset} ( $"CREATE TABLE {Table.ThemeAsset} (
theme_id TEXT NOT NULL REFERENCES {Table.Theme} (id) ON DELETE CASCADE, theme_id TEXT NOT NULL,
path TEXT NOT NULL, path TEXT NOT NULL,
updated_on TIMESTAMPTZ NOT NULL, updated_on TIMESTAMPTZ NOT NULL,
data BYTEA NOT NULL, data BYTEA NOT NULL,
@ -43,28 +44,32 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
// Web log table // Web log table
if needsTable Table.WebLog then if needsTable Table.WebLog then
Definition.createTable Table.WebLog Definition.createTable Table.WebLog
Definition.createKey Table.WebLog
Definition.createIndex Table.WebLog Optimized Definition.createIndex Table.WebLog Optimized
// Category table // Category table
if needsTable Table.Category then if needsTable Table.Category then
Definition.createTable Table.Category Definition.createTable Table.Category
Definition.createKey Table.Category
Definition.createIndex Table.Category Optimized Definition.createIndex Table.Category Optimized
// Web log user table // Web log user table
if needsTable Table.WebLogUser then if needsTable Table.WebLogUser then
Definition.createTable Table.WebLogUser Definition.createTable Table.WebLogUser
Definition.createKey Table.WebLogUser
Definition.createIndex Table.WebLogUser Optimized Definition.createIndex Table.WebLogUser Optimized
// Page tables // Page tables
if needsTable Table.Page then if needsTable Table.Page then
Definition.createTable Table.Page Definition.createTable Table.Page
Definition.createKey Table.Page
$"CREATE INDEX page_web_log_idx ON {Table.Page} ((data ->> '{nameof Page.Empty.WebLogId}'))" $"CREATE INDEX page_web_log_idx ON {Table.Page} ((data ->> '{nameof Page.Empty.WebLogId}'))"
$"CREATE INDEX page_author_idx ON {Table.Page} ((data ->> '{nameof Page.Empty.AuthorId}'))" $"CREATE INDEX page_author_idx ON {Table.Page} ((data ->> '{nameof Page.Empty.AuthorId}'))"
$"CREATE INDEX page_permalink_idx ON {Table.Page} $"CREATE INDEX page_permalink_idx ON {Table.Page}
((data ->> '{nameof Page.Empty.WebLogId}'), (data ->> '{nameof Page.Empty.Permalink}'))" ((data ->> '{nameof Page.Empty.WebLogId}'), (data ->> '{nameof Page.Empty.Permalink}'))"
if needsTable Table.PageRevision then if needsTable Table.PageRevision then
$"CREATE TABLE {Table.PageRevision} ( $"CREATE TABLE {Table.PageRevision} (
page_id TEXT NOT NULL REFERENCES {Table.Page} (id) ON DELETE CASCADE, page_id TEXT NOT NULL,
as_of TIMESTAMPTZ NOT NULL, as_of TIMESTAMPTZ NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (page_id, as_of))" PRIMARY KEY (page_id, as_of))"
@ -72,6 +77,7 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
// Post tables // Post tables
if needsTable Table.Post then if needsTable Table.Post then
Definition.createTable Table.Post Definition.createTable Table.Post
Definition.createKey Table.Post
$"CREATE INDEX post_web_log_idx ON {Table.Post} ((data ->> '{nameof Post.Empty.WebLogId}'))" $"CREATE INDEX post_web_log_idx ON {Table.Post} ((data ->> '{nameof Post.Empty.WebLogId}'))"
$"CREATE INDEX post_author_idx ON {Table.Post} ((data ->> '{nameof Post.Empty.AuthorId}'))" $"CREATE INDEX post_author_idx ON {Table.Post} ((data ->> '{nameof Post.Empty.AuthorId}'))"
$"CREATE INDEX post_status_idx ON {Table.Post} $"CREATE INDEX post_status_idx ON {Table.Post}
@ -83,25 +89,27 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
$"CREATE INDEX post_tag_idx ON {Table.Post} USING GIN ((data['{nameof Post.Empty.Tags}']))" $"CREATE INDEX post_tag_idx ON {Table.Post} USING GIN ((data['{nameof Post.Empty.Tags}']))"
if needsTable Table.PostRevision then if needsTable Table.PostRevision then
$"CREATE TABLE {Table.PostRevision} ( $"CREATE TABLE {Table.PostRevision} (
post_id TEXT NOT NULL REFERENCES {Table.Post} (id) ON DELETE CASCADE, post_id TEXT NOT NULL,
as_of TIMESTAMPTZ NOT NULL, as_of TIMESTAMPTZ NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (post_id, as_of))" PRIMARY KEY (post_id, as_of))"
if needsTable Table.PostComment then if needsTable Table.PostComment then
Definition.createTable Table.PostComment Definition.createTable Table.PostComment
Definition.createKey Table.PostComment
$"CREATE INDEX post_comment_post_idx ON {Table.PostComment} $"CREATE INDEX post_comment_post_idx ON {Table.PostComment}
((data ->> '{nameof Comment.Empty.PostId}'))" ((data ->> '{nameof Comment.Empty.PostId}'))"
// Tag map table // Tag map table
if needsTable Table.TagMap then if needsTable Table.TagMap then
Definition.createTable Table.TagMap Definition.createTable Table.TagMap
Definition.createKey Table.TagMap
Definition.createIndex Table.TagMap Optimized Definition.createIndex Table.TagMap Optimized
// Uploaded file table // Uploaded file table
if needsTable Table.Upload then if needsTable Table.Upload then
$"CREATE TABLE {Table.Upload} ( $"CREATE TABLE {Table.Upload} (
id TEXT NOT NULL PRIMARY KEY, id TEXT NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES {Table.WebLog} (id), web_log_id TEXT NOT NULL,
path TEXT NOT NULL, path TEXT NOT NULL,
updated_on TIMESTAMPTZ NOT NULL, updated_on TIMESTAMPTZ NOT NULL,
data BYTEA NOT NULL)" data BYTEA NOT NULL)"
@ -120,7 +128,7 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
(sql (sql
|> Seq.map (fun s -> |> Seq.map (fun s ->
let parts = s.Replace(" IF NOT EXISTS", "", System.StringComparison.OrdinalIgnoreCase).Split ' ' let parts = s.Replace(" IF NOT EXISTS", "", System.StringComparison.OrdinalIgnoreCase).Split ' '
if parts[1].ToLowerInvariant () = "table" then if parts[1].ToLowerInvariant() = "table" then
log.LogInformation $"Creating {parts[2]} table..." log.LogInformation $"Creating {parts[2]} table..."
s, [ [] ]) s, [ [] ])
|> List.ofSeq) |> List.ofSeq)
@ -150,7 +158,7 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
" - Drop all tables from the database" " - Drop all tables from the database"
" - Use this executable to restore each backup"; "" " - Use this executable to restore each backup"; ""
"Commands to back up all web logs:" "Commands to back up all web logs:"
yield! webLogs |> List.map (fun (url, slug) -> sprintf "./myWebLog backup %s v2-rc2.%s.json" url slug) yield! webLogs |> List.map (fun (url, slug) -> $"./myWebLog backup {url} v2-rc2.{slug}.json")
] ]
|> String.concat "\n" |> String.concat "\n"
|> log.LogWarning |> log.LogWarning