From 73c7a686a464928e88ffacb5dedb5d56f62fd9ff Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Thu, 18 Aug 2022 13:49:41 -0400 Subject: [PATCH] WIP on PostgreSQL data impl --- src/MyWebLog.Data/MyWebLog.Data.fsproj | 1 + .../PostgreSql/PostgreSqlCategoryData.fs | 56 ++- .../PostgreSql/PostgreSqlHelpers.fs | 58 ++- .../PostgreSql/PostgreSqlPageData.fs | 143 ++++--- .../PostgreSql/PostgreSqlPostData.fs | 115 ++--- .../PostgreSql/PostgreSqlTagMapData.fs | 54 +-- .../PostgreSql/PostgreSqlThemeData.fs | 67 +-- .../PostgreSql/PostgreSqlUploadData.fs | 30 +- .../PostgreSql/PostgreSqlWebLogData.fs | 392 ++++++++---------- .../PostgreSql/PostgreSqlWebLogUserData.fs | 151 +++++++ src/MyWebLog.Data/PostgreSqlData.fs | 336 +++++++-------- src/MyWebLog/Program.fs | 16 + 12 files changed, 799 insertions(+), 620 deletions(-) create mode 100644 src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogUserData.fs diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index 4b2d394..eec8ee5 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -39,6 +39,7 @@ + diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs index 92ffa36..4a13f9b 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs @@ -10,14 +10,14 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) = /// Count all categories for the given web log let countAll webLogId = Sql.existingConnection conn - |> Sql.query "SELECT COUNT(id) AS the_count FROM category WHERE web_log_id = @webLogId" + |> Sql.query $"SELECT COUNT(id) AS {countName} FROM category WHERE web_log_id = @webLogId" |> Sql.parameters [ webLogIdParam webLogId ] |> Sql.executeRowAsync Map.toCount /// Count all top-level categories for the given web log let countTopLevel webLogId = Sql.existingConnection conn - |> Sql.query "SELECT COUNT(id) FROM category WHERE web_log_id = @webLogId AND parent_id IS NULL" + |> Sql.query $"SELECT COUNT(id) AS {countName} FROM category WHERE web_log_id = @webLogId AND parent_id IS NULL" |> Sql.parameters [ webLogIdParam webLogId ] |> Sql.executeRowAsync Map.toCount @@ -41,13 +41,13 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) = |> inClause "id" id let postCount = Sql.existingConnection conn - |> Sql.query $""" - SELECT COUNT(DISTINCT p.id) AS the_count + |> Sql.query $" + SELECT COUNT(DISTINCT p.id) AS {countName} FROM post p INNER JOIN post_category pc ON pc.post_id = p.id WHERE p.web_log_id = @webLogId AND p.status = 'Published' - AND pc.category_id IN ({catIdSql})""" + AND pc.category_id IN ({catIdSql})" |> Sql.parameters (webLogIdParam webLogId :: catIdParams) |> Sql.executeRowAsync Map.toCount |> Async.AwaitTask @@ -66,14 +66,12 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) = |> Array.ofSeq } /// Find a category by its ID for the given web log - let findById catId webLogId = backgroundTask { - let! cat = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM category WHERE id = @id AND web_log_id = @webLogId" - |> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ] - |> Sql.executeAsync Map.toCategory - return List.tryHead cat - } + let findById catId webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM category WHERE id = @id AND web_log_id = @webLogId" + |> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ] + |> Sql.executeAsync Map.toCategory + |> tryHead /// Find all categories for the given web log let findByWebLog webLogId = @@ -88,13 +86,13 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) = match! findById catId webLogId with | Some cat -> // Reassign any children to the category's parent category - let parentParam = "@parentId", Sql.string (CategoryId.toString catId) - let! children = + let parentParam = "@parentId", Sql.string (CategoryId.toString catId) + let! hasChildren = Sql.existingConnection conn - |> Sql.query "SELECT COUNT(id) AS the_count FROM category WHERE parent_id = @parentId" + |> Sql.query $"SELECT EXISTS (SELECT 1 FROM category WHERE parent_id = @parentId) AS {existsName}" |> Sql.parameters [ parentParam ] - |> Sql.executeRowAsync Map.toCount - if children > 0 then + |> Sql.executeRowAsync Map.toExists + if hasChildren then let! _ = Sql.existingConnection conn |> Sql.query "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId" @@ -106,24 +104,24 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) = // Delete the category off all posts where it is assigned, and the category itself let! _ = Sql.existingConnection conn - |> Sql.query """ - DELETE FROM post_category - WHERE category_id = @id - AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId); - DELETE FROM category WHERE id = @id""" + |> Sql.query + "DELETE FROM post_category + WHERE category_id = @id + AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId); + DELETE FROM category WHERE id = @id" |> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ] |> Sql.executeNonQueryAsync - return if children = 0 then CategoryDeleted else ReassignedChildCategories + return if hasChildren then ReassignedChildCategories else CategoryDeleted | None -> return CategoryNotFound } /// The INSERT statement for a category - let catInsert = """ - INSERT INTO category ( + let catInsert = + "INSERT INTO category ( id, web_log_id, name, slug, description, parent_id ) VALUES ( @id, @webLogId, @name, @slug, @description, @parentId - )""" + )" /// Create parameters for a category insert / update let catParameters (cat : Category) = [ @@ -139,12 +137,12 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) = let save cat = backgroundTask { let! _ = Sql.existingConnection conn - |> Sql.query $""" + |> Sql.query $" {catInsert} ON CONFLICT (id) DO UPDATE SET name = EXCLUDED.name, slug = EXCLUDED.slug, description = EXCLUDED.description, - parent_id = EXCLUDED.parent_id""" + parent_id = EXCLUDED.parent_id" |> Sql.parameters (catParameters cat) |> Sql.executeNonQueryAsync () diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs index ed20a1e..addcf81 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs @@ -2,6 +2,7 @@ [] module MyWebLog.Data.PostgreSql.PostgreSqlHelpers +open System.Threading.Tasks open MyWebLog open Newtonsoft.Json open Npgsql.FSharp @@ -10,19 +11,11 @@ open Npgsql.FSharp let webLogIdParam webLogId = "@webLogId", Sql.string (WebLogId.toString webLogId) -/// Create the SQL and parameters to find a page or post by one or more prior permalinks -let priorPermalinkSql permalinks = - let mutable idx = 0 - permalinks - |> List.skip 1 - |> List.fold (fun (linkSql, linkParams) it -> - idx <- idx + 1 - $"{linkSql} OR prior_permalinks && ARRAY[@link{idx}]", - ($"@link{idx}", Sql.string (Permalink.toString it)) :: linkParams) - (Seq.ofList permalinks - |> Seq.map (fun it -> - "prior_permalinks && ARRAY[@link0]", [ "@link0", Sql.string (Permalink.toString it) ]) - |> Seq.head) +/// The name of the field to select to be able to use Map.toCount +let countName = "the_count" + +/// The name of the field to select to be able to use Map.toExists +let existsName = "does_exist" /// Create the SQL and parameters for an IN clause let inClause<'T> name (valueFunc: 'T -> string) (items : 'T list) = @@ -36,6 +29,26 @@ let inClause<'T> name (valueFunc: 'T -> string) (items : 'T list) = |> Seq.map (fun it -> $"@%s{name}0", [ $"@%s{name}0", Sql.string (valueFunc it) ]) |> Seq.head) +/// Create the SQL and parameters for the array equivalent of an IN clause +let arrayInClause<'T> name (valueFunc : 'T -> string) (items : 'T list) = + let mutable idx = 0 + items + |> List.skip 1 + |> List.fold (fun (itemS, itemP) it -> + idx <- idx + 1 + $"{itemS} OR %s{name} && ARRAY[@{name}{idx}]", + ($"@{name}{idx}", Sql.string (valueFunc it)) :: itemP) + (Seq.ofList items + |> Seq.map (fun it -> + $"{name} && ARRAY[@{name}0]", [ $"@{name}0", Sql.string (valueFunc it) ]) + |> Seq.head) + +/// Get the first result of the given query +let tryHead<'T> (query : Task<'T list>) = backgroundTask { + let! results = query + return List.tryHead results +} + /// Mapping functions for SQL queries module Map = @@ -55,7 +68,7 @@ module Map = /// Get a count from a row let toCount (row : RowReader) = - row.int "the_count" + row.int countName /// Create a custom feed from the current row let toCustomFeed (row : RowReader) : CustomFeed = @@ -88,7 +101,7 @@ module Map = /// Get a true/false value as to whether an item exists let toExists (row : RowReader) = - row.bool "does_exist" + row.bool existsName /// Create a meta item from the current row let toMetaItem (row : RowReader) : MetaItem = @@ -213,3 +226,18 @@ module Map = } } + /// Create a web log user from the current row + let toWebLogUser (row : RowReader) : WebLogUser = + { Id = row.string "id" |> WebLogUserId + WebLogId = row.string "web_log_id" |> WebLogId + Email = row.string "email" + FirstName = row.string "first_name" + LastName = row.string "last_name" + PreferredName = row.string "preferred_name" + PasswordHash = row.string "password_hash" + Salt = row.uuid "salt" + Url = row.stringOrNone "url" + AccessLevel = row.string "access_level" |> AccessLevel.parse + CreatedOn = row.dateTime "created_on" + LastSeenOn = row.dateTimeOrNone "last_seen_on" + } diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs index 826dc4b..1a099fe 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs @@ -55,6 +55,13 @@ type PostgreSqlPageData (conn : NpgsqlConnection) = () } + /// Does the given page exist? + let pageExists pageId webLogId = + Sql.existingConnection conn + |> Sql.query $"SELECT EXISTS (SELECT 1 FROM page WHERE id = @id AND web_log_id = @webLogId) AS {existsName}" + |> Sql.parameters [ "@id", Sql.string (PageId.toString pageId); webLogIdParam webLogId ] + |> Sql.executeRowAsync Map.toExists + // IMPLEMENTATION FUNCTIONS /// Get all pages for a web log (without text, revisions, prior permalinks, or metadata) @@ -67,26 +74,28 @@ type PostgreSqlPageData (conn : NpgsqlConnection) = /// Count all pages for the given web log let countAll webLogId = Sql.existingConnection conn - |> Sql.query "SELECT COUNT(id) AS the_count FROM page WHERE web_log_id = @webLogId" + |> Sql.query $"SELECT COUNT(id) AS {countName} FROM page WHERE web_log_id = @webLogId" |> Sql.parameters [ webLogIdParam webLogId ] |> Sql.executeRowAsync Map.toCount /// Count all pages shown in the page list for the given web log let countListed webLogId = Sql.existingConnection conn - |> Sql.query "SELECT COUNT(id) AS the_count FROM page WHERE web_log_id = @webLogId AND is_in_page_list = TRUE" + |> Sql.query $" + SELECT COUNT(id) AS {countName} + FROM page + WHERE web_log_id = @webLogId + AND is_in_page_list = TRUE" |> Sql.parameters [ webLogIdParam webLogId ] |> Sql.executeRowAsync Map.toCount /// Find a page by its ID (without revisions) - let findById pageId webLogId = backgroundTask { - let! page = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM page WHERE id = @id AND web_log_id = @webLogId" - |> Sql.parameters [ "@id", Sql.string (PageId.toString pageId); webLogIdParam webLogId ] - |> Sql.executeAsync Map.toPage - return List.tryHead page - } + let findById pageId webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM page WHERE id = @id AND web_log_id = @webLogId" + |> Sql.parameters [ "@id", Sql.string (PageId.toString pageId); webLogIdParam webLogId ] + |> Sql.executeAsync Map.toPage + |> tryHead /// Find a complete page by its ID let findFullById pageId webLogId = backgroundTask { @@ -99,40 +108,38 @@ type PostgreSqlPageData (conn : NpgsqlConnection) = /// Delete a page by its ID let delete pageId webLogId = backgroundTask { - match! findById pageId webLogId with - | Some _ -> + match! pageExists pageId webLogId with + | true -> let! _ = Sql.existingConnection conn - |> Sql.query """ - DELETE FROM page_revision WHERE page_id = @id; - DELETE FROM page WHERE id = @id""" + |> Sql.query + "DELETE FROM page_revision WHERE page_id = @id; + DELETE FROM page WHERE id = @id" |> Sql.parameters [ "@id", Sql.string (PageId.toString pageId) ] |> Sql.executeNonQueryAsync return true - | None -> return false + | false -> return false } /// Find a page by its permalink for the given web log - let findByPermalink permalink webLogId = backgroundTask { - let! page = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link" - |> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ] - |> Sql.executeAsync Map.toPage - return List.tryHead page - } + let findByPermalink permalink webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link" + |> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ] + |> Sql.executeAsync Map.toPage + |> tryHead /// Find the current permalink within a set of potential prior permalinks for the given web log let findCurrentPermalink permalinks webLogId = backgroundTask { if List.isEmpty permalinks then return None else - let linkSql, linkParams = priorPermalinkSql permalinks - let! links = + let linkSql, linkParams = arrayInClause "prior_permalinks" Permalink.toString permalinks + return! Sql.existingConnection conn |> Sql.query $"SELECT permalink FROM page WHERE web_log_id = @webLogId AND ({linkSql})" |> Sql.parameters (webLogIdParam webLogId :: linkParams) |> Sql.executeAsync Map.toPermalink - return List.tryHead links + |> tryHead } /// Get all complete pages for the given web log @@ -144,12 +151,12 @@ type PostgreSqlPageData (conn : NpgsqlConnection) = |> Sql.executeAsync Map.toPage let! revisions = Sql.existingConnection conn - |> Sql.query """ - SELECT * - FROM page_revision pr - INNER JOIN page p ON p.id = pr.page_id - WHERE p.web_log_id = @webLogId - ORDER BY pr.as_of DESC""" + |> Sql.query + "SELECT * + FROM page_revision pr + INNER JOIN page p ON p.id = pr.page_id + WHERE p.web_log_id = @webLogId + ORDER BY pr.as_of DESC" |> Sql.parameters [ webLogIdParam webLogId ] |> Sql.executeAsync (fun row -> PageId (row.string "page_id"), Map.toRevision row) return @@ -168,24 +175,24 @@ type PostgreSqlPageData (conn : NpgsqlConnection) = /// Get a page of pages for the given web log (without revisions) let findPageOfPages webLogId pageNbr = Sql.existingConnection conn - |> Sql.query""" - SELECT * - FROM page - WHERE web_log_id = @webLogId - ORDER BY LOWER(title) - LIMIT @pageSize OFFSET @toSkip""" + |> Sql.query + "SELECT * + FROM page + WHERE web_log_id = @webLogId + ORDER BY LOWER(title) + LIMIT @pageSize OFFSET @toSkip" |> Sql.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ] |> Sql.executeAsync Map.toPage /// The INSERT statement for a page - let pageInsert = """ - INSERT INTO page ( + let pageInsert = + "INSERT INTO page ( id, web_log_id, author_id, title, permalink, prior_permalinks, published_on, updated_on, is_in_page_list, template, page_text, meta_items ) VALUES ( @id, @webLogId, @authorId, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn, @isInPageList, @template, @text, @metaItems - )""" + )" /// The parameters for saving a page let pageParams (page : Page) = [ @@ -203,29 +210,6 @@ type PostgreSqlPageData (conn : NpgsqlConnection) = "@priorPermalinks", Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) ] - /// Save a page - let save (page : Page) = backgroundTask { - let! oldPage = findFullById page.Id page.WebLogId - let! _ = - Sql.existingConnection conn - |> Sql.query $""" - {pageInsert} ON CONFLICT (id) DO UPDATE - SET author_id = EXCLUDED.author_id, - title = EXCLUDED.title, - permalink = EXCLUDED.permalink, - prior_permalinks = EXCLUDED.prior_permalinks, - published_on = EXCLUDED.published_on, - updated_on = EXCLUDED.updated_on, - is_in_page_list = EXCLUDED.is_in_page_list, - template = EXCLUDED.template, - page_text = EXCLUDED.text, - meta_items = EXCLUDED.meta_items""" - |> Sql.parameters (pageParams page) - |> Sql.executeNonQueryAsync - do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions - () - } - /// Restore pages from a backup let restore (pages : Page list) = backgroundTask { let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r)) @@ -238,10 +222,33 @@ type PostgreSqlPageData (conn : NpgsqlConnection) = () } + /// Save a page + let save (page : Page) = backgroundTask { + let! oldPage = findFullById page.Id page.WebLogId + let! _ = + Sql.existingConnection conn + |> Sql.query $" + {pageInsert} ON CONFLICT (id) DO UPDATE + SET author_id = EXCLUDED.author_id, + title = EXCLUDED.title, + permalink = EXCLUDED.permalink, + prior_permalinks = EXCLUDED.prior_permalinks, + published_on = EXCLUDED.published_on, + updated_on = EXCLUDED.updated_on, + is_in_page_list = EXCLUDED.is_in_page_list, + template = EXCLUDED.template, + page_text = EXCLUDED.text, + meta_items = EXCLUDED.meta_items" + |> Sql.parameters (pageParams page) + |> Sql.executeNonQueryAsync + do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions + () + } + /// Update a page's prior permalinks let updatePriorPermalinks pageId webLogId permalinks = backgroundTask { - match! findById pageId webLogId with - | Some _ -> + match! pageExists pageId webLogId with + | true -> let! _ = Sql.existingConnection conn |> Sql.query "UPDATE page SET prior_permalinks = @prior WHERE id = @id" @@ -250,7 +257,7 @@ type PostgreSqlPageData (conn : NpgsqlConnection) = "@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ] |> Sql.executeNonQueryAsync return true - | None -> return false + | false -> return false } interface IPageData with diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs index 1d4da91..da694c1 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs @@ -24,8 +24,8 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = /// The SELECT statement for a post that will include category IDs let selectPost = - """SELECT *, ARRAY(SELECT cat.category_id FROM post_category cat WHERE cat.post_id = p.id) AS category_ids - FROM post""" + "SELECT *, ARRAY(SELECT cat.category_id FROM post_category cat WHERE cat.post_id = p.id) AS category_ids + FROM post" /// Return a post with no revisions, prior permalinks, or text let postWithoutText row = @@ -86,34 +86,37 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = () } + /// Does the given post exist? + let postExists postId webLogId = + Sql.existingConnection conn + |> Sql.query $"SELECT EXISTS (SELECT 1 FROM post WHERE id = @id AND web_log_id = @webLogId) AS {existsName}" + |> Sql.parameters [ "@id", Sql.string (PostId.toString postId); webLogIdParam webLogId ] + |> Sql.executeRowAsync Map.toExists + // IMPLEMENTATION FUNCTIONS /// Count posts in a status for the given web log let countByStatus status webLogId = Sql.existingConnection conn - |> Sql.query "SELECT COUNT(id) AS the_count FROM post WHERE web_log_id = @webLogId AND status = @status" + |> Sql.query $"SELECT COUNT(id) AS {countName} FROM post WHERE web_log_id = @webLogId AND status = @status" |> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString status) ] |> Sql.executeRowAsync Map.toCount /// Find a post by its ID for the given web log (excluding revisions) - let findById postId webLogId = backgroundTask { - let! post = - Sql.existingConnection conn - |> Sql.query $"{selectPost} WHERE id = @id AND web_log_id = @webLogId" - |> Sql.parameters [ "@id", Sql.string (PostId.toString postId); webLogIdParam webLogId ] - |> Sql.executeAsync Map.toPost - return List.tryHead post - } + let findById postId webLogId = + Sql.existingConnection conn + |> Sql.query $"{selectPost} WHERE id = @id AND web_log_id = @webLogId" + |> Sql.parameters [ "@id", Sql.string (PostId.toString postId); webLogIdParam webLogId ] + |> Sql.executeAsync Map.toPost + |> tryHead /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks) - let findByPermalink permalink webLogId = backgroundTask { - let! post = - Sql.existingConnection conn - |> Sql.query $"{selectPost} WHERE web_log_id = @webLogId AND permalink = @link" - |> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ] - |> Sql.executeAsync Map.toPost - return List.tryHead post - } + let findByPermalink permalink webLogId = + Sql.existingConnection conn + |> Sql.query $"{selectPost} WHERE web_log_id = @webLogId AND permalink = @link" + |> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ] + |> Sql.executeAsync Map.toPost + |> tryHead /// Find a complete post by its ID for the given web log let findFullById postId webLogId = backgroundTask { @@ -126,31 +129,31 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = /// Delete a post by its ID for the given web log let delete postId webLogId = backgroundTask { - match! findById postId webLogId with - | Some _ -> + match! postExists postId webLogId with + | true -> let! _ = Sql.existingConnection conn - |> Sql.query """ - DELETE FROM post_revision WHERE post_id = @id; - DELETE FROM post_category WHERE post_id = @id; - DELETE FROM post WHERE id = @id""" + |> Sql.query + "DELETE FROM post_revision WHERE post_id = @id; + DELETE FROM post_category WHERE post_id = @id; + DELETE FROM post WHERE id = @id" |> Sql.parameters [ "@id", Sql.string (PostId.toString postId) ] |> Sql.executeNonQueryAsync return true - | None -> return false + | false -> return false } /// Find the current permalink from a list of potential prior permalinks for the given web log let findCurrentPermalink permalinks webLogId = backgroundTask { if List.isEmpty permalinks then return None else - let linkSql, linkParams = priorPermalinkSql permalinks - let! links = + let linkSql, linkParams = arrayInClause "prior_permalinks" Permalink.toString permalinks + return! Sql.existingConnection conn |> Sql.query $"SELECT permalink FROM post WHERE web_log_id = @webLogId AND ({linkSql}" |> Sql.parameters (webLogIdParam webLogId :: linkParams) |> Sql.executeAsync Map.toPermalink - return List.tryHead links + |> tryHead } /// Get all complete posts for the given web log @@ -162,12 +165,12 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = |> Sql.executeAsync Map.toPost let! revisions = Sql.existingConnection conn - |> Sql.query """ - SELECT * - FROM post_revision pr - INNER JOIN post p ON p.id = pr.post_id - WHERE p.web_log_id = @webLogId - ORDER BY as_of DESC""" + |> Sql.query + "SELECT * + FROM post_revision pr + INNER JOIN post p ON p.id = pr.post_id + WHERE p.web_log_id = @webLogId + ORDER BY as_of DESC" |> Sql.parameters [ webLogIdParam webLogId ] |> Sql.executeAsync (fun row -> PostId (row.string "post_id"), Map.toRevision row) return @@ -180,14 +183,14 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = let catSql, catParams = inClause "catId" CategoryId.toString categoryIds Sql.existingConnection conn - |> Sql.query $""" + |> Sql.query $" {selectPost} p INNER JOIN post_category pc ON pc.post_id = p.id WHERE p.web_log_id = @webLogId AND p.status = @status AND pc.category_id IN ({catSql}) ORDER BY published_on DESC - LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" + LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" |> Sql.parameters [ webLogIdParam webLogId "@status", Sql.string (PostStatus.toString Published) @@ -197,36 +200,36 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = /// Get a page of posts for the given web log (excludes text and revisions) let findPageOfPosts webLogId pageNbr postsPerPage = Sql.existingConnection conn - |> Sql.query $""" + |> Sql.query $" {selectPost} WHERE web_log_id = @webLogId ORDER BY published_on DESC NULLS FIRST, updated_on - LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" + LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" |> Sql.parameters [ webLogIdParam webLogId ] |> Sql.executeAsync postWithoutText /// Get a page of published posts for the given web log (excludes revisions) let findPageOfPublishedPosts webLogId pageNbr postsPerPage = Sql.existingConnection conn - |> Sql.query $""" + |> Sql.query $" {selectPost} WHERE web_log_id = @webLogId AND status = @status ORDER BY published_on DESC - LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" + LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" |> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString Published) ] |> Sql.executeAsync Map.toPost /// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks) let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = Sql.existingConnection conn - |> Sql.query $""" + |> Sql.query $" {selectPost} WHERE web_log_id = @webLogId AND status = @status AND tag && ARRAY[@tag] ORDER BY published_on DESC - LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" + LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" |> Sql.parameters [ webLogIdParam webLogId "@status", Sql.string (PostStatus.toString Published) @@ -238,43 +241,43 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask { let queryParams = Sql.parameters [ webLogIdParam webLogId - "@status", Sql.string (PostStatus.toString Published) + "@status", Sql.string (PostStatus.toString Published) "@publishedOn", Sql.timestamptz publishedOn ] let! older = Sql.existingConnection conn - |> Sql.query $""" + |> Sql.query $" {selectPost} WHERE web_log_id = @webLogId AND status = @status AND published_on < @publishedOn ORDER BY published_on DESC - LIMIT 1""" + LIMIT 1" |> queryParams |> Sql.executeAsync Map.toPost let! newer = Sql.existingConnection conn - |> Sql.query $""" + |> Sql.query $" {selectPost} WHERE web_log_id = @webLogId AND status = @status AND published_on > @publishedOn ORDER BY published_on - LIMIT 1""" + LIMIT 1" |> queryParams |> Sql.executeAsync Map.toPost return List.tryHead older, List.tryHead newer } /// The INSERT statement for a post - let postInsert = """ - INSERT INTO post ( + let postInsert = + "INSERT INTO post ( id, web_log_id, author_id, status, title, permalink, prior_permalinks, published_on, updated_on, template, post_text, tags, meta_items, episode ) VALUES ( @id, @webLogId, @authorId, @status, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn, @template, @text, @tags, @metaItems, @episode - )""" + )" /// The parameters for saving a post let postParams (post : Post) = [ @@ -301,7 +304,7 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = let! oldPost = findFullById post.Id post.WebLogId let! _ = Sql.existingConnection conn - |> Sql.query $""" + |> Sql.query $" {postInsert} ON CONFLICT (id) DO UPDATE SET author_id = EXCLUDED.author_id, status = EXCLUDED.status, @@ -314,7 +317,7 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = post_text = EXCLUDED.text, tags = EXCLUDED.tags, meta_items = EXCLUDED.meta_items, - episode = EXCLUDED.episode""" + episode = EXCLUDED.episode" |> Sql.parameters (postParams post) |> Sql.executeNonQueryAsync do! updatePostCategories post.Id (match oldPost with Some p -> p.CategoryIds | None -> []) post.CategoryIds @@ -337,8 +340,8 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = /// Update prior permalinks for a post let updatePriorPermalinks postId webLogId permalinks = backgroundTask { - match! findById postId webLogId with - | Some _ -> + match! postExists postId webLogId with + | true -> let! _ = Sql.existingConnection conn |> Sql.query "UPDATE post SET prior_permalinks = @prior WHERE id = @id" @@ -347,7 +350,7 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = "@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ] |> Sql.executeNonQueryAsync return true - | None -> return false + | false -> return false } interface IPostData with diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs index 4287086..dce9f4a 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs @@ -9,37 +9,41 @@ open Npgsql.FSharp type PostgreSqlTagMapData (conn : NpgsqlConnection) = /// Find a tag mapping by its ID for the given web log - let findById tagMapId webLogId = backgroundTask { - let! tagMap = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM tag_map WHERE id = @id AND web_log_id = @webLogId" - |> Sql.parameters [ "@id", Sql.string (TagMapId.toString tagMapId); webLogIdParam webLogId ] - |> Sql.executeAsync Map.toTagMap - return List.tryHead tagMap - } + let findById tagMapId webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM tag_map WHERE id = @id AND web_log_id = @webLogId" + |> Sql.parameters [ "@id", Sql.string (TagMapId.toString tagMapId); webLogIdParam webLogId ] + |> Sql.executeAsync Map.toTagMap + |> tryHead /// Delete a tag mapping for the given web log let delete tagMapId webLogId = backgroundTask { - match! findById tagMapId webLogId with - | Some _ -> + let idParams = [ "@id", Sql.string (TagMapId.toString tagMapId) ] + let! exists = + Sql.existingConnection conn + |> Sql.query $" + SELECT EXISTS + (SELECT 1 FROM tag_map WHERE id = @id AND web_log_id = @webLogId) + AS {existsName}" + |> Sql.parameters (webLogIdParam webLogId :: idParams) + |> Sql.executeRowAsync Map.toExists + if exists then let! _ = Sql.existingConnection conn |> Sql.query "DELETE FROM tag_map WHERE id = @id" - |> Sql.parameters [ "@id", Sql.string (TagMapId.toString tagMapId) ] + |> Sql.parameters idParams |> Sql.executeNonQueryAsync return true - | None -> return false + else return false } /// Find a tag mapping by its URL value for the given web log - let findByUrlValue urlValue webLogId = backgroundTask { - let! tagMap = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue" - |> Sql.parameters [ webLogIdParam webLogId; "@urlValue", Sql.string urlValue ] - |> Sql.executeAsync Map.toTagMap - return List.tryHead tagMap - } + let findByUrlValue urlValue webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue" + |> Sql.parameters [ webLogIdParam webLogId; "@urlValue", Sql.string urlValue ] + |> Sql.executeAsync Map.toTagMap + |> tryHead /// Get all tag mappings for the given web log let findByWebLog webLogId = @@ -57,12 +61,12 @@ type PostgreSqlTagMapData (conn : NpgsqlConnection) = |> Sql.executeAsync Map.toTagMap /// The INSERT statement for a tag mapping - let tagMapInsert = """ - INSERT INTO tag_map ( + let tagMapInsert = + "INSERT INTO tag_map ( id, web_log_id, tag, url_value ) VALUES ( @id, @webLogId, @tag, @urlValue - )""" + )" /// The parameters for saving a tag mapping let tagMapParams (tagMap : TagMap) = [ @@ -76,10 +80,10 @@ type PostgreSqlTagMapData (conn : NpgsqlConnection) = let save tagMap = backgroundTask { let! _ = Sql.existingConnection conn - |> Sql.query $""" + |> Sql.query $" {tagMapInsert} ON CONFLICT (id) DO UPDATE SET tag = EXCLUDED.tag, - url_value = EXCLUDED.url_value""" + url_value = EXCLUDED.url_value" |> Sql.parameters (tagMapParams tagMap) |> Sql.executeNonQueryAsync () diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs index 35f5501..8c7c2f3 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs @@ -34,20 +34,20 @@ type PostgreSqlThemeData (conn : NpgsqlConnection) = /// Find a theme by its ID let findById themeId = backgroundTask { let themeIdParam = [ "@id", Sql.string (ThemeId.toString themeId) ] - let! tryTheme = + let! theme = Sql.existingConnection conn |> Sql.query "SELECT * FROM theme WHERE id = @id" |> Sql.parameters themeIdParam |> Sql.executeAsync Map.toTheme - match List.tryHead tryTheme with - | Some theme -> + |> tryHead + if Option.isSome theme then let! templates = Sql.existingConnection conn |> Sql.query "SELECT * FROM theme_template WHERE theme_id = @id" |> Sql.parameters themeIdParam |> Sql.executeAsync (Map.toThemeTemplate true) - return Some { theme with Templates = templates } - | None -> return None + return Some { theme.Value with Templates = templates } + else return None } /// Find a theme by its ID (excludes the text of templates) @@ -62,18 +62,23 @@ type PostgreSqlThemeData (conn : NpgsqlConnection) = /// Delete a theme by its ID let delete themeId = backgroundTask { - match! findByIdWithoutText themeId with - | Some _ -> + let idParams = [ "@id", Sql.string (ThemeId.toString themeId) ] + let! exists = + Sql.existingConnection conn + |> Sql.query $"SELECT EXISTS (SELECT 1 FROM theme WHERE id = @id) AS {existsName}" + |> Sql.parameters idParams + |> Sql.executeRowAsync Map.toExists + if exists then let! _ = Sql.existingConnection conn - |> Sql.query """ - DELETE FROM theme_asset WHERE theme_id = @id; - DELETE FROM theme_template WHERE theme_id = @id; - DELETE FROM theme WHERE id = @id""" - |> Sql.parameters [ "@id", Sql.string (ThemeId.toString themeId) ] + |> Sql.query + "DELETE FROM theme_asset WHERE theme_id = @id; + DELETE FROM theme_template WHERE theme_id = @id; + DELETE FROM theme WHERE id = @id" + |> Sql.parameters idParams |> Sql.executeNonQueryAsync return true - | None -> return false + else return false } /// Save a theme @@ -82,11 +87,11 @@ type PostgreSqlThemeData (conn : NpgsqlConnection) = let themeIdParam = Sql.string (ThemeId.toString theme.Id) let! _ = Sql.existingConnection conn - |> Sql.query """ - INSERT INTO theme VALUES (@id, @name, @version) - ON CONFLICT (id) DO UPDATE - SET name = EXCLUDED.name, - version = EXCLUDED.version""" + |> Sql.query + "INSERT INTO theme VALUES (@id, @name, @version) + ON CONFLICT (id) DO UPDATE + SET name = EXCLUDED.name, + version = EXCLUDED.version" |> Sql.parameters [ "@id", themeIdParam "@name", Sql.string theme.Name @@ -108,9 +113,9 @@ type PostgreSqlThemeData (conn : NpgsqlConnection) = "DELETE FROM theme_template WHERE theme_id = @themeId AND name = @name", toDelete |> List.map (fun tmpl -> [ "@themeId", themeIdParam; "@name", Sql.string tmpl.Name ]) if not (List.isEmpty toAddOrUpdate) then - """INSERT INTO theme_template VALUES (@themeId, @name, @template) - ON CONFLICT (theme_id, name) DO UPDATE - SET template = EXCLUDED.template""", + "INSERT INTO theme_template VALUES (@themeId, @name, @template) + ON CONFLICT (theme_id, name) DO UPDATE + SET template = EXCLUDED.template", toAddOrUpdate |> List.map (fun tmpl -> [ "@themeId", themeIdParam "@name", Sql.string tmpl.Name @@ -149,15 +154,13 @@ type PostgreSqlThemeAssetData (conn : NpgsqlConnection) = } /// Find a theme asset by its ID - let findById assetId = backgroundTask { + let findById assetId = let (ThemeAssetId (ThemeId themeId, path)) = assetId - let! asset = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId AND path = @path" - |> Sql.parameters [ "@themeId", Sql.string themeId; "@path", Sql.string path ] - |> Sql.executeAsync (Map.toThemeAsset true) - return List.tryHead asset - } + Sql.existingConnection conn + |> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId AND path = @path" + |> Sql.parameters [ "@themeId", Sql.string themeId; "@path", Sql.string path ] + |> Sql.executeAsync (Map.toThemeAsset true) + |> tryHead /// Get theme assets for the given theme (excludes data) let findByTheme themeId = @@ -178,14 +181,14 @@ type PostgreSqlThemeAssetData (conn : NpgsqlConnection) = let (ThemeAssetId (ThemeId themeId, path)) = asset.Id let! _ = Sql.existingConnection conn - |> Sql.query """ - INSERT INTO theme_asset ( + |> Sql.query + "INSERT INTO theme_asset ( theme_id, path, updated_on, data ) VALUES ( @themeId, @path, @updatedOn, @data ) ON CONFLICT (theme_id, path) DO UPDATE SET updated_on = EXCLUDED.updated_on, - data = EXCLUDED.data""" + data = EXCLUDED.data" |> Sql.parameters [ "@themeId", Sql.string themeId "@path", Sql.string path diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs index b509f02..b92a5f0 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs @@ -9,12 +9,12 @@ open Npgsql.FSharp type PostgreSqlUploadData (conn : NpgsqlConnection) = /// The INSERT statement for an uploaded file - let upInsert = """ - INSERT INTO upload ( + let upInsert = + "INSERT INTO upload ( id, web_log_id, path, updated_on, data ) VALUES ( @id, @webLogId, @path, @updatedOn, @data - )""" + )" /// Parameters for adding an uploaded file let upParams (upload : Upload) = [ @@ -38,31 +38,29 @@ type PostgreSqlUploadData (conn : NpgsqlConnection) = /// Delete an uploaded file by its ID let delete uploadId webLogId = backgroundTask { let theParams = [ "@id", Sql.string (UploadId.toString uploadId); webLogIdParam webLogId ] - let! tryPath = + let! path = Sql.existingConnection conn |> Sql.query "SELECT path FROM upload WHERE id = @id AND web_log_id = @webLogId" |> Sql.parameters theParams |> Sql.executeAsync (fun row -> row.string "path") - match List.tryHead tryPath with - | Some path -> + |> tryHead + if Option.isSome path then let! _ = Sql.existingConnection conn |> Sql.query "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId" |> Sql.parameters theParams |> Sql.executeNonQueryAsync - return Ok path - | None -> return Error $"""Upload ID {UploadId.toString uploadId} not found""" + return Ok path.Value + else return Error $"""Upload ID {UploadId.toString uploadId} not found""" } /// Find an uploaded file by its path for the given web log - let findByPath (path : string) webLogId = backgroundTask { - let! upload = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId AND path = @path" - |> Sql.parameters [ webLogIdParam webLogId; "@path", Sql.string path ] - |> Sql.executeAsync (Map.toUpload true) - return List.tryHead upload - } + let findByPath path webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId AND path = @path" + |> Sql.parameters [ webLogIdParam webLogId; "@path", Sql.string path ] + |> Sql.executeAsync (Map.toUpload true) + |> tryHead /// Find all uploaded files for the given web log (excludes data) let findByWebLog webLogId = diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs index 2f298f4..e6b0b53 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs @@ -5,56 +5,44 @@ open MyWebLog.Data open Npgsql open Npgsql.FSharp -// The web log podcast insert loop is not statically compilable; this is OK -//#nowarn "3511" - /// PostgreSQL myWebLog web log data implementation type PostgreSqlWebLogData (conn : NpgsqlConnection) = // SUPPORT FUNCTIONS - /// Add parameters for web log INSERT or web log/RSS options UPDATE statements - let addWebLogRssParameters (webLog : WebLog) = - [ cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled) - cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName) - cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed) - cmd.Parameters.AddWithValue ("@isCategoryEnabled", webLog.Rss.IsCategoryEnabled) - cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled) - cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright) - ] |> ignore + /// The parameters for web log INSERT or web log/RSS options UPDATE statements + let rssParams (webLog : WebLog) = [ + "@isFeedEnabled", Sql.bool webLog.Rss.IsFeedEnabled + "@feedName", Sql.string webLog.Rss.FeedName + "@itemsInFeed", Sql.intOrNone webLog.Rss.ItemsInFeed + "@isCategoryEnabled", Sql.bool webLog.Rss.IsCategoryEnabled + "@isTagEnabled", Sql.bool webLog.Rss.IsTagEnabled + "@copyright", Sql.stringOrNone webLog.Rss.Copyright + ] - /// Add parameters for web log INSERT or UPDATE statements - let addWebLogParameters (webLog : WebLog) = - [ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) - cmd.Parameters.AddWithValue ("@name", webLog.Name) - cmd.Parameters.AddWithValue ("@slug", webLog.Slug) - cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle) - cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage) - cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage) - cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId) - cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase) - cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone) - cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx) - cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads) - ] |> ignore - addWebLogRssParameters cmd webLog + /// The parameters for web log INSERT or UPDATE statements + let webLogParams (webLog : WebLog) = [ + "@id", Sql.string (WebLogId.toString webLog.Id) + "@name", Sql.string webLog.Name + "@slug", Sql.string webLog.Slug + "@subtitle", Sql.stringOrNone webLog.Subtitle + "@defaultPage", Sql.string webLog.DefaultPage + "@postsPerPage", Sql.int webLog.PostsPerPage + "@themeId", Sql.string (ThemeId.toString webLog.ThemeId) + "@urlBase", Sql.string webLog.UrlBase + "@timeZone", Sql.string webLog.TimeZone + "@autoHtmx", Sql.bool webLog.AutoHtmx + "@uploads", Sql.string (UploadDestination.toString webLog.Uploads) + yield! rssParams webLog + ] - /// Add parameters for custom feed INSERT or UPDATE statements - let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) = - [ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.Id) - cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) - cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source) - cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path) - ] |> ignore + /// The SELECT statement for custom feeds, which includes podcast feed settings if present + let feedSelect = "SELECT f.*, p.* FROM web_log_feed f LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id" /// Get the current custom feeds for a web log let getCustomFeeds (webLog : WebLog) = Sql.existingConnection conn - |> Sql.query """ - SELECT f.*, p.* - FROM web_log_feed f - LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id - WHERE f.web_log_id = @webLogId""" + |> Sql.query $"{feedSelect} WHERE f.web_log_id = @webLogId" |> Sql.parameters [ webLogIdParam webLog.Id ] |> Sql.executeAsync Map.toCustomFeed @@ -64,20 +52,8 @@ type PostgreSqlWebLogData (conn : NpgsqlConnection) = return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } } } - /// The INSERT statement for a podcast feed - let feedInsert = """ - INSERT INTO web_log_feed_podcast ( - feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url, apple_category, - apple_subcategory, explicit, default_media_type, media_base_url, podcast_guid, funding_url, funding_text, - medium - ) VALUES ( - @feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl, @appleCategory, - @appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @podcastGuid, @fundingUrl, @fundingText, - @medium - )""" - /// The parameters to save a podcast feed - let feedParams feedId (podcast : PodcastOptions) = [ + let podcastParams feedId (podcast : PodcastOptions) = [ "@feedId", Sql.string (CustomFeedId.toString feedId) "@title", Sql.string podcast.Title "@subtitle", Sql.stringOrNone podcast.Subtitle @@ -97,127 +73,115 @@ type PostgreSqlWebLogData (conn : NpgsqlConnection) = "@medium", Sql.stringOrNone (podcast.Medium |> Option.map PodcastMedium.toString) ] - /// Save a podcast for a custom feed - let savePodcast feedId (podcast : PodcastOptions) = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query $""" - {feedInsert} ON CONFLICT (feed_id) DO UPDATE - SET title = EXCLUDED.title, - subtitle = EXCLUDED.subtitle, - items_in_feed = EXCLUDED.items_in_feed, - summary = EXCLUDED.summary, - displayed_author = EXCLUDED.displayed_author, - email = EXCLUDED.email, - image_url = EXCLUDED.image_url, - apple_category = EXCLUDED.apple_category, - apple_subcategory = EXCLUDED.apple_subcategory, - explicit = EXCLUDED.explicit, - default_media_type = EXCLUDED.default_media_type, - media_base_url = EXCLUDED.media_base_url, - podcast_guid = EXCLUDED.podcast_guid, - funding_url = EXCLUDED.funding_url, - funding_text = EXCLUDED.funding_text, - medium = EXCLUDED.medium""" - |> Sql.parameters (feedParams feedId podcast) - |> Sql.executeNonQueryAsync - () - } - + /// The parameters to save a custom feed + let feedParams webLogId (feed : CustomFeed) = [ + webLogIdParam webLogId + "@id", Sql.string (CustomFeedId.toString feed.Id) + "@source", Sql.string (CustomFeedSource.toString feed.Source) + "@path", Sql.string (Permalink.toString feed.Path) + ] + /// Update the custom feeds for a web log let updateCustomFeeds (webLog : WebLog) = backgroundTask { let! feeds = getCustomFeeds webLog - let toDelete, toAdd = Utils.diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}") + let toDelete, _ = Utils.diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}") let toId (feed : CustomFeed) = feed.Id - let toUpdate = - webLog.Rss.CustomFeeds - |> List.filter (fun f -> - not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.Id)) - use cmd = conn.CreateCommand () - cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore - toDelete - |> List.map (fun it -> backgroundTask { - cmd.CommandText <- """ - DELETE FROM web_log_feed_podcast WHERE feed_id = @id; - DELETE FROM web_log_feed WHERE id = @id""" - cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id - do! write cmd - }) - |> Task.WhenAll - |> ignore - cmd.Parameters.Clear () - toAdd - |> List.map (fun it -> backgroundTask { - cmd.CommandText <- """ - INSERT INTO web_log_feed ( - id, web_log_id, source, path - ) VALUES ( - @id, @webLogId, @source, @path - )""" - cmd.Parameters.Clear () - addCustomFeedParameters cmd webLog.Id it - do! write cmd - match it.Podcast with - | Some podcast -> do! addPodcast it.Id podcast - | None -> () - }) - |> Task.WhenAll - |> ignore - toUpdate - |> List.map (fun it -> backgroundTask { - cmd.CommandText <- """ - UPDATE web_log_feed - SET source = @source, - path = @path - WHERE id = @id - AND web_log_id = @webLogId""" - cmd.Parameters.Clear () - addCustomFeedParameters cmd webLog.Id it - do! write cmd - let hadPodcast = Option.isSome (feeds |> List.find (fun f -> f.Id = it.Id)).Podcast - match it.Podcast with - | Some podcast -> do! savePodcast it.Id podcast - | None -> - if hadPodcast then - cmd.CommandText <- "DELETE FROM web_log_feed_podcast WHERE feed_id = @id" - cmd.Parameters.Clear () - cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString it.Id) |> ignore - do! write cmd - else - () - }) - |> Task.WhenAll - |> ignore + let toAddOrUpdate = + webLog.Rss.CustomFeeds |> List.filter (fun f -> not (toDelete |> List.map toId |> List.contains f.Id)) + if not (List.isEmpty toDelete) || not (List.isEmpty toAddOrUpdate) then + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync [ + if not (List.isEmpty toDelete) then + "DELETE FROM web_log_feed_podcast WHERE feed_id = @id; + DELETE FROM web_log_feed WHERE id = @id", + toDelete |> List.map (fun it -> [ "@id", Sql.string (CustomFeedId.toString it.Id) ]) + if not (List.isEmpty toAddOrUpdate) then + "INSERT INTO web_log_feed ( + id, web_log_id, source, path + ) VALUES ( + @id, @webLogId, @source, @path + ) ON CONFLICT (id) DO UPDATE + SET source = EXCLUDED.source, + path = EXCLUDED.path", + toAddOrUpdate |> List.map (feedParams webLog.Id) + let podcasts = toAddOrUpdate |> List.filter (fun it -> Option.isSome it.Podcast) + if not (List.isEmpty podcasts) then + "INSERT INTO web_log_feed_podcast ( + feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url, + apple_category, apple_subcategory, explicit, default_media_type, media_base_url, + podcast_guid, funding_url, funding_text, medium + ) VALUES ( + @feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl, + @appleCategory, @appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, + @podcastGuid, @fundingUrl, @fundingText, @medium + ) ON CONFLICT (feed_id) DO UPDATE + SET title = EXCLUDED.title, + subtitle = EXCLUDED.subtitle, + items_in_feed = EXCLUDED.items_in_feed, + summary = EXCLUDED.summary, + displayed_author = EXCLUDED.displayed_author, + email = EXCLUDED.email, + image_url = EXCLUDED.image_url, + apple_category = EXCLUDED.apple_category, + apple_subcategory = EXCLUDED.apple_subcategory, + explicit = EXCLUDED.explicit, + default_media_type = EXCLUDED.default_media_type, + media_base_url = EXCLUDED.media_base_url, + podcast_guid = EXCLUDED.podcast_guid, + funding_url = EXCLUDED.funding_url, + funding_text = EXCLUDED.funding_text, + medium = EXCLUDED.medium", + podcasts |> List.map (fun it -> podcastParams it.Id it.Podcast.Value) + let hadPodcasts = + toAddOrUpdate + |> List.filter (fun it -> + match feeds |> List.tryFind (fun feed -> feed.Id = it.Id) with + | Some feed -> Option.isSome feed.Podcast && Option.isNone it.Podcast + | None -> false) + if not (List.isEmpty hadPodcasts) then + "DELETE FROM web_log_feed_podcast WHERE feed_id = @id", + hadPodcasts |> List.map (fun it -> [ "@id", Sql.string (CustomFeedId.toString it.Id) ]) + ] + () } // IMPLEMENTATION FUNCTIONS /// Add a web log let add webLog = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- """ - INSERT INTO web_log ( - id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx, - uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright - ) VALUES ( - @id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx, - @uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright - )""" - addWebLogParameters cmd webLog - do! write cmd + let! _ = + Sql.existingConnection conn + |> Sql.query + "INSERT INTO web_log ( + id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx, + uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright + ) VALUES ( + @id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx, + @uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright + )" + |> Sql.parameters (webLogParams webLog) + |> Sql.executeNonQueryAsync do! updateCustomFeeds webLog } /// Retrieve all web logs let all () = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM web_log" - use! rdr = cmd.ExecuteReaderAsync () let! webLogs = - toList Map.toWebLog rdr - |> List.map (fun webLog -> backgroundTask { return! appendCustomFeeds webLog }) - |> Task.WhenAll - return List.ofArray webLogs + Sql.existingConnection conn + |> Sql.query "SELECT * FROM web_log" + |> Sql.executeAsync Map.toWebLog + let! feeds = + Sql.existingConnection conn + |> Sql.query feedSelect + |> Sql.executeAsync (fun row -> WebLogId (row.string "web_log_id"), Map.toCustomFeed row) + return + webLogs + |> List.map (fun it -> + { it with + Rss = + { it.Rss with + CustomFeeds = feeds |> List.filter (fun (wlId, _) -> wlId = it.Id) |> List.map snd } }) } /// Delete a web log by its ID @@ -247,72 +211,76 @@ type PostgreSqlWebLogData (conn : NpgsqlConnection) = } /// Find a web log by its host (URL base) - let findByHost (url : string) = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM web_log WHERE url_base = @urlBase" - cmd.Parameters.AddWithValue ("@urlBase", url) |> ignore - use! rdr = cmd.ExecuteReaderAsync () - if rdr.Read () then - let! webLog = appendCustomFeeds (Map.toWebLog rdr) - return Some webLog - else - return None + let findByHost url = backgroundTask { + let! webLog = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM web_log WHERE url_base = @urlBase" + |> Sql.parameters [ "@urlBase", Sql.string url ] + |> Sql.executeAsync Map.toWebLog + |> tryHead + if Option.isSome webLog then + let! withFeeds = appendCustomFeeds webLog.Value + return Some withFeeds + else return None } /// Find a web log by its ID let findById webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM web_log WHERE id = @webLogId" - addWebLogId cmd webLogId - use! rdr = cmd.ExecuteReaderAsync () - if rdr.Read () then - let! webLog = appendCustomFeeds (Map.toWebLog rdr) - return Some webLog - else - return None + let! webLog = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM web_log WHERE id = @webLogId" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync Map.toWebLog + |> tryHead + if Option.isSome webLog then + let! withFeeds = appendCustomFeeds webLog.Value + return Some withFeeds + else return None } /// Update settings for a web log let updateSettings webLog = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- """ - UPDATE web_log - SET name = @name, - slug = @slug, - subtitle = @subtitle, - default_page = @defaultPage, - posts_per_page = @postsPerPage, - theme_id = @themeId, - url_base = @urlBase, - time_zone = @timeZone, - auto_htmx = @autoHtmx, - uploads = @uploads, - is_feed_enabled = @isFeedEnabled, - feed_name = @feedName, - items_in_feed = @itemsInFeed, - is_category_enabled = @isCategoryEnabled, - is_tag_enabled = @isTagEnabled, - copyright = @copyright - WHERE id = @id""" - addWebLogParameters cmd webLog - do! write cmd + let! _ = + Sql.existingConnection conn + |> Sql.query + "UPDATE web_log + SET name = @name, + slug = @slug, + subtitle = @subtitle, + default_page = @defaultPage, + posts_per_page = @postsPerPage, + theme_id = @themeId, + url_base = @urlBase, + time_zone = @timeZone, + auto_htmx = @autoHtmx, + uploads = @uploads, + is_feed_enabled = @isFeedEnabled, + feed_name = @feedName, + items_in_feed = @itemsInFeed, + is_category_enabled = @isCategoryEnabled, + is_tag_enabled = @isTagEnabled, + copyright = @copyright + WHERE id = @id" + |> Sql.parameters (webLogParams webLog) + |> Sql.executeNonQueryAsync + () } /// Update RSS options for a web log - let updateRssOptions webLog = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- """ - UPDATE web_log - SET is_feed_enabled = @isFeedEnabled, - feed_name = @feedName, - items_in_feed = @itemsInFeed, - is_category_enabled = @isCategoryEnabled, - is_tag_enabled = @isTagEnabled, - copyright = @copyright - WHERE id = @id""" - addWebLogRssParameters cmd webLog - cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) |> ignore - do! write cmd + let updateRssOptions (webLog : WebLog) = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query + "UPDATE web_log + SET is_feed_enabled = @isFeedEnabled, + feed_name = @feedName, + items_in_feed = @itemsInFeed, + is_category_enabled = @isCategoryEnabled, + is_tag_enabled = @isTagEnabled, + copyright = @copyright + WHERE id = @webLogId" + |> Sql.parameters (webLogIdParam webLog.Id :: rssParams webLog) + |> Sql.executeNonQueryAsync do! updateCustomFeeds webLog } diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogUserData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogUserData.fs new file mode 100644 index 0000000..32f539a --- /dev/null +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogUserData.fs @@ -0,0 +1,151 @@ +namespace MyWebLog.Data.PostgreSql + +open MyWebLog +open MyWebLog.Data +open Npgsql +open Npgsql.FSharp + +/// PostgreSQL myWebLog user data implementation +type PostgreSqlWebLogUserData (conn : NpgsqlConnection) = + + /// The INSERT statement for a user + let userInsert = + "INSERT INTO web_log_user ( + id, web_log_id, email, first_name, last_name, preferred_name, password_hash, salt, url, access_level, + created_on, last_seen_on + ) VALUES ( + @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel, + @createdOn, @lastSeenOn + )" + + /// Parameters for saving web log users + let userParams (user : WebLogUser) = [ + "@id", Sql.string (WebLogUserId.toString user.Id) + "@webLogId", Sql.string (WebLogId.toString user.WebLogId) + "@email", Sql.string user.Email + "@firstName", Sql.string user.FirstName + "@lastName", Sql.string user.LastName + "@preferredName", Sql.string user.PreferredName + "@passwordHash", Sql.string user.PasswordHash + "@salt", Sql.uuid user.Salt + "@url", Sql.stringOrNone user.Url + "@accessLevel", Sql.string (AccessLevel.toString user.AccessLevel) + "@createdOn", Sql.timestamptz user.CreatedOn + "@lastSeenOn", Sql.timestamptzOrNone user.LastSeenOn + ] + + /// Find a user by their ID for the given web log + let findById userId webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM web_log_user WHERE id = @id AND web_log_id = @webLogId" + |> Sql.parameters [ "@id", Sql.string (WebLogUserId.toString userId); webLogIdParam webLogId ] + |> Sql.executeAsync Map.toWebLogUser + |> tryHead + + /// Delete a user if they have no posts or pages + let delete userId webLogId = backgroundTask { + match! findById userId webLogId with + | Some _ -> + let userParam = [ "@userId", Sql.string (WebLogUserId.toString userId) ] + let! isAuthor = + Sql.existingConnection conn + |> Sql.query + "SELECT ( EXISTS (SELECT 1 FROM page WHERE author_id = @userId + OR EXISTS (SELECT 1 FROM post WHERE author_id = @userId)) AS does_exist" + |> Sql.parameters userParam + |> Sql.executeRowAsync Map.toExists + if isAuthor then + return Error "User has pages or posts; cannot delete" + else + let! _ = + Sql.existingConnection conn + |> Sql.query "DELETE FROM web_log_user WHERE id = @userId" + |> Sql.parameters userParam + |> Sql.executeNonQueryAsync + return Ok true + | None -> return Error "User does not exist" + } + + /// Find a user by their e-mail address for the given web log + let findByEmail email webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND email = @email" + |> Sql.parameters [ webLogIdParam webLogId; "@email", Sql.string email ] + |> Sql.executeAsync Map.toWebLogUser + |> tryHead + + /// Get all users for the given web log + let findByWebLog webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM web_log_user WHERE web_log_id = @webLogId ORDER BY LOWER(preferred_name)" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync Map.toWebLogUser + + /// Find the names of users by their IDs for the given web log + let findNames webLogId userIds = backgroundTask { + let idSql, idParams = inClause "id" WebLogUserId.toString userIds + let! users = + Sql.existingConnection conn + |> Sql.query $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND id IN ({idSql})" + |> Sql.parameters (webLogIdParam webLogId :: idParams) + |> Sql.executeAsync Map.toWebLogUser + return + users + |> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u }) + } + + /// Restore users from a backup + let restore users = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync [ + userInsert, users |> List.map userParams + ] + () + } + + /// Set a user's last seen date/time to now + let setLastSeen userId webLogId = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query "UPDATE web_log_user SET last_seen_on = @lastSeenOn WHERE id = @id AND web_log_id = @webLogId" + |> Sql.parameters + [ webLogIdParam webLogId + "@id", Sql.string (WebLogUserId.toString userId) + "@lastSeenOn", Sql.timestamptz System.DateTime.UtcNow ] + |> Sql.executeNonQueryAsync + () + } + + /// Save a user + let save user = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query $" + {userInsert} ON CONFLICT (id) DO UPDATE + SET email = @email, + first_name = @firstName, + last_name = @lastName, + preferred_name = @preferredName, + password_hash = @passwordHash, + salt = @salt, + url = @url, + access_level = @accessLevel, + created_on = @createdOn, + last_seen_on = @lastSeenOn" + |> Sql.parameters (userParams user) + |> Sql.executeNonQueryAsync + () + } + + interface IWebLogUserData with + member _.Add user = save user + member _.Delete userId webLogId = delete userId webLogId + member _.FindByEmail email webLogId = findByEmail email webLogId + member _.FindById userId webLogId = findById userId webLogId + member _.FindByWebLog webLogId = findByWebLog webLogId + member _.FindNames webLogId userIds = findNames webLogId userIds + member _.Restore users = restore users + member _.SetLastSeen userId webLogId = setLastSeen userId webLogId + member _.Update user = save user + diff --git a/src/MyWebLog.Data/PostgreSqlData.fs b/src/MyWebLog.Data/PostgreSqlData.fs index 9ed7dfc..0497722 100644 --- a/src/MyWebLog.Data/PostgreSqlData.fs +++ b/src/MyWebLog.Data/PostgreSqlData.fs @@ -7,7 +7,6 @@ open Npgsql.FSharp /// Data implementation for PostgreSQL type PostgreSqlData (conn : NpgsqlConnection, log : ILogger) = - interface IData with @@ -19,6 +18,7 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger) = member _.ThemeAsset = PostgreSqlThemeAssetData conn member _.Upload = PostgreSqlUploadData conn member _.WebLog = PostgreSqlWebLogData conn + member _.WebLogUser = PostgreSqlWebLogUserData conn member _.StartUp () = backgroundTask { @@ -28,202 +28,204 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger) = |> Sql.executeAsync (fun row -> row.string "tablename") let needsTable table = not (List.contains table tables) - seq { + let sql = seq { // Theme tables if needsTable "theme" then - """CREATE TABLE theme ( - id TEXT NOT NULL PRIMARY KEY, - name TEXT NOT NULL, - version TEXT NOT NULL)""" + "CREATE TABLE theme ( + id TEXT NOT NULL PRIMARY KEY, + name TEXT NOT NULL, + version TEXT NOT NULL)" if needsTable "theme_template" then - """CREATE TABLE theme_template ( - theme_id TEXT NOT NULL REFERENCES theme (id), - name TEXT NOT NULL, - template TEXT NOT NULL, - PRIMARY KEY (theme_id, name))""" + "CREATE TABLE theme_template ( + theme_id TEXT NOT NULL REFERENCES theme (id), + name TEXT NOT NULL, + template TEXT NOT NULL, + PRIMARY KEY (theme_id, name))" if needsTable "theme_asset" then - """CREATE TABLE theme_asset ( - theme_id TEXT NOT NULL REFERENCES theme (id), - path TEXT NOT NULL, - updated_on TIMESTAMPTZ NOT NULL, - data BYTEA NOT NULL, - PRIMARY KEY (theme_id, path))""" + "CREATE TABLE theme_asset ( + theme_id TEXT NOT NULL REFERENCES theme (id), + path TEXT NOT NULL, + updated_on TIMESTAMPTZ NOT NULL, + data BYTEA NOT NULL, + PRIMARY KEY (theme_id, path))" // Web log tables if needsTable "web_log" then - """CREATE TABLE web_log ( - id TEXT NOT NULL PRIMARY KEY, - name TEXT NOT NULL, - slug TEXT NOT NULL, - subtitle TEXT, - default_page TEXT NOT NULL, - posts_per_page INTEGER NOT NULL, - theme_id TEXT NOT NULL REFERENCES theme (id), - url_base TEXT NOT NULL, - time_zone TEXT NOT NULL, - auto_htmx BOOLEAN NOT NULL DEFAULT FALSE, - uploads TEXT NOT NULL, - is_feed_enabled BOOLEAN NOT NULL DEFAULT FALSE, - feed_name TEXT NOT NULL, - items_in_feed INTEGER, - is_category_enabled BOOLEAN NOT NULL DEFAULT FALSE, - is_tag_enabled BOOLEAN NOT NULL DEFAULT FALSE, - copyright TEXT); - CREATE INDEX web_log_theme_idx ON web_log (theme_id)""" + "CREATE TABLE web_log ( + id TEXT NOT NULL PRIMARY KEY, + name TEXT NOT NULL, + slug TEXT NOT NULL, + subtitle TEXT, + default_page TEXT NOT NULL, + posts_per_page INTEGER NOT NULL, + theme_id TEXT NOT NULL REFERENCES theme (id), + url_base TEXT NOT NULL, + time_zone TEXT NOT NULL, + auto_htmx BOOLEAN NOT NULL DEFAULT FALSE, + uploads TEXT NOT NULL, + is_feed_enabled BOOLEAN NOT NULL DEFAULT FALSE, + feed_name TEXT NOT NULL, + items_in_feed INTEGER, + is_category_enabled BOOLEAN NOT NULL DEFAULT FALSE, + is_tag_enabled BOOLEAN NOT NULL DEFAULT FALSE, + copyright TEXT); + CREATE INDEX web_log_theme_idx ON web_log (theme_id)" if needsTable "web_log_feed" then - """CREATE TABLE web_log_feed ( - id TEXT NOT NULL PRIMARY KEY, - web_log_id TEXT NOT NULL REFERENCES web_log (id), - source TEXT NOT NULL, - path TEXT NOT NULL); - CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)""" + "CREATE TABLE web_log_feed ( + id TEXT NOT NULL PRIMARY KEY, + web_log_id TEXT NOT NULL REFERENCES web_log (id), + source TEXT NOT NULL, + path TEXT NOT NULL); + CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)" if needsTable "web_log_feed_podcast" then - """CREATE TABLE web_log_feed_podcast ( - feed_id TEXT NOT NULL PRIMARY KEY REFERENCES web_log_feed (id), - title TEXT NOT NULL, - subtitle TEXT, - items_in_feed INTEGER NOT NULL, - summary TEXT NOT NULL, - displayed_author TEXT NOT NULL, - email TEXT NOT NULL, - image_url TEXT NOT NULL, - apple_category TEXT NOT NULL, - apple_subcategory TEXT, - explicit TEXT NOT NULL, - default_media_type TEXT, - media_base_url TEXT, - podcast_guid TEXT, - funding_url TEXT, - funding_text TEXT, - medium TEXT)""" + "CREATE TABLE web_log_feed_podcast ( + feed_id TEXT NOT NULL PRIMARY KEY REFERENCES web_log_feed (id), + title TEXT NOT NULL, + subtitle TEXT, + items_in_feed INTEGER NOT NULL, + summary TEXT NOT NULL, + displayed_author TEXT NOT NULL, + email TEXT NOT NULL, + image_url TEXT NOT NULL, + apple_category TEXT NOT NULL, + apple_subcategory TEXT, + explicit TEXT NOT NULL, + default_media_type TEXT, + media_base_url TEXT, + podcast_guid TEXT, + funding_url TEXT, + funding_text TEXT, + medium TEXT)" // Category table if needsTable "category" then - """CREATE TABLE category ( - id TEXT NOT NULL PRIMARY KEY, - web_log_id TEXT NOT NULL REFERENCES web_log (id), - name TEXT NOT NULL, - slug TEXT NOT NULL, - description TEXT, - parent_id TEXT); - CREATE INDEX category_web_log_idx ON category (web_log_id)""" + "CREATE TABLE category ( + id TEXT NOT NULL PRIMARY KEY, + web_log_id TEXT NOT NULL REFERENCES web_log (id), + name TEXT NOT NULL, + slug TEXT NOT NULL, + description TEXT, + parent_id TEXT); + CREATE INDEX category_web_log_idx ON category (web_log_id)" // Web log user table if needsTable "web_log_user" then - """CREATE TABLE web_log_user ( - id TEXT NOT NULL PRIMARY KEY, - web_log_id TEXT NOT NULL REFERENCES web_log (id), - email TEXT NOT NULL, - first_name TEXT NOT NULL, - last_name TEXT NOT NULL, - preferred_name TEXT NOT NULL, - password_hash TEXT NOT NULL, - salt TEXT NOT NULL, - url TEXT, - access_level TEXT NOT NULL, - created_on TIMESTAMPTZ NOT NULL, - last_seen_on TIMESTAMPTZ); - CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id); - CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)""" + "CREATE TABLE web_log_user ( + id TEXT NOT NULL PRIMARY KEY, + web_log_id TEXT NOT NULL REFERENCES web_log (id), + email TEXT NOT NULL, + first_name TEXT NOT NULL, + last_name TEXT NOT NULL, + preferred_name TEXT NOT NULL, + password_hash TEXT NOT NULL, + salt TEXT NOT NULL, + url TEXT, + access_level TEXT NOT NULL, + created_on TIMESTAMPTZ NOT NULL, + last_seen_on TIMESTAMPTZ); + CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id); + CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)" // Page tables if needsTable "page" then - """CREATE TABLE page ( - id TEXT NOT NULL PRIMARY KEY, - web_log_id TEXT NOT NULL REFERENCES web_log (id), - author_id TEXT NOT NULL REFERENCES web_log_user (id), - title TEXT NOT NULL, - permalink TEXT NOT NULL, - prior_permalinks TEXT[] NOT NULL DEFAULT '{}', - published_on TIMESTAMPTZ NOT NULL, - updated_on TIMESTAMPTZ NOT NULL, - is_in_page_list BOOLEAN NOT NULL DEFAULT FALSE, - template TEXT, - page_text TEXT NOT NULL - meta_items JSONB); - CREATE INDEX page_web_log_idx ON page (web_log_id); - CREATE INDEX page_author_idx ON page (author_id); - CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)""" + "CREATE TABLE page ( + id TEXT NOT NULL PRIMARY KEY, + web_log_id TEXT NOT NULL REFERENCES web_log (id), + author_id TEXT NOT NULL REFERENCES web_log_user (id), + title TEXT NOT NULL, + permalink TEXT NOT NULL, + prior_permalinks TEXT[] NOT NULL DEFAULT '{}', + published_on TIMESTAMPTZ NOT NULL, + updated_on TIMESTAMPTZ NOT NULL, + is_in_page_list BOOLEAN NOT NULL DEFAULT FALSE, + template TEXT, + page_text TEXT NOT NULL + meta_items JSONB); + CREATE INDEX page_web_log_idx ON page (web_log_id); + CREATE INDEX page_author_idx ON page (author_id); + CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)" if needsTable "page_revision" then - """CREATE TABLE page_revision ( - page_id TEXT NOT NULL REFERENCES page (id), - as_of TIMESTAMPTZ NOT NULL, - revision_text TEXT NOT NULL, - PRIMARY KEY (page_id, as_of))""" + "CREATE TABLE page_revision ( + page_id TEXT NOT NULL REFERENCES page (id), + as_of TIMESTAMPTZ NOT NULL, + revision_text TEXT NOT NULL, + PRIMARY KEY (page_id, as_of))" // Post tables if needsTable "post" then - """CREATE TABLE post ( - id TEXT NOT NULL PRIMARY KEY, - web_log_id TEXT NOT NULL REFERENCES web_log (id), - author_id TEXT NOT NULL REFERENCES web_log_user (id), - status TEXT NOT NULL, - title TEXT NOT NULL, - permalink TEXT NOT NULL, - prior_permalinks TEXT[] NOT NULL DEFAULT '{}', - published_on TIMESTAMPTZ, - updated_on TIMESTAMPTZ NOT NULL, - template TEXT, - post_text TEXT NOT NULL, - tags TEXT[], - meta_items JSONB, - episode JSONB); - CREATE INDEX post_web_log_idx ON post (web_log_id); - CREATE INDEX post_author_idx ON post (author_id); - CREATE INDEX post_status_idx ON post (web_log_id, status, updated_on); - CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)""" + "CREATE TABLE post ( + id TEXT NOT NULL PRIMARY KEY, + web_log_id TEXT NOT NULL REFERENCES web_log (id), + author_id TEXT NOT NULL REFERENCES web_log_user (id), + status TEXT NOT NULL, + title TEXT NOT NULL, + permalink TEXT NOT NULL, + prior_permalinks TEXT[] NOT NULL DEFAULT '{}', + published_on TIMESTAMPTZ, + updated_on TIMESTAMPTZ NOT NULL, + template TEXT, + post_text TEXT NOT NULL, + tags TEXT[], + meta_items JSONB, + episode JSONB); + CREATE INDEX post_web_log_idx ON post (web_log_id); + CREATE INDEX post_author_idx ON post (author_id); + CREATE INDEX post_status_idx ON post (web_log_id, status, updated_on); + CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)" if needsTable "post_category" then - """CREATE TABLE post_category ( - post_id TEXT NOT NULL REFERENCES post (id), - category_id TEXT NOT NULL REFERENCES category (id), - PRIMARY KEY (post_id, category_id)); - CREATE INDEX post_category_category_idx ON post_category (category_id)""" + "CREATE TABLE post_category ( + post_id TEXT NOT NULL REFERENCES post (id), + category_id TEXT NOT NULL REFERENCES category (id), + PRIMARY KEY (post_id, category_id)); + CREATE INDEX post_category_category_idx ON post_category (category_id)" if needsTable "post_revision" then - """CREATE TABLE post_revision ( - post_id TEXT NOT NULL REFERENCES post (id), - as_of TIMESTAMPTZ NOT NULL, - revision_text TEXT NOT NULL, - PRIMARY KEY (post_id, as_of))""" + "CREATE TABLE post_revision ( + post_id TEXT NOT NULL REFERENCES post (id), + as_of TIMESTAMPTZ NOT NULL, + revision_text TEXT NOT NULL, + PRIMARY KEY (post_id, as_of))" if needsTable "post_comment" then - """CREATE TABLE post_comment ( - id TEXT NOT NULL PRIMARY KEY, - post_id TEXT NOT NULL REFERENCES post(id), - in_reply_to_id TEXT, - name TEXT NOT NULL, - email TEXT NOT NULL, - url TEXT, - status TEXT NOT NULL, - posted_on TIMESTAMPTZ NOT NULL, - comment_text TEXT NOT NULL); - CREATE INDEX post_comment_post_idx ON post_comment (post_id)""" + "CREATE TABLE post_comment ( + id TEXT NOT NULL PRIMARY KEY, + post_id TEXT NOT NULL REFERENCES post(id), + in_reply_to_id TEXT, + name TEXT NOT NULL, + email TEXT NOT NULL, + url TEXT, + status TEXT NOT NULL, + posted_on TIMESTAMPTZ NOT NULL, + comment_text TEXT NOT NULL); + CREATE INDEX post_comment_post_idx ON post_comment (post_id)" // Tag map table if needsTable "tag_map" then - """CREATE TABLE tag_map ( - id TEXT NOT NULL PRIMARY KEY, - web_log_id TEXT NOT NULL REFERENCES web_log (id), - tag TEXT NOT NULL, - url_value TEXT NOT NULL); - CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)""" + "CREATE TABLE tag_map ( + id TEXT NOT NULL PRIMARY KEY, + web_log_id TEXT NOT NULL REFERENCES web_log (id), + tag TEXT NOT NULL, + url_value TEXT NOT NULL); + CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)" // Uploaded file table if needsTable "upload" then - """CREATE TABLE upload ( - id TEXT NOT NULL PRIMARY KEY, - web_log_id TEXT NOT NULL REFERENCES web_log (id), - path TEXT NOT NULL, - updated_on TIMESTAMPTZ NOT NULL, - data BYTEA NOT NULL); - CREATE INDEX upload_web_log_idx ON upload (web_log_id); - CREATE INDEX upload_path_idx ON upload (web_log_id, path)""" + "CREATE TABLE upload ( + id TEXT NOT NULL PRIMARY KEY, + web_log_id TEXT NOT NULL REFERENCES web_log (id), + path TEXT NOT NULL, + updated_on TIMESTAMPTZ NOT NULL, + data BYTEA NOT NULL); + CREATE INDEX upload_web_log_idx ON upload (web_log_id); + CREATE INDEX upload_path_idx ON upload (web_log_id, path)" } - |> Seq.iter (fun sql -> - let table = (sql.Split ' ')[2] - log.LogInformation $"Creating {(sql.Split ' ')[2]} table..." - Sql.existingConnection conn - |> Sql.query sql - |> Sql.executeNonQueryAsync - |> Async.AwaitTask - |> Async.RunSynchronously - |> ignore) + + Sql.existingConnection conn + |> Sql.executeTransactionAsync + (sql + |> Seq.map (fun s -> + log.LogInformation $"Creating {(s.Split ' ')[2]} table..." + s, [ [] ]) + |> List.ofSeq) + |> Async.AwaitTask + |> Async.RunSynchronously + |> ignore } diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 5eca40c..bd9ef78 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -3,6 +3,7 @@ open Microsoft.Data.Sqlite open Microsoft.Extensions.Configuration open Microsoft.Extensions.Logging open MyWebLog +open Npgsql /// Middleware to derive the current web log type WebLogMiddleware (next : RequestDelegate, log : ILogger) = @@ -58,6 +59,11 @@ module DataImplementation = let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB") let conn = await (rethinkCfg.CreateConnectionAsync log) upcast RethinkDbData (conn, rethinkCfg, log) + elif hasConnStr "PostgreSQL" then + let log = sp.GetRequiredService> () + let conn = new NpgsqlConnection (connStr "PostgreSQL") + log.LogInformation $"Using PostgreSQL database {conn.Host}:{conn.Port}/{conn.Database}" + PostgreSqlData (conn, log) else upcast createSQLite "Data Source=./myweblog.db;Cache=Shared" @@ -138,6 +144,16 @@ let rec main args = // Use SQLite for caching as well let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./session.db" builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath) |> ignore + | :? PostgreSqlData -> + // ADO.NET connections are designed to work as per-request instantiation + let cfg = sp.GetRequiredService () + builder.Services.AddScoped (fun sp -> + new NpgsqlConnection (cfg.GetConnectionString "PostgreSQL")) + |> ignore + builder.Services.AddScoped () |> ignore + // Use SQLite for caching (for now) + let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./session.db" + builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath) |> ignore | _ -> () let _ = builder.Services.AddSession(fun opts ->