From 2902e8b3796c7c25a42da6c2b407ee9198d92fd0 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Tue, 16 Aug 2022 23:24:28 -0400 Subject: [PATCH 01/13] WIP on PostgreSQL data implementation --- src/MyWebLog.Data/MyWebLog.Data.fsproj | 5 + .../PostgreSql/PostgreSqlCategoryData.fs | 185 ++++++++++++ .../PostgreSql/PostgreSqlHelpers.fs | 27 ++ src/MyWebLog.Data/PostgreSqlData.fs | 263 ++++++++++++++++++ 4 files changed, 480 insertions(+) create mode 100644 src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs create mode 100644 src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs create mode 100644 src/MyWebLog.Data/PostgreSqlData.fs diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index 558c1cf..3014d6d 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -9,6 +9,8 @@ + + @@ -29,6 +31,9 @@ + + + diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs new file mode 100644 index 0000000..8783c9d --- /dev/null +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs @@ -0,0 +1,185 @@ +namespace MyWebLog.Data.PostgreSql + +open MyWebLog +open MyWebLog.Data +open Npgsql +open Npgsql.FSharp + +type PostgreSqlCategoryData (conn : NpgsqlConnection) = + + /// Add parameters for category INSERT or UPDATE statements + let addCategoryParameters (cat : Category) = + Sql.parameters [ + webLogIdParam cat.WebLogId + "@id", Sql.string (CategoryId.toString cat.Id) + "@name", Sql.string cat.Name + "@slug", Sql.string cat.Slug + "@description", Sql.stringOrNone cat.Description + "@parentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) + ] + + /// Add a category + let add cat = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query """ + INSERT INTO category ( + id, web_log_id, name, slug, description, parent_id + ) VALUES ( + @id, @webLogId, @name, @slug, @description, @parentId + )""" + |> addCategoryParameters cat + |> Sql.executeNonQueryAsync + () + } + + /// 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.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.parameters [ webLogIdParam webLogId ] + |> Sql.executeRowAsync Map.toCount + + /// Retrieve all categories for the given web log in a DotLiquid-friendly format + let findAllForView webLogId = backgroundTask { + let! cats = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM category WHERE web_log_id = @webLogId ORDER BY LOWER(name)" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync Map.toCategory + let ordered = Utils.orderByHierarchy cats None None [] + let counts = + ordered + // |> Seq.map (fun it -> backgroundTask { + // // Parent category post counts include posts in subcategories + // cmd.Parameters.Clear () + // addWebLogId cmd webLogId + // cmd.CommandText <- """ + // SELECT COUNT(DISTINCT p.id) + // 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 (""" + // ordered + // |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name) + // |> Seq.map (fun cat -> cat.Id) + // |> Seq.append (Seq.singleton it.Id) + // |> Seq.iteri (fun idx item -> + // if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " + // cmd.CommandText <- $"{cmd.CommandText}@catId{idx}" + // cmd.Parameters.AddWithValue ($"@catId{idx}", item) |> ignore) + // cmd.CommandText <- $"{cmd.CommandText})" + // let! postCount = count cmd + // return it.Id, postCount + // }) + // |> Task.WhenAll + return + ordered + |> Seq.map (fun cat -> + { cat with + PostCount = counts + |> Array.tryFind (fun c -> fst c = cat.Id) + |> Option.map snd + |> Option.defaultValue 0 + }) + |> Array.ofSeq + } + /// 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 + } + + /// Find all categories for the given web log + let findByWebLog webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM category WHERE web_log_id = @webLogId" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync Map.toCategory + + + /// Delete a category + let delete catId webLogId = backgroundTask { + 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 = + Sql.existingConnection conn + |> Sql.query "SELECT COUNT(id) AS the_count FROM category WHERE parent_id = @parentId" + |> Sql.parameters [ parentParam ] + |> Sql.executeRowAsync Map.toCount + if children > 0 then + let! _ = + Sql.existingConnection conn + |> Sql.query "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId" + |> Sql.parameters + [ parentParam + "@newParentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) ] + |> Sql.executeNonQueryAsync + () + // Delete the category off all posts where it is assigned + let catIdParam = "@id", Sql.string (CategoryId.toString catId) + 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)""" + |> Sql.parameters [ catIdParam; webLogIdParam webLogId ] + |> Sql.executeNonQueryAsync + // Delete the category itself + let! _ = + Sql.existingConnection conn + |> Sql.query "DELETE FROM category WHERE id = @id" + |> Sql.parameters [ catIdParam ] + |> Sql.executeNonQueryAsync + return if children = 0 then CategoryDeleted else ReassignedChildCategories + | None -> return CategoryNotFound + } + + /// Restore categories from a backup + let restore cats = backgroundTask { + for cat in cats do + do! add cat + } + + /// Update a category + let update cat = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query """ + UPDATE category + SET name = @name, + slug = @slug, + description = @description, + parent_id = @parentId + WHERE id = @id + AND web_log_id = @webLogId""" + |> addCategoryParameters cat + |> Sql.executeNonQueryAsync + () + } + + interface ICategoryData with + member _.Add cat = add cat + member _.CountAll webLogId = countAll webLogId + member _.CountTopLevel webLogId = countTopLevel webLogId + member _.FindAllForView webLogId = findAllForView webLogId + member _.FindById catId webLogId = findById catId webLogId + member _.FindByWebLog webLogId = findByWebLog webLogId + member _.Delete catId webLogId = delete catId webLogId + member _.Restore cats = restore cats + member _.Update cat = update cat diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs new file mode 100644 index 0000000..ed8ee91 --- /dev/null +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs @@ -0,0 +1,27 @@ +/// Helper functions for the PostgreSQL data implementation +[] +module MyWebLog.Data.PostgreSql.PostgreSqlHelpers + +open MyWebLog +open Npgsql.FSharp + +/// Create a SQL parameter for the web log ID +let webLogIdParam webLogId = + "@webLogId", Sql.string (WebLogId.toString webLogId) + +/// Mapping functions for SQL queries +module Map = + + /// Create a category from the current row in the given data reader + let toCategory (row : RowReader) : Category = + { Id = row.string "id" |> CategoryId + WebLogId = row.string "web_log_id" |> WebLogId + Name = row.string "name" + Slug = row.string "slug" + Description = row.stringOrNone "description" + ParentId = row.stringOrNone "parent_id" |> Option.map CategoryId + } + + /// Get a count from a row + let toCount (row : RowReader) = + row.int "the_count" diff --git a/src/MyWebLog.Data/PostgreSqlData.fs b/src/MyWebLog.Data/PostgreSqlData.fs new file mode 100644 index 0000000..230966d --- /dev/null +++ b/src/MyWebLog.Data/PostgreSqlData.fs @@ -0,0 +1,263 @@ +namespace MyWebLog.Data + +open Microsoft.Extensions.Logging +open MyWebLog.Data.PostgreSql +open Npgsql +open Npgsql.FSharp + +/// Data implementation for PostgreSQL +type PostgreSqlData (conn : NpgsqlConnection, log : ILogger) = + + + interface IData with + + member _.Category = PostgreSqlCategoryData conn + + member _.StartUp () = backgroundTask { + + let! tables = + Sql.existingConnection conn + |> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'" + |> Sql.executeAsync (fun row -> row.string "tablename") + let needsTable table = not (List.contains table tables) + + seq { + // Theme tables + if needsTable "theme" then + """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))""" + 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))""" + + // 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)""" + 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)""" + 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)""" + + // 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)""" + + // 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)""" + + // 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, + 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); + 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_meta" then + """CREATE TABLE page_meta ( + page_id TEXT NOT NULL REFERENCES page (id), + name TEXT NOT NULL, + value TEXT NOT NULL, + PRIMARY KEY (page_id, name, value))""" + if needsTable "page_permalink" then + """CREATE TABLE page_permalink ( + page_id TEXT NOT NULL REFERENCES page (id), + permalink TEXT NOT NULL, + PRIMARY KEY (page_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))""" + + // 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, + published_on TIMESTAMPTZ, + updated_on TIMESTAMPTZ NOT NULL, + template TEXT, + post_text TEXT NOT NULL); + 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)""" + if needsTable "post_episode" then + """CREATE TABLE post_episode ( + post_id TEXT NOT NULL PRIMARY KEY REFERENCES post(id), + media TEXT NOT NULL, + length INTEGER NOT NULL, + duration TEXT, + media_type TEXT, + image_url TEXT, + subtitle TEXT, + explicit TEXT, + chapter_file TEXT, + chapter_type TEXT, + transcript_url TEXT, + transcript_type TEXT, + transcript_lang TEXT, + transcript_captions INTEGER, + season_number INTEGER, + season_description TEXT, + episode_number TEXT, + episode_description TEXT)""" + if needsTable "post_tag" then + """CREATE TABLE post_tag ( + post_id TEXT NOT NULL REFERENCES post (id), + tag TEXT NOT NULL, + PRIMARY KEY (post_id, tag))""" + if needsTable "post_meta" then + """CREATE TABLE post_meta ( + post_id TEXT NOT NULL REFERENCES post (id), + name TEXT NOT NULL, + value TEXT NOT NULL, + PRIMARY KEY (post_id, name, value))""" + if needsTable "post_permalink" then + """CREATE TABLE post_permalink ( + post_id TEXT NOT NULL REFERENCES post (id), + permalink TEXT NOT NULL, + PRIMARY KEY (post_id, permalink))""" + 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))""" + 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)""" + + // 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)""" + + // 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)""" + } + |> 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) + } -- 2.45.1 From 5829d1cb9940b2d32d54fa6a3850bd2221f29e60 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Wed, 17 Aug 2022 20:07:20 -0400 Subject: [PATCH 02/13] WIP on PostgreSQL impl --- src/MyWebLog.Data/MyWebLog.Data.fsproj | 3 + .../PostgreSql/PostgreSqlCategoryData.fs | 133 +++---- .../PostgreSql/PostgreSqlHelpers.fs | 104 +++++- .../PostgreSql/PostgreSqlPageData.fs | 254 +++++++++++++ .../PostgreSql/PostgreSqlPostData.fs | 352 ++++++++++++++++++ .../PostgreSql/PostgreSqlTagMapData.fs | 94 +++++ src/MyWebLog.Data/PostgreSqlData.fs | 77 +--- src/MyWebLog.Data/SQLite/Helpers.fs | 17 - src/MyWebLog.Data/SQLite/SQLitePageData.fs | 6 +- src/MyWebLog.Data/SQLite/SQLitePostData.fs | 10 +- src/MyWebLog.Data/SQLite/SQLiteThemeData.fs | 4 +- src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs | 2 +- src/MyWebLog.Data/Utils.fs | 17 + 13 files changed, 906 insertions(+), 167 deletions(-) create mode 100644 src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs create mode 100644 src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs create mode 100644 src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index 3014d6d..090e70e 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -33,6 +33,9 @@ + + + diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs index 8783c9d..e0d7c9c 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs @@ -7,32 +7,6 @@ open Npgsql.FSharp type PostgreSqlCategoryData (conn : NpgsqlConnection) = - /// Add parameters for category INSERT or UPDATE statements - let addCategoryParameters (cat : Category) = - Sql.parameters [ - webLogIdParam cat.WebLogId - "@id", Sql.string (CategoryId.toString cat.Id) - "@name", Sql.string cat.Name - "@slug", Sql.string cat.Slug - "@description", Sql.stringOrNone cat.Description - "@parentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) - ] - - /// Add a category - let add cat = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query """ - INSERT INTO category ( - id, web_log_id, name, slug, description, parent_id - ) VALUES ( - @id, @webLogId, @name, @slug, @description, @parentId - )""" - |> addCategoryParameters cat - |> Sql.executeNonQueryAsync - () - } - /// Count all categories for the given web log let countAll webLogId = Sql.existingConnection conn @@ -54,39 +28,38 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) = |> Sql.query "SELECT * FROM category WHERE web_log_id = @webLogId ORDER BY LOWER(name)" |> Sql.parameters [ webLogIdParam webLogId ] |> Sql.executeAsync Map.toCategory - let ordered = Utils.orderByHierarchy cats None None [] + let ordered = Utils.orderByHierarchy cats None None [] let counts = ordered - // |> Seq.map (fun it -> backgroundTask { - // // Parent category post counts include posts in subcategories - // cmd.Parameters.Clear () - // addWebLogId cmd webLogId - // cmd.CommandText <- """ - // SELECT COUNT(DISTINCT p.id) - // 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 (""" - // ordered - // |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name) - // |> Seq.map (fun cat -> cat.Id) - // |> Seq.append (Seq.singleton it.Id) - // |> Seq.iteri (fun idx item -> - // if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " - // cmd.CommandText <- $"{cmd.CommandText}@catId{idx}" - // cmd.Parameters.AddWithValue ($"@catId{idx}", item) |> ignore) - // cmd.CommandText <- $"{cmd.CommandText})" - // let! postCount = count cmd - // return it.Id, postCount - // }) - // |> Task.WhenAll + |> Seq.map (fun it -> + // Parent category post counts include posts in subcategories + let catIdSql, catIdParams = + ordered + |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name) + |> Seq.map (fun cat -> cat.Id) + |> List.ofSeq + |> inClause "id" id + let postCount = + Sql.existingConnection conn + |> Sql.query $""" + SELECT COUNT(DISTINCT p.id) AS the_count + 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})""" + |> Sql.parameters (webLogIdParam webLogId :: catIdParams) + |> Sql.executeRowAsync Map.toCount + |> Async.AwaitTask + |> Async.RunSynchronously + it.Id, postCount) + |> List.ofSeq return ordered |> Seq.map (fun cat -> { cat with PostCount = counts - |> Array.tryFind (fun c -> fst c = cat.Id) + |> List.tryFind (fun c -> fst c = cat.Id) |> Option.map snd |> Option.defaultValue 0 }) @@ -130,51 +103,53 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) = "@newParentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) ] |> Sql.executeNonQueryAsync () - // Delete the category off all posts where it is assigned - let catIdParam = "@id", Sql.string (CategoryId.toString catId) + // 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)""" - |> Sql.parameters [ catIdParam; webLogIdParam webLogId ] - |> Sql.executeNonQueryAsync - // Delete the category itself - let! _ = - Sql.existingConnection conn - |> Sql.query "DELETE FROM category WHERE id = @id" - |> Sql.parameters [ catIdParam ] + 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 | None -> return CategoryNotFound } - /// Restore categories from a backup - let restore cats = backgroundTask { - for cat in cats do - do! add cat - } - /// Update a category - let update cat = backgroundTask { + let save (cat : Category) = backgroundTask { let! _ = Sql.existingConnection conn |> Sql.query """ - UPDATE category - SET name = @name, - slug = @slug, - description = @description, - parent_id = @parentId - WHERE id = @id - AND web_log_id = @webLogId""" - |> addCategoryParameters cat + INSERT INTO category ( + id, web_log_id, name, slug, description, parent_id + ) VALUES ( + @id, @webLogId, @name, @slug, @description, @parentId + ) ON CONFLICT (id) DO UPDATE + SET name = EXCLUDED.name, + slug = EXCLUDED.slug, + description = EXCLUDED.description, + parent_id = EXCLUDED.parent_id""" + |> Sql.parameters + [ webLogIdParam cat.WebLogId + "@id", Sql.string (CategoryId.toString cat.Id) + "@name", Sql.string cat.Name + "@slug", Sql.string cat.Slug + "@description", Sql.stringOrNone cat.Description + "@parentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) ] |> Sql.executeNonQueryAsync () } + /// Restore categories from a backup + let restore cats = backgroundTask { + for cat in cats do + do! save cat + } + interface ICategoryData with - member _.Add cat = add cat + member _.Add cat = save cat member _.CountAll webLogId = countAll webLogId member _.CountTopLevel webLogId = countTopLevel webLogId member _.FindAllForView webLogId = findAllForView webLogId @@ -182,4 +157,4 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) = member _.FindByWebLog webLogId = findByWebLog webLogId member _.Delete catId webLogId = delete catId webLogId member _.Restore cats = restore cats - member _.Update cat = update cat + member _.Update cat = save cat diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs index ed8ee91..8004f45 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs @@ -3,18 +3,49 @@ module MyWebLog.Data.PostgreSql.PostgreSqlHelpers open MyWebLog +open Newtonsoft.Json open Npgsql.FSharp /// Create a SQL parameter for the web log ID 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) + +/// Create the SQL and parameters for an IN clause +let inClause<'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}, @%s{name}{idx}", ($"@%s{name}{idx}", Sql.string (valueFunc it)) :: itemP) + (Seq.ofList items + |> Seq.map (fun it -> $"@%s{name}0", [ $"@%s{name}0", Sql.string (valueFunc it) ]) + |> Seq.head) + /// Mapping functions for SQL queries module Map = - /// Create a category from the current row in the given data reader + /// Map an id field to a category ID + let toCategoryId (row : RowReader) = + CategoryId (row.string "id") + + /// Create a category from the current row let toCategory (row : RowReader) : Category = - { Id = row.string "id" |> CategoryId + { Id = toCategoryId row WebLogId = row.string "web_log_id" |> WebLogId Name = row.string "name" Slug = row.string "slug" @@ -25,3 +56,72 @@ module Map = /// Get a count from a row let toCount (row : RowReader) = row.int "the_count" + + /// Create a meta item from the current row + let toMetaItem (row : RowReader) : MetaItem = + { Name = row.string "name" + Value = row.string "value" + } + + /// Create a permalink from the current row + let toPermalink (row : RowReader) = + Permalink (row.string "permalink") + + /// Create a page from the current row + let toPage (row : RowReader) : Page = + { Page.empty with + Id = row.string "id" |> PageId + WebLogId = row.string "web_log_id" |> WebLogId + AuthorId = row.string "author_id" |> WebLogUserId + Title = row.string "title" + Permalink = toPermalink row + PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray + PublishedOn = row.dateTime "published_on" + UpdatedOn = row.dateTime "updated_on" + IsInPageList = row.bool "is_in_page_list" + Template = row.stringOrNone "template" + Text = row.string "page_text" + Metadata = row.stringOrNone "meta_items" + |> Option.map JsonConvert.DeserializeObject + |> Option.defaultValue [] + } + + /// Create a post from the current row + let toPost (row : RowReader) : Post = + { Post.empty with + Id = row.string "id" |> PostId + WebLogId = row.string "web_log_id" |> WebLogId + AuthorId = row.string "author_id" |> WebLogUserId + Status = row.string "status" |> PostStatus.parse + Title = row.string "title" + Permalink = toPermalink row + PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray + PublishedOn = row.dateTimeOrNone "published_on" + UpdatedOn = row.dateTime "updated_on" + Template = row.stringOrNone "template" + Text = row.string "post_text" + CategoryIds = row.stringArrayOrNone "category_ids" + |> Option.map (Array.map CategoryId >> List.ofArray) + |> Option.defaultValue [] + Tags = row.stringArrayOrNone "tags" + |> Option.map List.ofArray + |> Option.defaultValue [] + Metadata = row.stringOrNone "meta_items" + |> Option.map JsonConvert.DeserializeObject + |> Option.defaultValue [] + Episode = row.stringOrNone "episode" |> Option.map JsonConvert.DeserializeObject + } + + /// Create a revision from the current row + let toRevision (row : RowReader) : Revision = + { AsOf = row.dateTime "as_of" + Text = row.string "revision_text" |> MarkupText.parse + } + + /// Create a tag mapping from the current row in the given data reader + let toTagMap (row : RowReader) : TagMap = + { Id = row.string "id" |> TagMapId + WebLogId = row.string "web_log_id" |> WebLogId + Tag = row.string "tag" + UrlValue = row.string "url_value" + } diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs new file mode 100644 index 0000000..0fd42ee --- /dev/null +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs @@ -0,0 +1,254 @@ +namespace MyWebLog.Data.PostgreSql + +open MyWebLog +open MyWebLog.Data +open Newtonsoft.Json +open Npgsql +open Npgsql.FSharp + +/// PostgreSQL myWebLog page data implementation +type PostgreSqlPageData (conn : NpgsqlConnection) = + + // SUPPORT FUNCTIONS + + /// Append revisions and permalinks to a page + let appendPageRevisions (page : Page) = backgroundTask { + let! revisions = + Sql.existingConnection conn + |> Sql.query "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC" + |> Sql.parameters [ "@pageId", Sql.string (PageId.toString page.Id) ] + |> Sql.executeAsync Map.toRevision + return { page with Revisions = revisions } + } + + /// Return a page with no text or revisions + let pageWithoutText row = + { Map.toPage row with Text = "" } + + /// Update a page's revisions + let updatePageRevisions pageId oldRevs newRevs = backgroundTask { + let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs + if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync [ + if not (List.isEmpty toDelete) then + "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf", + toDelete + |> List.map (fun it -> [ + "@pageId", Sql.string (PageId.toString pageId) + "@asOf", Sql.timestamptz it.AsOf + ]) + if not (List.isEmpty toAdd) then + "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)", + toAdd + |> List.map (fun it -> [ + "@pageId", Sql.string (PageId.toString pageId) + "@asOf", Sql.timestamptz it.AsOf + "@text", Sql.string (MarkupText.toString it.Text) + ]) + ] + () + } + + // IMPLEMENTATION FUNCTIONS + + /// Get all pages for a web log (without text, revisions, prior permalinks, or metadata) + let all webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync pageWithoutText + + /// 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.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.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 + } + + /// Find a complete page by its ID + let findFullById pageId webLogId = backgroundTask { + match! findById pageId webLogId with + | Some page -> + let! withMore = appendPageRevisions page + return Some withMore + | None -> return None + } + + /// Delete a page by its ID + let delete pageId webLogId = backgroundTask { + match! findById pageId webLogId with + | Some _ -> + let! _ = + Sql.existingConnection conn + |> 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 + } + + /// 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 + } + + /// 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 = + 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 + } + + /// Get all complete pages for the given web log + let findFullByWebLog webLogId = backgroundTask { + let! pages = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId" + |> Sql.parameters [ webLogIdParam webLogId ] + |> 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.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync (fun row -> PageId (row.string "page_id"), Map.toRevision row) + return + pages + |> List.map (fun it -> + { it with Revisions = revisions |> List.filter (fun r -> fst r = it.Id) |> List.map snd }) + } + + /// Get all listed pages for the given web log (without revisions or text) + let findListed webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND is_in_page_list = TRUE ORDER BY LOWER(title)" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync pageWithoutText + + /// 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.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ] + |> Sql.executeAsync Map.toPage + + /// Save a page + let save (page : Page) = backgroundTask { + let! oldPage = findFullById page.Id page.WebLogId + let! _ = + Sql.existingConnection conn + |> Sql.query """ + 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 + ) 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 + [ webLogIdParam page.WebLogId + "@id", Sql.string (PageId.toString page.Id) + "@authorId", Sql.string (WebLogUserId.toString page.AuthorId) + "@title", Sql.string page.Title + "@permalink", Sql.string (Permalink.toString page.Permalink) + "@publishedOn", Sql.timestamptz page.PublishedOn + "@updatedOn", Sql.timestamptz page.UpdatedOn + "@isInPageList", Sql.bool page.IsInPageList + "@template", Sql.stringOrNone page.Template + "@text", Sql.string page.Text + "@metaItems", Sql.jsonb (JsonConvert.SerializeObject page.Metadata) + "@priorPermalinks", + Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) ] + |> Sql.executeNonQueryAsync + do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions + () + } + + /// Restore pages from a backup + let restore pages = backgroundTask { + for page in pages do + do! save page + } + + /// Update a page's prior permalinks + let updatePriorPermalinks pageId webLogId permalinks = backgroundTask { + match! findById pageId webLogId with + | Some _ -> + let! _ = + Sql.existingConnection conn + |> Sql.query "UPDATE page SET prior_permalinks = @prior WHERE id = @id" + |> Sql.parameters + [ "@id", Sql.string (PageId.toString pageId) + "@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ] + |> Sql.executeNonQueryAsync + return true + | None -> return false + } + + interface IPageData with + member _.Add page = save page + member _.All webLogId = all webLogId + member _.CountAll webLogId = countAll webLogId + member _.CountListed webLogId = countListed webLogId + member _.Delete pageId webLogId = delete pageId webLogId + member _.FindById pageId webLogId = findById pageId webLogId + member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId + member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId + member _.FindFullById pageId webLogId = findFullById pageId webLogId + member _.FindFullByWebLog webLogId = findFullByWebLog webLogId + member _.FindListed webLogId = findListed webLogId + member _.FindPageOfPages webLogId pageNbr = findPageOfPages webLogId pageNbr + member _.Restore pages = restore pages + member _.Update page = save page + member _.UpdatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs new file mode 100644 index 0000000..4679ab9 --- /dev/null +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs @@ -0,0 +1,352 @@ +namespace MyWebLog.Data.PostgreSql + +open System +open MyWebLog +open MyWebLog.Data +open Newtonsoft.Json +open Npgsql +open Npgsql.FSharp + +/// PostgreSQL myWebLog post data implementation +type PostgreSqlPostData (conn : NpgsqlConnection) = + + // SUPPORT FUNCTIONS + + /// Append revisions to a post + let appendPostRevisions (post : Post) = backgroundTask { + let! revisions = + Sql.existingConnection conn + |> Sql.query "SELECT as_of, revision_text FROM post_revision WHERE post_id = @id ORDER BY as_of DESC" + |> Sql.parameters [ "@id", Sql.string (PostId.toString post.Id) ] + |> Sql.executeAsync Map.toRevision + return { post with Revisions = revisions } + } + + /// 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""" + + /// Return a post with no revisions, prior permalinks, or text + let postWithoutText row = + { Map.toPost row with Text = "" } + + /// Update a post's assigned categories + let updatePostCategories postId oldCats newCats = backgroundTask { + let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString + if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then + let catParams cats = + cats + |> List.map (fun it -> [ + "@postId", Sql.string (PostId.toString postId) + "categoryId", Sql.string (CategoryId.toString it) + ]) + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync [ + if not (List.isEmpty toDelete) then + "DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId", + catParams toDelete + if not (List.isEmpty toAdd) then + "INSERT INTO post_category VALUES (@postId, @categoryId)", catParams toAdd + ] + () + } + + /// Update a post's revisions + let updatePostRevisions postId oldRevs newRevs = backgroundTask { + let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs + if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync [ + if not (List.isEmpty toDelete) then + "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf", + toDelete + |> List.map (fun it -> [ + "@postId", Sql.string (PostId.toString postId) + "@asOf", Sql.timestamptz it.AsOf + ]) + if not (List.isEmpty toAdd) then + "INSERT INTO post_revision VALUES (@postId, @asOf, @text)", + toAdd + |> List.map (fun it -> [ + "@postId", Sql.string (PostId.toString postId) + "@asOf", Sql.timestamptz it.AsOf + "@text", Sql.string (MarkupText.toString it.Text) + ]) + ] + () + } + + // 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.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 + } + + /// 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 + } + + /// Find a complete post by its ID for the given web log + let findFullById postId webLogId = backgroundTask { + match! findById postId webLogId with + | Some post -> + let! withRevisions = appendPostRevisions post + return Some withRevisions + | None -> return None + } + + /// Delete a post by its ID for the given web log + let delete postId webLogId = backgroundTask { + match! findById postId webLogId with + | Some _ -> + 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.parameters [ "@id", Sql.string (PostId.toString postId) ] + |> Sql.executeNonQueryAsync + return true + | None -> 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 = + 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 + } + + /// Get all complete posts for the given web log + let findFullByWebLog webLogId = backgroundTask { + let! posts = + Sql.existingConnection conn + |> Sql.query $"{selectPost} WHERE web_log_id = @webLogId" + |> Sql.parameters [ webLogIdParam webLogId ] + |> 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.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync (fun row -> PostId (row.string "post_id"), Map.toRevision row) + return + posts + |> List.map (fun it -> + { it with Revisions = revisions |> List.filter (fun r -> fst r = it.Id) |> List.map snd }) + } + + /// Get a page of categorized posts for the given web log (excludes revisions) + let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = + let catSql, catParams = inClause "catId" CategoryId.toString categoryIds + Sql.existingConnection conn + |> 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}""" + |> Sql.parameters + [ webLogIdParam webLogId + "@status", Sql.string (PostStatus.toString Published) + yield! catParams ] + |> Sql.executeAsync Map.toPost + + /// Get a page of posts for the given web log (excludes text and revisions) + let findPageOfPosts webLogId pageNbr postsPerPage = + Sql.existingConnection conn + |> Sql.query $""" + {selectPost} + WHERE web_log_id = @webLogId + ORDER BY published_on DESC NULLS FIRST, updated_on + 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 $""" + {selectPost} + WHERE web_log_id = @webLogId + AND status = @status + ORDER BY published_on DESC + 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 $""" + {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}""" + |> Sql.parameters + [ webLogIdParam webLogId + "@status", Sql.string (PostStatus.toString Published) + "@tag", Sql.string tag + ] + |> Sql.executeAsync Map.toPost + + /// Find the next newest and oldest post from a publish date for the given web log + let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask { + let queryParams = Sql.parameters [ + webLogIdParam webLogId + "@status", Sql.string (PostStatus.toString Published) + "@publishedOn", Sql.timestamptz publishedOn + ] + let! older = + Sql.existingConnection conn + |> Sql.query $""" + {selectPost} + WHERE web_log_id = @webLogId + AND status = @status + AND published_on < @publishedOn + ORDER BY published_on DESC + LIMIT 1""" + |> queryParams + |> Sql.executeAsync Map.toPost + let! newer = + Sql.existingConnection conn + |> Sql.query $""" + {selectPost} + WHERE web_log_id = @webLogId + AND status = @status + AND published_on > @publishedOn + ORDER BY published_on + LIMIT 1""" + |> queryParams + |> Sql.executeAsync Map.toPost + return List.tryHead older, List.tryHead newer + } + + /// Save a post + let save (post : Post) = backgroundTask { + let! oldPost = findFullById post.Id post.WebLogId + let! _ = + Sql.existingConnection conn + |> Sql.query """ + 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 + ) ON CONFLICT (id) DO UPDATE + SET author_id = EXCLUDED.author_id, + status = EXCLUDED.status, + title = EXCLUDED.title, + permalink = EXCLUDED.permalink, + prior_permalinks = EXCLUDED.prior_permalinks, + published_on = EXCLUDED.published_on, + updated_on = EXCLUDED.updated_on, + template = EXCLUDED.template, + post_text = EXCLUDED.text, + tags = EXCLUDED.tags, + meta_items = EXCLUDED.meta_items, + episode = EXCLUDED.episode""" + |> Sql.parameters + [ webLogIdParam post.WebLogId + "@id", Sql.string (PostId.toString post.Id) + "@authorId", Sql.string (WebLogUserId.toString post.AuthorId) + "@status", Sql.string (PostStatus.toString post.Status) + "@title", Sql.string post.Title + "@permalink", Sql.string (Permalink.toString post.Permalink) + "@publishedOn", Sql.timestamptzOrNone post.PublishedOn + "@updatedOn", Sql.timestamptz post.UpdatedOn + "@template", Sql.stringOrNone post.Template + "@text", Sql.string post.Text + "@episode", Sql.jsonbOrNone (post.Episode |> Option.map JsonConvert.SerializeObject) + "@priorPermalinks", + Sql.stringArray (post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) + "@tags", + Sql.stringArrayOrNone (if List.isEmpty post.Tags then None else Some (Array.ofList post.Tags)) + "@metaItems", + if List.isEmpty post.Metadata then None else Some (JsonConvert.SerializeObject post.Metadata) + |> Sql.jsonbOrNone + ] + |> Sql.executeNonQueryAsync + do! updatePostCategories post.Id (match oldPost with Some p -> p.CategoryIds | None -> []) post.CategoryIds + do! updatePostRevisions post.Id (match oldPost with Some p -> p.Revisions | None -> []) post.Revisions + } + + /// Restore posts from a backup + let restore posts = backgroundTask { + for post in posts do + do! save post + } + + /// Update prior permalinks for a post + let updatePriorPermalinks postId webLogId permalinks = backgroundTask { + match! findById postId webLogId with + | Some _ -> + let! _ = + Sql.existingConnection conn + |> Sql.query "UPDATE post SET prior_permalinks = @prior WHERE id = @id" + |> Sql.parameters + [ "@id", Sql.string (PostId.toString postId) + "@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ] + |> Sql.executeNonQueryAsync + return true + | None -> return false + } + + interface IPostData with + member _.Add post = save post + member _.CountByStatus status webLogId = countByStatus status webLogId + member _.Delete postId webLogId = delete postId webLogId + member _.FindById postId webLogId = findById postId webLogId + member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId + member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId + member _.FindFullById postId webLogId = findFullById postId webLogId + member _.FindFullByWebLog webLogId = findFullByWebLog webLogId + member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = + findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage + member _.FindPageOfPosts webLogId pageNbr postsPerPage = findPageOfPosts webLogId pageNbr postsPerPage + member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage = + findPageOfPublishedPosts webLogId pageNbr postsPerPage + member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage = + findPageOfTaggedPosts webLogId tag pageNbr postsPerPage + member _.FindSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn + member _.Restore posts = restore posts + member _.Update post = save post + member _.UpdatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs new file mode 100644 index 0000000..52e9cb6 --- /dev/null +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs @@ -0,0 +1,94 @@ +namespace MyWebLog.Data.PostgreSql + +open MyWebLog +open MyWebLog.Data +open Npgsql +open Npgsql.FSharp + +/// PostgreSQL myWebLog tag mapping data implementation +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 + } + + /// Delete a tag mapping for the given web log + let delete tagMapId webLogId = backgroundTask { + match! findById tagMapId webLogId with + | Some _ -> + let! _ = + Sql.existingConnection conn + |> Sql.query "DELETE FROM tag_map WHERE id = @id" + |> Sql.parameters [ "@id", Sql.string (TagMapId.toString tagMapId) ] + |> Sql.executeNonQueryAsync + return true + | None -> 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 + } + + /// Get all tag mappings for the given web log + let findByWebLog webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM tag_map WHERE web_log_id = @webLogId ORDER BY tag" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync Map.toTagMap + + /// Find any tag mappings in a list of tags for the given web log + let findMappingForTags tags webLogId = + let tagSql, tagParams = inClause "tag" id tags + Sql.existingConnection conn + |> Sql.query $"SELECT * FROM tag_map WHERE web_log_id = @webLogId AND tag IN ({tagSql}" + |> Sql.parameters (webLogIdParam webLogId :: tagParams) + |> Sql.executeAsync Map.toTagMap + + /// Save a tag mapping + let save (tagMap : TagMap) = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query """ + INSERT INTO tag_map ( + id, web_log_id, tag, url_value + ) VALUES ( + @id, @webLogId, @tag, @urlValue + ) ON CONFLICT (id) DO UPDATE + SET tag = EXCLUDED.tag, + url_value = EXCLUDED.url_value""" + |> Sql.parameters + [ webLogIdParam tagMap.WebLogId + "@id", Sql.string (TagMapId.toString tagMap.Id) + "@tag", Sql.string tagMap.Tag + "@urlValue", Sql.string tagMap.UrlValue + ] + |> Sql.executeNonQueryAsync + () + } + + /// Restore tag mappings from a backup + let restore tagMaps = backgroundTask { + for tagMap in tagMaps do + do! save tagMap + } + + interface ITagMapData with + member _.Delete tagMapId webLogId = delete tagMapId webLogId + member _.FindById tagMapId webLogId = findById tagMapId webLogId + member _.FindByUrlValue urlValue webLogId = findByUrlValue urlValue webLogId + member _.FindByWebLog webLogId = findByWebLog webLogId + member _.FindMappingForTags tags webLogId = findMappingForTags tags webLogId + member _.Save tagMap = save tagMap + member _.Restore tagMaps = restore tagMaps diff --git a/src/MyWebLog.Data/PostgreSqlData.fs b/src/MyWebLog.Data/PostgreSqlData.fs index 230966d..a121728 100644 --- a/src/MyWebLog.Data/PostgreSqlData.fs +++ b/src/MyWebLog.Data/PostgreSqlData.fs @@ -12,6 +12,8 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger) = interface IData with member _.Category = PostgreSqlCategoryData conn + member _.Page = PostgreSqlPageData conn + member _.Post = PostgreSqlPostData conn member _.StartUp () = backgroundTask { @@ -127,25 +129,16 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger) = 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); + 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_meta" then - """CREATE TABLE page_meta ( - page_id TEXT NOT NULL REFERENCES page (id), - name TEXT NOT NULL, - value TEXT NOT NULL, - PRIMARY KEY (page_id, name, value))""" - if needsTable "page_permalink" then - """CREATE TABLE page_permalink ( - page_id TEXT NOT NULL REFERENCES page (id), - permalink TEXT NOT NULL, - PRIMARY KEY (page_id, permalink))""" if needsTable "page_revision" then """CREATE TABLE page_revision ( page_id TEXT NOT NULL REFERENCES page (id), @@ -156,16 +149,20 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger) = // 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, - published_on TIMESTAMPTZ, - updated_on TIMESTAMPTZ NOT NULL, - template TEXT, - post_text TEXT NOT NULL); + 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); @@ -176,42 +173,6 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger) = 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_episode" then - """CREATE TABLE post_episode ( - post_id TEXT NOT NULL PRIMARY KEY REFERENCES post(id), - media TEXT NOT NULL, - length INTEGER NOT NULL, - duration TEXT, - media_type TEXT, - image_url TEXT, - subtitle TEXT, - explicit TEXT, - chapter_file TEXT, - chapter_type TEXT, - transcript_url TEXT, - transcript_type TEXT, - transcript_lang TEXT, - transcript_captions INTEGER, - season_number INTEGER, - season_description TEXT, - episode_number TEXT, - episode_description TEXT)""" - if needsTable "post_tag" then - """CREATE TABLE post_tag ( - post_id TEXT NOT NULL REFERENCES post (id), - tag TEXT NOT NULL, - PRIMARY KEY (post_id, tag))""" - if needsTable "post_meta" then - """CREATE TABLE post_meta ( - post_id TEXT NOT NULL REFERENCES post (id), - name TEXT NOT NULL, - value TEXT NOT NULL, - PRIMARY KEY (post_id, name, value))""" - if needsTable "post_permalink" then - """CREATE TABLE post_permalink ( - post_id TEXT NOT NULL REFERENCES post (id), - permalink TEXT NOT NULL, - PRIMARY KEY (post_id, permalink))""" if needsTable "post_revision" then """CREATE TABLE post_revision ( post_id TEXT NOT NULL REFERENCES post (id), diff --git a/src/MyWebLog.Data/SQLite/Helpers.fs b/src/MyWebLog.Data/SQLite/Helpers.fs index 88955d6..f35fa70 100644 --- a/src/MyWebLog.Data/SQLite/Helpers.fs +++ b/src/MyWebLog.Data/SQLite/Helpers.fs @@ -12,23 +12,6 @@ let count (cmd : SqliteCommand) = backgroundTask { return int (it :?> int64) } -/// Get lists of items removed from and added to the given lists -let diffLists<'T, 'U when 'U : equality> oldItems newItems (f : 'T -> 'U) = - let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other)) - List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems - -/// Find meta items added and removed -let diffMetaItems (oldItems : MetaItem list) newItems = - diffLists oldItems newItems (fun item -> $"{item.Name}|{item.Value}") - -/// Find the permalinks added and removed -let diffPermalinks oldLinks newLinks = - diffLists oldLinks newLinks Permalink.toString - -/// Find the revisions added and removed -let diffRevisions oldRevs newRevs = - diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.Ticks}|{MarkupText.toString rev.Text}") - /// Create a list of items from the given data reader let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) = seq { while rdr.Read () do it rdr } diff --git a/src/MyWebLog.Data/SQLite/SQLitePageData.fs b/src/MyWebLog.Data/SQLite/SQLitePageData.fs index 5dbb71e..7ca61fc 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePageData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePageData.fs @@ -54,7 +54,7 @@ type SQLitePageData (conn : SqliteConnection) = /// Update a page's metadata items let updatePageMeta pageId oldItems newItems = backgroundTask { - let toDelete, toAdd = diffMetaItems oldItems newItems + let toDelete, toAdd = Utils.diffMetaItems oldItems newItems if List.isEmpty toDelete && List.isEmpty toAdd then return () else @@ -82,7 +82,7 @@ type SQLitePageData (conn : SqliteConnection) = /// Update a page's prior permalinks let updatePagePermalinks pageId oldLinks newLinks = backgroundTask { - let toDelete, toAdd = diffPermalinks oldLinks newLinks + let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks if List.isEmpty toDelete && List.isEmpty toAdd then return () else @@ -108,7 +108,7 @@ type SQLitePageData (conn : SqliteConnection) = /// Update a page's revisions let updatePageRevisions pageId oldRevs newRevs = backgroundTask { - let toDelete, toAdd = diffRevisions oldRevs newRevs + let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs if List.isEmpty toDelete && List.isEmpty toAdd then return () else diff --git a/src/MyWebLog.Data/SQLite/SQLitePostData.fs b/src/MyWebLog.Data/SQLite/SQLitePostData.fs index fdfa1e9..5de370b 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePostData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePostData.fs @@ -99,7 +99,7 @@ type SQLitePostData (conn : SqliteConnection) = /// Update a post's assigned categories let updatePostCategories postId oldCats newCats = backgroundTask { - let toDelete, toAdd = diffLists oldCats newCats CategoryId.toString + let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString if List.isEmpty toDelete && List.isEmpty toAdd then return () else @@ -125,7 +125,7 @@ type SQLitePostData (conn : SqliteConnection) = /// Update a post's assigned categories let updatePostTags postId (oldTags : string list) newTags = backgroundTask { - let toDelete, toAdd = diffLists oldTags newTags id + let toDelete, toAdd = Utils.diffLists oldTags newTags id if List.isEmpty toDelete && List.isEmpty toAdd then return () else @@ -203,7 +203,7 @@ type SQLitePostData (conn : SqliteConnection) = /// Update a post's metadata items let updatePostMeta postId oldItems newItems = backgroundTask { - let toDelete, toAdd = diffMetaItems oldItems newItems + let toDelete, toAdd = Utils.diffMetaItems oldItems newItems if List.isEmpty toDelete && List.isEmpty toAdd then return () else @@ -231,7 +231,7 @@ type SQLitePostData (conn : SqliteConnection) = /// Update a post's prior permalinks let updatePostPermalinks postId oldLinks newLinks = backgroundTask { - let toDelete, toAdd = diffPermalinks oldLinks newLinks + let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks if List.isEmpty toDelete && List.isEmpty toAdd then return () else @@ -257,7 +257,7 @@ type SQLitePostData (conn : SqliteConnection) = /// Update a post's revisions let updatePostRevisions postId oldRevs newRevs = backgroundTask { - let toDelete, toAdd = diffRevisions oldRevs newRevs + let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs if List.isEmpty toDelete && List.isEmpty toAdd then return () else diff --git a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs index 53c4204..7a0182d 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs @@ -92,8 +92,8 @@ type SQLiteThemeData (conn : SqliteConnection) = do! write cmd let toDelete, toAdd = - diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue []) - theme.Templates (fun t -> t.Name) + Utils.diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue []) + theme.Templates (fun t -> t.Name) let toUpdate = theme.Templates |> List.filter (fun t -> diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs index 7013583..c498c13 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs @@ -107,7 +107,7 @@ type SQLiteWebLogData (conn : SqliteConnection) = /// Update the custom feeds for a web log let updateCustomFeeds (webLog : WebLog) = backgroundTask { let! feeds = getCustomFeeds webLog - let toDelete, toAdd = diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}") + let toDelete, toAdd = Utils.diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}") let toId (feed : CustomFeed) = feed.Id let toUpdate = webLog.Rss.CustomFeeds diff --git a/src/MyWebLog.Data/Utils.fs b/src/MyWebLog.Data/Utils.fs index f225a49..cc06d9b 100644 --- a/src/MyWebLog.Data/Utils.fs +++ b/src/MyWebLog.Data/Utils.fs @@ -20,3 +20,20 @@ let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = yield! orderByHierarchy cats (Some cat.Id) (Some fullSlug) ([ cat.Name ] |> List.append parentNames) } +/// Get lists of items removed from and added to the given lists +let diffLists<'T, 'U when 'U : equality> oldItems newItems (f : 'T -> 'U) = + let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other)) + List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems + +/// Find meta items added and removed +let diffMetaItems (oldItems : MetaItem list) newItems = + diffLists oldItems newItems (fun item -> $"{item.Name}|{item.Value}") + +/// Find the permalinks added and removed +let diffPermalinks oldLinks newLinks = + diffLists oldLinks newLinks Permalink.toString + +/// Find the revisions added and removed +let diffRevisions oldRevs newRevs = + diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.Ticks}|{MarkupText.toString rev.Text}") + -- 2.45.1 From b3c008629aa9e25707b02fdc3289d8eb99c582e9 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Wed, 17 Aug 2022 23:10:52 -0400 Subject: [PATCH 03/13] WIP on PostgreSQL data impl --- src/MyWebLog.Data/MyWebLog.Data.fsproj | 3 + .../PostgreSql/PostgreSqlCategoryData.fs | 46 ++- .../PostgreSql/PostgreSqlHelpers.fs | 90 ++++- .../PostgreSql/PostgreSqlPageData.fs | 81 +++-- .../PostgreSql/PostgreSqlPostData.fs | 110 +++--- .../PostgreSql/PostgreSqlTagMapData.fs | 41 ++- .../PostgreSql/PostgreSqlThemeData.fs | 204 +++++++++++ .../PostgreSql/PostgreSqlUploadData.fs | 99 ++++++ .../PostgreSql/PostgreSqlWebLogData.fs | 326 ++++++++++++++++++ src/MyWebLog.Data/PostgreSqlData.fs | 11 +- 10 files changed, 898 insertions(+), 113 deletions(-) create mode 100644 src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs create mode 100644 src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs create mode 100644 src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index 090e70e..4b2d394 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -36,6 +36,9 @@ + + + diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs index e0d7c9c..92ffa36 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs @@ -117,35 +117,47 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) = | None -> return CategoryNotFound } - /// Update a category - let save (cat : Category) = backgroundTask { + /// The INSERT statement for a 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) = [ + webLogIdParam cat.WebLogId + "@id", Sql.string (CategoryId.toString cat.Id) + "@name", Sql.string cat.Name + "@slug", Sql.string cat.Slug + "@description", Sql.stringOrNone cat.Description + "@parentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) + ] + + /// Save a category + let save cat = backgroundTask { let! _ = Sql.existingConnection conn - |> Sql.query """ - INSERT INTO category ( - id, web_log_id, name, slug, description, parent_id - ) VALUES ( - @id, @webLogId, @name, @slug, @description, @parentId - ) ON CONFLICT (id) DO UPDATE + |> Sql.query $""" + {catInsert} ON CONFLICT (id) DO UPDATE SET name = EXCLUDED.name, slug = EXCLUDED.slug, description = EXCLUDED.description, parent_id = EXCLUDED.parent_id""" - |> Sql.parameters - [ webLogIdParam cat.WebLogId - "@id", Sql.string (CategoryId.toString cat.Id) - "@name", Sql.string cat.Name - "@slug", Sql.string cat.Slug - "@description", Sql.stringOrNone cat.Description - "@parentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) ] + |> Sql.parameters (catParameters cat) |> Sql.executeNonQueryAsync () } /// Restore categories from a backup let restore cats = backgroundTask { - for cat in cats do - do! save cat + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync [ + catInsert, cats |> List.map catParameters + ] + () } interface ICategoryData with diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs index 8004f45..ed20a1e 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs @@ -57,6 +57,39 @@ module Map = let toCount (row : RowReader) = row.int "the_count" + /// Create a custom feed from the current row + let toCustomFeed (row : RowReader) : CustomFeed = + { Id = row.string "id" |> CustomFeedId + Source = row.string "source" |> CustomFeedSource.parse + Path = row.string "path" |> Permalink + Podcast = + match row.stringOrNone "title" with + | Some title -> + Some { + Title = title + Subtitle = row.stringOrNone "subtitle" + ItemsInFeed = row.int "items_in_feed" + Summary = row.string "summary" + DisplayedAuthor = row.string "displayed_author" + Email = row.string "email" + ImageUrl = row.string "image_url" |> Permalink + AppleCategory = row.string "apple_category" + AppleSubcategory = row.stringOrNone "apple_subcategory" + Explicit = row.string "explicit" |> ExplicitRating.parse + DefaultMediaType = row.stringOrNone "default_media_type" + MediaBaseUrl = row.stringOrNone "media_base_url" + PodcastGuid = row.uuidOrNone "podcast_guid" + FundingUrl = row.stringOrNone "funding_url" + FundingText = row.stringOrNone "funding_text" + Medium = row.stringOrNone "medium" |> Option.map PodcastMedium.parse + } + | None -> None + } + + /// Get a true/false value as to whether an item exists + let toExists (row : RowReader) = + row.bool "does_exist" + /// Create a meta item from the current row let toMetaItem (row : RowReader) : MetaItem = { Name = row.string "name" @@ -118,10 +151,65 @@ module Map = Text = row.string "revision_text" |> MarkupText.parse } - /// Create a tag mapping from the current row in the given data reader + /// Create a tag mapping from the current row let toTagMap (row : RowReader) : TagMap = { Id = row.string "id" |> TagMapId WebLogId = row.string "web_log_id" |> WebLogId Tag = row.string "tag" UrlValue = row.string "url_value" } + + /// Create a theme from the current row (excludes templates) + let toTheme (row : RowReader) : Theme = + { Theme.empty with + Id = row.string "id" |> ThemeId + Name = row.string "name" + Version = row.string "version" + } + + /// Create a theme asset from the current row + let toThemeAsset includeData (row : RowReader) : ThemeAsset = + { Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path") + UpdatedOn = row.dateTime "updated_on" + Data = if includeData then row.bytea "data" else [||] + } + + /// Create a theme template from the current row + let toThemeTemplate includeText (row : RowReader) : ThemeTemplate = + { Name = row.string "name" + Text = if includeText then row.string "template" else "" + } + + /// Create an uploaded file from the current row + let toUpload includeData (row : RowReader) : Upload = + { Id = row.string "id" |> UploadId + WebLogId = row.string "web_log_id" |> WebLogId + Path = row.string "path" |> Permalink + UpdatedOn = row.dateTime "updated_on" + Data = if includeData then row.bytea "data" else [||] + } + + /// Create a web log from the current row + let toWebLog (row : RowReader) : WebLog = + { Id = row.string "id" |> WebLogId + Name = row.string "name" + Slug = row.string "slug" + Subtitle = row.stringOrNone "subtitle" + DefaultPage = row.string "default_page" + PostsPerPage = row.int "posts_per_page" + ThemeId = row.string "theme_id" |> ThemeId + UrlBase = row.string "url_base" + TimeZone = row.string "time_zone" + AutoHtmx = row.bool "auto_htmx" + Uploads = row.string "uploads" |> UploadDestination.parse + Rss = { + IsFeedEnabled = row.bool "is_feed_enabled" + FeedName = row.string "feed_name" + ItemsInFeed = row.intOrNone "items_in_feed" + IsCategoryEnabled = row.bool "is_category_enabled" + IsTagEnabled = row.bool "is_tag_enabled" + Copyright = row.stringOrNone "copyright" + CustomFeeds = [] + } + } + diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs index 0fd42ee..826dc4b 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs @@ -25,6 +25,16 @@ type PostgreSqlPageData (conn : NpgsqlConnection) = let pageWithoutText row = { Map.toPage row with Text = "" } + /// The INSERT statement for a page revision + let revInsert = "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)" + + /// Parameters for a revision INSERT statement + let revParams pageId rev = [ + "@pageId", Sql.string (PageId.toString pageId) + "@asOf", Sql.timestamptz rev.AsOf + "@text", Sql.string (MarkupText.toString rev.Text) + ] + /// Update a page's revisions let updatePageRevisions pageId oldRevs newRevs = backgroundTask { let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs @@ -40,13 +50,7 @@ type PostgreSqlPageData (conn : NpgsqlConnection) = "@asOf", Sql.timestamptz it.AsOf ]) if not (List.isEmpty toAdd) then - "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)", - toAdd - |> List.map (fun it -> [ - "@pageId", Sql.string (PageId.toString pageId) - "@asOf", Sql.timestamptz it.AsOf - "@text", Sql.string (MarkupText.toString it.Text) - ]) + revInsert, toAdd |> List.map (revParams pageId) ] () } @@ -173,19 +177,39 @@ type PostgreSqlPageData (conn : NpgsqlConnection) = |> 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 ( + 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) = [ + webLogIdParam page.WebLogId + "@id", Sql.string (PageId.toString page.Id) + "@authorId", Sql.string (WebLogUserId.toString page.AuthorId) + "@title", Sql.string page.Title + "@permalink", Sql.string (Permalink.toString page.Permalink) + "@publishedOn", Sql.timestamptz page.PublishedOn + "@updatedOn", Sql.timestamptz page.UpdatedOn + "@isInPageList", Sql.bool page.IsInPageList + "@template", Sql.stringOrNone page.Template + "@text", Sql.string page.Text + "@metaItems", Sql.jsonb (JsonConvert.SerializeObject page.Metadata) + "@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 """ - 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 - ) ON CONFLICT (id) DO UPDATE + |> Sql.query $""" + {pageInsert} ON CONFLICT (id) DO UPDATE SET author_id = EXCLUDED.author_id, title = EXCLUDED.title, permalink = EXCLUDED.permalink, @@ -196,29 +220,22 @@ type PostgreSqlPageData (conn : NpgsqlConnection) = template = EXCLUDED.template, page_text = EXCLUDED.text, meta_items = EXCLUDED.meta_items""" - |> Sql.parameters - [ webLogIdParam page.WebLogId - "@id", Sql.string (PageId.toString page.Id) - "@authorId", Sql.string (WebLogUserId.toString page.AuthorId) - "@title", Sql.string page.Title - "@permalink", Sql.string (Permalink.toString page.Permalink) - "@publishedOn", Sql.timestamptz page.PublishedOn - "@updatedOn", Sql.timestamptz page.UpdatedOn - "@isInPageList", Sql.bool page.IsInPageList - "@template", Sql.stringOrNone page.Template - "@text", Sql.string page.Text - "@metaItems", Sql.jsonb (JsonConvert.SerializeObject page.Metadata) - "@priorPermalinks", - Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) ] + |> 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 = backgroundTask { - for page in pages do - do! save page + let restore (pages : Page list) = backgroundTask { + let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r)) + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync [ + pageInsert, pages |> List.map pageParams + revInsert, revisions |> List.map (fun (pageId, rev) -> revParams pageId rev) + ] + () } /// Update a page's prior permalinks diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs index 4679ab9..1d4da91 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs @@ -31,28 +31,41 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = let postWithoutText row = { Map.toPost row with Text = "" } + /// The INSERT statement for a post/category cross-reference + let catInsert = "INSERT INTO post_category VALUES (@postId, @categoryId)" + + /// Parameters for adding or updating a post/category cross-reference + let catParams postId cat = [ + "@postId", Sql.string (PostId.toString postId) + "categoryId", Sql.string (CategoryId.toString cat) + ] + /// Update a post's assigned categories let updatePostCategories postId oldCats newCats = backgroundTask { let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then - let catParams cats = - cats - |> List.map (fun it -> [ - "@postId", Sql.string (PostId.toString postId) - "categoryId", Sql.string (CategoryId.toString it) - ]) let! _ = Sql.existingConnection conn |> Sql.executeTransactionAsync [ if not (List.isEmpty toDelete) then "DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId", - catParams toDelete + toDelete |> List.map (catParams postId) if not (List.isEmpty toAdd) then - "INSERT INTO post_category VALUES (@postId, @categoryId)", catParams toAdd + catInsert, toAdd |> List.map (catParams postId) ] () } + /// The INSERT statement for a post revision + let revInsert = "INSERT INTO post_revision VALUES (@postId, @asOf, @text)" + + /// The parameters for adding a post revision + let revParams postId rev = [ + "@postId", Sql.string (PostId.toString postId) + "@asOf", Sql.timestamptz rev.AsOf + "@text", Sql.string (MarkupText.toString rev.Text) + ] + /// Update a post's revisions let updatePostRevisions postId oldRevs newRevs = backgroundTask { let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs @@ -68,13 +81,7 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = "@asOf", Sql.timestamptz it.AsOf ]) if not (List.isEmpty toAdd) then - "INSERT INTO post_revision VALUES (@postId, @asOf, @text)", - toAdd - |> List.map (fun it -> [ - "@postId", Sql.string (PostId.toString postId) - "@asOf", Sql.timestamptz it.AsOf - "@text", Sql.string (MarkupText.toString it.Text) - ]) + revInsert, toAdd |> List.map (revParams postId) ] () } @@ -259,19 +266,43 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = return List.tryHead older, List.tryHead newer } + /// The INSERT statement for a 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) = [ + webLogIdParam post.WebLogId + "@id", Sql.string (PostId.toString post.Id) + "@authorId", Sql.string (WebLogUserId.toString post.AuthorId) + "@status", Sql.string (PostStatus.toString post.Status) + "@title", Sql.string post.Title + "@permalink", Sql.string (Permalink.toString post.Permalink) + "@publishedOn", Sql.timestamptzOrNone post.PublishedOn + "@updatedOn", Sql.timestamptz post.UpdatedOn + "@template", Sql.stringOrNone post.Template + "@text", Sql.string post.Text + "@episode", Sql.jsonbOrNone (post.Episode |> Option.map JsonConvert.SerializeObject) + "@priorPermalinks", Sql.stringArray (post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) + "@tags", Sql.stringArrayOrNone (if List.isEmpty post.Tags then None else Some (Array.ofList post.Tags)) + "@metaItems", + if List.isEmpty post.Metadata then None else Some (JsonConvert.SerializeObject post.Metadata) + |> Sql.jsonbOrNone + ] + /// Save a post let save (post : Post) = backgroundTask { let! oldPost = findFullById post.Id post.WebLogId let! _ = Sql.existingConnection conn - |> Sql.query """ - 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 - ) ON CONFLICT (id) DO UPDATE + |> Sql.query $""" + {postInsert} ON CONFLICT (id) DO UPDATE SET author_id = EXCLUDED.author_id, status = EXCLUDED.status, title = EXCLUDED.title, @@ -284,26 +315,7 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = tags = EXCLUDED.tags, meta_items = EXCLUDED.meta_items, episode = EXCLUDED.episode""" - |> Sql.parameters - [ webLogIdParam post.WebLogId - "@id", Sql.string (PostId.toString post.Id) - "@authorId", Sql.string (WebLogUserId.toString post.AuthorId) - "@status", Sql.string (PostStatus.toString post.Status) - "@title", Sql.string post.Title - "@permalink", Sql.string (Permalink.toString post.Permalink) - "@publishedOn", Sql.timestamptzOrNone post.PublishedOn - "@updatedOn", Sql.timestamptz post.UpdatedOn - "@template", Sql.stringOrNone post.Template - "@text", Sql.string post.Text - "@episode", Sql.jsonbOrNone (post.Episode |> Option.map JsonConvert.SerializeObject) - "@priorPermalinks", - Sql.stringArray (post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) - "@tags", - Sql.stringArrayOrNone (if List.isEmpty post.Tags then None else Some (Array.ofList post.Tags)) - "@metaItems", - if List.isEmpty post.Metadata then None else Some (JsonConvert.SerializeObject post.Metadata) - |> Sql.jsonbOrNone - ] + |> Sql.parameters (postParams post) |> Sql.executeNonQueryAsync do! updatePostCategories post.Id (match oldPost with Some p -> p.CategoryIds | None -> []) post.CategoryIds do! updatePostRevisions post.Id (match oldPost with Some p -> p.Revisions | None -> []) post.Revisions @@ -311,8 +323,16 @@ type PostgreSqlPostData (conn : NpgsqlConnection) = /// Restore posts from a backup let restore posts = backgroundTask { - for post in posts do - do! save post + let cats = posts |> List.collect (fun p -> p.CategoryIds |> List.map (fun c -> p.Id, c)) + let revisions = posts |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r)) + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync [ + postInsert, posts |> List.map postParams + catInsert, cats |> List.map (fun (postId, catId) -> catParams postId catId) + revInsert, revisions |> List.map (fun (postId, rev) -> revParams postId rev) + ] + () } /// Update prior permalinks for a post diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs index 52e9cb6..4287086 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs @@ -56,32 +56,43 @@ type PostgreSqlTagMapData (conn : NpgsqlConnection) = |> Sql.parameters (webLogIdParam webLogId :: tagParams) |> Sql.executeAsync Map.toTagMap + /// The INSERT statement for a tag mapping + 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) = [ + webLogIdParam tagMap.WebLogId + "@id", Sql.string (TagMapId.toString tagMap.Id) + "@tag", Sql.string tagMap.Tag + "@urlValue", Sql.string tagMap.UrlValue + ] + /// Save a tag mapping - let save (tagMap : TagMap) = backgroundTask { + let save tagMap = backgroundTask { let! _ = Sql.existingConnection conn - |> Sql.query """ - INSERT INTO tag_map ( - id, web_log_id, tag, url_value - ) VALUES ( - @id, @webLogId, @tag, @urlValue - ) ON CONFLICT (id) DO UPDATE + |> Sql.query $""" + {tagMapInsert} ON CONFLICT (id) DO UPDATE SET tag = EXCLUDED.tag, url_value = EXCLUDED.url_value""" - |> Sql.parameters - [ webLogIdParam tagMap.WebLogId - "@id", Sql.string (TagMapId.toString tagMap.Id) - "@tag", Sql.string tagMap.Tag - "@urlValue", Sql.string tagMap.UrlValue - ] + |> Sql.parameters (tagMapParams tagMap) |> Sql.executeNonQueryAsync () } /// Restore tag mappings from a backup let restore tagMaps = backgroundTask { - for tagMap in tagMaps do - do! save tagMap + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync [ + tagMapInsert, tagMaps |> List.map tagMapParams + ] + () } interface ITagMapData with diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs new file mode 100644 index 0000000..35f5501 --- /dev/null +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs @@ -0,0 +1,204 @@ +namespace MyWebLog.Data.PostgreSql + +open MyWebLog +open MyWebLog.Data +open Npgsql +open Npgsql.FSharp + +/// PostreSQL myWebLog theme data implementation +type PostgreSqlThemeData (conn : NpgsqlConnection) = + + /// Retrieve all themes (except 'admin'; excludes template text) + let all () = backgroundTask { + let! themes = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id" + |> Sql.executeAsync Map.toTheme + let! templates = + Sql.existingConnection conn + |> Sql.query "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name" + |> Sql.executeAsync (fun row -> ThemeId (row.string "theme_id"), Map.toThemeTemplate false row) + return + themes + |> List.map (fun t -> + { t with Templates = templates |> List.filter (fun tt -> fst tt = t.Id) |> List.map snd }) + } + + /// Does a given theme exist? + let exists themeId = + Sql.existingConnection conn + |> Sql.query "SELECT EXISTS (SELECT 1 FROM theme WHERE id = @id) AS does_exist" + |> Sql.parameters [ "@id", Sql.string (ThemeId.toString themeId) ] + |> Sql.executeRowAsync Map.toExists + + /// Find a theme by its ID + let findById themeId = backgroundTask { + let themeIdParam = [ "@id", Sql.string (ThemeId.toString themeId) ] + let! tryTheme = + 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 -> + 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 + } + + /// Find a theme by its ID (excludes the text of templates) + let findByIdWithoutText themeId = backgroundTask { + match! findById themeId with + | Some theme -> + return Some { + theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" }) + } + | None -> return None + } + + /// Delete a theme by its ID + let delete themeId = backgroundTask { + match! findByIdWithoutText themeId with + | Some _ -> + 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.executeNonQueryAsync + return true + | None -> return false + } + + /// Save a theme + let save (theme : Theme) = backgroundTask { + let! oldTheme = findById theme.Id + 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.parameters + [ "@id", themeIdParam + "@name", Sql.string theme.Name + "@version", Sql.string theme.Version ] + |> Sql.executeNonQueryAsync + + let toDelete, _ = + Utils.diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue []) + theme.Templates (fun t -> t.Name) + let toAddOrUpdate = + theme.Templates + |> List.filter (fun t -> not (toDelete |> List.exists (fun d -> d.Name = t.Name))) + + if not (List.isEmpty toDelete) || not (List.isEmpty toAddOrUpdate) then + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync [ + if not (List.isEmpty toDelete) then + "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""", + toAddOrUpdate |> List.map (fun tmpl -> [ + "@themeId", themeIdParam + "@name", Sql.string tmpl.Name + "@template", Sql.string tmpl.Text + ]) + ] + () + } + + interface IThemeData with + member _.All () = all () + member _.Delete themeId = delete themeId + member _.Exists themeId = exists themeId + member _.FindById themeId = findById themeId + member _.FindByIdWithoutText themeId = findByIdWithoutText themeId + member _.Save theme = save theme + + +/// PostreSQL myWebLog theme data implementation +type PostgreSqlThemeAssetData (conn : NpgsqlConnection) = + + /// Get all theme assets (excludes data) + let all () = + Sql.existingConnection conn + |> Sql.query "SELECT theme_id, path, updated_on FROM theme_asset" + |> Sql.executeAsync (Map.toThemeAsset false) + + /// Delete all assets for the given theme + let deleteByTheme themeId = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query "DELETE FROM theme_asset WHERE theme_id = @themeId" + |> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ] + |> Sql.executeNonQueryAsync + () + } + + /// Find a theme asset by its ID + let findById assetId = backgroundTask { + 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 + } + + /// Get theme assets for the given theme (excludes data) + let findByTheme themeId = + Sql.existingConnection conn + |> Sql.query "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId" + |> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ] + |> Sql.executeAsync (Map.toThemeAsset false) + + /// Get theme assets for the given theme + let findByThemeWithData themeId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId" + |> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ] + |> Sql.executeAsync (Map.toThemeAsset true) + + /// Save a theme asset + let save (asset : ThemeAsset) = backgroundTask { + let (ThemeAssetId (ThemeId themeId, path)) = asset.Id + let! _ = + Sql.existingConnection conn + |> 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""" + |> Sql.parameters + [ "@themeId", Sql.string themeId + "@path", Sql.string path + "@updatedOn", Sql.timestamptz asset.UpdatedOn + "@data", Sql.bytea asset.Data ] + |> Sql.executeNonQueryAsync + () + } + + interface IThemeAssetData with + member _.All () = all () + member _.DeleteByTheme themeId = deleteByTheme themeId + member _.FindById assetId = findById assetId + member _.FindByTheme themeId = findByTheme themeId + member _.FindByThemeWithData themeId = findByThemeWithData themeId + member _.Save asset = save asset diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs new file mode 100644 index 0000000..b509f02 --- /dev/null +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs @@ -0,0 +1,99 @@ +namespace MyWebLog.Data.PostgreSql + +open MyWebLog +open MyWebLog.Data +open Npgsql +open Npgsql.FSharp + +/// PostgreSQL myWebLog uploaded file data implementation +type PostgreSqlUploadData (conn : NpgsqlConnection) = + + /// The INSERT statement for an uploaded file + 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) = [ + webLogIdParam upload.WebLogId + "@id", Sql.string (UploadId.toString upload.Id) + "@path", Sql.string (Permalink.toString upload.Path) + "@updatedOn", Sql.timestamptz upload.UpdatedOn + "@data", Sql.bytea upload.Data + ] + + /// Save an uploaded file + let add upload = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query upInsert + |> Sql.parameters (upParams upload) + |> Sql.executeNonQueryAsync + () + } + + /// Delete an uploaded file by its ID + let delete uploadId webLogId = backgroundTask { + let theParams = [ "@id", Sql.string (UploadId.toString uploadId); webLogIdParam webLogId ] + let! tryPath = + 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 -> + 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""" + } + + /// 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 + } + + /// Find all uploaded files for the given web log (excludes data) + let findByWebLog webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT id, web_log_id, path, updated_on FROM upload WHERE web_log_id = @webLogId" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync (Map.toUpload false) + + /// Find all uploaded files for the given web log + let findByWebLogWithData webLogId = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeAsync (Map.toUpload true) + + /// Restore uploads from a backup + let restore uploads = backgroundTask { + for batch in uploads |> List.chunkBySize 5 do + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync [ + upInsert, batch |> List.map upParams + ] + () + } + + interface IUploadData with + member _.Add upload = add upload + member _.Delete uploadId webLogId = delete uploadId webLogId + member _.FindByPath path webLogId = findByPath path webLogId + member _.FindByWebLog webLogId = findByWebLog webLogId + member _.FindByWebLogWithData webLogId = findByWebLogWithData webLogId + member _.Restore uploads = restore uploads + \ No newline at end of file diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs new file mode 100644 index 0000000..2f298f4 --- /dev/null +++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs @@ -0,0 +1,326 @@ +namespace MyWebLog.Data.PostgreSql + +open MyWebLog +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 + + /// 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 + + /// 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 + + /// 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.parameters [ webLogIdParam webLog.Id ] + |> Sql.executeAsync Map.toCustomFeed + + /// Append custom feeds to a web log + let appendCustomFeeds (webLog : WebLog) = backgroundTask { + let! feeds = getCustomFeeds webLog + 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) = [ + "@feedId", Sql.string (CustomFeedId.toString feedId) + "@title", Sql.string podcast.Title + "@subtitle", Sql.stringOrNone podcast.Subtitle + "@itemsInFeed", Sql.int podcast.ItemsInFeed + "@summary", Sql.string podcast.Summary + "@displayedAuthor", Sql.string podcast.DisplayedAuthor + "@email", Sql.string podcast.Email + "@imageUrl", Sql.string (Permalink.toString podcast.ImageUrl) + "@appleCategory", Sql.string podcast.AppleCategory + "@appleSubcategory", Sql.stringOrNone podcast.AppleSubcategory + "@explicit", Sql.string (ExplicitRating.toString podcast.Explicit) + "@defaultMediaType", Sql.stringOrNone podcast.DefaultMediaType + "@mediaBaseUrl", Sql.stringOrNone podcast.MediaBaseUrl + "@podcastGuid", Sql.uuidOrNone podcast.PodcastGuid + "@fundingUrl", Sql.stringOrNone podcast.FundingUrl + "@fundingText", Sql.stringOrNone podcast.FundingText + "@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 + () + } + + /// 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 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 + } + + // 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 + 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 + } + + /// Delete a web log by its ID + let delete webLogId = backgroundTask { + let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)" + let postSubQuery = subQuery "post" + let pageSubQuery = subQuery "page" + let! _ = + Sql.existingConnection conn + |> Sql.query $""" + DELETE FROM post_comment WHERE post_id IN {postSubQuery}; + DELETE FROM post_revision WHERE post_id IN {postSubQuery}; + DELETE FROM post_category WHERE post_id IN {postSubQuery}; + DELETE FROM post WHERE web_log_id = @webLogId; + DELETE FROM page_revision WHERE page_id IN {pageSubQuery}; + DELETE FROM page WHERE web_log_id = @webLogId; + DELETE FROM category WHERE web_log_id = @webLogId; + DELETE FROM tag_map WHERE web_log_id = @webLogId; + DELETE FROM upload WHERE web_log_id = @webLogId; + DELETE FROM web_log_user WHERE web_log_id = @webLogId; + DELETE FROM web_log_feed_podcast WHERE feed_id IN {subQuery "web_log_feed"}; + DELETE FROM web_log_feed WHERE web_log_id = @webLogId; + DELETE FROM web_log WHERE id = @webLogId""" + |> Sql.parameters [ webLogIdParam webLogId ] + |> Sql.executeNonQueryAsync + () + } + + /// 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 + } + + /// 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 + } + + /// 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 + } + + /// 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 + do! updateCustomFeeds webLog + } + + interface IWebLogData with + member _.Add webLog = add webLog + member _.All () = all () + member _.Delete webLogId = delete webLogId + member _.FindByHost url = findByHost url + member _.FindById webLogId = findById webLogId + member _.UpdateSettings webLog = updateSettings webLog + member _.UpdateRssOptions webLog = updateRssOptions webLog diff --git a/src/MyWebLog.Data/PostgreSqlData.fs b/src/MyWebLog.Data/PostgreSqlData.fs index a121728..9ed7dfc 100644 --- a/src/MyWebLog.Data/PostgreSqlData.fs +++ b/src/MyWebLog.Data/PostgreSqlData.fs @@ -11,9 +11,14 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger) = interface IData with - member _.Category = PostgreSqlCategoryData conn - member _.Page = PostgreSqlPageData conn - member _.Post = PostgreSqlPostData conn + member _.Category = PostgreSqlCategoryData conn + member _.Page = PostgreSqlPageData conn + member _.Post = PostgreSqlPostData conn + member _.TagMap = PostgreSqlTagMapData conn + member _.Theme = PostgreSqlThemeData conn + member _.ThemeAsset = PostgreSqlThemeAssetData conn + member _.Upload = PostgreSqlUploadData conn + member _.WebLog = PostgreSqlWebLogData conn member _.StartUp () = backgroundTask { -- 2.45.1 From 73c7a686a464928e88ffacb5dedb5d56f62fd9ff Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Thu, 18 Aug 2022 13:49:41 -0400 Subject: [PATCH 04/13] 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 -> -- 2.45.1 From bed08b81ee54330f13e995c203163978ec07987e Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Fri, 19 Aug 2022 00:19:13 -0400 Subject: [PATCH 05/13] WIP on PostgreSQL data impl - Rename files - Add cache provider --- src/MyWebLog.Data/MyWebLog.Data.fsproj | 23 +- src/MyWebLog.Data/Postgres/PostgresCache.fs | 216 ++++++++++++++++++ .../PostgresCategoryData.fs} | 5 +- .../PostgresHelpers.fs} | 2 +- .../PostgresPageData.fs} | 4 +- .../PostgresPostData.fs} | 4 +- .../PostgresTagMapData.fs} | 4 +- .../PostgresThemeData.fs} | 6 +- .../PostgresUploadData.fs} | 4 +- .../PostgresWebLogData.fs} | 4 +- .../PostgresWebLogUserData.fs} | 4 +- .../{PostgreSqlData.fs => PostgresData.fs} | 22 +- src/MyWebLog/Program.fs | 8 +- 13 files changed, 263 insertions(+), 43 deletions(-) create mode 100644 src/MyWebLog.Data/Postgres/PostgresCache.fs rename src/MyWebLog.Data/{PostgreSql/PostgreSqlCategoryData.fs => Postgres/PostgresCategoryData.fs} (98%) rename src/MyWebLog.Data/{PostgreSql/PostgreSqlHelpers.fs => Postgres/PostgresHelpers.fs} (99%) rename src/MyWebLog.Data/{PostgreSql/PostgreSqlPageData.fs => Postgres/PostgresPageData.fs} (99%) rename src/MyWebLog.Data/{PostgreSql/PostgreSqlPostData.fs => Postgres/PostgresPostData.fs} (99%) rename src/MyWebLog.Data/{PostgreSql/PostgreSqlTagMapData.fs => Postgres/PostgresTagMapData.fs} (97%) rename src/MyWebLog.Data/{PostgreSql/PostgreSqlThemeData.fs => Postgres/PostgresThemeData.fs} (98%) rename src/MyWebLog.Data/{PostgreSql/PostgreSqlUploadData.fs => Postgres/PostgresUploadData.fs} (97%) rename src/MyWebLog.Data/{PostgreSql/PostgreSqlWebLogData.fs => Postgres/PostgresWebLogData.fs} (99%) rename src/MyWebLog.Data/{PostgreSql/PostgreSqlWebLogUserData.fs => Postgres/PostgresWebLogUserData.fs} (98%) rename src/MyWebLog.Data/{PostgreSqlData.fs => PostgresData.fs} (94%) diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index eec8ee5..3ba45e5 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -6,9 +6,11 @@ + + @@ -31,16 +33,17 @@ - - - - - - - - - - + + + + + + + + + + + diff --git a/src/MyWebLog.Data/Postgres/PostgresCache.fs b/src/MyWebLog.Data/Postgres/PostgresCache.fs new file mode 100644 index 0000000..c01db67 --- /dev/null +++ b/src/MyWebLog.Data/Postgres/PostgresCache.fs @@ -0,0 +1,216 @@ +namespace MyWebLog.Data.Postgres + +open System.Threading +open System.Threading.Tasks +open Microsoft.Extensions.Caching.Distributed +open NodaTime +open Npgsql +open Npgsql.FSharp + +/// Helper types and functions for the cache +[] +module private Helpers = + + /// The cache entry + type Entry = + { /// The ID of the cache entry + Id : string + + /// The value to be cached + Payload : byte[] + + /// When this entry will expire + ExpireAt : Instant + + /// The duration by which the expiration should be pushed out when being refreshed + SlidingExpiration : Duration option + + /// The must-expire-by date/time for the cache entry + AbsoluteExpiration : Instant option + } + + /// Run a task synchronously + let sync<'T> (it : Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously) + + /// Get the current instant + let getNow () = SystemClock.Instance.GetCurrentInstant () + + /// Create a parameter for the expire-at time + let expireParam (it : Instant) = + "@expireAt", Sql.parameter (NpgsqlParameter ("@expireAt", it)) + + /// Create a parameter for a possibly-missing NodaTime type + let optParam<'T> name (it : 'T option) = + let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else null) + p.ParameterName, Sql.parameter p + + +/// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog +type DistributedCache (connStr : string) = + + // ~~~ INITIALIZATION ~~~ + + do + task { + let! exists = + Sql.connect connStr + |> Sql.query $" + SELECT EXISTS + (SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session') + AS {existsName}" + |> Sql.executeRowAsync Map.toExists + if not exists then + let! _ = + Sql.connect connStr + |> Sql.query + "CREATE TABLE session ( + id TEXT NOT NULL PRIMARY KEY, + payload BYETA NOT NULL, + expire_at TIMESTAMPTZ NOT NULL, + sliding_expiration INTERVAL, + absolute_expiration TIMESTAMPTZ); + CREATE INDEX idx_session_expiration ON session (expire_at)" + |> Sql.executeNonQueryAsync + () + } |> sync + + // ~~~ SUPPORT FUNCTIONS ~~~ + + /// Get an entry, updating it for sliding expiration + let getEntry key = backgroundTask { + let idParam = "@id", Sql.string key + let! tryEntry = + Sql.connect connStr + |> Sql.query "SELECT * FROM session WHERE id = @id" + |> Sql.parameters [ idParam ] + |> Sql.executeAsync (fun row -> + { Id = row.string "id" + Payload = row.bytea "payload" + ExpireAt = row.fieldValue "expire_at" + SlidingExpiration = row.fieldValueOrNone "sliding_expiration" + AbsoluteExpiration = row.fieldValueOrNone "absolute_expiration" }) + |> tryHead + match tryEntry with + | Some entry -> + let now = getNow () + let slideExp = defaultArg entry.SlidingExpiration Duration.MinValue + let absExp = defaultArg entry.AbsoluteExpiration Instant.MinValue + let needsRefresh, item = + if entry.ExpireAt = absExp then false, entry + elif slideExp = Duration.MinValue && absExp = Instant.MinValue then false, entry + elif absExp > Instant.MinValue && entry.ExpireAt.Plus slideExp > absExp then + true, { entry with ExpireAt = absExp } + else true, { entry with ExpireAt = now.Plus slideExp } + if needsRefresh then + let! _ = + Sql.connect connStr + |> Sql.query "UPDATE session SET expire_at = @expireAt WHERE id = @id" + |> Sql.parameters [ expireParam item.ExpireAt; idParam ] + |> Sql.executeNonQueryAsync + () + return if item.ExpireAt > now then Some entry else None + | None -> return None + } + + /// The last time expired entries were purged (runs every 30 minutes) + let mutable lastPurge = Instant.MinValue + + /// Purge expired entries every 30 minutes + let purge () = backgroundTask { + let now = getNow () + if lastPurge.Plus (Duration.FromMinutes 30L) < now then + let! _ = + Sql.connect connStr + |> Sql.query "DELETE FROM session WHERE expire_at < @expireAt" + |> Sql.parameters [ expireParam now ] + |> Sql.executeNonQueryAsync + lastPurge <- now + } + + /// Remove a cache entry + let removeEntry key = backgroundTask { + let! _ = + Sql.connect connStr + |> Sql.query "DELETE FROM session WHERE id = @id" + |> Sql.parameters [ "@id", Sql.string key ] + |> Sql.executeNonQueryAsync + () + } + + /// Save an entry + let saveEntry (opts : DistributedCacheEntryOptions) key payload = backgroundTask { + let now = getNow () + let expireAt, slideExp, absExp = + if opts.SlidingExpiration.HasValue then + let slide = Duration.FromTimeSpan opts.SlidingExpiration.Value + now.Plus slide, Some slide, None + elif opts.AbsoluteExpiration.HasValue then + let exp = Instant.FromDateTimeOffset opts.AbsoluteExpiration.Value + exp, None, Some exp + elif opts.AbsoluteExpirationRelativeToNow.HasValue then + let exp = now.Plus (Duration.FromTimeSpan opts.AbsoluteExpirationRelativeToNow.Value) + exp, None, Some exp + else + // Default to 1 hour sliding expiration + let slide = Duration.FromHours 1 + now.Plus slide, Some slide, None + let! _ = + Sql.connect connStr + |> Sql.query + "INSERT INTO session ( + id, payload, expire_at, sliding_expiration, absolute_expiration + ) VALUES ( + @id, @payload, @expireAt, @slideExp, @absExp + ) ON CONFLICT (id) DO UPDATE + SET payload = EXCLUDED.payload, + expire_at = EXCLUDED.expire_at, + sliding_expiration = EXCLUDED.sliding_expiration, + absolute_expiration = EXCLUDED.absolute_expiration" + |> Sql.parameters + [ "@id", Sql.string key + "@payload", Sql.bytea payload + expireParam expireAt + optParam "slideExp" slideExp + optParam "absExp" absExp ] + |> Sql.executeNonQueryAsync + () + } + + // ~~~ IMPLEMENTATION FUNCTIONS ~~~ + + /// Retrieve the data for a cache entry + let get key (_ : CancellationToken) = backgroundTask { + match! getEntry key with + | Some entry -> + do! purge () + return entry.Payload + | None -> return null + } + + /// Refresh an entry + let refresh key (cancelToken : CancellationToken) = backgroundTask { + let! _ = get key cancelToken + () + } + + /// Remove an entry + let remove key (_ : CancellationToken) = backgroundTask { + do! removeEntry key + do! purge () + } + + /// Set an entry + let set key value options (_ : CancellationToken) = backgroundTask { + do! saveEntry options key value + do! purge () + } + + interface IDistributedCache with + member this.Get key = get key CancellationToken.None |> sync + member this.GetAsync (key, token) = get key token + member this.Refresh key = refresh key CancellationToken.None |> sync + member this.RefreshAsync (key, token) = refresh key token + member this.Remove key = remove key CancellationToken.None |> sync + member this.RemoveAsync (key, token) = remove key token + member this.Set (key, value, options) = set key value options CancellationToken.None |> sync + member this.SetAsync (key, value, options, token) = set key value options token diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs b/src/MyWebLog.Data/Postgres/PostgresCategoryData.fs similarity index 98% rename from src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs rename to src/MyWebLog.Data/Postgres/PostgresCategoryData.fs index 4a13f9b..32db33a 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresCategoryData.fs @@ -1,11 +1,12 @@ -namespace MyWebLog.Data.PostgreSql +namespace MyWebLog.Data.Postgres open MyWebLog open MyWebLog.Data open Npgsql open Npgsql.FSharp -type PostgreSqlCategoryData (conn : NpgsqlConnection) = +/// PostgreSQL myWebLog category data implementation +type PostgresCategoryData (conn : NpgsqlConnection) = /// Count all categories for the given web log let countAll webLogId = diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs b/src/MyWebLog.Data/Postgres/PostgresHelpers.fs similarity index 99% rename from src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs rename to src/MyWebLog.Data/Postgres/PostgresHelpers.fs index addcf81..4cf2729 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs +++ b/src/MyWebLog.Data/Postgres/PostgresHelpers.fs @@ -1,6 +1,6 @@ /// Helper functions for the PostgreSQL data implementation [] -module MyWebLog.Data.PostgreSql.PostgreSqlHelpers +module MyWebLog.Data.Postgres.PostgresHelpers open System.Threading.Tasks open MyWebLog diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs b/src/MyWebLog.Data/Postgres/PostgresPageData.fs similarity index 99% rename from src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs rename to src/MyWebLog.Data/Postgres/PostgresPageData.fs index 1a099fe..fd4e57a 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresPageData.fs @@ -1,4 +1,4 @@ -namespace MyWebLog.Data.PostgreSql +namespace MyWebLog.Data.Postgres open MyWebLog open MyWebLog.Data @@ -7,7 +7,7 @@ open Npgsql open Npgsql.FSharp /// PostgreSQL myWebLog page data implementation -type PostgreSqlPageData (conn : NpgsqlConnection) = +type PostgresPageData (conn : NpgsqlConnection) = // SUPPORT FUNCTIONS diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs b/src/MyWebLog.Data/Postgres/PostgresPostData.fs similarity index 99% rename from src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs rename to src/MyWebLog.Data/Postgres/PostgresPostData.fs index da694c1..9652fa4 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresPostData.fs @@ -1,4 +1,4 @@ -namespace MyWebLog.Data.PostgreSql +namespace MyWebLog.Data.Postgres open System open MyWebLog @@ -8,7 +8,7 @@ open Npgsql open Npgsql.FSharp /// PostgreSQL myWebLog post data implementation -type PostgreSqlPostData (conn : NpgsqlConnection) = +type PostgresPostData (conn : NpgsqlConnection) = // SUPPORT FUNCTIONS diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs b/src/MyWebLog.Data/Postgres/PostgresTagMapData.fs similarity index 97% rename from src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs rename to src/MyWebLog.Data/Postgres/PostgresTagMapData.fs index dce9f4a..c0b9c51 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresTagMapData.fs @@ -1,4 +1,4 @@ -namespace MyWebLog.Data.PostgreSql +namespace MyWebLog.Data.Postgres open MyWebLog open MyWebLog.Data @@ -6,7 +6,7 @@ open Npgsql open Npgsql.FSharp /// PostgreSQL myWebLog tag mapping data implementation -type PostgreSqlTagMapData (conn : NpgsqlConnection) = +type PostgresTagMapData (conn : NpgsqlConnection) = /// Find a tag mapping by its ID for the given web log let findById tagMapId webLogId = diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs b/src/MyWebLog.Data/Postgres/PostgresThemeData.fs similarity index 98% rename from src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs rename to src/MyWebLog.Data/Postgres/PostgresThemeData.fs index 8c7c2f3..472ff95 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresThemeData.fs @@ -1,4 +1,4 @@ -namespace MyWebLog.Data.PostgreSql +namespace MyWebLog.Data.Postgres open MyWebLog open MyWebLog.Data @@ -6,7 +6,7 @@ open Npgsql open Npgsql.FSharp /// PostreSQL myWebLog theme data implementation -type PostgreSqlThemeData (conn : NpgsqlConnection) = +type PostgresThemeData (conn : NpgsqlConnection) = /// Retrieve all themes (except 'admin'; excludes template text) let all () = backgroundTask { @@ -135,7 +135,7 @@ type PostgreSqlThemeData (conn : NpgsqlConnection) = /// PostreSQL myWebLog theme data implementation -type PostgreSqlThemeAssetData (conn : NpgsqlConnection) = +type PostgresThemeAssetData (conn : NpgsqlConnection) = /// Get all theme assets (excludes data) let all () = diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs b/src/MyWebLog.Data/Postgres/PostgresUploadData.fs similarity index 97% rename from src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs rename to src/MyWebLog.Data/Postgres/PostgresUploadData.fs index b92a5f0..2bf4f1f 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresUploadData.fs @@ -1,4 +1,4 @@ -namespace MyWebLog.Data.PostgreSql +namespace MyWebLog.Data.Postgres open MyWebLog open MyWebLog.Data @@ -6,7 +6,7 @@ open Npgsql open Npgsql.FSharp /// PostgreSQL myWebLog uploaded file data implementation -type PostgreSqlUploadData (conn : NpgsqlConnection) = +type PostgresUploadData (conn : NpgsqlConnection) = /// The INSERT statement for an uploaded file let upInsert = diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs b/src/MyWebLog.Data/Postgres/PostgresWebLogData.fs similarity index 99% rename from src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs rename to src/MyWebLog.Data/Postgres/PostgresWebLogData.fs index e6b0b53..2cd9605 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresWebLogData.fs @@ -1,4 +1,4 @@ -namespace MyWebLog.Data.PostgreSql +namespace MyWebLog.Data.Postgres open MyWebLog open MyWebLog.Data @@ -6,7 +6,7 @@ open Npgsql open Npgsql.FSharp /// PostgreSQL myWebLog web log data implementation -type PostgreSqlWebLogData (conn : NpgsqlConnection) = +type PostgresWebLogData (conn : NpgsqlConnection) = // SUPPORT FUNCTIONS diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogUserData.fs b/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs similarity index 98% rename from src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogUserData.fs rename to src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs index 32f539a..014b9ca 100644 --- a/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogUserData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs @@ -1,4 +1,4 @@ -namespace MyWebLog.Data.PostgreSql +namespace MyWebLog.Data.Postgres open MyWebLog open MyWebLog.Data @@ -6,7 +6,7 @@ open Npgsql open Npgsql.FSharp /// PostgreSQL myWebLog user data implementation -type PostgreSqlWebLogUserData (conn : NpgsqlConnection) = +type PostgresWebLogUserData (conn : NpgsqlConnection) = /// The INSERT statement for a user let userInsert = diff --git a/src/MyWebLog.Data/PostgreSqlData.fs b/src/MyWebLog.Data/PostgresData.fs similarity index 94% rename from src/MyWebLog.Data/PostgreSqlData.fs rename to src/MyWebLog.Data/PostgresData.fs index 0497722..a0a5e3a 100644 --- a/src/MyWebLog.Data/PostgreSqlData.fs +++ b/src/MyWebLog.Data/PostgresData.fs @@ -1,24 +1,24 @@ namespace MyWebLog.Data open Microsoft.Extensions.Logging -open MyWebLog.Data.PostgreSql +open MyWebLog.Data.Postgres open Npgsql open Npgsql.FSharp /// Data implementation for PostgreSQL -type PostgreSqlData (conn : NpgsqlConnection, log : ILogger) = +type PostgresData (conn : NpgsqlConnection, log : ILogger) = interface IData with - member _.Category = PostgreSqlCategoryData conn - member _.Page = PostgreSqlPageData conn - member _.Post = PostgreSqlPostData conn - member _.TagMap = PostgreSqlTagMapData conn - member _.Theme = PostgreSqlThemeData conn - member _.ThemeAsset = PostgreSqlThemeAssetData conn - member _.Upload = PostgreSqlUploadData conn - member _.WebLog = PostgreSqlWebLogData conn - member _.WebLogUser = PostgreSqlWebLogUserData conn + member _.Category = PostgresCategoryData conn + member _.Page = PostgresPageData conn + member _.Post = PostgresPostData conn + member _.TagMap = PostgresTagMapData conn + member _.Theme = PostgresThemeData conn + member _.ThemeAsset = PostgresThemeAssetData conn + member _.Upload = PostgresUploadData conn + member _.WebLog = PostgresWebLogData conn + member _.WebLogUser = PostgresWebLogUserData conn member _.StartUp () = backgroundTask { diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index bd9ef78..971f2be 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -60,10 +60,10 @@ module DataImplementation = let conn = await (rethinkCfg.CreateConnectionAsync log) upcast RethinkDbData (conn, rethinkCfg, log) elif hasConnStr "PostgreSQL" then - let log = sp.GetRequiredService> () + let log = sp.GetRequiredService> () let conn = new NpgsqlConnection (connStr "PostgreSQL") log.LogInformation $"Using PostgreSQL database {conn.Host}:{conn.Port}/{conn.Database}" - PostgreSqlData (conn, log) + PostgresData (conn, log) else upcast createSQLite "Data Source=./myweblog.db;Cache=Shared" @@ -144,13 +144,13 @@ 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 -> + | :? PostgresData -> // 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 + 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 -- 2.45.1 From 0b2a17d4c8601443fdfd895b181da14842957731 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Fri, 19 Aug 2022 22:51:43 -0400 Subject: [PATCH 06/13] WIP on NodaTime implementation --- src/MyWebLog.Data/Converters.fs | 22 +- src/MyWebLog.Data/MyWebLog.Data.fsproj | 4 +- src/MyWebLog.Data/Postgres/PostgresCache.fs | 12 +- src/MyWebLog.Data/Postgres/PostgresHelpers.fs | 101 +++--- .../Postgres/PostgresPageData.fs | 14 +- .../Postgres/PostgresPostData.fs | 32 +- .../Postgres/PostgresThemeData.fs | 8 +- .../Postgres/PostgresUploadData.fs | 8 +- .../Postgres/PostgresWebLogUserData.fs | 8 +- src/MyWebLog.Data/PostgresData.fs | 63 ++-- src/MyWebLog.Data/RethinkDbData.fs | 2 +- src/MyWebLog.Data/SQLite/Helpers.fs | 94 ++++-- .../SQLite/SQLiteCategoryData.fs | 58 ++-- src/MyWebLog.Data/SQLite/SQLitePageData.fs | 104 +++--- src/MyWebLog.Data/SQLite/SQLitePostData.fs | 206 ++++++------ src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs | 28 +- src/MyWebLog.Data/SQLite/SQLiteThemeData.fs | 30 +- src/MyWebLog.Data/SQLite/SQLiteUploadData.fs | 24 +- src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs | 207 ++++++------ .../SQLite/SQLiteWebLogUserData.fs | 71 ++--- src/MyWebLog.Data/SQLiteData.fs | 300 ++++++------------ src/MyWebLog.Data/Utils.fs | 5 +- src/MyWebLog.Domain/DataTypes.fs | 42 +-- src/MyWebLog.Domain/MyWebLog.Domain.fsproj | 3 +- src/MyWebLog.Domain/SupportTypes.fs | 8 +- src/MyWebLog.Domain/ViewModels.fs | 20 +- src/MyWebLog/Maintenance.fs | 3 +- src/MyWebLog/Program.fs | 66 ++-- 28 files changed, 758 insertions(+), 785 deletions(-) diff --git a/src/MyWebLog.Data/Converters.fs b/src/MyWebLog.Data/Converters.fs index b17d587..53fc88f 100644 --- a/src/MyWebLog.Data/Converters.fs +++ b/src/MyWebLog.Data/Converters.fs @@ -122,12 +122,13 @@ module Json = (string >> WebLogUserId) reader.Value open Microsoft.FSharpLu.Json - - /// All converters to use for data conversion - let all () : JsonConverter seq = - seq { - // Our converters - CategoryIdConverter () + open NodaTime + open NodaTime.Serialization.JsonNet + + /// Configure a serializer to use these converters + let configure (ser : JsonSerializer) = + // Our converters + [ CategoryIdConverter () :> JsonConverter CommentIdConverter () CustomFeedIdConverter () CustomFeedSourceConverter () @@ -143,6 +144,9 @@ module Json = UploadIdConverter () WebLogIdConverter () WebLogUserIdConverter () - // Handles DUs with no associated data, as well as option fields - CompactUnionJsonConverter () - } + ] |> List.iter ser.Converters.Add + // NodaTime + let _ = ser.ConfigureForNodaTime DateTimeZoneProviders.Tzdb + // Handles DUs with no associated data, as well as option fields + ser.Converters.Add (CompactUnionJsonConverter ()) + ser diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index 3ba45e5..4f2b61b 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -5,14 +5,16 @@ - + + + diff --git a/src/MyWebLog.Data/Postgres/PostgresCache.fs b/src/MyWebLog.Data/Postgres/PostgresCache.fs index c01db67..a9e9d6f 100644 --- a/src/MyWebLog.Data/Postgres/PostgresCache.fs +++ b/src/MyWebLog.Data/Postgres/PostgresCache.fs @@ -4,7 +4,6 @@ open System.Threading open System.Threading.Tasks open Microsoft.Extensions.Caching.Distributed open NodaTime -open Npgsql open Npgsql.FSharp /// Helper types and functions for the cache @@ -36,13 +35,8 @@ module private Helpers = let getNow () = SystemClock.Instance.GetCurrentInstant () /// Create a parameter for the expire-at time - let expireParam (it : Instant) = - "@expireAt", Sql.parameter (NpgsqlParameter ("@expireAt", it)) - - /// Create a parameter for a possibly-missing NodaTime type - let optParam<'T> name (it : 'T option) = - let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else null) - p.ParameterName, Sql.parameter p + let expireParam = + typedParam "@expireAt" /// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog @@ -65,7 +59,7 @@ type DistributedCache (connStr : string) = |> Sql.query "CREATE TABLE session ( id TEXT NOT NULL PRIMARY KEY, - payload BYETA NOT NULL, + payload BYTEA NOT NULL, expire_at TIMESTAMPTZ NOT NULL, sliding_expiration INTERVAL, absolute_expiration TIMESTAMPTZ); diff --git a/src/MyWebLog.Data/Postgres/PostgresHelpers.fs b/src/MyWebLog.Data/Postgres/PostgresHelpers.fs index 4cf2729..85eb7dd 100644 --- a/src/MyWebLog.Data/Postgres/PostgresHelpers.fs +++ b/src/MyWebLog.Data/Postgres/PostgresHelpers.fs @@ -2,9 +2,12 @@ [] module MyWebLog.Data.Postgres.PostgresHelpers +open System open System.Threading.Tasks open MyWebLog open Newtonsoft.Json +open NodaTime +open Npgsql open Npgsql.FSharp /// Create a SQL parameter for the web log ID @@ -49,6 +52,15 @@ let tryHead<'T> (query : Task<'T list>) = backgroundTask { return List.tryHead results } +/// Create a parameter for a non-standard type +let typedParam<'T> name (it : 'T) = + $"@%s{name}", Sql.parameter (NpgsqlParameter ($"@{name}", it)) + +/// Create a parameter for a possibly-missing non-standard type +let optParam<'T> name (it : 'T option) = + let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value) + p.ParameterName, Sql.parameter p + /// Mapping functions for SQL queries module Map = @@ -116,18 +128,18 @@ module Map = /// Create a page from the current row let toPage (row : RowReader) : Page = { Page.empty with - Id = row.string "id" |> PageId - WebLogId = row.string "web_log_id" |> WebLogId - AuthorId = row.string "author_id" |> WebLogUserId - Title = row.string "title" + Id = row.string "id" |> PageId + WebLogId = row.string "web_log_id" |> WebLogId + AuthorId = row.string "author_id" |> WebLogUserId + Title = row.string "title" Permalink = toPermalink row - PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray - PublishedOn = row.dateTime "published_on" - UpdatedOn = row.dateTime "updated_on" - IsInPageList = row.bool "is_in_page_list" - Template = row.stringOrNone "template" - Text = row.string "page_text" - Metadata = row.stringOrNone "meta_items" + PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray + PublishedOn = row.fieldValue "published_on" + UpdatedOn = row.fieldValue "updated_on" + IsInPageList = row.bool "is_in_page_list" + Template = row.stringOrNone "template" + Text = row.string "page_text" + Metadata = row.stringOrNone "meta_items" |> Option.map JsonConvert.DeserializeObject |> Option.defaultValue [] } @@ -135,33 +147,34 @@ module Map = /// Create a post from the current row let toPost (row : RowReader) : Post = { Post.empty with - Id = row.string "id" |> PostId - WebLogId = row.string "web_log_id" |> WebLogId - AuthorId = row.string "author_id" |> WebLogUserId - Status = row.string "status" |> PostStatus.parse - Title = row.string "title" + Id = row.string "id" |> PostId + WebLogId = row.string "web_log_id" |> WebLogId + AuthorId = row.string "author_id" |> WebLogUserId + Status = row.string "status" |> PostStatus.parse + Title = row.string "title" Permalink = toPermalink row - PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray - PublishedOn = row.dateTimeOrNone "published_on" - UpdatedOn = row.dateTime "updated_on" - Template = row.stringOrNone "template" - Text = row.string "post_text" - CategoryIds = row.stringArrayOrNone "category_ids" + PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray + PublishedOn = row.fieldValueOrNone "published_on" + UpdatedOn = row.fieldValue "updated_on" + Template = row.stringOrNone "template" + Text = row.string "post_text" + CategoryIds = row.stringArrayOrNone "category_ids" |> Option.map (Array.map CategoryId >> List.ofArray) |> Option.defaultValue [] - Tags = row.stringArrayOrNone "tags" + Tags = row.stringArrayOrNone "tags" |> Option.map List.ofArray |> Option.defaultValue [] - Metadata = row.stringOrNone "meta_items" + Metadata = row.stringOrNone "meta_items" |> Option.map JsonConvert.DeserializeObject |> Option.defaultValue [] - Episode = row.stringOrNone "episode" |> Option.map JsonConvert.DeserializeObject + Episode = row.stringOrNone "episode" + |> Option.map JsonConvert.DeserializeObject } /// Create a revision from the current row let toRevision (row : RowReader) : Revision = - { AsOf = row.dateTime "as_of" - Text = row.string "revision_text" |> MarkupText.parse + { AsOf = row.fieldValue "as_of" + Text = row.string "revision_text" |> MarkupText.parse } /// Create a tag mapping from the current row @@ -183,7 +196,7 @@ module Map = /// Create a theme asset from the current row let toThemeAsset includeData (row : RowReader) : ThemeAsset = { Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path") - UpdatedOn = row.dateTime "updated_on" + UpdatedOn = row.fieldValue "updated_on" Data = if includeData then row.bytea "data" else [||] } @@ -195,10 +208,10 @@ module Map = /// Create an uploaded file from the current row let toUpload includeData (row : RowReader) : Upload = - { Id = row.string "id" |> UploadId - WebLogId = row.string "web_log_id" |> WebLogId - Path = row.string "path" |> Permalink - UpdatedOn = row.dateTime "updated_on" + { Id = row.string "id" |> UploadId + WebLogId = row.string "web_log_id" |> WebLogId + Path = row.string "path" |> Permalink + UpdatedOn = row.fieldValue "updated_on" Data = if includeData then row.bytea "data" else [||] } @@ -228,16 +241,16 @@ 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" + { 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.fieldValue "created_on" + LastSeenOn = row.fieldValueOrNone "last_seen_on" } diff --git a/src/MyWebLog.Data/Postgres/PostgresPageData.fs b/src/MyWebLog.Data/Postgres/PostgresPageData.fs index fd4e57a..c50bcdd 100644 --- a/src/MyWebLog.Data/Postgres/PostgresPageData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresPageData.fs @@ -30,9 +30,9 @@ type PostgresPageData (conn : NpgsqlConnection) = /// Parameters for a revision INSERT statement let revParams pageId rev = [ - "@pageId", Sql.string (PageId.toString pageId) - "@asOf", Sql.timestamptz rev.AsOf - "@text", Sql.string (MarkupText.toString rev.Text) + typedParam "@asOf" rev.AsOf + "@pageId", Sql.string (PageId.toString pageId) + "@text", Sql.string (MarkupText.toString rev.Text) ] /// Update a page's revisions @@ -46,8 +46,8 @@ type PostgresPageData (conn : NpgsqlConnection) = "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf", toDelete |> List.map (fun it -> [ - "@pageId", Sql.string (PageId.toString pageId) - "@asOf", Sql.timestamptz it.AsOf + "@pageId", Sql.string (PageId.toString pageId) + typedParam "@asOf" it.AsOf ]) if not (List.isEmpty toAdd) then revInsert, toAdd |> List.map (revParams pageId) @@ -201,13 +201,13 @@ type PostgresPageData (conn : NpgsqlConnection) = "@authorId", Sql.string (WebLogUserId.toString page.AuthorId) "@title", Sql.string page.Title "@permalink", Sql.string (Permalink.toString page.Permalink) - "@publishedOn", Sql.timestamptz page.PublishedOn - "@updatedOn", Sql.timestamptz page.UpdatedOn "@isInPageList", Sql.bool page.IsInPageList "@template", Sql.stringOrNone page.Template "@text", Sql.string page.Text "@metaItems", Sql.jsonb (JsonConvert.SerializeObject page.Metadata) "@priorPermalinks", Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) + typedParam "@publishedOn" page.PublishedOn + typedParam "@updatedOn" page.UpdatedOn ] /// Restore pages from a backup diff --git a/src/MyWebLog.Data/Postgres/PostgresPostData.fs b/src/MyWebLog.Data/Postgres/PostgresPostData.fs index 9652fa4..4e5cb61 100644 --- a/src/MyWebLog.Data/Postgres/PostgresPostData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresPostData.fs @@ -61,9 +61,9 @@ type PostgresPostData (conn : NpgsqlConnection) = /// The parameters for adding a post revision let revParams postId rev = [ - "@postId", Sql.string (PostId.toString postId) - "@asOf", Sql.timestamptz rev.AsOf - "@text", Sql.string (MarkupText.toString rev.Text) + typedParam "@asOf" rev.AsOf + "@postId", Sql.string (PostId.toString postId) + "@text", Sql.string (MarkupText.toString rev.Text) ] /// Update a post's revisions @@ -77,8 +77,8 @@ type PostgresPostData (conn : NpgsqlConnection) = "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf", toDelete |> List.map (fun it -> [ - "@postId", Sql.string (PostId.toString postId) - "@asOf", Sql.timestamptz it.AsOf + "@postId", Sql.string (PostId.toString postId) + typedParam "@asOf" it.AsOf ]) if not (List.isEmpty toAdd) then revInsert, toAdd |> List.map (revParams postId) @@ -282,21 +282,21 @@ type PostgresPostData (conn : NpgsqlConnection) = /// The parameters for saving a post let postParams (post : Post) = [ webLogIdParam post.WebLogId - "@id", Sql.string (PostId.toString post.Id) - "@authorId", Sql.string (WebLogUserId.toString post.AuthorId) - "@status", Sql.string (PostStatus.toString post.Status) - "@title", Sql.string post.Title - "@permalink", Sql.string (Permalink.toString post.Permalink) - "@publishedOn", Sql.timestamptzOrNone post.PublishedOn - "@updatedOn", Sql.timestamptz post.UpdatedOn - "@template", Sql.stringOrNone post.Template - "@text", Sql.string post.Text - "@episode", Sql.jsonbOrNone (post.Episode |> Option.map JsonConvert.SerializeObject) - "@priorPermalinks", Sql.stringArray (post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) + "@id", Sql.string (PostId.toString post.Id) + "@authorId", Sql.string (WebLogUserId.toString post.AuthorId) + "@status", Sql.string (PostStatus.toString post.Status) + "@title", Sql.string post.Title + "@permalink", Sql.string (Permalink.toString post.Permalink) + "@template", Sql.stringOrNone post.Template + "@text", Sql.string post.Text + "@episode", Sql.jsonbOrNone (post.Episode |> Option.map JsonConvert.SerializeObject) + "@priorPermalinks", Sql.stringArray (post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) "@tags", Sql.stringArrayOrNone (if List.isEmpty post.Tags then None else Some (Array.ofList post.Tags)) "@metaItems", if List.isEmpty post.Metadata then None else Some (JsonConvert.SerializeObject post.Metadata) |> Sql.jsonbOrNone + optParam "@publishedOn" post.PublishedOn + typedParam "@updatedOn" post.UpdatedOn ] /// Save a post diff --git a/src/MyWebLog.Data/Postgres/PostgresThemeData.fs b/src/MyWebLog.Data/Postgres/PostgresThemeData.fs index 472ff95..108e51f 100644 --- a/src/MyWebLog.Data/Postgres/PostgresThemeData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresThemeData.fs @@ -190,10 +190,10 @@ type PostgresThemeAssetData (conn : NpgsqlConnection) = SET updated_on = EXCLUDED.updated_on, data = EXCLUDED.data" |> Sql.parameters - [ "@themeId", Sql.string themeId - "@path", Sql.string path - "@updatedOn", Sql.timestamptz asset.UpdatedOn - "@data", Sql.bytea asset.Data ] + [ "@themeId", Sql.string themeId + "@path", Sql.string path + "@data", Sql.bytea asset.Data + typedParam "@updatedOn" asset.UpdatedOn ] |> Sql.executeNonQueryAsync () } diff --git a/src/MyWebLog.Data/Postgres/PostgresUploadData.fs b/src/MyWebLog.Data/Postgres/PostgresUploadData.fs index 2bf4f1f..6087fbb 100644 --- a/src/MyWebLog.Data/Postgres/PostgresUploadData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresUploadData.fs @@ -19,10 +19,10 @@ type PostgresUploadData (conn : NpgsqlConnection) = /// Parameters for adding an uploaded file let upParams (upload : Upload) = [ webLogIdParam upload.WebLogId - "@id", Sql.string (UploadId.toString upload.Id) - "@path", Sql.string (Permalink.toString upload.Path) - "@updatedOn", Sql.timestamptz upload.UpdatedOn - "@data", Sql.bytea upload.Data + typedParam "@updatedOn" upload.UpdatedOn + "@id", Sql.string (UploadId.toString upload.Id) + "@path", Sql.string (Permalink.toString upload.Path) + "@data", Sql.bytea upload.Data ] /// Save an uploaded file diff --git a/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs b/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs index 014b9ca..6dde53e 100644 --- a/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs @@ -30,8 +30,8 @@ type PostgresWebLogUserData (conn : NpgsqlConnection) = "@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 + typedParam "@createdOn" user.CreatedOn + optParam "@lastSeenOn" user.LastSeenOn ] /// Find a user by their ID for the given web log @@ -111,8 +111,8 @@ type PostgresWebLogUserData (conn : NpgsqlConnection) = |> 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 ] + typedParam "@lastSeenOn" (Utils.now ()) + "@id", Sql.string (WebLogUserId.toString userId) ] |> Sql.executeNonQueryAsync () } diff --git a/src/MyWebLog.Data/PostgresData.fs b/src/MyWebLog.Data/PostgresData.fs index a0a5e3a..aa6813e 100644 --- a/src/MyWebLog.Data/PostgresData.fs +++ b/src/MyWebLog.Data/PostgresData.fs @@ -21,7 +21,9 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger) = member _.WebLogUser = PostgresWebLogUserData conn member _.StartUp () = backgroundTask { - + + let _ = NpgsqlConnection.GlobalTypeMapper.UseNodaTime () + let! tables = Sql.existingConnection conn |> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'" @@ -68,15 +70,15 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger) = 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)" + 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)" + 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), @@ -105,8 +107,8 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger) = name TEXT NOT NULL, slug TEXT NOT NULL, description TEXT, - parent_id TEXT); - CREATE INDEX category_web_log_idx ON category (web_log_id)" + parent_id TEXT)" + "CREATE INDEX category_web_log_idx ON category (web_log_id)" // Web log user table if needsTable "web_log_user" then @@ -122,9 +124,9 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger) = 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)" + 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 @@ -139,11 +141,11 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger) = 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)" + 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), @@ -167,17 +169,17 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger) = 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)" + 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)" + 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), @@ -194,8 +196,8 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger) = 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)" + comment_text TEXT NOT NULL)" + "CREATE INDEX post_comment_post_idx ON post_comment (post_id)" // Tag map table if needsTable "tag_map" then @@ -203,8 +205,8 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger) = 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)" + 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 @@ -213,16 +215,17 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger) = 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)" + 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)" } Sql.existingConnection conn |> Sql.executeTransactionAsync (sql |> Seq.map (fun s -> - log.LogInformation $"Creating {(s.Split ' ')[2]} table..." + let parts = s.Split ' ' + log.LogInformation $"Creating {parts[2]} {parts[1].ToLower()}..." s, [ [] ]) |> List.ofSeq) |> Async.AwaitTask diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index 620c10a..88c3260 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -1079,7 +1079,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger obj ] + update [ nameof WebLogUser.empty.LastSeenOn, Utils.now () :> obj ] write; withRetryOnce; ignoreResult conn } | None -> () diff --git a/src/MyWebLog.Data/SQLite/Helpers.fs b/src/MyWebLog.Data/SQLite/Helpers.fs index f35fa70..071da2a 100644 --- a/src/MyWebLog.Data/SQLite/Helpers.fs +++ b/src/MyWebLog.Data/SQLite/Helpers.fs @@ -5,6 +5,7 @@ module MyWebLog.Data.SQLite.Helpers open System open Microsoft.Data.Sqlite open MyWebLog +open NodaTime.Text /// Run a command that returns a count let count (cmd : SqliteCommand) = backgroundTask { @@ -30,6 +31,23 @@ let write (cmd : SqliteCommand) = backgroundTask { () } +/// Create a value for a Duration +let durationParam = + DurationPattern.Roundtrip.Format + +/// Create a value for an Instant +let instantParam = + InstantPattern.ExtendedIso.Format + +/// Create an optional value for a Duration +let maybeDuration = + Option.map durationParam + +/// Create an optional value for an Instant +let maybeInstant = + Option.map instantParam + + /// Functions to map domain items from a data reader module Map = @@ -56,6 +74,26 @@ module Map = /// Get a string value from a data reader let getString col (rdr : SqliteDataReader) = rdr.GetString (rdr.GetOrdinal col) + /// Parse a Duration from the given value + let parseDuration value = + match DurationPattern.Roundtrip.Parse value with + | it when it.Success -> it.Value + | it -> raise it.Exception + + /// Get a Duration value from a data reader + let getDuration col rdr = + getString col rdr |> parseDuration + + /// Parse an Instant from the given value + let parseInstant value = + match InstantPattern.General.Parse value with + | it when it.Success -> it.Value + | it -> raise it.Exception + + /// Get an Instant value from a data reader + let getInstant col rdr = + getString col rdr |> parseInstant + /// Get a timespan value from a data reader let getTimeSpan col (rdr : SqliteDataReader) = rdr.GetTimeSpan (rdr.GetOrdinal col) @@ -79,6 +117,14 @@ module Map = let tryString col (rdr : SqliteDataReader) = if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr) + /// Get a possibly null Duration value from a data reader + let tryDuration col rdr = + tryString col rdr |> Option.map parseDuration + + /// Get a possibly null Instant value from a data reader + let tryInstant col rdr = + tryString col rdr |> Option.map parseInstant + /// Get a possibly null timespan value from a data reader let tryTimeSpan col (rdr : SqliteDataReader) = if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr) @@ -142,8 +188,8 @@ module Map = AuthorId = getString "author_id" rdr |> WebLogUserId Title = getString "title" rdr Permalink = toPermalink rdr - PublishedOn = getDateTime "published_on" rdr - UpdatedOn = getDateTime "updated_on" rdr + PublishedOn = getInstant "published_on" rdr + UpdatedOn = getInstant "updated_on" rdr IsInPageList = getBoolean "is_in_page_list" rdr Template = tryString "template" rdr Text = getString "page_text" rdr @@ -158,8 +204,8 @@ module Map = Status = getString "status" rdr |> PostStatus.parse Title = getString "title" rdr Permalink = toPermalink rdr - PublishedOn = tryDateTime "published_on" rdr - UpdatedOn = getDateTime "updated_on" rdr + PublishedOn = tryInstant "published_on" rdr + UpdatedOn = getInstant "updated_on" rdr Template = tryString "template" rdr Text = getString "post_text" rdr Episode = @@ -168,7 +214,7 @@ module Map = Some { Media = media Length = getLong "length" rdr - Duration = tryTimeSpan "duration" rdr + Duration = tryDuration "duration" rdr MediaType = tryString "media_type" rdr ImageUrl = tryString "image_url" rdr Subtitle = tryString "subtitle" rdr @@ -189,8 +235,8 @@ module Map = /// Create a revision from the current row in the given data reader let toRevision rdr : Revision = - { AsOf = getDateTime "as_of" rdr - Text = getString "revision_text" rdr |> MarkupText.parse + { AsOf = getInstant "as_of" rdr + Text = getString "revision_text" rdr |> MarkupText.parse } /// Create a tag mapping from the current row in the given data reader @@ -220,7 +266,7 @@ module Map = else [||] { Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr) - UpdatedOn = getDateTime "updated_on" rdr + UpdatedOn = getInstant "updated_on" rdr Data = assetData } @@ -240,10 +286,10 @@ module Map = dataStream.ToArray () else [||] - { Id = getString "id" rdr |> UploadId - WebLogId = getString "web_log_id" rdr |> WebLogId - Path = getString "path" rdr |> Permalink - UpdatedOn = getDateTime "updated_on" rdr + { Id = getString "id" rdr |> UploadId + WebLogId = getString "web_log_id" rdr |> WebLogId + Path = getString "path" rdr |> Permalink + UpdatedOn = getInstant "updated_on" rdr Data = data } @@ -273,18 +319,18 @@ module Map = /// Create a web log user from the current row in the given data reader let toWebLogUser rdr : WebLogUser = - { Id = getString "id" rdr |> WebLogUserId - WebLogId = getString "web_log_id" rdr |> WebLogId - Email = getString "email" rdr - FirstName = getString "first_name" rdr - LastName = getString "last_name" rdr - PreferredName = getString "preferred_name" rdr - PasswordHash = getString "password_hash" rdr - Salt = getGuid "salt" rdr - Url = tryString "url" rdr - AccessLevel = getString "access_level" rdr |> AccessLevel.parse - CreatedOn = getDateTime "created_on" rdr - LastSeenOn = tryDateTime "last_seen_on" rdr + { Id = getString "id" rdr |> WebLogUserId + WebLogId = getString "web_log_id" rdr |> WebLogId + Email = getString "email" rdr + FirstName = getString "first_name" rdr + LastName = getString "last_name" rdr + PreferredName = getString "preferred_name" rdr + PasswordHash = getString "password_hash" rdr + Salt = getGuid "salt" rdr + Url = tryString "url" rdr + AccessLevel = getString "access_level" rdr |> AccessLevel.parse + CreatedOn = getInstant "created_on" rdr + LastSeenOn = tryInstant "last_seen_on" rdr } /// Add a possibly-missing parameter, substituting null for None diff --git a/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs b/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs index f14e2ec..d596475 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs @@ -10,23 +10,23 @@ type SQLiteCategoryData (conn : SqliteConnection) = /// Add parameters for category INSERT or UPDATE statements let addCategoryParameters (cmd : SqliteCommand) (cat : Category) = - [ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.Id) - cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId) - cmd.Parameters.AddWithValue ("@name", cat.Name) - cmd.Parameters.AddWithValue ("@slug", cat.Slug) + [ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.Id) + cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId) + cmd.Parameters.AddWithValue ("@name", cat.Name) + cmd.Parameters.AddWithValue ("@slug", cat.Slug) cmd.Parameters.AddWithValue ("@description", maybe cat.Description) - cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map CategoryId.toString)) + cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map CategoryId.toString)) ] |> ignore /// Add a category let add cat = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - INSERT INTO category ( + cmd.CommandText <- + "INSERT INTO category ( id, web_log_id, name, slug, description, parent_id ) VALUES ( @id, @webLogId, @name, @slug, @description, @parentId - )""" + )" addCategoryParameters cmd cat let! _ = cmd.ExecuteNonQueryAsync () () @@ -70,13 +70,13 @@ type SQLiteCategoryData (conn : SqliteConnection) = // Parent category post counts include posts in subcategories cmd.Parameters.Clear () addWebLogId cmd webLogId - cmd.CommandText <- """ - SELECT COUNT(DISTINCT p.id) + cmd.CommandText <- + "SELECT COUNT(DISTINCT p.id) 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 (""" + AND pc.category_id IN (" ordered |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name) |> Seq.map (fun cat -> cat.Id) @@ -133,19 +133,15 @@ type SQLiteCategoryData (conn : SqliteConnection) = cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map CategoryId.toString)) |> ignore do! write cmd - // Delete the category off all posts where it is assigned - cmd.CommandText <- """ - DELETE FROM post_category - WHERE category_id = @id - AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)""" + // Delete the category off all posts where it is assigned, and the category itself + cmd.CommandText <- + "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" cmd.Parameters.Clear () - let catIdParameter = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) - cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore - do! write cmd - // Delete the category itself - cmd.CommandText <- "DELETE FROM category WHERE id = @id" - cmd.Parameters.Clear () - cmd.Parameters.Add catIdParameter |> ignore + let _ = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) + addWebLogId cmd webLogId do! write cmd return if children = 0 then CategoryDeleted else ReassignedChildCategories | None -> return CategoryNotFound @@ -160,14 +156,14 @@ type SQLiteCategoryData (conn : SqliteConnection) = /// Update a category let update cat = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - UPDATE category - SET name = @name, - slug = @slug, - description = @description, - parent_id = @parentId - WHERE id = @id - AND web_log_id = @webLogId""" + cmd.CommandText <- + "UPDATE category + SET name = @name, + slug = @slug, + description = @description, + parent_id = @parentId + WHERE id = @id + AND web_log_id = @webLogId" addCategoryParameters cmd cat do! write cmd } diff --git a/src/MyWebLog.Data/SQLite/SQLitePageData.fs b/src/MyWebLog.Data/SQLite/SQLitePageData.fs index 7ca61fc..9d71761 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePageData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePageData.fs @@ -12,16 +12,16 @@ type SQLitePageData (conn : SqliteConnection) = /// Add parameters for page INSERT or UPDATE statements let addPageParameters (cmd : SqliteCommand) (page : Page) = - [ cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id) - cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId) - cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId) - cmd.Parameters.AddWithValue ("@title", page.Title) - cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink) - cmd.Parameters.AddWithValue ("@publishedOn", page.PublishedOn) - cmd.Parameters.AddWithValue ("@updatedOn", page.UpdatedOn) + [ cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id) + cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId) + cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId) + cmd.Parameters.AddWithValue ("@title", page.Title) + cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink) + cmd.Parameters.AddWithValue ("@publishedOn", instantParam page.PublishedOn) + cmd.Parameters.AddWithValue ("@updatedOn", instantParam page.UpdatedOn) cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList) - cmd.Parameters.AddWithValue ("@template", maybe page.Template) - cmd.Parameters.AddWithValue ("@text", page.Text) + cmd.Parameters.AddWithValue ("@template", maybe page.Template) + cmd.Parameters.AddWithValue ("@text", page.Text) ] |> ignore /// Append meta items to a page @@ -139,14 +139,14 @@ type SQLitePageData (conn : SqliteConnection) = let add page = backgroundTask { use cmd = conn.CreateCommand () // The page itself - cmd.CommandText <- """ - INSERT INTO page ( + cmd.CommandText <- + "INSERT INTO page ( id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template, page_text ) VALUES ( @id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template, @text - )""" + )" addPageParameters cmd page do! write cmd do! updatePageMeta page.Id [] page.Metadata @@ -174,11 +174,11 @@ type SQLitePageData (conn : SqliteConnection) = /// Count all pages shown in the page list for the given web log let countListed webLogId = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - SELECT COUNT(id) - FROM page - WHERE web_log_id = @webLogId - AND is_in_page_list = @isInPageList""" + cmd.CommandText <- + "SELECT COUNT(id) + FROM page + WHERE web_log_id = @webLogId + AND is_in_page_list = @isInPageList" addWebLogId cmd webLogId cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore return! count cmd @@ -211,11 +211,11 @@ type SQLitePageData (conn : SqliteConnection) = | Some _ -> use cmd = conn.CreateCommand () cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore - cmd.CommandText <- """ - DELETE FROM page_revision WHERE page_id = @id; - DELETE FROM page_permalink WHERE page_id = @id; - DELETE FROM page_meta WHERE page_id = @id; - DELETE FROM page WHERE id = @id""" + cmd.CommandText <- + "DELETE FROM page_revision WHERE page_id = @id; + DELETE FROM page_permalink WHERE page_id = @id; + DELETE FROM page_meta WHERE page_id = @id; + DELETE FROM page WHERE id = @id" do! write cmd return true | None -> return false @@ -238,12 +238,12 @@ type SQLitePageData (conn : SqliteConnection) = /// Find the current permalink within a set of potential prior permalinks for the given web log let findCurrentPermalink permalinks webLogId = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - SELECT p.permalink - FROM page p - INNER JOIN page_permalink pp ON pp.page_id = p.id - WHERE p.web_log_id = @webLogId - AND pp.permalink IN (""" + cmd.CommandText <- + "SELECT p.permalink + FROM page p + INNER JOIN page_permalink pp ON pp.page_id = p.id + WHERE p.web_log_id = @webLogId + AND pp.permalink IN (" permalinks |> List.iteri (fun idx link -> if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " @@ -274,12 +274,12 @@ type SQLitePageData (conn : SqliteConnection) = /// Get all listed pages for the given web log (without revisions, prior permalinks, or text) let findListed webLogId = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - SELECT * - FROM page - WHERE web_log_id = @webLogId - AND is_in_page_list = @isInPageList - ORDER BY LOWER(title)""" + cmd.CommandText <- + "SELECT * + FROM page + WHERE web_log_id = @webLogId + AND is_in_page_list = @isInPageList + ORDER BY LOWER(title)" addWebLogId cmd webLogId cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore use! rdr = cmd.ExecuteReaderAsync () @@ -293,12 +293,12 @@ type SQLitePageData (conn : SqliteConnection) = /// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata) let findPageOfPages webLogId pageNbr = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - SELECT * - FROM page - WHERE web_log_id = @webLogId - ORDER BY LOWER(title) - LIMIT @pageSize OFFSET @toSkip""" + cmd.CommandText <- + "SELECT * + FROM page + WHERE web_log_id = @webLogId + ORDER BY LOWER(title) + LIMIT @pageSize OFFSET @toSkip" addWebLogId cmd webLogId [ cmd.Parameters.AddWithValue ("@pageSize", 26) cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25) @@ -318,18 +318,18 @@ type SQLitePageData (conn : SqliteConnection) = match! findFullById page.Id page.WebLogId with | Some oldPage -> use cmd = conn.CreateCommand () - cmd.CommandText <- """ - UPDATE page - SET author_id = @authorId, - title = @title, - permalink = @permalink, - published_on = @publishedOn, - updated_on = @updatedOn, - is_in_page_list = @isInPageList, - template = @template, - page_text = @text - WHERE id = @id - AND web_log_id = @webLogId""" + cmd.CommandText <- + "UPDATE page + SET author_id = @authorId, + title = @title, + permalink = @permalink, + published_on = @publishedOn, + updated_on = @updatedOn, + is_in_page_list = @isInPageList, + template = @template, + page_text = @text + WHERE id = @id + AND web_log_id = @webLogId" addPageParameters cmd page do! write cmd do! updatePageMeta page.Id oldPage.Metadata page.Metadata diff --git a/src/MyWebLog.Data/SQLite/SQLitePostData.fs b/src/MyWebLog.Data/SQLite/SQLitePostData.fs index 5de370b..3a8f7fd 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePostData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePostData.fs @@ -13,36 +13,37 @@ type SQLitePostData (conn : SqliteConnection) = /// Add parameters for post INSERT or UPDATE statements let addPostParameters (cmd : SqliteCommand) (post : Post) = - [ cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id) - cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId) - cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId) - cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status) - cmd.Parameters.AddWithValue ("@title", post.Title) - cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink) - cmd.Parameters.AddWithValue ("@publishedOn", maybe post.PublishedOn) - cmd.Parameters.AddWithValue ("@updatedOn", post.UpdatedOn) - cmd.Parameters.AddWithValue ("@template", maybe post.Template) - cmd.Parameters.AddWithValue ("@text", post.Text) + [ cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id) + cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId) + cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId) + cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status) + cmd.Parameters.AddWithValue ("@title", post.Title) + cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink) + cmd.Parameters.AddWithValue ("@publishedOn", maybeInstant post.PublishedOn) + cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn) + cmd.Parameters.AddWithValue ("@template", maybe post.Template) + cmd.Parameters.AddWithValue ("@text", post.Text) ] |> ignore /// Add parameters for episode INSERT or UPDATE statements let addEpisodeParameters (cmd : SqliteCommand) (ep : Episode) = - [ cmd.Parameters.AddWithValue ("@media", ep.Media) - cmd.Parameters.AddWithValue ("@length", ep.Length) - cmd.Parameters.AddWithValue ("@duration", maybe ep.Duration) - cmd.Parameters.AddWithValue ("@mediaType", maybe ep.MediaType) - cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.ImageUrl) - cmd.Parameters.AddWithValue ("@subtitle", maybe ep.Subtitle) - cmd.Parameters.AddWithValue ("@explicit", maybe (ep.Explicit |> Option.map ExplicitRating.toString)) - cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.ChapterFile) - cmd.Parameters.AddWithValue ("@chapterType", maybe ep.ChapterType) - cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.TranscriptUrl) - cmd.Parameters.AddWithValue ("@transcriptType", maybe ep.TranscriptType) - cmd.Parameters.AddWithValue ("@transcriptLang", maybe ep.TranscriptLang) + [ cmd.Parameters.AddWithValue ("@media", ep.Media) + cmd.Parameters.AddWithValue ("@length", ep.Length) + cmd.Parameters.AddWithValue ("@duration", maybeDuration ep.Duration) + cmd.Parameters.AddWithValue ("@mediaType", maybe ep.MediaType) + cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.ImageUrl) + cmd.Parameters.AddWithValue ("@subtitle", maybe ep.Subtitle) + cmd.Parameters.AddWithValue ("@explicit", maybe (ep.Explicit + |> Option.map ExplicitRating.toString)) + cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.ChapterFile) + cmd.Parameters.AddWithValue ("@chapterType", maybe ep.ChapterType) + cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.TranscriptUrl) + cmd.Parameters.AddWithValue ("@transcriptType", maybe ep.TranscriptType) + cmd.Parameters.AddWithValue ("@transcriptLang", maybe ep.TranscriptLang) cmd.Parameters.AddWithValue ("@transcriptCaptions", maybe ep.TranscriptCaptions) - cmd.Parameters.AddWithValue ("@seasonNumber", maybe ep.SeasonNumber) - cmd.Parameters.AddWithValue ("@seasonDescription", maybe ep.SeasonDescription) - cmd.Parameters.AddWithValue ("@episodeNumber", maybe (ep.EpisodeNumber |> Option.map string)) + cmd.Parameters.AddWithValue ("@seasonNumber", maybe ep.SeasonNumber) + cmd.Parameters.AddWithValue ("@seasonDescription", maybe ep.SeasonDescription) + cmd.Parameters.AddWithValue ("@episodeNumber", maybe (ep.EpisodeNumber |> Option.map string)) cmd.Parameters.AddWithValue ("@episodeDescription", maybe ep.EpisodeDescription) ] |> ignore @@ -158,26 +159,26 @@ type SQLitePostData (conn : SqliteConnection) = if count = 1 then match post.Episode with | Some ep -> - cmd.CommandText <- """ - UPDATE post_episode - SET media = @media, - length = @length, - duration = @duration, - media_type = @mediaType, - image_url = @imageUrl, - subtitle = @subtitle, - explicit = @explicit, - chapter_file = @chapterFile, - chapter_type = @chapterType, - transcript_url = @transcriptUrl, - transcript_type = @transcriptType, - transcript_lang = @transcriptLang, - transcript_captions = @transcriptCaptions, - season_number = @seasonNumber, - season_description = @seasonDescription, - episode_number = @episodeNumber, - episode_description = @episodeDescription - WHERE post_id = @postId""" + cmd.CommandText <- + "UPDATE post_episode + SET media = @media, + length = @length, + duration = @duration, + media_type = @mediaType, + image_url = @imageUrl, + subtitle = @subtitle, + explicit = @explicit, + chapter_file = @chapterFile, + chapter_type = @chapterType, + transcript_url = @transcriptUrl, + transcript_type = @transcriptType, + transcript_lang = @transcriptLang, + transcript_captions = @transcriptCaptions, + season_number = @seasonNumber, + season_description = @seasonDescription, + episode_number = @episodeNumber, + episode_description = @episodeDescription + WHERE post_id = @postId" addEpisodeParameters cmd ep do! write cmd | None -> @@ -186,8 +187,8 @@ type SQLitePostData (conn : SqliteConnection) = else match post.Episode with | Some ep -> - cmd.CommandText <- """ - INSERT INTO post_episode ( + cmd.CommandText <- + "INSERT INTO post_episode ( post_id, media, length, duration, media_type, image_url, subtitle, explicit, chapter_file, chapter_type, transcript_url, transcript_type, transcript_lang, transcript_captions, season_number, season_description, episode_number, episode_description @@ -195,7 +196,7 @@ type SQLitePostData (conn : SqliteConnection) = @postId, @media, @length, @duration, @mediaType, @imageUrl, @subtitle, @explicit, @chapterFile, @chapterType, @transcriptUrl, @transcriptType, @transcriptLang, @transcriptCaptions, @seasonNumber, @seasonDescription, @episodeNumber, @episodeDescription - )""" + )" addEpisodeParameters cmd ep do! write cmd | None -> () @@ -287,12 +288,12 @@ type SQLitePostData (conn : SqliteConnection) = /// Add a post let add post = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - INSERT INTO post ( + cmd.CommandText <- + "INSERT INTO post ( id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text ) VALUES ( @id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text - )""" + )" addPostParameters cmd post do! write cmd do! updatePostCategories post.Id [] post.CategoryIds @@ -350,14 +351,14 @@ type SQLitePostData (conn : SqliteConnection) = | Some _ -> use cmd = conn.CreateCommand () cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore - cmd.CommandText <- """ - DELETE FROM post_revision WHERE post_id = @id; - DELETE FROM post_permalink WHERE post_id = @id; - DELETE FROM post_meta WHERE post_id = @id; - DELETE FROM post_episode WHERE post_id = @id; - DELETE FROM post_tag WHERE post_id = @id; - DELETE FROM post_category WHERE post_id = @id; - DELETE FROM post WHERE id = @id""" + cmd.CommandText <- + "DELETE FROM post_revision WHERE post_id = @id; + DELETE FROM post_permalink WHERE post_id = @id; + DELETE FROM post_meta WHERE post_id = @id; + DELETE FROM post_episode WHERE post_id = @id; + DELETE FROM post_tag WHERE post_id = @id; + DELETE FROM post_category WHERE post_id = @id; + DELETE FROM post WHERE id = @id" do! write cmd return true | None -> return false @@ -366,12 +367,12 @@ type SQLitePostData (conn : SqliteConnection) = /// Find the current permalink from a list of potential prior permalinks for the given web log let findCurrentPermalink permalinks webLogId = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - SELECT p.permalink - FROM post p - INNER JOIN post_permalink pp ON pp.post_id = p.id - WHERE p.web_log_id = @webLogId - AND pp.permalink IN (""" + cmd.CommandText <- + "SELECT p.permalink + FROM post p + INNER JOIN post_permalink pp ON pp.post_id = p.id + WHERE p.web_log_id = @webLogId + AND pp.permalink IN (" permalinks |> List.iteri (fun idx link -> if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " @@ -402,21 +403,20 @@ type SQLitePostData (conn : SqliteConnection) = /// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks) let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- $""" + cmd.CommandText <- $" {selectPost} 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 (""" + AND pc.category_id IN (" categoryIds |> List.iteri (fun idx catId -> if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " cmd.CommandText <- $"{cmd.CommandText}@catId{idx}" cmd.Parameters.AddWithValue ($"@catId{idx}", CategoryId.toString catId) |> ignore) - cmd.CommandText <- - $"""{cmd.CommandText}) - ORDER BY published_on DESC - LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" + cmd.CommandText <- $"{cmd.CommandText}) + ORDER BY published_on DESC + LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" addWebLogId cmd webLogId cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore use! rdr = cmd.ExecuteReaderAsync () @@ -430,11 +430,11 @@ type SQLitePostData (conn : SqliteConnection) = /// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks) let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- $""" + cmd.CommandText <- $" {selectPost} - WHERE p.web_log_id = @webLogId - ORDER BY p.published_on DESC NULLS FIRST, p.updated_on - LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" + WHERE p.web_log_id = @webLogId + ORDER BY p.published_on DESC NULLS FIRST, p.updated_on + LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" addWebLogId cmd webLogId use! rdr = cmd.ExecuteReaderAsync () let! posts = @@ -447,12 +447,12 @@ type SQLitePostData (conn : SqliteConnection) = /// Get a page of published posts for the given web log (excludes revisions and prior permalinks) let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- $""" + cmd.CommandText <- $" {selectPost} - WHERE p.web_log_id = @webLogId - AND p.status = @status - ORDER BY p.published_on DESC - LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" + WHERE p.web_log_id = @webLogId + AND p.status = @status + ORDER BY p.published_on DESC + LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" addWebLogId cmd webLogId cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore use! rdr = cmd.ExecuteReaderAsync () @@ -466,14 +466,14 @@ type SQLitePostData (conn : SqliteConnection) = /// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks) let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- $""" + cmd.CommandText <- $" {selectPost} - INNER JOIN post_tag pt ON pt.post_id = p.id - WHERE p.web_log_id = @webLogId - AND p.status = @status - AND pt.tag = @tag - ORDER BY p.published_on DESC - LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" + INNER JOIN post_tag pt ON pt.post_id = p.id + WHERE p.web_log_id = @webLogId + AND p.status = @status + AND pt.tag = @tag + ORDER BY p.published_on DESC + LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" addWebLogId cmd webLogId [ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) cmd.Parameters.AddWithValue ("@tag", tag) @@ -489,13 +489,13 @@ type SQLitePostData (conn : SqliteConnection) = /// Find the next newest and oldest post from a publish date for the given web log let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- $""" + cmd.CommandText <- $" {selectPost} WHERE p.web_log_id = @webLogId AND p.status = @status AND p.published_on < @publishedOn ORDER BY p.published_on DESC - LIMIT 1""" + LIMIT 1" addWebLogId cmd webLogId [ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) cmd.Parameters.AddWithValue ("@publishedOn", publishedOn) @@ -509,13 +509,13 @@ type SQLitePostData (conn : SqliteConnection) = return None } do! rdr.CloseAsync () - cmd.CommandText <- $""" + cmd.CommandText <- $" {selectPost} WHERE p.web_log_id = @webLogId AND p.status = @status AND p.published_on > @publishedOn ORDER BY p.published_on - LIMIT 1""" + LIMIT 1" use! rdr = cmd.ExecuteReaderAsync () let! newer = backgroundTask { if rdr.Read () then @@ -538,18 +538,18 @@ type SQLitePostData (conn : SqliteConnection) = match! findFullById post.Id post.WebLogId with | Some oldPost -> use cmd = conn.CreateCommand () - cmd.CommandText <- """ - UPDATE post - SET author_id = @authorId, - status = @status, - title = @title, - permalink = @permalink, - published_on = @publishedOn, - updated_on = @updatedOn, - template = @template, - post_text = @text - WHERE id = @id - AND web_log_id = @webLogId""" + cmd.CommandText <- + "UPDATE post + SET author_id = @authorId, + status = @status, + title = @title, + permalink = @permalink, + published_on = @publishedOn, + updated_on = @updatedOn, + template = @template, + post_text = @text + WHERE id = @id + AND web_log_id = @webLogId" addPostParameters cmd post do! write cmd do! updatePostCategories post.Id oldPost.CategoryIds post.CategoryIds diff --git a/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs b/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs index 12f53a5..2adc75c 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs @@ -50,11 +50,11 @@ type SQLiteTagMapData (conn : SqliteConnection) = /// Find any tag mappings in a list of tags for the given web log let findMappingForTags (tags : string list) webLogId = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - SELECT * - FROM tag_map - WHERE web_log_id = @webLogId - AND tag IN (""" + cmd.CommandText <- + "SELECT * + FROM tag_map + WHERE web_log_id = @webLogId + AND tag IN (" tags |> List.iteri (fun idx tag -> if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " @@ -71,19 +71,19 @@ type SQLiteTagMapData (conn : SqliteConnection) = use cmd = conn.CreateCommand () match! findById tagMap.Id tagMap.WebLogId with | Some _ -> - cmd.CommandText <- """ - UPDATE tag_map - SET tag = @tag, - url_value = @urlValue - WHERE id = @id - AND web_log_id = @webLogId""" + cmd.CommandText <- + "UPDATE tag_map + SET tag = @tag, + url_value = @urlValue + WHERE id = @id + AND web_log_id = @webLogId" | None -> - cmd.CommandText <- """ - INSERT INTO tag_map ( + cmd.CommandText <- + "INSERT INTO tag_map ( id, web_log_id, tag, url_value ) VALUES ( @id, @webLogId, @tag, @urlValue - )""" + )" addWebLogId cmd tagMap.WebLogId [ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id) cmd.Parameters.AddWithValue ("@tag", tagMap.Tag) diff --git a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs index 7a0182d..3218667 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs @@ -67,10 +67,10 @@ type SQLiteThemeData (conn : SqliteConnection) = match! findByIdWithoutText themeId with | Some _ -> use cmd = conn.CreateCommand () - cmd.CommandText <- """ - DELETE FROM theme_asset WHERE theme_id = @id; - DELETE FROM theme_template WHERE theme_id = @id; - DELETE FROM theme WHERE id = @id""" + cmd.CommandText <- + "DELETE FROM theme_asset WHERE theme_id = @id; + DELETE FROM theme_template WHERE theme_id = @id; + DELETE FROM theme WHERE id = @id" cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore do! write cmd return true @@ -208,20 +208,20 @@ type SQLiteThemeAssetData (conn : SqliteConnection) = use cmd = conn.CreateCommand () cmd.CommandText <- if exists = 1 then - """UPDATE theme_asset - SET updated_on = @updatedOn, - data = ZEROBLOB(@dataLength) - WHERE theme_id = @themeId - AND path = @path""" + "UPDATE theme_asset + SET updated_on = @updatedOn, + data = ZEROBLOB(@dataLength) + WHERE theme_id = @themeId + AND path = @path" else - """INSERT INTO theme_asset ( - theme_id, path, updated_on, data - ) VALUES ( - @themeId, @path, @updatedOn, ZEROBLOB(@dataLength) - )""" + "INSERT INTO theme_asset ( + theme_id, path, updated_on, data + ) VALUES ( + @themeId, @path, @updatedOn, ZEROBLOB(@dataLength) + )" [ cmd.Parameters.AddWithValue ("@themeId", themeId) cmd.Parameters.AddWithValue ("@path", path) - cmd.Parameters.AddWithValue ("@updatedOn", asset.UpdatedOn) + cmd.Parameters.AddWithValue ("@updatedOn", instantParam asset.UpdatedOn) cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length) ] |> ignore do! write cmd diff --git a/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs b/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs index 3960194..886e113 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs @@ -10,22 +10,22 @@ type SQLiteUploadData (conn : SqliteConnection) = /// Add parameters for uploaded file INSERT and UPDATE statements let addUploadParameters (cmd : SqliteCommand) (upload : Upload) = - [ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id) - cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId) - cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.Path) - cmd.Parameters.AddWithValue ("@updatedOn", upload.UpdatedOn) + [ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id) + cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId) + cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.Path) + cmd.Parameters.AddWithValue ("@updatedOn", instantParam upload.UpdatedOn) cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length) ] |> ignore /// Save an uploaded file let add upload = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - INSERT INTO upload ( + cmd.CommandText <- + "INSERT INTO upload ( id, web_log_id, path, updated_on, data ) VALUES ( @id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength) - )""" + )" addUploadParameters cmd upload do! write cmd @@ -40,11 +40,11 @@ type SQLiteUploadData (conn : SqliteConnection) = /// Delete an uploaded file by its ID let delete uploadId webLogId = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - SELECT id, web_log_id, path, updated_on - FROM upload - WHERE id = @id - AND web_log_id = @webLogId""" + cmd.CommandText <- + "SELECT id, web_log_id, path, updated_on + FROM upload + WHERE id = @id + AND web_log_id = @webLogId" addWebLogId cmd webLogId cmd.Parameters.AddWithValue ("@id", UploadId.toString uploadId) |> ignore let! rdr = cmd.ExecuteReaderAsync () diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs index c498c13..7203ac9 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs @@ -15,67 +15,68 @@ type SQLiteWebLogData (conn : SqliteConnection) = /// Add parameters for web log INSERT or web log/RSS options UPDATE statements let addWebLogRssParameters (cmd : SqliteCommand) (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 ("@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) + cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled) + cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright) ] |> ignore /// Add parameters for web log INSERT or UPDATE statements let addWebLogParameters (cmd : SqliteCommand) (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 ("@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) + 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 /// 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 ("@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) + cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source) + cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path) ] |> ignore /// Add parameters for podcast INSERT or UPDATE statements let addPodcastParameters (cmd : SqliteCommand) feedId (podcast : PodcastOptions) = - [ cmd.Parameters.AddWithValue ("@feedId", CustomFeedId.toString feedId) - cmd.Parameters.AddWithValue ("@title", podcast.Title) - cmd.Parameters.AddWithValue ("@subtitle", maybe podcast.Subtitle) - cmd.Parameters.AddWithValue ("@itemsInFeed", podcast.ItemsInFeed) - cmd.Parameters.AddWithValue ("@summary", podcast.Summary) - cmd.Parameters.AddWithValue ("@displayedAuthor", podcast.DisplayedAuthor) - cmd.Parameters.AddWithValue ("@email", podcast.Email) - cmd.Parameters.AddWithValue ("@imageUrl", Permalink.toString podcast.ImageUrl) - cmd.Parameters.AddWithValue ("@appleCategory", podcast.AppleCategory) + [ cmd.Parameters.AddWithValue ("@feedId", CustomFeedId.toString feedId) + cmd.Parameters.AddWithValue ("@title", podcast.Title) + cmd.Parameters.AddWithValue ("@subtitle", maybe podcast.Subtitle) + cmd.Parameters.AddWithValue ("@itemsInFeed", podcast.ItemsInFeed) + cmd.Parameters.AddWithValue ("@summary", podcast.Summary) + cmd.Parameters.AddWithValue ("@displayedAuthor", podcast.DisplayedAuthor) + cmd.Parameters.AddWithValue ("@email", podcast.Email) + cmd.Parameters.AddWithValue ("@imageUrl", Permalink.toString podcast.ImageUrl) + cmd.Parameters.AddWithValue ("@appleCategory", podcast.AppleCategory) cmd.Parameters.AddWithValue ("@appleSubcategory", maybe podcast.AppleSubcategory) - cmd.Parameters.AddWithValue ("@explicit", ExplicitRating.toString podcast.Explicit) + cmd.Parameters.AddWithValue ("@explicit", ExplicitRating.toString podcast.Explicit) cmd.Parameters.AddWithValue ("@defaultMediaType", maybe podcast.DefaultMediaType) - cmd.Parameters.AddWithValue ("@mediaBaseUrl", maybe podcast.MediaBaseUrl) - cmd.Parameters.AddWithValue ("@podcastGuid", maybe podcast.PodcastGuid) - cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.FundingUrl) - cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.FundingText) - cmd.Parameters.AddWithValue ("@medium", maybe (podcast.Medium |> Option.map PodcastMedium.toString)) + cmd.Parameters.AddWithValue ("@mediaBaseUrl", maybe podcast.MediaBaseUrl) + cmd.Parameters.AddWithValue ("@podcastGuid", maybe podcast.PodcastGuid) + cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.FundingUrl) + cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.FundingText) + cmd.Parameters.AddWithValue ("@medium", maybe (podcast.Medium + |> Option.map PodcastMedium.toString)) ] |> ignore /// Get the current custom feeds for a web log let getCustomFeeds (webLog : WebLog) = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - 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""" + cmd.CommandText <- + "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" addWebLogId cmd webLog.Id use! rdr = cmd.ExecuteReaderAsync () return toList Map.toCustomFeed rdr @@ -90,8 +91,8 @@ type SQLiteWebLogData (conn : SqliteConnection) = /// Add a podcast to a custom feed let addPodcast feedId (podcast : PodcastOptions) = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - INSERT INTO web_log_feed_podcast ( + cmd.CommandText <- + "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 @@ -99,7 +100,7 @@ type SQLiteWebLogData (conn : SqliteConnection) = @feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl, @appleCategory, @appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @podcastGuid, @fundingUrl, @fundingText, @medium - )""" + )" addPodcastParameters cmd feedId podcast do! write cmd } @@ -117,9 +118,9 @@ type SQLiteWebLogData (conn : SqliteConnection) = 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.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 }) @@ -128,12 +129,12 @@ type SQLiteWebLogData (conn : SqliteConnection) = cmd.Parameters.Clear () toAdd |> List.map (fun it -> backgroundTask { - cmd.CommandText <- """ - INSERT INTO web_log_feed ( + 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 @@ -145,12 +146,12 @@ type SQLiteWebLogData (conn : SqliteConnection) = |> 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.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 @@ -158,25 +159,25 @@ type SQLiteWebLogData (conn : SqliteConnection) = match it.Podcast with | Some podcast -> if hadPodcast then - cmd.CommandText <- """ - UPDATE web_log_feed_podcast - SET title = @title, - subtitle = @subtitle, - items_in_feed = @itemsInFeed, - summary = @summary, - displayed_author = @displayedAuthor, - email = @email, - image_url = @imageUrl, - apple_category = @appleCategory, - apple_subcategory = @appleSubcategory, - explicit = @explicit, - default_media_type = @defaultMediaType, - media_base_url = @mediaBaseUrl, - podcast_guid = @podcastGuid, - funding_url = @fundingUrl, - funding_text = @fundingText, - medium = @medium - WHERE feed_id = @feedId""" + cmd.CommandText <- + "UPDATE web_log_feed_podcast + SET title = @title, + subtitle = @subtitle, + items_in_feed = @itemsInFeed, + summary = @summary, + displayed_author = @displayedAuthor, + email = @email, + image_url = @imageUrl, + apple_category = @appleCategory, + apple_subcategory = @appleSubcategory, + explicit = @explicit, + default_media_type = @defaultMediaType, + media_base_url = @mediaBaseUrl, + podcast_guid = @podcastGuid, + funding_url = @fundingUrl, + funding_text = @fundingText, + medium = @medium + WHERE feed_id = @feedId" cmd.Parameters.Clear () addPodcastParameters cmd it.Id podcast do! write cmd @@ -200,14 +201,14 @@ type SQLiteWebLogData (conn : SqliteConnection) = /// Add a web log let add webLog = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - INSERT INTO web_log ( + 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 do! updateCustomFeeds webLog @@ -284,25 +285,25 @@ type SQLiteWebLogData (conn : SqliteConnection) = /// 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""" + 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 } @@ -310,15 +311,15 @@ type SQLiteWebLogData (conn : SqliteConnection) = /// 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""" + 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 diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs index 334dc6a..678705f 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs @@ -1,6 +1,5 @@ namespace MyWebLog.Data.SQLite -open System open Microsoft.Data.Sqlite open MyWebLog open MyWebLog.Data @@ -12,18 +11,18 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = /// Add parameters for web log user INSERT or UPDATE statements let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) = - [ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.Id) - cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.WebLogId) - cmd.Parameters.AddWithValue ("@email", user.Email) - cmd.Parameters.AddWithValue ("@firstName", user.FirstName) - cmd.Parameters.AddWithValue ("@lastName", user.LastName) + [ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.Id) + cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.WebLogId) + cmd.Parameters.AddWithValue ("@email", user.Email) + cmd.Parameters.AddWithValue ("@firstName", user.FirstName) + cmd.Parameters.AddWithValue ("@lastName", user.LastName) cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName) - cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash) - cmd.Parameters.AddWithValue ("@salt", user.Salt) - cmd.Parameters.AddWithValue ("@url", maybe user.Url) - cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel) - cmd.Parameters.AddWithValue ("@createdOn", user.CreatedOn) - cmd.Parameters.AddWithValue ("@lastSeenOn", maybe user.LastSeenOn) + cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash) + cmd.Parameters.AddWithValue ("@salt", user.Salt) + cmd.Parameters.AddWithValue ("@url", maybe user.Url) + cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel) + cmd.Parameters.AddWithValue ("@createdOn", instantParam user.CreatedOn) + cmd.Parameters.AddWithValue ("@lastSeenOn", maybeInstant user.LastSeenOn) ] |> ignore // IMPLEMENTATION FUNCTIONS @@ -31,14 +30,14 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = /// Add a user let add user = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - INSERT INTO web_log_user ( + cmd.CommandText <- + "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 - )""" + )" addWebLogUserParameters cmd user do! write cmd } @@ -116,14 +115,14 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = /// Set a user's last seen date/time to now let setLastSeen userId webLogId = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - UPDATE web_log_user - SET last_seen_on = @lastSeenOn - WHERE id = @id - AND web_log_id = @webLogId""" + cmd.CommandText <- + "UPDATE web_log_user + SET last_seen_on = @lastSeenOn + WHERE id = @id + AND web_log_id = @webLogId" addWebLogId cmd webLogId - [ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) - cmd.Parameters.AddWithValue ("@lastSeenOn", DateTime.UtcNow) + [ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) + cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Utils.now ())) ] |> ignore let! _ = cmd.ExecuteNonQueryAsync () () @@ -132,20 +131,20 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = /// Update a user let update user = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- """ - UPDATE web_log_user - 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 - WHERE id = @id - AND web_log_id = @webLogId""" + cmd.CommandText <- + "UPDATE web_log_user + 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 + WHERE id = @id + AND web_log_id = @webLogId" addWebLogUserParameters cmd user do! write cmd } diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index 3d356f4..9e1afd7 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -7,15 +7,6 @@ open MyWebLog.Data.SQLite /// SQLite myWebLog data implementation type SQLiteData (conn : SqliteConnection, log : ILogger) = - /// Determine if the given table exists - let tableExists (table : string) = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT COUNT(*) FROM sqlite_master WHERE type = 'table' AND name = @table" - cmd.Parameters.AddWithValue ("@table", table) |> ignore - let! count = count cmd - return count = 1 - } - /// The connection for this instance member _.Conn = conn @@ -44,48 +35,41 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = use cmd = conn.CreateCommand () - // Theme tables - match! tableExists "theme" with - | true -> () - | false -> - log.LogInformation "Creating theme table..." - cmd.CommandText <- """ - CREATE TABLE theme ( + let! tables = backgroundTask { + cmd.CommandText <- "SELECT name FROM sqlite_master WHERE type = 'table'" + let! rdr = cmd.ExecuteReaderAsync () + let mutable tableList = [] + while rdr.Read() do + tableList <- Map.getString "name" rdr :: tableList + do! rdr.CloseAsync () + return tableList + } + let needsTable table = + List.contains table tables + seq { + // Theme tables + if needsTable "theme" then + "CREATE TABLE theme ( id TEXT PRIMARY KEY, name TEXT NOT NULL, - version TEXT NOT NULL)""" - do! write cmd - match! tableExists "theme_template" with - | true -> () - | false -> - log.LogInformation "Creating theme_template table..." - cmd.CommandText <- """ - CREATE TABLE theme_template ( + 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))""" - do! write cmd - match! tableExists "theme_asset" with - | true -> () - | false -> - log.LogInformation "Creating theme_asset table..." - cmd.CommandText <- """ - CREATE TABLE theme_asset ( + 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 TEXT NOT NULL, data BLOB NOT NULL, - PRIMARY KEY (theme_id, path))""" - do! write cmd - - // Web log tables - match! tableExists "web_log" with - | true -> () - | false -> - log.LogInformation "Creating web_log table..." - cmd.CommandText <- """ - CREATE TABLE web_log ( + PRIMARY KEY (theme_id, path))" + + // Web log tables + if needsTable "web_log" then + "CREATE TABLE web_log ( id TEXT PRIMARY KEY, name TEXT NOT NULL, slug TEXT NOT NULL, @@ -103,26 +87,16 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = is_category_enabled INTEGER NOT NULL DEFAULT 0, is_tag_enabled INTEGER NOT NULL DEFAULT 0, copyright TEXT); - CREATE INDEX web_log_theme_idx ON web_log (theme_id)""" - do! write cmd - match! tableExists "web_log_feed" with - | true -> () - | false -> - log.LogInformation "Creating web_log_feed table..." - cmd.CommandText <- """ - CREATE TABLE web_log_feed ( + CREATE INDEX web_log_theme_idx ON web_log (theme_id)" + if needsTable "web_log_feed" then + "CREATE TABLE web_log_feed ( id TEXT 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)""" - do! write cmd - match! tableExists "web_log_feed_podcast" with - | true -> () - | false -> - log.LogInformation "Creating web_log_feed_podcast table..." - cmd.CommandText <- """ - CREATE TABLE web_log_feed_podcast ( + 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 PRIMARY KEY REFERENCES web_log_feed (id), title TEXT NOT NULL, subtitle TEXT, @@ -139,32 +113,22 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = podcast_guid TEXT, funding_url TEXT, funding_text TEXT, - medium TEXT)""" - do! write cmd - - // Category table - match! tableExists "category" with - | true -> () - | false -> - log.LogInformation "Creating category table..." - cmd.CommandText <- """ - CREATE TABLE category ( + medium TEXT)" + + // Category table + if needsTable "category" then + "CREATE TABLE category ( id TEXT 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)""" - do! write cmd - - // Web log user table - match! tableExists "web_log_user" with - | true -> () - | false -> - log.LogInformation "Creating web_log_user table..." - cmd.CommandText <- """ - CREATE TABLE web_log_user ( + 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 PRIMARY KEY, web_log_id TEXT NOT NULL REFERENCES web_log (id), email TEXT NOT NULL, @@ -178,16 +142,11 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = created_on TEXT NOT NULL, last_seen_on TEXT); 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)""" - do! write cmd - - // Page tables - match! tableExists "page" with - | true -> () - | false -> - log.LogInformation "Creating page table..." - cmd.CommandText <- """ - CREATE TABLE page ( + 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 PRIMARY KEY, web_log_id TEXT NOT NULL REFERENCES web_log (id), author_id TEXT NOT NULL REFERENCES web_log_user (id), @@ -200,48 +159,28 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = page_text TEXT NOT NULL); 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)""" - do! write cmd - match! tableExists "page_meta" with - | true -> () - | false -> - log.LogInformation "Creating page_meta table..." - cmd.CommandText <- """ - CREATE TABLE page_meta ( + CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)" + if needsTable "page_meta" then + "CREATE TABLE page_meta ( page_id TEXT NOT NULL REFERENCES page (id), name TEXT NOT NULL, value TEXT NOT NULL, - PRIMARY KEY (page_id, name, value))""" - do! write cmd - match! tableExists "page_permalink" with - | true -> () - | false -> - log.LogInformation "Creating page_permalink table..." - cmd.CommandText <- """ - CREATE TABLE page_permalink ( + PRIMARY KEY (page_id, name, value))" + if needsTable "page_permalink" then + "CREATE TABLE page_permalink ( page_id TEXT NOT NULL REFERENCES page (id), permalink TEXT NOT NULL, - PRIMARY KEY (page_id, permalink))""" - do! write cmd - match! tableExists "page_revision" with - | true -> () - | false -> - log.LogInformation "Creating page_revision table..." - cmd.CommandText <- """ - CREATE TABLE page_revision ( + PRIMARY KEY (page_id, permalink))" + if needsTable "page_revision" then + "CREATE TABLE page_revision ( page_id TEXT NOT NULL REFERENCES page (id), as_of TEXT NOT NULL, revision_text TEXT NOT NULL, - PRIMARY KEY (page_id, as_of))""" - do! write cmd - - // Post tables - match! tableExists "post" with - | true -> () - | false -> - log.LogInformation "Creating post table..." - cmd.CommandText <- """ - CREATE TABLE post ( + PRIMARY KEY (page_id, as_of))" + + // Post tables + if needsTable "post" then + "CREATE TABLE post ( id TEXT PRIMARY KEY, web_log_id TEXT NOT NULL REFERENCES web_log (id), author_id TEXT NOT NULL REFERENCES web_log_user (id), @@ -255,25 +194,15 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = 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)""" - do! write cmd - match! tableExists "post_category" with - | true -> () - | false -> - log.LogInformation "Creating post_category table..." - cmd.CommandText <- """ - CREATE TABLE post_category ( + 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)""" - do! write cmd - match! tableExists "post_episode" with - | true -> () - | false -> - log.LogInformation "Creating post_episode table..." - cmd.CommandText <- """ - CREATE TABLE post_episode ( + CREATE INDEX post_category_category_idx ON post_category (category_id)" + if needsTable "post_episode" then + "CREATE TABLE post_episode ( post_id TEXT PRIMARY KEY REFERENCES post(id), media TEXT NOT NULL, length INTEGER NOT NULL, @@ -291,56 +220,31 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = season_number INTEGER, season_description TEXT, episode_number TEXT, - episode_description TEXT)""" - do! write cmd - match! tableExists "post_tag" with - | true -> () - | false -> - log.LogInformation "Creating post_tag table..." - cmd.CommandText <- """ - CREATE TABLE post_tag ( + episode_description TEXT)" + if needsTable "post_tag" then + "CREATE TABLE post_tag ( post_id TEXT NOT NULL REFERENCES post (id), tag TEXT NOT NULL, - PRIMARY KEY (post_id, tag))""" - do! write cmd - match! tableExists "post_meta" with - | true -> () - | false -> - log.LogInformation "Creating post_meta table..." - cmd.CommandText <- """ - CREATE TABLE post_meta ( + PRIMARY KEY (post_id, tag))" + if needsTable "post_meta" then + "CREATE TABLE post_meta ( post_id TEXT NOT NULL REFERENCES post (id), name TEXT NOT NULL, value TEXT NOT NULL, - PRIMARY KEY (post_id, name, value))""" - do! write cmd - match! tableExists "post_permalink" with - | true -> () - | false -> - log.LogInformation "Creating post_permalink table..." - cmd.CommandText <- """ - CREATE TABLE post_permalink ( + PRIMARY KEY (post_id, name, value))" + if needsTable "post_permalink" then + "CREATE TABLE post_permalink ( post_id TEXT NOT NULL REFERENCES post (id), permalink TEXT NOT NULL, - PRIMARY KEY (post_id, permalink))""" - do! write cmd - match! tableExists "post_revision" with - | true -> () - | false -> - log.LogInformation "Creating post_revision table..." - cmd.CommandText <- """ - CREATE TABLE post_revision ( + PRIMARY KEY (post_id, permalink))" + if needsTable "post_revision" then + "CREATE TABLE post_revision ( post_id TEXT NOT NULL REFERENCES post (id), as_of TEXT NOT NULL, revision_text TEXT NOT NULL, - PRIMARY KEY (post_id, as_of))""" - do! write cmd - match! tableExists "post_comment" with - | true -> () - | false -> - log.LogInformation "Creating post_comment table..." - cmd.CommandText <- """ - CREATE TABLE post_comment ( + PRIMARY KEY (post_id, as_of))" + if needsTable "post_comment" then + "CREATE TABLE post_comment ( id TEXT PRIMARY KEY, post_id TEXT NOT NULL REFERENCES post(id), in_reply_to_id TEXT, @@ -350,36 +254,32 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = status TEXT NOT NULL, posted_on TEXT NOT NULL, comment_text TEXT NOT NULL); - CREATE INDEX post_comment_post_idx ON post_comment (post_id)""" - do! write cmd - - // Tag map table - match! tableExists "tag_map" with - | true -> () - | false -> - log.LogInformation "Creating tag_map table..." - cmd.CommandText <- """ - CREATE TABLE tag_map ( + 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 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)""" - do! write cmd - - // Uploaded file table - match! tableExists "upload" with - | true -> () - | false -> - log.LogInformation "Creating upload table..." - cmd.CommandText <- """ - CREATE TABLE upload ( + 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 PRIMARY KEY, web_log_id TEXT NOT NULL REFERENCES web_log (id), path TEXT NOT NULL, updated_on TEXT NOT NULL, data BLOB NOT NULL); CREATE INDEX upload_web_log_idx ON upload (web_log_id); - CREATE INDEX upload_path_idx ON upload (web_log_id, path)""" - do! write cmd + CREATE INDEX upload_path_idx ON upload (web_log_id, path)" + } + |> Seq.map (fun sql -> + log.LogInformation $"Creating {(sql.Split ' ')[2]} table..." + cmd.CommandText <- sql + write cmd |> Async.AwaitTask |> Async.RunSynchronously) + |> List.ofSeq + |> ignore } diff --git a/src/MyWebLog.Data/Utils.fs b/src/MyWebLog.Data/Utils.fs index cc06d9b..f0b6ee0 100644 --- a/src/MyWebLog.Data/Utils.fs +++ b/src/MyWebLog.Data/Utils.fs @@ -35,5 +35,8 @@ let diffPermalinks oldLinks newLinks = /// Find the revisions added and removed let diffRevisions oldRevs newRevs = - diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.Ticks}|{MarkupText.toString rev.Text}") + diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.ToUnixTimeTicks ()}|{MarkupText.toString rev.Text}") +/// Get the current instant +let now () = + NodaTime.SystemClock.Instance.GetCurrentInstant () \ No newline at end of file diff --git a/src/MyWebLog.Domain/DataTypes.fs b/src/MyWebLog.Domain/DataTypes.fs index be25d27..2c1febe 100644 --- a/src/MyWebLog.Domain/DataTypes.fs +++ b/src/MyWebLog.Domain/DataTypes.fs @@ -2,6 +2,7 @@ open System open MyWebLog +open NodaTime /// A category under which a post may be identified [] @@ -64,7 +65,7 @@ type Comment = Status : CommentStatus /// When the comment was posted - PostedOn : DateTime + PostedOn : Instant /// The text of the comment Text : string @@ -82,7 +83,7 @@ module Comment = Email = "" Url = None Status = Pending - PostedOn = DateTime.UtcNow + PostedOn = Instant.MinValue Text = "" } @@ -106,10 +107,10 @@ type Page = Permalink : Permalink /// When this page was published - PublishedOn : DateTime + PublishedOn : Instant /// When this page was last updated - UpdatedOn : DateTime + UpdatedOn : Instant /// Whether this page shows as part of the web log's navigation IsInPageList : bool @@ -140,8 +141,8 @@ module Page = AuthorId = WebLogUserId.empty Title = "" Permalink = Permalink.empty - PublishedOn = DateTime.MinValue - UpdatedOn = DateTime.MinValue + PublishedOn = Instant.MinValue + UpdatedOn = Instant.MinValue IsInPageList = false Template = None Text = "" @@ -173,10 +174,10 @@ type Post = Permalink : Permalink /// The instant on which the post was originally published - PublishedOn : DateTime option + PublishedOn : Instant option /// The instant on which the post was last updated - UpdatedOn : DateTime + UpdatedOn : Instant /// The template to use in displaying the post Template : string option @@ -215,7 +216,7 @@ module Post = Title = "" Permalink = Permalink.empty PublishedOn = None - UpdatedOn = DateTime.MinValue + UpdatedOn = Instant.MinValue Text = "" Template = None CategoryIds = [] @@ -288,7 +289,7 @@ type ThemeAsset = Id : ThemeAssetId /// The updated date (set from the file date from the ZIP archive) - UpdatedOn : DateTime + UpdatedOn : Instant /// The data for the asset Data : byte[] @@ -300,7 +301,7 @@ module ThemeAsset = /// An empty theme asset let empty = { Id = ThemeAssetId (ThemeId "", "") - UpdatedOn = DateTime.MinValue + UpdatedOn = Instant.MinValue Data = [||] } @@ -317,7 +318,7 @@ type Upload = Path : Permalink /// The updated date/time for this upload - UpdatedOn : DateTime + UpdatedOn : Instant /// The data for the upload Data : byte[] @@ -331,7 +332,7 @@ module Upload = { Id = UploadId.empty WebLogId = WebLogId.empty Path = Permalink.empty - UpdatedOn = DateTime.MinValue + UpdatedOn = Instant.MinValue Data = [||] } @@ -410,10 +411,11 @@ module WebLog = let _, leadPath = hostAndPath webLog $"{leadPath}/{Permalink.toString permalink}" - /// Convert a UTC date/time to the web log's local date/time - let localTime webLog (date : DateTime) = - TimeZoneInfo.ConvertTimeFromUtc - (DateTime (date.Ticks, DateTimeKind.Utc), TimeZoneInfo.FindSystemTimeZoneById webLog.TimeZone) + /// Convert an Instant (UTC reference) to the web log's local date/time + let localTime webLog (date : Instant) = + match DateTimeZoneProviders.Tzdb[webLog.TimeZone] with + | null -> date.ToDateTimeUtc () + | tz -> date.InZone(tz).ToDateTimeUnspecified () /// A user of the web log @@ -450,10 +452,10 @@ type WebLogUser = AccessLevel : AccessLevel /// When the user was created - CreatedOn : DateTime + CreatedOn : Instant /// When the user last logged on - LastSeenOn : DateTime option + LastSeenOn : Instant option } /// Functions to support web log users @@ -471,7 +473,7 @@ module WebLogUser = Salt = Guid.Empty Url = None AccessLevel = Author - CreatedOn = DateTime.UnixEpoch + CreatedOn = Instant.FromUnixTimeSeconds 0L LastSeenOn = None } diff --git a/src/MyWebLog.Domain/MyWebLog.Domain.fsproj b/src/MyWebLog.Domain/MyWebLog.Domain.fsproj index 3414816..49fa066 100644 --- a/src/MyWebLog.Domain/MyWebLog.Domain.fsproj +++ b/src/MyWebLog.Domain/MyWebLog.Domain.fsproj @@ -7,9 +7,10 @@ - + + diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index e73a4fb..30e6910 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -1,6 +1,7 @@ namespace MyWebLog open System +open NodaTime /// Support functions for domain definition [] @@ -146,7 +147,7 @@ type Episode = Length : int64 /// The duration of the episode - Duration : TimeSpan option + Duration : Duration option /// The media type of the file (overrides podcast default if present) MediaType : string option @@ -269,12 +270,11 @@ module MetaItem = let empty = { Name = ""; Value = "" } - /// A revision of a page or post [] type Revision = { /// When this revision was saved - AsOf : DateTime + AsOf : Instant /// The text of the revision Text : MarkupText @@ -285,7 +285,7 @@ module Revision = /// An empty revision let empty = - { AsOf = DateTime.UtcNow + { AsOf = Instant.MinValue Text = Html "" } diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index 8dbc854..d2e71b1 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -2,6 +2,8 @@ open System open MyWebLog +open NodaTime +open NodaTime.Text /// Helper functions for view models [] @@ -138,8 +140,8 @@ type DisplayPage = AuthorId = WebLogUserId.toString page.AuthorId Title = page.Title Permalink = Permalink.toString page.Permalink - PublishedOn = page.PublishedOn - UpdatedOn = page.UpdatedOn + PublishedOn = WebLog.localTime webLog page.PublishedOn + UpdatedOn = WebLog.localTime webLog page.UpdatedOn IsInPageList = page.IsInPageList IsDefault = pageId = webLog.DefaultPage Text = "" @@ -154,8 +156,8 @@ type DisplayPage = AuthorId = WebLogUserId.toString page.AuthorId Title = page.Title Permalink = Permalink.toString page.Permalink - PublishedOn = page.PublishedOn - UpdatedOn = page.UpdatedOn + PublishedOn = WebLog.localTime webLog page.PublishedOn + UpdatedOn = WebLog.localTime webLog page.UpdatedOn IsInPageList = page.IsInPageList IsDefault = pageId = webLog.DefaultPage Text = addBaseToRelativeUrls extra page.Text @@ -179,7 +181,7 @@ with /// Create a display revision from an actual revision static member fromRevision webLog (rev : Revision) = - { AsOf = rev.AsOf + { AsOf = rev.AsOf.ToDateTimeUtc () AsOfLocal = WebLog.localTime webLog rev.AsOf Format = MarkupText.sourceType rev.Text } @@ -703,7 +705,8 @@ type EditPostModel = match post.Revisions |> List.sortByDescending (fun r -> r.AsOf) |> List.tryHead with | Some rev -> rev | None -> Revision.empty - let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.empty ] } else post + let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.empty ] } else post + let format = DurationPattern.CreateWithInvariantCulture("H:mm:ss").Format let episode = defaultArg post.Episode Episode.empty { PostId = PostId.toString post.Id Title = post.Title @@ -723,7 +726,7 @@ type EditPostModel = IsEpisode = Option.isSome post.Episode Media = episode.Media Length = episode.Length - Duration = defaultArg (episode.Duration |> Option.map (fun it -> it.ToString """hh\:mm\:ss""")) "" + Duration = defaultArg (episode.Duration |> Option.map format) "" MediaType = defaultArg episode.MediaType "" ImageUrl = defaultArg episode.ImageUrl "" Subtitle = defaultArg episode.Subtitle "" @@ -781,7 +784,8 @@ type EditPostModel = Some { Media = this.Media Length = this.Length - Duration = noneIfBlank this.Duration |> Option.map TimeSpan.Parse + Duration = noneIfBlank this.Duration + |> Option.map (TimeSpan.Parse >> Duration.FromTimeSpan) MediaType = noneIfBlank this.MediaType ImageUrl = noneIfBlank this.ImageUrl Subtitle = noneIfBlank this.Subtitle diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index c620721..814405a 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -253,8 +253,7 @@ module Backup = /// Create a JSON serializer (uses RethinkDB data implementation's JSON converters) let private getSerializer prettyOutput = - let serializer = JsonSerializer.CreateDefault () - Json.all () |> Seq.iter serializer.Converters.Add + let serializer = Json.configure (JsonSerializer.CreateDefault ()) if prettyOutput then serializer.Formatting <- Formatting.Indented serializer diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 971f2be..182d1cf 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 Newtonsoft.Json open Npgsql /// Middleware to derive the current web log @@ -39,33 +40,33 @@ module DataImplementation = open RethinkDb.Driver.Net /// Get the configured data implementation - let get (sp : IServiceProvider) : IData = + let get (sp : IServiceProvider) : IData * JsonSerializer = let config = sp.GetRequiredService () let await it = (Async.AwaitTask >> Async.RunSynchronously) it let connStr name = config.GetConnectionString name let hasConnStr name = (connStr >> isNull >> not) name - let createSQLite connStr = + let createSQLite connStr : IData * JsonSerializer = let log = sp.GetRequiredService> () let conn = new SqliteConnection (connStr) log.LogInformation $"Using SQLite database {conn.DataSource}" await (SQLiteData.setUpConnection conn) - SQLiteData (conn, log) + SQLiteData (conn, log), Json.configure (JsonSerializer.CreateDefault ()) if hasConnStr "SQLite" then - upcast createSQLite (connStr "SQLite") + createSQLite (connStr "SQLite") elif hasConnStr "RethinkDB" then - let log = sp.GetRequiredService> () - Json.all () |> Seq.iter Converter.Serializer.Converters.Add + let log = sp.GetRequiredService> () + let _ = Json.configure Converter.Serializer let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB") let conn = await (rethinkCfg.CreateConnectionAsync log) - upcast RethinkDbData (conn, rethinkCfg, log) + RethinkDbData (conn, rethinkCfg, log), Converter.Serializer 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}" - PostgresData (conn, log) + PostgresData (conn, log), Json.configure (JsonSerializer.CreateDefault ()) else - upcast createSQLite "Data Source=./myweblog.db;Cache=Shared" + createSQLite "Data Source=./myweblog.db;Cache=Shared" open System.Threading.Tasks @@ -94,6 +95,7 @@ open Giraffe.EndpointRouting open Microsoft.AspNetCore.Authentication.Cookies open Microsoft.AspNetCore.Builder open Microsoft.AspNetCore.HttpOverrides +open Microsoft.Extensions.Caching.Distributed open NeoSmart.Caching.Sqlite open RethinkDB.DistributedCache @@ -114,8 +116,9 @@ let rec main args = let _ = builder.Services.AddAuthorization () let _ = builder.Services.AddAntiforgery () - let sp = builder.Services.BuildServiceProvider () - let data = DataImplementation.get sp + let sp = builder.Services.BuildServiceProvider () + let data, serializer = DataImplementation.get sp + let _ = builder.Services.AddSingleton serializer task { do! data.StartUp () @@ -127,33 +130,36 @@ let rec main args = match data with | :? RethinkDbData as rethink -> // A RethinkDB connection is designed to work as a singleton - builder.Services.AddSingleton data |> ignore - builder.Services.AddDistributedRethinkDBCache (fun opts -> - opts.TableName <- "Session" - opts.Connection <- rethink.Conn) - |> ignore + let _ = builder.Services.AddSingleton data + let _ = + builder.Services.AddDistributedRethinkDBCache (fun opts -> + opts.TableName <- "Session" + opts.Connection <- rethink.Conn) + () | :? SQLiteData as sql -> // ADO.NET connections are designed to work as per-request instantiation let cfg = sp.GetRequiredService () - builder.Services.AddScoped (fun sp -> - let conn = new SqliteConnection (sql.Conn.ConnectionString) - SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously - conn) - |> ignore - builder.Services.AddScoped () |> ignore + let _ = + builder.Services.AddScoped (fun sp -> + let conn = new SqliteConnection (sql.Conn.ConnectionString) + SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously + conn) + let _ = builder.Services.AddScoped () |> ignore // 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 + let _ = builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath) + () | :? PostgresData -> // 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.AddScoped (fun sp -> + new NpgsqlConnection (cfg.GetConnectionString "PostgreSQL")) + let _ = builder.Services.AddScoped () + let _ = + builder.Services.AddSingleton (fun sp -> + Postgres.DistributedCache (cfg.GetConnectionString "PostgreSQL") :> IDistributedCache) + () | _ -> () let _ = builder.Services.AddSession(fun opts -> -- 2.45.1 From 80e7e26d51b6056a83ff814d91a8d1ddeb6dec25 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sat, 20 Aug 2022 09:00:15 -0400 Subject: [PATCH 07/13] WIP on NodaTime implementation --- src/MyWebLog.Data/Interfaces.fs | 4 ++-- src/MyWebLog.Data/Postgres/PostgresPostData.fs | 8 ++++---- src/MyWebLog.Data/SQLite/SQLitePostData.fs | 6 +++--- src/MyWebLog.Domain/SupportTypes.fs | 6 ++++++ src/MyWebLog.Domain/ViewModels.fs | 4 +--- src/MyWebLog/Caches.fs | 4 ++++ src/MyWebLog/Handlers/Admin.fs | 4 +++- src/MyWebLog/Handlers/Feed.fs | 10 +++++----- src/MyWebLog/Handlers/Helpers.fs | 3 ++- src/MyWebLog/Handlers/Page.fs | 6 ++---- src/MyWebLog/Handlers/Post.fs | 11 +++++------ src/MyWebLog/Handlers/Routes.fs | 2 +- src/MyWebLog/Handlers/Upload.fs | 13 ++++++++----- src/MyWebLog/Handlers/User.fs | 12 +++++++----- src/MyWebLog/Maintenance.fs | 7 ++++--- src/MyWebLog/Program.fs | 8 +++++--- 16 files changed, 62 insertions(+), 46 deletions(-) diff --git a/src/MyWebLog.Data/Interfaces.fs b/src/MyWebLog.Data/Interfaces.fs index afa5e0c..970a2b3 100644 --- a/src/MyWebLog.Data/Interfaces.fs +++ b/src/MyWebLog.Data/Interfaces.fs @@ -1,9 +1,9 @@ namespace MyWebLog.Data -open System open System.Threading.Tasks open MyWebLog open MyWebLog.ViewModels +open NodaTime /// The result of a category deletion attempt type CategoryDeleteResult = @@ -137,7 +137,7 @@ type IPostData = WebLogId -> tag : string -> pageNbr : int -> postsPerPage : int -> Task /// Find the next older and newer post for the given published date/time (excluding revisions and prior permalinks) - abstract member FindSurroundingPosts : WebLogId -> publishedOn : DateTime -> Task + abstract member FindSurroundingPosts : WebLogId -> publishedOn : Instant -> Task /// Restore posts from a backup abstract member Restore : Post list -> Task diff --git a/src/MyWebLog.Data/Postgres/PostgresPostData.fs b/src/MyWebLog.Data/Postgres/PostgresPostData.fs index 4e5cb61..1e06242 100644 --- a/src/MyWebLog.Data/Postgres/PostgresPostData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresPostData.fs @@ -1,9 +1,9 @@ namespace MyWebLog.Data.Postgres -open System open MyWebLog open MyWebLog.Data open Newtonsoft.Json +open NodaTime open Npgsql open Npgsql.FSharp @@ -238,11 +238,11 @@ type PostgresPostData (conn : NpgsqlConnection) = |> Sql.executeAsync Map.toPost /// Find the next newest and oldest post from a publish date for the given web log - let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask { + let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask { let queryParams = Sql.parameters [ webLogIdParam webLogId - "@status", Sql.string (PostStatus.toString Published) - "@publishedOn", Sql.timestamptz publishedOn + typedParam "@publishedOn" publishedOn + "@status", Sql.string (PostStatus.toString Published) ] let! older = Sql.existingConnection conn diff --git a/src/MyWebLog.Data/SQLite/SQLitePostData.fs b/src/MyWebLog.Data/SQLite/SQLitePostData.fs index 3a8f7fd..ab15dcc 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePostData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePostData.fs @@ -1,10 +1,10 @@ namespace MyWebLog.Data.SQLite -open System open System.Threading.Tasks open Microsoft.Data.Sqlite open MyWebLog open MyWebLog.Data +open NodaTime /// SQLite myWebLog post data implementation type SQLitePostData (conn : SqliteConnection) = @@ -487,7 +487,7 @@ type SQLitePostData (conn : SqliteConnection) = } /// Find the next newest and oldest post from a publish date for the given web log - let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask { + let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask { use cmd = conn.CreateCommand () cmd.CommandText <- $" {selectPost} @@ -498,7 +498,7 @@ type SQLitePostData (conn : SqliteConnection) = LIMIT 1" addWebLogId cmd webLogId [ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) - cmd.Parameters.AddWithValue ("@publishedOn", publishedOn) + cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn) ] |> ignore use! rdr = cmd.ExecuteReaderAsync () let! older = backgroundTask { diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index 30e6910..c3457dc 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -138,6 +138,8 @@ module ExplicitRating = | x -> raise (invalidArg "rating" $"{x} is not a valid explicit rating") +open NodaTime.Text + /// A podcast episode type Episode = { /// The URL to the media file for the episode (may be permalink) @@ -215,6 +217,10 @@ module Episode = EpisodeNumber = None EpisodeDescription = None } + + /// Format a duration for an episode + let formatDuration ep = + ep.Duration |> Option.map (DurationPattern.CreateWithInvariantCulture("H:mm:ss").Format) open Markdig diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index d2e71b1..f7d204f 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -3,7 +3,6 @@ open System open MyWebLog open NodaTime -open NodaTime.Text /// Helper functions for view models [] @@ -706,7 +705,6 @@ type EditPostModel = | Some rev -> rev | None -> Revision.empty let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.empty ] } else post - let format = DurationPattern.CreateWithInvariantCulture("H:mm:ss").Format let episode = defaultArg post.Episode Episode.empty { PostId = PostId.toString post.Id Title = post.Title @@ -726,7 +724,7 @@ type EditPostModel = IsEpisode = Option.isSome post.Episode Media = episode.Media Length = episode.Length - Duration = defaultArg (episode.Duration |> Option.map format) "" + Duration = defaultArg (Episode.formatDuration episode) "" MediaType = defaultArg episode.MediaType "" ImageUrl = defaultArg episode.ImageUrl "" Subtitle = defaultArg episode.Subtitle "" diff --git a/src/MyWebLog/Caches.fs b/src/MyWebLog/Caches.fs index 5042f55..81fa5b3 100644 --- a/src/MyWebLog/Caches.fs +++ b/src/MyWebLog/Caches.fs @@ -11,6 +11,7 @@ module Extensions = open Microsoft.AspNetCore.Antiforgery open Microsoft.Extensions.Configuration open Microsoft.Extensions.DependencyInjection + open NodaTime /// Hold variable for the configured generator string let mutable private generatorString : string option = None @@ -20,6 +21,9 @@ module Extensions = /// The anti-CSRF service member this.AntiForgery = this.RequestServices.GetRequiredService () + /// The system clock + member this.Clock = this.RequestServices.GetRequiredService () + /// The cross-site request forgery token set for this request member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index b4ece20..04932c0 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -5,6 +5,7 @@ open System.Threading.Tasks open Giraffe open MyWebLog open MyWebLog.ViewModels +open NodaTime /// ~~ DASHBOARDS ~~ module Dashboard = @@ -344,7 +345,8 @@ module Theme = do! asset.Open().CopyToAsync stream do! data.ThemeAsset.Save { Id = ThemeAssetId (themeId, assetName) - UpdatedOn = asset.LastWriteTime.DateTime + UpdatedOn = LocalDateTime.FromDateTime(asset.LastWriteTime.DateTime) + .InZoneLeniently(DateTimeZone.Utc).ToInstant () Data = stream.ToArray () } } diff --git a/src/MyWebLog/Handlers/Feed.fs b/src/MyWebLog/Handlers/Feed.fs index 7efec6b..7db1dd9 100644 --- a/src/MyWebLog/Handlers/Feed.fs +++ b/src/MyWebLog/Handlers/Feed.fs @@ -95,8 +95,8 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[ let item = SyndicationItem ( Id = WebLog.absoluteUrl webLog post.Permalink, Title = TextSyndicationContent.CreateHtmlContent post.Title, - PublishDate = DateTimeOffset post.PublishedOn.Value, - LastUpdatedTime = DateTimeOffset post.UpdatedOn, + PublishDate = post.PublishedOn.Value.ToDateTimeOffset (), + LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset (), Content = TextSyndicationContent.CreatePlaintextContent plainText) item.AddPermalink (Uri item.Id) @@ -163,8 +163,8 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor) item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit) episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it)) - episode.Duration - |> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.ToString """hh\:mm\:ss""")) + Episode.formatDuration episode + |> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it)) match episode.ChapterFile with | Some chapters -> @@ -381,7 +381,7 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg addNamespace feed "content" Namespace.content setTitleAndDescription feedType webLog cats feed - feed.LastUpdatedTime <- (List.head posts).UpdatedOn |> DateTimeOffset + feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset () feed.Generator <- ctx.Generator feed.Items <- posts |> Seq.ofList |> Seq.map toItem feed.Language <- "en" diff --git a/src/MyWebLog/Handlers/Helpers.fs b/src/MyWebLog/Handlers/Helpers.fs index 77b6241..ee7075c 100644 --- a/src/MyWebLog/Handlers/Helpers.fs +++ b/src/MyWebLog/Handlers/Helpers.fs @@ -419,10 +419,11 @@ let getCategoryIds slug ctx = open System open System.Globalization +open NodaTime /// Parse a date/time to UTC let parseToUtc (date : string) = - DateTime.Parse (date, null, DateTimeStyles.AdjustToUniversal) + Instant.FromDateTimeUtc (DateTime.Parse (date, null, DateTimeStyles.AdjustToUniversal)) open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.Logging diff --git a/src/MyWebLog/Handlers/Page.fs b/src/MyWebLog/Handlers/Page.fs index 8869cd8..58f67c5 100644 --- a/src/MyWebLog/Handlers/Page.fs +++ b/src/MyWebLog/Handlers/Page.fs @@ -139,15 +139,13 @@ let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun | _, None -> return! Error.notFound next ctx } -open System - // POST /admin/page/{id}/revision/{revision-date}/restore let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! findPageRevision pgId revDate ctx with | Some pg, Some rev when canEdit pg.AuthorId ctx -> do! ctx.Data.Page.Update { pg with - Revisions = { rev with AsOf = DateTime.UtcNow } + Revisions = { rev with AsOf = ctx.Clock.GetCurrentInstant () } :: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) } do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" } @@ -173,7 +171,7 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { let! model = ctx.BindFormAsync () let data = ctx.Data - let now = DateTime.UtcNow + let now = ctx.Clock.GetCurrentInstant () let tryPage = if model.IsNew then { Page.empty with diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs index f79bfbe..98883c4 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -52,9 +52,9 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage (data : let! olderPost, newerPost = match listType with | SinglePost -> - let post = List.head posts - let dateTime = defaultArg post.PublishedOn post.UpdatedOn - data.Post.FindSurroundingPosts webLog.Id dateTime + let post = List.head posts + let target = defaultArg post.PublishedOn post.UpdatedOn + data.Post.FindSurroundingPosts webLog.Id target | _ -> Task.FromResult (None, None) let newerLink = match listType, pageNbr with @@ -350,7 +350,7 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f | Some post, Some rev when canEdit post.AuthorId ctx -> do! ctx.Data.Post.Update { post with - Revisions = { rev with AsOf = DateTime.UtcNow } + Revisions = { rev with AsOf = ctx.Clock.GetCurrentInstant () } :: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) } do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" } @@ -376,7 +376,6 @@ let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fu let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { let! model = ctx.BindFormAsync () let data = ctx.Data - let now = DateTime.UtcNow let tryPost = if model.IsNew then { Post.empty with @@ -389,7 +388,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { | Some post when canEdit post.AuthorId ctx -> let priorCats = post.CategoryIds let updatedPost = - model.UpdatePost post now + model.UpdatePost post (ctx.Clock.GetCurrentInstant ()) |> function | post -> if model.SetPublished then diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs index 1239c0c..e664a9d 100644 --- a/src/MyWebLog/Handlers/Routes.fs +++ b/src/MyWebLog/Handlers/Routes.fs @@ -94,7 +94,7 @@ module Asset = | Some asset -> match Upload.checkModified asset.UpdatedOn ctx with | Some threeOhFour -> return! threeOhFour next ctx - | None -> return! Upload.sendFile asset.UpdatedOn path asset.Data next ctx + | None -> return! Upload.sendFile (asset.UpdatedOn.ToDateTimeUtc ()) path asset.Data next ctx | None -> return! Error.notFound next ctx } diff --git a/src/MyWebLog/Handlers/Upload.fs b/src/MyWebLog/Handlers/Upload.fs index 3755484..9e6a2b0 100644 --- a/src/MyWebLog/Handlers/Upload.fs +++ b/src/MyWebLog/Handlers/Upload.fs @@ -29,15 +29,17 @@ module private Helpers = // ~~ SERVING UPLOADS ~~ +open System.Globalization open Giraffe open Microsoft.AspNetCore.Http +open NodaTime /// Determine if the file has been modified since the date/time specified by the If-Modified-Since header let checkModified since (ctx : HttpContext) : HttpHandler option = match ctx.Request.Headers.IfModifiedSince with | it when it.Count < 1 -> None - | it when since > DateTime.Parse it[0] -> None - | _ -> Some (setStatusCode 304 >=> setBodyFromString "Not Modified") + | it when since > Instant.FromDateTimeUtc (DateTime.Parse (it[0], null, DateTimeStyles.AdjustToUniversal)) -> None + | _ -> Some (setStatusCode 304) open Microsoft.AspNetCore.Http.Headers @@ -73,7 +75,7 @@ let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task { | Some upload -> match checkModified upload.UpdatedOn ctx with | Some threeOhFour -> return! threeOhFour next ctx - | None -> return! sendFile upload.UpdatedOn path upload.Data next ctx + | None -> return! sendFile (upload.UpdatedOn.ToDateTimeUtc ()) path upload.Data next ctx | None -> return! Error.notFound next ctx else return! Error.notFound next ctx @@ -143,7 +145,8 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { let upload = Seq.head ctx.Request.Form.Files let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName), Path.GetExtension(upload.FileName).ToLowerInvariant ()) - let localNow = WebLog.localTime ctx.WebLog DateTime.Now + let now = ctx.Clock.GetCurrentInstant () + let localNow = WebLog.localTime ctx.WebLog now let year = localNow.ToString "yyyy" let month = localNow.ToString "MM" let! form = ctx.BindFormAsync () @@ -156,7 +159,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { { Id = UploadId.create () WebLogId = ctx.WebLog.Id Path = Permalink $"{year}/{month}/{fileName}" - UpdatedOn = DateTime.UtcNow + UpdatedOn = now Data = stream.ToArray () } do! ctx.Data.Upload.Add file diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index 608d2b3..bd19066 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -4,6 +4,7 @@ module MyWebLog.Handlers.User open System open System.Security.Cryptography open System.Text +open NodaTime // ~~ LOG ON / LOG OFF ~~ @@ -147,7 +148,9 @@ let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandl |> addToHash ViewContext.Model model |> addToHash "access_level" (AccessLevel.toString user.AccessLevel) |> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn) - |> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog (defaultArg user.LastSeenOn DateTime.UnixEpoch)) + |> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog + (defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0))) + |> adminView "my-info" next ctx @@ -198,9 +201,9 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let tryUser = if model.IsNew then { WebLogUser.empty with - Id = WebLogUserId.create () - WebLogId = ctx.WebLog.Id - CreatedOn = DateTime.UtcNow + Id = WebLogUserId.create () + WebLogId = ctx.WebLog.Id + CreatedOn = ctx.Clock.GetCurrentInstant () } |> someTask else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id match! tryUser with @@ -227,4 +230,3 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { next ctx | None -> return! Error.notFound next ctx } - diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 814405a..6088888 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -4,6 +4,7 @@ open System open System.IO open Microsoft.Extensions.DependencyInjection open MyWebLog.Data +open NodaTime /// Create the web log information let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { @@ -42,7 +43,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { // Create the admin user let salt = Guid.NewGuid () - let now = DateTime.UtcNow + let now = SystemClock.Instance.GetCurrentInstant () do! data.WebLogUser.Add { WebLogUser.empty with @@ -165,7 +166,7 @@ module Backup = Id : ThemeAssetId /// The updated date for this asset - UpdatedOn : DateTime + UpdatedOn : Instant /// The data for this asset, base-64 encoded Data : string @@ -197,7 +198,7 @@ module Backup = Path : Permalink /// The date/time this upload was last updated (file time) - UpdatedOn : DateTime + UpdatedOn : Instant /// The data for the upload, base-64 encoded Data : string diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 182d1cf..4e7ff12 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -3,8 +3,6 @@ open Microsoft.Data.Sqlite open Microsoft.Extensions.Configuration open Microsoft.Extensions.Logging open MyWebLog -open Newtonsoft.Json -open Npgsql /// Middleware to derive the current web log type WebLogMiddleware (next : RequestDelegate, log : ILogger) = @@ -31,6 +29,9 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger) open System open Microsoft.Extensions.DependencyInjection open MyWebLog.Data +open Newtonsoft.Json +open NodaTime +open Npgsql /// Logic to obtain a data connection and implementation based on configured values module DataImplementation = @@ -118,7 +119,8 @@ let rec main args = let sp = builder.Services.BuildServiceProvider () let data, serializer = DataImplementation.get sp - let _ = builder.Services.AddSingleton serializer + let _ = builder.Services.AddSingleton serializer + let _ = builder.Services.AddSingleton SystemClock.Instance task { do! data.StartUp () -- 2.45.1 From 2131bd096bd53279a848f19fb0280eecf9e66c5a Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sat, 20 Aug 2022 16:26:59 -0400 Subject: [PATCH 08/13] PostgreSQL data works - Add (de)serializer functions - Add NodaTime support functions --- src/MyWebLog.Data/Converters.fs | 26 ++++ src/MyWebLog.Data/Interfaces.fs | 4 + src/MyWebLog.Data/Postgres/PostgresCache.fs | 2 +- .../Postgres/PostgresCategoryData.fs | 5 +- src/MyWebLog.Data/Postgres/PostgresHelpers.fs | 91 ++++++------- .../Postgres/PostgresPageData.fs | 27 ++-- .../Postgres/PostgresPostData.fs | 57 +++++---- .../Postgres/PostgresTagMapData.fs | 4 +- .../Postgres/PostgresThemeData.fs | 2 +- .../Postgres/PostgresUploadData.fs | 2 +- .../Postgres/PostgresWebLogData.fs | 120 +++++------------- .../Postgres/PostgresWebLogUserData.fs | 10 +- src/MyWebLog.Data/PostgresData.fs | 35 ++--- src/MyWebLog.Data/RethinkDbData.fs | 5 +- .../SQLite/SQLiteWebLogUserData.fs | 2 +- src/MyWebLog.Data/SQLiteData.fs | 5 +- src/MyWebLog.Data/Utils.fs | 13 +- src/MyWebLog.Domain/DataTypes.fs | 14 +- src/MyWebLog.Domain/SupportTypes.fs | 15 ++- src/MyWebLog/Caches.fs | 5 - src/MyWebLog/Handlers/Admin.fs | 27 ++-- src/MyWebLog/Handlers/Page.fs | 4 +- src/MyWebLog/Handlers/Post.fs | 4 +- src/MyWebLog/Handlers/Upload.fs | 2 +- src/MyWebLog/Handlers/User.fs | 2 +- src/MyWebLog/Maintenance.fs | 19 +-- src/MyWebLog/Program.fs | 18 +-- 27 files changed, 247 insertions(+), 273 deletions(-) diff --git a/src/MyWebLog.Data/Converters.fs b/src/MyWebLog.Data/Converters.fs index 53fc88f..82ff4c7 100644 --- a/src/MyWebLog.Data/Converters.fs +++ b/src/MyWebLog.Data/Converters.fs @@ -149,4 +149,30 @@ module Json = let _ = ser.ConfigureForNodaTime DateTimeZoneProviders.Tzdb // Handles DUs with no associated data, as well as option fields ser.Converters.Add (CompactUnionJsonConverter ()) + ser.NullValueHandling <- NullValueHandling.Ignore + ser.MissingMemberHandling <- MissingMemberHandling.Ignore ser + + /// Serializer settings extracted from a JsonSerializer (a property sure would be nice...) + let mutable private serializerSettings : JsonSerializerSettings option = None + + /// Extract settings from the serializer to be used in JsonConvert calls + let settings (ser : JsonSerializer) = + if Option.isNone serializerSettings then + serializerSettings <- JsonSerializerSettings ( + ConstructorHandling = ser.ConstructorHandling, + ContractResolver = ser.ContractResolver, + Converters = ser.Converters, + DefaultValueHandling = ser.DefaultValueHandling, + DateFormatHandling = ser.DateFormatHandling, + MetadataPropertyHandling = ser.MetadataPropertyHandling, + MissingMemberHandling = ser.MissingMemberHandling, + NullValueHandling = ser.NullValueHandling, + ObjectCreationHandling = ser.ObjectCreationHandling, + ReferenceLoopHandling = ser.ReferenceLoopHandling, + SerializationBinder = ser.SerializationBinder, + TraceWriter = ser.TraceWriter, + TypeNameAssemblyFormatHandling = ser.TypeNameAssemblyFormatHandling, + TypeNameHandling = ser.TypeNameHandling) + |> Some + serializerSettings.Value diff --git a/src/MyWebLog.Data/Interfaces.fs b/src/MyWebLog.Data/Interfaces.fs index 970a2b3..f064cc4 100644 --- a/src/MyWebLog.Data/Interfaces.fs +++ b/src/MyWebLog.Data/Interfaces.fs @@ -3,6 +3,7 @@ namespace MyWebLog.Data open System.Threading.Tasks open MyWebLog open MyWebLog.ViewModels +open Newtonsoft.Json open NodaTime /// The result of a category deletion attempt @@ -326,6 +327,9 @@ type IData = /// Web log user data functions abstract member WebLogUser : IWebLogUserData + /// A JSON serializer for use in persistence + abstract member Serializer : JsonSerializer + /// Do any required start up data checks abstract member StartUp : unit -> Task \ No newline at end of file diff --git a/src/MyWebLog.Data/Postgres/PostgresCache.fs b/src/MyWebLog.Data/Postgres/PostgresCache.fs index a9e9d6f..70b79d8 100644 --- a/src/MyWebLog.Data/Postgres/PostgresCache.fs +++ b/src/MyWebLog.Data/Postgres/PostgresCache.fs @@ -36,7 +36,7 @@ module private Helpers = /// Create a parameter for the expire-at time let expireParam = - typedParam "@expireAt" + typedParam "expireAt" /// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog diff --git a/src/MyWebLog.Data/Postgres/PostgresCategoryData.fs b/src/MyWebLog.Data/Postgres/PostgresCategoryData.fs index 32db33a..eec7703 100644 --- a/src/MyWebLog.Data/Postgres/PostgresCategoryData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresCategoryData.fs @@ -38,8 +38,9 @@ type PostgresCategoryData (conn : NpgsqlConnection) = ordered |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name) |> Seq.map (fun cat -> cat.Id) + |> Seq.append (Seq.singleton it.Id) |> List.ofSeq - |> inClause "id" id + |> inClause "AND pc.category_id" "id" id let postCount = Sql.existingConnection conn |> Sql.query $" @@ -48,7 +49,7 @@ type PostgresCategoryData (conn : NpgsqlConnection) = 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})" + {catIdSql}" |> Sql.parameters (webLogIdParam webLogId :: catIdParams) |> Sql.executeRowAsync Map.toCount |> Async.AwaitTask diff --git a/src/MyWebLog.Data/Postgres/PostgresHelpers.fs b/src/MyWebLog.Data/Postgres/PostgresHelpers.fs index 85eb7dd..32c90fb 100644 --- a/src/MyWebLog.Data/Postgres/PostgresHelpers.fs +++ b/src/MyWebLog.Data/Postgres/PostgresHelpers.fs @@ -5,6 +5,7 @@ module MyWebLog.Data.Postgres.PostgresHelpers open System open System.Threading.Tasks open MyWebLog +open MyWebLog.Data open Newtonsoft.Json open NodaTime open Npgsql @@ -21,30 +22,36 @@ let countName = "the_count" let existsName = "does_exist" /// Create the SQL and parameters for an IN clause -let inClause<'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}, @%s{name}{idx}", ($"@%s{name}{idx}", Sql.string (valueFunc it)) :: itemP) - (Seq.ofList items - |> Seq.map (fun it -> $"@%s{name}0", [ $"@%s{name}0", Sql.string (valueFunc it) ]) - |> Seq.head) +let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) = + if List.isEmpty items then "", [] + else + let mutable idx = 0 + items + |> List.skip 1 + |> List.fold (fun (itemS, itemP) it -> + idx <- idx + 1 + $"{itemS}, @%s{paramName}{idx}", ($"@%s{paramName}{idx}", Sql.string (valueFunc it)) :: itemP) + (Seq.ofList items + |> Seq.map (fun it -> + $"%s{colNameAndPrefix} IN (@%s{paramName}0", [ $"@%s{paramName}0", Sql.string (valueFunc it) ]) + |> Seq.head) + |> function sql, ps -> $"{sql})", ps /// 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) + if List.isEmpty items then "TRUE = FALSE", [] + else + 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 { @@ -83,32 +90,11 @@ module Map = row.int countName /// Create a custom feed from the current row - let toCustomFeed (row : RowReader) : CustomFeed = - { Id = row.string "id" |> CustomFeedId - Source = row.string "source" |> CustomFeedSource.parse - Path = row.string "path" |> Permalink - Podcast = - match row.stringOrNone "title" with - | Some title -> - Some { - Title = title - Subtitle = row.stringOrNone "subtitle" - ItemsInFeed = row.int "items_in_feed" - Summary = row.string "summary" - DisplayedAuthor = row.string "displayed_author" - Email = row.string "email" - ImageUrl = row.string "image_url" |> Permalink - AppleCategory = row.string "apple_category" - AppleSubcategory = row.stringOrNone "apple_subcategory" - Explicit = row.string "explicit" |> ExplicitRating.parse - DefaultMediaType = row.stringOrNone "default_media_type" - MediaBaseUrl = row.stringOrNone "media_base_url" - PodcastGuid = row.uuidOrNone "podcast_guid" - FundingUrl = row.stringOrNone "funding_url" - FundingText = row.stringOrNone "funding_text" - Medium = row.stringOrNone "medium" |> Option.map PodcastMedium.parse - } - | None -> None + let toCustomFeed (ser : JsonSerializer) (row : RowReader) : CustomFeed = + { Id = row.string "id" |> CustomFeedId + Source = row.string "source" |> CustomFeedSource.parse + Path = row.string "path" |> Permalink + Podcast = row.stringOrNone "podcast" |> Option.map (Utils.deserialize ser) } /// Get a true/false value as to whether an item exists @@ -126,7 +112,7 @@ module Map = Permalink (row.string "permalink") /// Create a page from the current row - let toPage (row : RowReader) : Page = + let toPage (ser : JsonSerializer) (row : RowReader) : Page = { Page.empty with Id = row.string "id" |> PageId WebLogId = row.string "web_log_id" |> WebLogId @@ -140,12 +126,12 @@ module Map = Template = row.stringOrNone "template" Text = row.string "page_text" Metadata = row.stringOrNone "meta_items" - |> Option.map JsonConvert.DeserializeObject + |> Option.map (Utils.deserialize ser) |> Option.defaultValue [] } /// Create a post from the current row - let toPost (row : RowReader) : Post = + let toPost (ser : JsonSerializer) (row : RowReader) : Post = { Post.empty with Id = row.string "id" |> PostId WebLogId = row.string "web_log_id" |> WebLogId @@ -158,6 +144,7 @@ module Map = UpdatedOn = row.fieldValue "updated_on" Template = row.stringOrNone "template" Text = row.string "post_text" + Episode = row.stringOrNone "episode" |> Option.map (Utils.deserialize ser) CategoryIds = row.stringArrayOrNone "category_ids" |> Option.map (Array.map CategoryId >> List.ofArray) |> Option.defaultValue [] @@ -165,10 +152,8 @@ module Map = |> Option.map List.ofArray |> Option.defaultValue [] Metadata = row.stringOrNone "meta_items" - |> Option.map JsonConvert.DeserializeObject + |> Option.map (Utils.deserialize ser) |> Option.defaultValue [] - Episode = row.stringOrNone "episode" - |> Option.map JsonConvert.DeserializeObject } /// Create a revision from the current row diff --git a/src/MyWebLog.Data/Postgres/PostgresPageData.fs b/src/MyWebLog.Data/Postgres/PostgresPageData.fs index c50bcdd..48ab3c3 100644 --- a/src/MyWebLog.Data/Postgres/PostgresPageData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresPageData.fs @@ -7,7 +7,7 @@ open Npgsql open Npgsql.FSharp /// PostgreSQL myWebLog page data implementation -type PostgresPageData (conn : NpgsqlConnection) = +type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) = // SUPPORT FUNCTIONS @@ -21,16 +21,19 @@ type PostgresPageData (conn : NpgsqlConnection) = return { page with Revisions = revisions } } + /// Shorthand to map to a page + let toPage = Map.toPage ser + /// Return a page with no text or revisions let pageWithoutText row = - { Map.toPage row with Text = "" } + { toPage row with Text = "" } /// The INSERT statement for a page revision let revInsert = "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)" /// Parameters for a revision INSERT statement let revParams pageId rev = [ - typedParam "@asOf" rev.AsOf + typedParam "asOf" rev.AsOf "@pageId", Sql.string (PageId.toString pageId) "@text", Sql.string (MarkupText.toString rev.Text) ] @@ -47,7 +50,7 @@ type PostgresPageData (conn : NpgsqlConnection) = toDelete |> List.map (fun it -> [ "@pageId", Sql.string (PageId.toString pageId) - typedParam "@asOf" it.AsOf + typedParam "asOf" it.AsOf ]) if not (List.isEmpty toAdd) then revInsert, toAdd |> List.map (revParams pageId) @@ -94,7 +97,7 @@ type PostgresPageData (conn : NpgsqlConnection) = 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 + |> Sql.executeAsync toPage |> tryHead /// Find a complete page by its ID @@ -126,7 +129,7 @@ type PostgresPageData (conn : NpgsqlConnection) = 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 + |> Sql.executeAsync toPage |> tryHead /// Find the current permalink within a set of potential prior permalinks for the given web log @@ -148,7 +151,7 @@ type PostgresPageData (conn : NpgsqlConnection) = Sql.existingConnection conn |> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId" |> Sql.parameters [ webLogIdParam webLogId ] - |> Sql.executeAsync Map.toPage + |> Sql.executeAsync toPage let! revisions = Sql.existingConnection conn |> Sql.query @@ -182,7 +185,7 @@ type PostgresPageData (conn : NpgsqlConnection) = 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 + |> Sql.executeAsync toPage /// The INSERT statement for a page let pageInsert = @@ -204,10 +207,10 @@ type PostgresPageData (conn : NpgsqlConnection) = "@isInPageList", Sql.bool page.IsInPageList "@template", Sql.stringOrNone page.Template "@text", Sql.string page.Text - "@metaItems", Sql.jsonb (JsonConvert.SerializeObject page.Metadata) + "@metaItems", Sql.jsonb (Utils.serialize ser page.Metadata) "@priorPermalinks", Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) - typedParam "@publishedOn" page.PublishedOn - typedParam "@updatedOn" page.UpdatedOn + typedParam "publishedOn" page.PublishedOn + typedParam "updatedOn" page.UpdatedOn ] /// Restore pages from a backup @@ -237,7 +240,7 @@ type PostgresPageData (conn : NpgsqlConnection) = updated_on = EXCLUDED.updated_on, is_in_page_list = EXCLUDED.is_in_page_list, template = EXCLUDED.template, - page_text = EXCLUDED.text, + page_text = EXCLUDED.page_text, meta_items = EXCLUDED.meta_items" |> Sql.parameters (pageParams page) |> Sql.executeNonQueryAsync diff --git a/src/MyWebLog.Data/Postgres/PostgresPostData.fs b/src/MyWebLog.Data/Postgres/PostgresPostData.fs index 1e06242..aad6af6 100644 --- a/src/MyWebLog.Data/Postgres/PostgresPostData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresPostData.fs @@ -8,7 +8,7 @@ open Npgsql open Npgsql.FSharp /// PostgreSQL myWebLog post data implementation -type PostgresPostData (conn : NpgsqlConnection) = +type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) = // SUPPORT FUNCTIONS @@ -25,11 +25,14 @@ type PostgresPostData (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" + FROM post p" + + /// Shorthand for mapping to a post + let toPost = Map.toPost ser /// Return a post with no revisions, prior permalinks, or text let postWithoutText row = - { Map.toPost row with Text = "" } + { toPost row with Text = "" } /// The INSERT statement for a post/category cross-reference let catInsert = "INSERT INTO post_category VALUES (@postId, @categoryId)" @@ -61,7 +64,7 @@ type PostgresPostData (conn : NpgsqlConnection) = /// The parameters for adding a post revision let revParams postId rev = [ - typedParam "@asOf" rev.AsOf + typedParam "asOf" rev.AsOf "@postId", Sql.string (PostId.toString postId) "@text", Sql.string (MarkupText.toString rev.Text) ] @@ -78,7 +81,7 @@ type PostgresPostData (conn : NpgsqlConnection) = toDelete |> List.map (fun it -> [ "@postId", Sql.string (PostId.toString postId) - typedParam "@asOf" it.AsOf + typedParam "asOf" it.AsOf ]) if not (List.isEmpty toAdd) then revInsert, toAdd |> List.map (revParams postId) @@ -107,7 +110,7 @@ type PostgresPostData (conn : NpgsqlConnection) = 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 + |> Sql.executeAsync toPost |> tryHead /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks) @@ -115,7 +118,7 @@ type PostgresPostData (conn : NpgsqlConnection) = 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 + |> Sql.executeAsync toPost |> tryHead /// Find a complete post by its ID for the given web log @@ -150,7 +153,7 @@ type PostgresPostData (conn : NpgsqlConnection) = 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.query $"SELECT permalink FROM post WHERE web_log_id = @webLogId AND ({linkSql})" |> Sql.parameters (webLogIdParam webLogId :: linkParams) |> Sql.executeAsync Map.toPermalink |> tryHead @@ -162,7 +165,7 @@ type PostgresPostData (conn : NpgsqlConnection) = Sql.existingConnection conn |> Sql.query $"{selectPost} WHERE web_log_id = @webLogId" |> Sql.parameters [ webLogIdParam webLogId ] - |> Sql.executeAsync Map.toPost + |> Sql.executeAsync toPost let! revisions = Sql.existingConnection conn |> Sql.query @@ -181,21 +184,21 @@ type PostgresPostData (conn : NpgsqlConnection) = /// Get a page of categorized posts for the given web log (excludes revisions) let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = - let catSql, catParams = inClause "catId" CategoryId.toString categoryIds + let catSql, catParams = inClause "AND pc.category_id" "catId" CategoryId.toString categoryIds Sql.existingConnection conn |> Sql.query $" - {selectPost} p + {selectPost} 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}) + {catSql} ORDER BY published_on DESC LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" |> Sql.parameters [ webLogIdParam webLogId "@status", Sql.string (PostStatus.toString Published) yield! catParams ] - |> Sql.executeAsync Map.toPost + |> Sql.executeAsync toPost /// Get a page of posts for the given web log (excludes text and revisions) let findPageOfPosts webLogId pageNbr postsPerPage = @@ -218,7 +221,7 @@ type PostgresPostData (conn : NpgsqlConnection) = ORDER BY published_on DESC LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" |> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString Published) ] - |> Sql.executeAsync Map.toPost + |> Sql.executeAsync toPost /// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks) let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = @@ -227,7 +230,7 @@ type PostgresPostData (conn : NpgsqlConnection) = {selectPost} WHERE web_log_id = @webLogId AND status = @status - AND tag && ARRAY[@tag] + AND tags && ARRAY[@tag] ORDER BY published_on DESC LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" |> Sql.parameters @@ -235,13 +238,13 @@ type PostgresPostData (conn : NpgsqlConnection) = "@status", Sql.string (PostStatus.toString Published) "@tag", Sql.string tag ] - |> Sql.executeAsync Map.toPost + |> Sql.executeAsync toPost /// Find the next newest and oldest post from a publish date for the given web log let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask { - let queryParams = Sql.parameters [ + let queryParams () = Sql.parameters [ webLogIdParam webLogId - typedParam "@publishedOn" publishedOn + typedParam "publishedOn" publishedOn "@status", Sql.string (PostStatus.toString Published) ] let! older = @@ -253,8 +256,8 @@ type PostgresPostData (conn : NpgsqlConnection) = AND published_on < @publishedOn ORDER BY published_on DESC LIMIT 1" - |> queryParams - |> Sql.executeAsync Map.toPost + |> queryParams () + |> Sql.executeAsync toPost let! newer = Sql.existingConnection conn |> Sql.query $" @@ -264,8 +267,8 @@ type PostgresPostData (conn : NpgsqlConnection) = AND published_on > @publishedOn ORDER BY published_on LIMIT 1" - |> queryParams - |> Sql.executeAsync Map.toPost + |> queryParams () + |> Sql.executeAsync toPost return List.tryHead older, List.tryHead newer } @@ -289,14 +292,14 @@ type PostgresPostData (conn : NpgsqlConnection) = "@permalink", Sql.string (Permalink.toString post.Permalink) "@template", Sql.stringOrNone post.Template "@text", Sql.string post.Text - "@episode", Sql.jsonbOrNone (post.Episode |> Option.map JsonConvert.SerializeObject) "@priorPermalinks", Sql.stringArray (post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) + "@episode", Sql.jsonbOrNone (post.Episode |> Option.map (Utils.serialize ser)) "@tags", Sql.stringArrayOrNone (if List.isEmpty post.Tags then None else Some (Array.ofList post.Tags)) "@metaItems", - if List.isEmpty post.Metadata then None else Some (JsonConvert.SerializeObject post.Metadata) + if List.isEmpty post.Metadata then None else Some (Utils.serialize ser post.Metadata) |> Sql.jsonbOrNone - optParam "@publishedOn" post.PublishedOn - typedParam "@updatedOn" post.UpdatedOn + optParam "publishedOn" post.PublishedOn + typedParam "updatedOn" post.UpdatedOn ] /// Save a post @@ -314,7 +317,7 @@ type PostgresPostData (conn : NpgsqlConnection) = published_on = EXCLUDED.published_on, updated_on = EXCLUDED.updated_on, template = EXCLUDED.template, - post_text = EXCLUDED.text, + post_text = EXCLUDED.post_text, tags = EXCLUDED.tags, meta_items = EXCLUDED.meta_items, episode = EXCLUDED.episode" diff --git a/src/MyWebLog.Data/Postgres/PostgresTagMapData.fs b/src/MyWebLog.Data/Postgres/PostgresTagMapData.fs index c0b9c51..d76bbe6 100644 --- a/src/MyWebLog.Data/Postgres/PostgresTagMapData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresTagMapData.fs @@ -54,9 +54,9 @@ type PostgresTagMapData (conn : NpgsqlConnection) = /// Find any tag mappings in a list of tags for the given web log let findMappingForTags tags webLogId = - let tagSql, tagParams = inClause "tag" id tags + let tagSql, tagParams = inClause "AND tag" "tag" id tags Sql.existingConnection conn - |> Sql.query $"SELECT * FROM tag_map WHERE web_log_id = @webLogId AND tag IN ({tagSql}" + |> Sql.query $"SELECT * FROM tag_map WHERE web_log_id = @webLogId {tagSql}" |> Sql.parameters (webLogIdParam webLogId :: tagParams) |> Sql.executeAsync Map.toTagMap diff --git a/src/MyWebLog.Data/Postgres/PostgresThemeData.fs b/src/MyWebLog.Data/Postgres/PostgresThemeData.fs index 108e51f..be2805d 100644 --- a/src/MyWebLog.Data/Postgres/PostgresThemeData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresThemeData.fs @@ -193,7 +193,7 @@ type PostgresThemeAssetData (conn : NpgsqlConnection) = [ "@themeId", Sql.string themeId "@path", Sql.string path "@data", Sql.bytea asset.Data - typedParam "@updatedOn" asset.UpdatedOn ] + typedParam "updatedOn" asset.UpdatedOn ] |> Sql.executeNonQueryAsync () } diff --git a/src/MyWebLog.Data/Postgres/PostgresUploadData.fs b/src/MyWebLog.Data/Postgres/PostgresUploadData.fs index 6087fbb..89de2e9 100644 --- a/src/MyWebLog.Data/Postgres/PostgresUploadData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresUploadData.fs @@ -19,7 +19,7 @@ type PostgresUploadData (conn : NpgsqlConnection) = /// Parameters for adding an uploaded file let upParams (upload : Upload) = [ webLogIdParam upload.WebLogId - typedParam "@updatedOn" upload.UpdatedOn + typedParam "updatedOn" upload.UpdatedOn "@id", Sql.string (UploadId.toString upload.Id) "@path", Sql.string (Permalink.toString upload.Path) "@data", Sql.bytea upload.Data diff --git a/src/MyWebLog.Data/Postgres/PostgresWebLogData.fs b/src/MyWebLog.Data/Postgres/PostgresWebLogData.fs index 2cd9605..59899ac 100644 --- a/src/MyWebLog.Data/Postgres/PostgresWebLogData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresWebLogData.fs @@ -2,11 +2,12 @@ open MyWebLog open MyWebLog.Data +open Newtonsoft.Json open Npgsql open Npgsql.FSharp /// PostgreSQL myWebLog web log data implementation -type PostgresWebLogData (conn : NpgsqlConnection) = +type PostgresWebLogData (conn : NpgsqlConnection, ser : JsonSerializer) = // SUPPORT FUNCTIONS @@ -36,15 +37,16 @@ type PostgresWebLogData (conn : NpgsqlConnection) = yield! rssParams webLog ] - /// 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" + /// Shorthand to map a result to a custom feed + let toCustomFeed = + Map.toCustomFeed ser /// Get the current custom feeds for a web log let getCustomFeeds (webLog : WebLog) = Sql.existingConnection conn - |> Sql.query $"{feedSelect} WHERE f.web_log_id = @webLogId" + |> Sql.query "SELECT * FROM web_log_feed WHERE web_log_id = @webLogId" |> Sql.parameters [ webLogIdParam webLog.Id ] - |> Sql.executeAsync Map.toCustomFeed + |> Sql.executeAsync toCustomFeed /// Append custom feeds to a web log let appendCustomFeeds (webLog : WebLog) = backgroundTask { @@ -52,33 +54,13 @@ type PostgresWebLogData (conn : NpgsqlConnection) = return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } } } - /// The parameters to save a podcast feed - let podcastParams feedId (podcast : PodcastOptions) = [ - "@feedId", Sql.string (CustomFeedId.toString feedId) - "@title", Sql.string podcast.Title - "@subtitle", Sql.stringOrNone podcast.Subtitle - "@itemsInFeed", Sql.int podcast.ItemsInFeed - "@summary", Sql.string podcast.Summary - "@displayedAuthor", Sql.string podcast.DisplayedAuthor - "@email", Sql.string podcast.Email - "@imageUrl", Sql.string (Permalink.toString podcast.ImageUrl) - "@appleCategory", Sql.string podcast.AppleCategory - "@appleSubcategory", Sql.stringOrNone podcast.AppleSubcategory - "@explicit", Sql.string (ExplicitRating.toString podcast.Explicit) - "@defaultMediaType", Sql.stringOrNone podcast.DefaultMediaType - "@mediaBaseUrl", Sql.stringOrNone podcast.MediaBaseUrl - "@podcastGuid", Sql.uuidOrNone podcast.PodcastGuid - "@fundingUrl", Sql.stringOrNone podcast.FundingUrl - "@fundingText", Sql.stringOrNone podcast.FundingText - "@medium", Sql.stringOrNone (podcast.Medium |> Option.map PodcastMedium.toString) - ] - /// 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) + "@id", Sql.string (CustomFeedId.toString feed.Id) + "@source", Sql.string (CustomFeedSource.toString feed.Source) + "@path", Sql.string (Permalink.toString feed.Path) + "@podcast", Sql.jsonbOrNone (feed.Podcast |> Option.map (Utils.serialize ser)) ] /// Update the custom feeds for a web log @@ -93,55 +75,18 @@ type PostgresWebLogData (conn : NpgsqlConnection) = 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", + "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 + id, web_log_id, source, path, podcast ) VALUES ( - @id, @webLogId, @source, @path + @id, @webLogId, @source, @path, @podcast ) ON CONFLICT (id) DO UPDATE - SET source = EXCLUDED.source, - path = EXCLUDED.path", + SET source = EXCLUDED.source, + path = EXCLUDED.path, + podcast = EXCLUDED.podcast", 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) ]) ] () } @@ -173,8 +118,8 @@ type PostgresWebLogData (conn : NpgsqlConnection) = |> 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) + |> Sql.query "SELECT * FROM web_log_feed" + |> Sql.executeAsync (fun row -> WebLogId (row.string "web_log_id"), toCustomFeed row) return webLogs |> List.map (fun it -> @@ -191,20 +136,19 @@ type PostgresWebLogData (conn : NpgsqlConnection) = let pageSubQuery = subQuery "page" let! _ = Sql.existingConnection conn - |> Sql.query $""" - DELETE FROM post_comment WHERE post_id IN {postSubQuery}; - DELETE FROM post_revision WHERE post_id IN {postSubQuery}; - DELETE FROM post_category WHERE post_id IN {postSubQuery}; - DELETE FROM post WHERE web_log_id = @webLogId; - DELETE FROM page_revision WHERE page_id IN {pageSubQuery}; - DELETE FROM page WHERE web_log_id = @webLogId; - DELETE FROM category WHERE web_log_id = @webLogId; - DELETE FROM tag_map WHERE web_log_id = @webLogId; - DELETE FROM upload WHERE web_log_id = @webLogId; - DELETE FROM web_log_user WHERE web_log_id = @webLogId; - DELETE FROM web_log_feed_podcast WHERE feed_id IN {subQuery "web_log_feed"}; - DELETE FROM web_log_feed WHERE web_log_id = @webLogId; - DELETE FROM web_log WHERE id = @webLogId""" + |> Sql.query $" + DELETE FROM post_comment WHERE post_id IN {postSubQuery}; + DELETE FROM post_revision WHERE post_id IN {postSubQuery}; + DELETE FROM post_category WHERE post_id IN {postSubQuery}; + DELETE FROM post WHERE web_log_id = @webLogId; + DELETE FROM page_revision WHERE page_id IN {pageSubQuery}; + DELETE FROM page WHERE web_log_id = @webLogId; + DELETE FROM category WHERE web_log_id = @webLogId; + DELETE FROM tag_map WHERE web_log_id = @webLogId; + DELETE FROM upload WHERE web_log_id = @webLogId; + DELETE FROM web_log_user WHERE web_log_id = @webLogId; + DELETE FROM web_log_feed WHERE web_log_id = @webLogId; + DELETE FROM web_log WHERE id = @webLogId" |> Sql.parameters [ webLogIdParam webLogId ] |> Sql.executeNonQueryAsync () diff --git a/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs b/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs index 6dde53e..87d4f4b 100644 --- a/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs @@ -30,8 +30,8 @@ type PostgresWebLogUserData (conn : NpgsqlConnection) = "@salt", Sql.uuid user.Salt "@url", Sql.stringOrNone user.Url "@accessLevel", Sql.string (AccessLevel.toString user.AccessLevel) - typedParam "@createdOn" user.CreatedOn - optParam "@lastSeenOn" user.LastSeenOn + typedParam "createdOn" user.CreatedOn + optParam "lastSeenOn" user.LastSeenOn ] /// Find a user by their ID for the given web log @@ -83,10 +83,10 @@ type PostgresWebLogUserData (conn : NpgsqlConnection) = /// 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 idSql, idParams = inClause "AND id" "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.query $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {idSql}" |> Sql.parameters (webLogIdParam webLogId :: idParams) |> Sql.executeAsync Map.toWebLogUser return @@ -111,7 +111,7 @@ type PostgresWebLogUserData (conn : NpgsqlConnection) = |> Sql.query "UPDATE web_log_user SET last_seen_on = @lastSeenOn WHERE id = @id AND web_log_id = @webLogId" |> Sql.parameters [ webLogIdParam webLogId - typedParam "@lastSeenOn" (Utils.now ()) + typedParam "lastSeenOn" (Noda.now ()) "@id", Sql.string (WebLogUserId.toString userId) ] |> Sql.executeNonQueryAsync () diff --git a/src/MyWebLog.Data/PostgresData.fs b/src/MyWebLog.Data/PostgresData.fs index aa6813e..bb7b2b2 100644 --- a/src/MyWebLog.Data/PostgresData.fs +++ b/src/MyWebLog.Data/PostgresData.fs @@ -2,24 +2,27 @@ open Microsoft.Extensions.Logging open MyWebLog.Data.Postgres +open Newtonsoft.Json open Npgsql open Npgsql.FSharp /// Data implementation for PostgreSQL -type PostgresData (conn : NpgsqlConnection, log : ILogger) = +type PostgresData (conn : NpgsqlConnection, log : ILogger, ser : JsonSerializer) = interface IData with member _.Category = PostgresCategoryData conn - member _.Page = PostgresPageData conn - member _.Post = PostgresPostData conn + member _.Page = PostgresPageData (conn, ser) + member _.Post = PostgresPostData (conn, ser) member _.TagMap = PostgresTagMapData conn member _.Theme = PostgresThemeData conn member _.ThemeAsset = PostgresThemeAssetData conn member _.Upload = PostgresUploadData conn - member _.WebLog = PostgresWebLogData conn + member _.WebLog = PostgresWebLogData (conn, ser) member _.WebLogUser = PostgresWebLogUserData conn + member _.Serializer = ser + member _.StartUp () = backgroundTask { let _ = NpgsqlConnection.GlobalTypeMapper.UseNodaTime () @@ -77,27 +80,9 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger) = id TEXT NOT NULL PRIMARY KEY, web_log_id TEXT NOT NULL REFERENCES web_log (id), source TEXT NOT NULL, - path TEXT NOT NULL)" + path TEXT NOT NULL, + podcast JSONB)" "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)" // Category table if needsTable "category" then @@ -120,7 +105,7 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger) = last_name TEXT NOT NULL, preferred_name TEXT NOT NULL, password_hash TEXT NOT NULL, - salt TEXT NOT NULL, + salt UUID NOT NULL, url TEXT, access_level TEXT NOT NULL, created_on TIMESTAMPTZ NOT NULL, diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index 88c3260..f151aed 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -1079,7 +1079,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger obj ] + update [ nameof WebLogUser.empty.LastSeenOn, Noda.now () :> obj ] write; withRetryOnce; ignoreResult conn } | None -> () @@ -1102,6 +1102,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { dbList; result; withRetryOnce conn } if not (dbs |> List.contains config.Database) then diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs index 678705f..262be7e 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs @@ -122,7 +122,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = AND web_log_id = @webLogId" addWebLogId cmd webLogId [ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) - cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Utils.now ())) + cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Noda.now ())) ] |> ignore let! _ = cmd.ExecuteNonQueryAsync () () diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index 9e1afd7..a142a5c 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -3,9 +3,10 @@ namespace MyWebLog.Data open Microsoft.Data.Sqlite open Microsoft.Extensions.Logging open MyWebLog.Data.SQLite +open Newtonsoft.Json /// SQLite myWebLog data implementation -type SQLiteData (conn : SqliteConnection, log : ILogger) = +type SQLiteData (conn : SqliteConnection, log : ILogger, ser : JsonSerializer) = /// The connection for this instance member _.Conn = conn @@ -31,6 +32,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = member _.WebLog = SQLiteWebLogData conn member _.WebLogUser = SQLiteWebLogUserData conn + member _.Serializer = ser + member _.StartUp () = backgroundTask { use cmd = conn.CreateCommand () diff --git a/src/MyWebLog.Data/Utils.fs b/src/MyWebLog.Data/Utils.fs index f0b6ee0..50c68c1 100644 --- a/src/MyWebLog.Data/Utils.fs +++ b/src/MyWebLog.Data/Utils.fs @@ -37,6 +37,13 @@ let diffPermalinks oldLinks newLinks = let diffRevisions oldRevs newRevs = diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.ToUnixTimeTicks ()}|{MarkupText.toString rev.Text}") -/// Get the current instant -let now () = - NodaTime.SystemClock.Instance.GetCurrentInstant () \ No newline at end of file +open MyWebLog.Converters +open Newtonsoft.Json + +/// Serialize an object to JSON +let serialize<'T> ser (item : 'T) = + JsonConvert.SerializeObject (item, Json.settings ser) + +/// Deserialize a JSON string +let deserialize<'T> (ser : JsonSerializer) value = + JsonConvert.DeserializeObject<'T> (value, Json.settings ser) diff --git a/src/MyWebLog.Domain/DataTypes.fs b/src/MyWebLog.Domain/DataTypes.fs index 2c1febe..42f9793 100644 --- a/src/MyWebLog.Domain/DataTypes.fs +++ b/src/MyWebLog.Domain/DataTypes.fs @@ -83,7 +83,7 @@ module Comment = Email = "" Url = None Status = Pending - PostedOn = Instant.MinValue + PostedOn = Noda.epoch Text = "" } @@ -141,8 +141,8 @@ module Page = AuthorId = WebLogUserId.empty Title = "" Permalink = Permalink.empty - PublishedOn = Instant.MinValue - UpdatedOn = Instant.MinValue + PublishedOn = Noda.epoch + UpdatedOn = Noda.epoch IsInPageList = false Template = None Text = "" @@ -216,7 +216,7 @@ module Post = Title = "" Permalink = Permalink.empty PublishedOn = None - UpdatedOn = Instant.MinValue + UpdatedOn = Noda.epoch Text = "" Template = None CategoryIds = [] @@ -301,7 +301,7 @@ module ThemeAsset = /// An empty theme asset let empty = { Id = ThemeAssetId (ThemeId "", "") - UpdatedOn = Instant.MinValue + UpdatedOn = Noda.epoch Data = [||] } @@ -332,7 +332,7 @@ module Upload = { Id = UploadId.empty WebLogId = WebLogId.empty Path = Permalink.empty - UpdatedOn = Instant.MinValue + UpdatedOn = Noda.epoch Data = [||] } @@ -473,7 +473,7 @@ module WebLogUser = Salt = Guid.Empty Url = None AccessLevel = Author - CreatedOn = Instant.FromUnixTimeSeconds 0L + CreatedOn = Noda.epoch LastSeenOn = None } diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index c3457dc..3785293 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -13,6 +13,19 @@ module private Helpers = Convert.ToBase64String(Guid.NewGuid().ToByteArray ()).Replace('/', '_').Replace('+', '-').Substring (0, 22) +/// Functions to support NodaTime manipulation +module Noda = + + /// The clock to use when getting "now" (will make mutable for testing) + let clock : IClock = SystemClock.Instance + + /// The Unix epoch + let epoch = Instant.FromUnixTimeSeconds 0L + + /// The current Instant, with fractional seconds truncated + let now () = Instant.FromUnixTimeSeconds (clock.GetCurrentInstant().ToUnixTimeSeconds ()) + + /// A user's access level type AccessLevel = /// The user may create and publish posts and edit the ones they have created @@ -291,7 +304,7 @@ module Revision = /// An empty revision let empty = - { AsOf = Instant.MinValue + { AsOf = Noda.epoch Text = Html "" } diff --git a/src/MyWebLog/Caches.fs b/src/MyWebLog/Caches.fs index 81fa5b3..2c4e74b 100644 --- a/src/MyWebLog/Caches.fs +++ b/src/MyWebLog/Caches.fs @@ -11,7 +11,6 @@ module Extensions = open Microsoft.AspNetCore.Antiforgery open Microsoft.Extensions.Configuration open Microsoft.Extensions.DependencyInjection - open NodaTime /// Hold variable for the configured generator string let mutable private generatorString : string option = None @@ -21,9 +20,6 @@ module Extensions = /// The anti-CSRF service member this.AntiForgery = this.RequestServices.GetRequiredService () - /// The system clock - member this.Clock = this.RequestServices.GetRequiredService () - /// The cross-site request forgery token set for this request member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this @@ -60,7 +56,6 @@ module Extensions = defaultArg (this.UserAccessLevel |> Option.map (AccessLevel.hasAccess level)) false - open System.Collections.Concurrent /// diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index 04932c0..30ebac4 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -13,23 +13,22 @@ module Dashboard = // GET /admin/dashboard let user : HttpHandler = requireAccess Author >=> fun next ctx -> task { let getCount (f : WebLogId -> Task) = f ctx.WebLog.Id - let data = ctx.Data - let posts = getCount (data.Post.CountByStatus Published) - let drafts = getCount (data.Post.CountByStatus Draft) - let pages = getCount data.Page.CountAll - let listed = getCount data.Page.CountListed - let cats = getCount data.Category.CountAll - let topCats = getCount data.Category.CountTopLevel - let! _ = Task.WhenAll (posts, drafts, pages, listed, cats, topCats) + let data = ctx.Data + let! posts = getCount (data.Post.CountByStatus Published) + let! drafts = getCount (data.Post.CountByStatus Draft) + let! pages = getCount data.Page.CountAll + let! listed = getCount data.Page.CountListed + let! cats = getCount data.Category.CountAll + let! topCats = getCount data.Category.CountTopLevel return! hashForPage "Dashboard" |> addToHash ViewContext.Model { - Posts = posts.Result - Drafts = drafts.Result - Pages = pages.Result - ListedPages = listed.Result - Categories = cats.Result - TopLevelCategories = topCats.Result + Posts = posts + Drafts = drafts + Pages = pages + ListedPages = listed + Categories = cats + TopLevelCategories = topCats } |> adminView "dashboard" next ctx } diff --git a/src/MyWebLog/Handlers/Page.fs b/src/MyWebLog/Handlers/Page.fs index 58f67c5..5dee988 100644 --- a/src/MyWebLog/Handlers/Page.fs +++ b/src/MyWebLog/Handlers/Page.fs @@ -145,7 +145,7 @@ let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun | Some pg, Some rev when canEdit pg.AuthorId ctx -> do! ctx.Data.Page.Update { pg with - Revisions = { rev with AsOf = ctx.Clock.GetCurrentInstant () } + Revisions = { rev with AsOf = Noda.now () } :: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) } do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" } @@ -171,7 +171,7 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { let! model = ctx.BindFormAsync () let data = ctx.Data - let now = ctx.Clock.GetCurrentInstant () + let now = Noda.now () let tryPage = if model.IsNew then { Page.empty with diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs index 98883c4..c39dc86 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -350,7 +350,7 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f | Some post, Some rev when canEdit post.AuthorId ctx -> do! ctx.Data.Post.Update { post with - Revisions = { rev with AsOf = ctx.Clock.GetCurrentInstant () } + Revisions = { rev with AsOf = Noda.now () } :: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) } do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" } @@ -388,7 +388,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { | Some post when canEdit post.AuthorId ctx -> let priorCats = post.CategoryIds let updatedPost = - model.UpdatePost post (ctx.Clock.GetCurrentInstant ()) + model.UpdatePost post (Noda.now ()) |> function | post -> if model.SetPublished then diff --git a/src/MyWebLog/Handlers/Upload.fs b/src/MyWebLog/Handlers/Upload.fs index 9e6a2b0..c1c840d 100644 --- a/src/MyWebLog/Handlers/Upload.fs +++ b/src/MyWebLog/Handlers/Upload.fs @@ -145,7 +145,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { let upload = Seq.head ctx.Request.Form.Files let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName), Path.GetExtension(upload.FileName).ToLowerInvariant ()) - let now = ctx.Clock.GetCurrentInstant () + let now = Noda.now () let localNow = WebLog.localTime ctx.WebLog now let year = localNow.ToString "yyyy" let month = localNow.ToString "MM" diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index bd19066..bbfd4ee 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -203,7 +203,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { { WebLogUser.empty with Id = WebLogUserId.create () WebLogId = ctx.WebLog.Id - CreatedOn = ctx.Clock.GetCurrentInstant () + CreatedOn = Noda.now () } |> someTask else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id match! tryUser with diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 6088888..4d4fbe9 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -156,7 +156,6 @@ let loadTheme (args : string[]) (sp : IServiceProvider) = task { /// Back up a web log's data module Backup = - open System.Threading.Tasks open MyWebLog.Converters open Newtonsoft.Json @@ -252,7 +251,7 @@ module Backup = Uploads : EncodedUpload list } - /// Create a JSON serializer (uses RethinkDB data implementation's JSON converters) + /// Create a JSON serializer let private getSerializer prettyOutput = let serializer = Json.configure (JsonSerializer.CreateDefault ()) if prettyOutput then serializer.Formatting <- Formatting.Indented @@ -382,7 +381,8 @@ module Backup = printfn "" printfn "- Importing theme..." do! data.Theme.Save restore.Theme - let! _ = restore.Assets |> List.map (EncodedAsset.toAsset >> data.ThemeAsset.Save) |> Task.WhenAll + restore.Assets + |> List.iter (EncodedAsset.toAsset >> data.ThemeAsset.Save >> Async.AwaitTask >> Async.RunSynchronously) // Restore web log data @@ -393,19 +393,22 @@ module Backup = do! data.WebLogUser.Restore restore.Users printfn "- Restoring categories and tag mappings..." - do! data.TagMap.Restore restore.TagMappings - do! data.Category.Restore restore.Categories + if not (List.isEmpty restore.TagMappings) then do! data.TagMap.Restore restore.TagMappings + if not (List.isEmpty restore.Categories) then do! data.Category.Restore restore.Categories printfn "- Restoring pages..." - do! data.Page.Restore restore.Pages + if not (List.isEmpty restore.Pages) then + printfn "here" + do! data.Page.Restore restore.Pages printfn "- Restoring posts..." - do! data.Post.Restore restore.Posts + if not (List.isEmpty restore.Posts) then do! data.Post.Restore restore.Posts // TODO: comments not yet implemented printfn "- Restoring uploads..." - do! data.Upload.Restore (restore.Uploads |> List.map EncodedUpload.toUpload) + if not (List.isEmpty restore.Uploads) then + do! data.Upload.Restore (restore.Uploads |> List.map EncodedUpload.toUpload) displayStats "Restored for <>NAME<>:" restore.WebLog restore } diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 4e7ff12..0aa0d85 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -30,28 +30,28 @@ open System open Microsoft.Extensions.DependencyInjection open MyWebLog.Data open Newtonsoft.Json -open NodaTime open Npgsql /// Logic to obtain a data connection and implementation based on configured values module DataImplementation = open MyWebLog.Converters + // open Npgsql.Logging open RethinkDb.Driver.FSharp open RethinkDb.Driver.Net /// Get the configured data implementation - let get (sp : IServiceProvider) : IData * JsonSerializer = + let get (sp : IServiceProvider) : IData = let config = sp.GetRequiredService () let await it = (Async.AwaitTask >> Async.RunSynchronously) it let connStr name = config.GetConnectionString name let hasConnStr name = (connStr >> isNull >> not) name - let createSQLite connStr : IData * JsonSerializer = + let createSQLite connStr : IData = let log = sp.GetRequiredService> () let conn = new SqliteConnection (connStr) log.LogInformation $"Using SQLite database {conn.DataSource}" await (SQLiteData.setUpConnection conn) - SQLiteData (conn, log), Json.configure (JsonSerializer.CreateDefault ()) + SQLiteData (conn, log, Json.configure (JsonSerializer.CreateDefault ())) if hasConnStr "SQLite" then createSQLite (connStr "SQLite") @@ -60,12 +60,13 @@ module DataImplementation = let _ = Json.configure Converter.Serializer let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB") let conn = await (rethinkCfg.CreateConnectionAsync log) - RethinkDbData (conn, rethinkCfg, log), Converter.Serializer + RethinkDbData (conn, rethinkCfg, log) elif hasConnStr "PostgreSQL" then let log = sp.GetRequiredService> () + // NpgsqlLogManager.Provider <- ConsoleLoggingProvider NpgsqlLogLevel.Debug let conn = new NpgsqlConnection (connStr "PostgreSQL") log.LogInformation $"Using PostgreSQL database {conn.Host}:{conn.Port}/{conn.Database}" - PostgresData (conn, log), Json.configure (JsonSerializer.CreateDefault ()) + PostgresData (conn, log, Json.configure (JsonSerializer.CreateDefault ())) else createSQLite "Data Source=./myweblog.db;Cache=Shared" @@ -118,9 +119,8 @@ let rec main args = let _ = builder.Services.AddAntiforgery () let sp = builder.Services.BuildServiceProvider () - let data, serializer = DataImplementation.get sp - let _ = builder.Services.AddSingleton serializer - let _ = builder.Services.AddSingleton SystemClock.Instance + let data = DataImplementation.get sp + let _ = builder.Services.AddSingleton data.Serializer task { do! data.StartUp () -- 2.45.1 From a21993e28a7f554164a32eac737722eae82927ee Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sat, 20 Aug 2022 20:58:01 -0400 Subject: [PATCH 09/13] WIP on v2-rc2 migrations - Convert meta/podcast to JSON in SQLite - Add SQLite inClause function --- src/MyWebLog.Data/PostgresData.fs | 424 ++++++------ src/MyWebLog.Data/RethinkDbData.fs | 39 +- src/MyWebLog.Data/SQLite/Helpers.fs | 108 ++- .../SQLite/SQLiteCategoryData.fs | 23 +- src/MyWebLog.Data/SQLite/SQLitePageData.fs | 113 +--- src/MyWebLog.Data/SQLite/SQLitePostData.fs | 218 ++---- src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs | 20 +- src/MyWebLog.Data/SQLite/SQLiteThemeData.fs | 36 +- src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs | 145 +--- .../SQLite/SQLiteWebLogUserData.fs | 14 +- src/MyWebLog.Data/SQLiteData.fs | 623 +++++++++++------- src/MyWebLog.Data/Utils.fs | 3 + 12 files changed, 846 insertions(+), 920 deletions(-) diff --git a/src/MyWebLog.Data/PostgresData.fs b/src/MyWebLog.Data/PostgresData.fs index bb7b2b2..98df821 100644 --- a/src/MyWebLog.Data/PostgresData.fs +++ b/src/MyWebLog.Data/PostgresData.fs @@ -8,7 +8,230 @@ open Npgsql.FSharp /// Data implementation for PostgreSQL type PostgresData (conn : NpgsqlConnection, log : ILogger, ser : JsonSerializer) = - + + /// Create any needed tables + let ensureTables () = backgroundTask { + let _ = NpgsqlConnection.GlobalTypeMapper.UseNodaTime () + + let! tables = + Sql.existingConnection conn + |> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'" + |> Sql.executeAsync (fun row -> row.string "tablename") + let needsTable table = not (List.contains table tables) + let mutable isNew = false + + let sql = seq { + // Theme tables + if needsTable "theme" then + isNew <- true + "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))" + 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))" + + // 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)" + 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, + podcast JSONB)" + "CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)" + + // 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)" + + // 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 UUID 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)" + 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))" + + // 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)" + 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)" + 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))" + 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)" + + // 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)" + + // 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)" + + // Database version table + if needsTable "db_version" then + "CREATE TABLE db_version (id TEXT NOT NULL PRIMARY KEY" + $"INSERT INTO db_version VALUES ('{Utils.currentDbVersion}')" + } + + Sql.existingConnection conn + |> Sql.executeTransactionAsync + (sql + |> Seq.map (fun s -> + let parts = s.Split ' ' + if parts[1].ToLowerInvariant () = "table" then + log.LogInformation $"Creating {parts[2]} table..." + s, [ [] ]) + |> List.ofSeq) + |> Async.AwaitTask + |> Async.RunSynchronously + |> ignore + } + + /// Set a specific database version + let setDbVersion version = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')" + |> Sql.executeNonQueryAsync + () + } + + /// Do required data migration between versions + let migrate version = backgroundTask { + match version with + | Some "v2-rc2" -> () + // Future versions will be inserted here + | Some _ + | None -> + log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}" + do! setDbVersion Utils.currentDbVersion + } + interface IData with member _.Category = PostgresCategoryData conn @@ -24,196 +247,15 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger, ser : J member _.Serializer = ser member _.StartUp () = backgroundTask { + do! ensureTables () - let _ = NpgsqlConnection.GlobalTypeMapper.UseNodaTime () - - let! tables = + let! version = Sql.existingConnection conn - |> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'" - |> Sql.executeAsync (fun row -> row.string "tablename") - let needsTable table = not (List.contains table tables) - - 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)" - 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))" - 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))" - - // 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)" - 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, - podcast JSONB)" - "CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)" - - // 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)" - - // 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 UUID 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)" - 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))" - - // 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)" - 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)" - 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))" - 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)" - - // 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)" - - // 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)" - } - - Sql.existingConnection conn - |> Sql.executeTransactionAsync - (sql - |> Seq.map (fun s -> - let parts = s.Split ' ' - log.LogInformation $"Creating {parts[2]} {parts[1].ToLower()}..." - s, [ [] ]) - |> List.ofSeq) - |> Async.AwaitTask - |> Async.RunSynchronously - |> ignore + |> Sql.query "SELECT id FROM db_version" + |> Sql.executeAsync (fun row -> row.string "id") + |> tryHead + match version with + | Some v when v = Utils.currentDbVersion -> () + | Some _ + | None -> do! migrate version } diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index f151aed..beefab9 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -17,7 +17,10 @@ module private RethinkHelpers = /// The comment table let Comment = "Comment" - + + /// The database version table + let DbVersion = "DbVersion" + /// The page table let Page = "Page" @@ -43,7 +46,7 @@ module private RethinkHelpers = let WebLogUser = "WebLogUser" /// A list of all tables - let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ] + let all = [ Category; Comment; DbVersion; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ] /// Index names for indexes not on a data item's name @@ -81,6 +84,10 @@ module private RethinkHelpers = /// Cast a strongly-typed list to an object list let objList<'T> (objects : 'T list) = objects |> List.map (fun it -> it :> obj) + + /// A simple type for the database version table + [] + type DbVersion = { Id : string } open System @@ -187,7 +194,21 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + withTable Table.DbVersion + result; withRetryOnce conn + } + match List.tryHead version with + | Some v when v.Id = "v2-rc2" -> () + // Future migrations will be checked here + | Some _ + | None -> + log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}" + do! setDbVersion Utils.currentDbVersion } diff --git a/src/MyWebLog.Data/SQLite/Helpers.fs b/src/MyWebLog.Data/SQLite/Helpers.fs index 071da2a..c68f926 100644 --- a/src/MyWebLog.Data/SQLite/Helpers.fs +++ b/src/MyWebLog.Data/SQLite/Helpers.fs @@ -5,6 +5,7 @@ module MyWebLog.Data.SQLite.Helpers open System open Microsoft.Data.Sqlite open MyWebLog +open MyWebLog.Data open NodaTime.Text /// Run a command that returns a count @@ -47,6 +48,22 @@ let maybeDuration = let maybeInstant = Option.map instantParam +/// Create the SQL and parameters for an IN clause +let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) = + if List.isEmpty items then "", [] + else + let mutable idx = 0 + items + |> List.skip 1 + |> List.fold (fun (itemS, itemP) it -> + idx <- idx + 1 + $"{itemS}, @%s{paramName}{idx}", (SqliteParameter ($"@%s{paramName}{idx}", valueFunc it) :: itemP)) + (Seq.ofList items + |> Seq.map (fun it -> + $"%s{colNameAndPrefix} IN (@%s{paramName}0", [ SqliteParameter ($"@%s{paramName}0", valueFunc it) ]) + |> Seq.head) + |> function sql, ps -> $"{sql})", ps + /// Functions to map domain items from a data reader module Map = @@ -143,45 +160,18 @@ module Map = } /// Create a custom feed from the current row in the given data reader - let toCustomFeed rdr : CustomFeed = - { Id = getString "id" rdr |> CustomFeedId - Source = getString "source" rdr |> CustomFeedSource.parse - Path = getString "path" rdr |> Permalink - Podcast = - if rdr.IsDBNull (rdr.GetOrdinal "title") then - None - else - Some { - Title = getString "title" rdr - Subtitle = tryString "subtitle" rdr - ItemsInFeed = getInt "items_in_feed" rdr - Summary = getString "summary" rdr - DisplayedAuthor = getString "displayed_author" rdr - Email = getString "email" rdr - ImageUrl = getString "image_url" rdr |> Permalink - AppleCategory = getString "apple_category" rdr - AppleSubcategory = tryString "apple_subcategory" rdr - Explicit = getString "explicit" rdr |> ExplicitRating.parse - DefaultMediaType = tryString "default_media_type" rdr - MediaBaseUrl = tryString "media_base_url" rdr - PodcastGuid = tryGuid "podcast_guid" rdr - FundingUrl = tryString "funding_url" rdr - FundingText = tryString "funding_text" rdr - Medium = tryString "medium" rdr |> Option.map PodcastMedium.parse - } - } - - /// Create a meta item from the current row in the given data reader - let toMetaItem rdr : MetaItem = - { Name = getString "name" rdr - Value = getString "value" rdr + let toCustomFeed ser rdr : CustomFeed = + { Id = getString "id" rdr |> CustomFeedId + Source = getString "source" rdr |> CustomFeedSource.parse + Path = getString "path" rdr |> Permalink + Podcast = tryString "podcast" rdr |> Option.map (Utils.deserialize ser) } /// Create a permalink from the current row in the given data reader let toPermalink rdr = getString "permalink" rdr |> Permalink /// Create a page from the current row in the given data reader - let toPage rdr : Page = + let toPage ser rdr : Page = { Page.empty with Id = getString "id" rdr |> PageId WebLogId = getString "web_log_id" rdr |> WebLogId @@ -193,44 +183,28 @@ module Map = IsInPageList = getBoolean "is_in_page_list" rdr Template = tryString "template" rdr Text = getString "page_text" rdr + Metadata = tryString "meta_items" rdr + |> Option.map (Utils.deserialize ser) + |> Option.defaultValue [] } /// Create a post from the current row in the given data reader - let toPost rdr : Post = + let toPost ser rdr : Post = { Post.empty with - Id = getString "id" rdr |> PostId - WebLogId = getString "web_log_id" rdr |> WebLogId - AuthorId = getString "author_id" rdr |> WebLogUserId - Status = getString "status" rdr |> PostStatus.parse - Title = getString "title" rdr - Permalink = toPermalink rdr - PublishedOn = tryInstant "published_on" rdr - UpdatedOn = getInstant "updated_on" rdr - Template = tryString "template" rdr - Text = getString "post_text" rdr - Episode = - match tryString "media" rdr with - | Some media -> - Some { - Media = media - Length = getLong "length" rdr - Duration = tryDuration "duration" rdr - MediaType = tryString "media_type" rdr - ImageUrl = tryString "image_url" rdr - Subtitle = tryString "subtitle" rdr - Explicit = tryString "explicit" rdr |> Option.map ExplicitRating.parse - ChapterFile = tryString "chapter_file" rdr - ChapterType = tryString "chapter_type" rdr - TranscriptUrl = tryString "transcript_url" rdr - TranscriptType = tryString "transcript_type" rdr - TranscriptLang = tryString "transcript_lang" rdr - TranscriptCaptions = tryBoolean "transcript_captions" rdr - SeasonNumber = tryInt "season_number" rdr - SeasonDescription = tryString "season_description" rdr - EpisodeNumber = tryString "episode_number" rdr |> Option.map Double.Parse - EpisodeDescription = tryString "episode_description" rdr - } - | None -> None + Id = getString "id" rdr |> PostId + WebLogId = getString "web_log_id" rdr |> WebLogId + AuthorId = getString "author_id" rdr |> WebLogUserId + Status = getString "status" rdr |> PostStatus.parse + Title = getString "title" rdr + Permalink = toPermalink rdr + PublishedOn = tryInstant "published_on" rdr + UpdatedOn = getInstant "updated_on" rdr + Template = tryString "template" rdr + Text = getString "post_text" rdr + Episode = tryString "episode" rdr |> Option.map (Utils.deserialize ser) + Metadata = tryString "meta_items" rdr + |> Option.map (Utils.deserialize ser) + |> Option.defaultValue [] } /// Create a revision from the current row in the given data reader diff --git a/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs b/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs index d596475..75728b8 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs @@ -68,24 +68,23 @@ type SQLiteCategoryData (conn : SqliteConnection) = ordered |> Seq.map (fun it -> backgroundTask { // Parent category post counts include posts in subcategories + let catSql, catParams = + ordered + |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name) + |> Seq.map (fun cat -> cat.Id) + |> Seq.append (Seq.singleton it.Id) + |> List.ofSeq + |> inClause "AND pc.category_id" "catId" id cmd.Parameters.Clear () addWebLogId cmd webLogId - cmd.CommandText <- - "SELECT COUNT(DISTINCT p.id) + cmd.Parameters.AddRange catParams + cmd.CommandText <- $" + SELECT COUNT(DISTINCT p.id) 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 (" - ordered - |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name) - |> Seq.map (fun cat -> cat.Id) - |> Seq.append (Seq.singleton it.Id) - |> Seq.iteri (fun idx item -> - if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " - cmd.CommandText <- $"{cmd.CommandText}@catId{idx}" - cmd.Parameters.AddWithValue ($"@catId{idx}", item) |> ignore) - cmd.CommandText <- $"{cmd.CommandText})" + {catSql}" let! postCount = count cmd return it.Id, postCount }) diff --git a/src/MyWebLog.Data/SQLite/SQLitePageData.fs b/src/MyWebLog.Data/SQLite/SQLitePageData.fs index 9d71761..1854cb5 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePageData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePageData.fs @@ -4,9 +4,10 @@ open System.Threading.Tasks open Microsoft.Data.Sqlite open MyWebLog open MyWebLog.Data +open Newtonsoft.Json /// SQLite myWebLog page data implementation -type SQLitePageData (conn : SqliteConnection) = +type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) = // SUPPORT FUNCTIONS @@ -22,17 +23,10 @@ type SQLitePageData (conn : SqliteConnection) = cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList) cmd.Parameters.AddWithValue ("@template", maybe page.Template) cmd.Parameters.AddWithValue ("@text", page.Text) + cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty page.Metadata then None + else Some (Utils.serialize ser page.Metadata))) ] |> ignore - /// Append meta items to a page - let appendPageMeta (page : Page) = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT name, value FROM page_meta WHERE page_id = @id" - cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id) |> ignore - use! rdr = cmd.ExecuteReaderAsync () - return { page with Metadata = toList Map.toMetaItem rdr } - } - /// Append revisions and permalinks to a page let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask { use cmd = conn.CreateCommand () @@ -48,37 +42,13 @@ type SQLitePageData (conn : SqliteConnection) = return { page with Revisions = toList Map.toRevision rdr } } - /// Return a page with no text (or meta items, prior permalinks, or revisions) - let pageWithoutTextOrMeta rdr = - { Map.toPage rdr with Text = "" } + /// Shorthand for mapping a data reader to a page + let toPage = + Map.toPage ser - /// Update a page's metadata items - let updatePageMeta pageId oldItems newItems = backgroundTask { - let toDelete, toAdd = Utils.diffMetaItems oldItems newItems - if List.isEmpty toDelete && List.isEmpty toAdd then - return () - else - use cmd = conn.CreateCommand () - [ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId) - cmd.Parameters.Add ("@name", SqliteType.Text) - cmd.Parameters.Add ("@value", SqliteType.Text) - ] |> ignore - let runCmd (item : MetaItem) = backgroundTask { - cmd.Parameters["@name" ].Value <- item.Name - cmd.Parameters["@value"].Value <- item.Value - do! write cmd - } - cmd.CommandText <- "DELETE FROM page_meta WHERE page_id = @pageId AND name = @name AND value = @value" - toDelete - |> List.map runCmd - |> Task.WhenAll - |> ignore - cmd.CommandText <- "INSERT INTO page_meta VALUES (@pageId, @name, @value)" - toAdd - |> List.map runCmd - |> Task.WhenAll - |> ignore - } + /// Return a page with no text (or prior permalinks or revisions) + let pageWithoutText rdr = + { toPage rdr with Text = "" } /// Update a page's prior permalinks let updatePagePermalinks pageId oldLinks newLinks = backgroundTask { @@ -88,7 +58,7 @@ type SQLitePageData (conn : SqliteConnection) = else use cmd = conn.CreateCommand () [ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId) - cmd.Parameters.Add ("@link", SqliteType.Text) + cmd.Parameters.Add ("@link", SqliteType.Text) ] |> ignore let runCmd link = backgroundTask { cmd.Parameters["@link"].Value <- Permalink.toString link @@ -115,8 +85,8 @@ type SQLitePageData (conn : SqliteConnection) = use cmd = conn.CreateCommand () let runCmd withText rev = backgroundTask { cmd.Parameters.Clear () - [ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId) - cmd.Parameters.AddWithValue ("@asOf", rev.AsOf) + [ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId) + cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf) ] |> ignore if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore do! write cmd @@ -142,14 +112,13 @@ type SQLitePageData (conn : SqliteConnection) = cmd.CommandText <- "INSERT INTO page ( id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template, - page_text + page_text, meta_items ) VALUES ( @id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template, - @text + @text, @meta_items )" addPageParameters cmd page do! write cmd - do! updatePageMeta page.Id [] page.Metadata do! updatePagePermalinks page.Id [] page.PriorPermalinks do! updatePageRevisions page.Id [] page.Revisions } @@ -160,7 +129,7 @@ type SQLitePageData (conn : SqliteConnection) = cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)" addWebLogId cmd webLogId use! rdr = cmd.ExecuteReaderAsync () - return toList pageWithoutTextOrMeta rdr + return toList pageWithoutText rdr } /// Count all pages for the given web log @@ -190,11 +159,7 @@ type SQLitePageData (conn : SqliteConnection) = cmd.CommandText <- "SELECT * FROM page WHERE id = @id" cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore use! rdr = cmd.ExecuteReaderAsync () - match Helpers.verifyWebLog webLogId (fun it -> it.WebLogId) Map.toPage rdr with - | Some page -> - let! page = appendPageMeta page - return Some page - | None -> return None + return Helpers.verifyWebLog webLogId (fun it -> it.WebLogId) (Map.toPage ser) rdr } /// Find a complete page by its ID @@ -214,7 +179,6 @@ type SQLitePageData (conn : SqliteConnection) = cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @id; DELETE FROM page_permalink WHERE page_id = @id; - DELETE FROM page_meta WHERE page_id = @id; DELETE FROM page WHERE id = @id" do! write cmd return true @@ -228,29 +192,21 @@ type SQLitePageData (conn : SqliteConnection) = addWebLogId cmd webLogId cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore use! rdr = cmd.ExecuteReaderAsync () - if rdr.Read () then - let! page = appendPageMeta (Map.toPage rdr) - return Some page - else - return None + return if rdr.Read () then Some (toPage rdr) else None } /// Find the current permalink within a set of potential prior permalinks for the given web log let findCurrentPermalink permalinks webLogId = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- - "SELECT p.permalink + let linkSql, linkParams = inClause "AND pp.permalink" "link" Permalink.toString permalinks + cmd.CommandText <- $" + SELECT p.permalink FROM page p INNER JOIN page_permalink pp ON pp.page_id = p.id WHERE p.web_log_id = @webLogId - AND pp.permalink IN (" - permalinks - |> List.iteri (fun idx link -> - if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " - cmd.CommandText <- $"{cmd.CommandText}@link{idx}" - cmd.Parameters.AddWithValue ($"@link{idx}", Permalink.toString link) |> ignore) - cmd.CommandText <- $"{cmd.CommandText})" + {linkSql}" addWebLogId cmd webLogId + cmd.Parameters.AddRange linkParams use! rdr = cmd.ExecuteReaderAsync () return if rdr.Read () then Some (Map.toPermalink rdr) else None } @@ -262,11 +218,8 @@ type SQLitePageData (conn : SqliteConnection) = addWebLogId cmd webLogId use! rdr = cmd.ExecuteReaderAsync () let! pages = - toList Map.toPage rdr - |> List.map (fun page -> backgroundTask { - let! page = appendPageMeta page - return! appendPageRevisionsAndPermalinks page - }) + toList toPage rdr + |> List.map (fun page -> backgroundTask { return! appendPageRevisionsAndPermalinks page }) |> Task.WhenAll return List.ofArray pages } @@ -283,11 +236,7 @@ type SQLitePageData (conn : SqliteConnection) = addWebLogId cmd webLogId cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore use! rdr = cmd.ExecuteReaderAsync () - let! pages = - toList pageWithoutTextOrMeta rdr - |> List.map (fun page -> backgroundTask { return! appendPageMeta page }) - |> Task.WhenAll - return List.ofArray pages + return toList pageWithoutText rdr } /// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata) @@ -300,11 +249,11 @@ type SQLitePageData (conn : SqliteConnection) = ORDER BY LOWER(title) LIMIT @pageSize OFFSET @toSkip" addWebLogId cmd webLogId - [ cmd.Parameters.AddWithValue ("@pageSize", 26) - cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25) + [ cmd.Parameters.AddWithValue ("@pageSize", 26) + cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25) ] |> ignore use! rdr = cmd.ExecuteReaderAsync () - return toList Map.toPage rdr + return toList toPage rdr } /// Restore pages from a backup @@ -327,12 +276,12 @@ type SQLitePageData (conn : SqliteConnection) = updated_on = @updatedOn, is_in_page_list = @isInPageList, template = @template, - page_text = @text + page_text = @text, + meta_items = @metaItems WHERE id = @id AND web_log_id = @webLogId" addPageParameters cmd page do! write cmd - do! updatePageMeta page.Id oldPage.Metadata page.Metadata do! updatePagePermalinks page.Id oldPage.PriorPermalinks page.PriorPermalinks do! updatePageRevisions page.Id oldPage.Revisions page.Revisions return () diff --git a/src/MyWebLog.Data/SQLite/SQLitePostData.fs b/src/MyWebLog.Data/SQLite/SQLitePostData.fs index ab15dcc..257bdf7 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePostData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePostData.fs @@ -4,10 +4,11 @@ open System.Threading.Tasks open Microsoft.Data.Sqlite open MyWebLog open MyWebLog.Data +open Newtonsoft.Json open NodaTime /// SQLite myWebLog post data implementation -type SQLitePostData (conn : SqliteConnection) = +type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) = // SUPPORT FUNCTIONS @@ -23,32 +24,15 @@ type SQLitePostData (conn : SqliteConnection) = cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn) cmd.Parameters.AddWithValue ("@template", maybe post.Template) cmd.Parameters.AddWithValue ("@text", post.Text) + cmd.Parameters.AddWithValue ("@episode", maybe (if Option.isSome post.Episode then + Some (Utils.serialize ser post.Episode) + else None)) + cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty post.Metadata then None + else Some (Utils.serialize ser post.Metadata))) ] |> ignore - /// Add parameters for episode INSERT or UPDATE statements - let addEpisodeParameters (cmd : SqliteCommand) (ep : Episode) = - [ cmd.Parameters.AddWithValue ("@media", ep.Media) - cmd.Parameters.AddWithValue ("@length", ep.Length) - cmd.Parameters.AddWithValue ("@duration", maybeDuration ep.Duration) - cmd.Parameters.AddWithValue ("@mediaType", maybe ep.MediaType) - cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.ImageUrl) - cmd.Parameters.AddWithValue ("@subtitle", maybe ep.Subtitle) - cmd.Parameters.AddWithValue ("@explicit", maybe (ep.Explicit - |> Option.map ExplicitRating.toString)) - cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.ChapterFile) - cmd.Parameters.AddWithValue ("@chapterType", maybe ep.ChapterType) - cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.TranscriptUrl) - cmd.Parameters.AddWithValue ("@transcriptType", maybe ep.TranscriptType) - cmd.Parameters.AddWithValue ("@transcriptLang", maybe ep.TranscriptLang) - cmd.Parameters.AddWithValue ("@transcriptCaptions", maybe ep.TranscriptCaptions) - cmd.Parameters.AddWithValue ("@seasonNumber", maybe ep.SeasonNumber) - cmd.Parameters.AddWithValue ("@seasonDescription", maybe ep.SeasonDescription) - cmd.Parameters.AddWithValue ("@episodeNumber", maybe (ep.EpisodeNumber |> Option.map string)) - cmd.Parameters.AddWithValue ("@episodeDescription", maybe ep.EpisodeDescription) - ] |> ignore - - /// Append category IDs, tags, and meta items to a post - let appendPostCategoryTagAndMeta (post : Post) = backgroundTask { + /// Append category IDs and tags to a post + let appendPostCategoryAndTag (post : Post) = backgroundTask { use cmd = conn.CreateCommand () cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id) |> ignore @@ -59,12 +43,7 @@ type SQLitePostData (conn : SqliteConnection) = cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id" use! rdr = cmd.ExecuteReaderAsync () - let post = { post with Tags = toList (Map.getString "tag") rdr } - do! rdr.CloseAsync () - - cmd.CommandText <- "SELECT name, value FROM post_meta WHERE post_id = @id" - use! rdr = cmd.ExecuteReaderAsync () - return { post with Metadata = toList Map.toMetaItem rdr } + return { post with Tags = toList (Map.getString "tag") rdr } } /// Append revisions and permalinks to a post @@ -83,7 +62,11 @@ type SQLitePostData (conn : SqliteConnection) = } /// The SELECT statement for a post that will include episode data, if it exists - let selectPost = "SELECT p.*, e.* FROM post p LEFT JOIN post_episode e ON e.post_id = p.id" + let selectPost = "SELECT p.* FROM post p" + + /// Shorthand for mapping a data reader to a post + let toPost = + Map.toPost ser /// Find just-the-post by its ID for the given web log (excludes category, tag, meta, revisions, and permalinks) let findPostById postId webLogId = backgroundTask { @@ -91,12 +74,12 @@ type SQLitePostData (conn : SqliteConnection) = cmd.CommandText <- $"{selectPost} WHERE p.id = @id" cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore use! rdr = cmd.ExecuteReaderAsync () - return Helpers.verifyWebLog webLogId (fun p -> p.WebLogId) Map.toPost rdr + return Helpers.verifyWebLog webLogId (fun p -> p.WebLogId) toPost rdr } /// Return a post with no revisions, prior permalinks, or text let postWithoutText rdr = - { Map.toPost rdr with Text = "" } + { toPost rdr with Text = "" } /// Update a post's assigned categories let updatePostCategories postId oldCats newCats = backgroundTask { @@ -105,8 +88,8 @@ type SQLitePostData (conn : SqliteConnection) = return () else use cmd = conn.CreateCommand () - [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) - cmd.Parameters.Add ("@categoryId", SqliteType.Text) + [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) + cmd.Parameters.Add ("@categoryId", SqliteType.Text) ] |> ignore let runCmd catId = backgroundTask { cmd.Parameters["@categoryId"].Value <- CategoryId.toString catId @@ -131,8 +114,8 @@ type SQLitePostData (conn : SqliteConnection) = return () else use cmd = conn.CreateCommand () - [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) - cmd.Parameters.Add ("@tag", SqliteType.Text) + [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) + cmd.Parameters.Add ("@tag", SqliteType.Text) ] |> ignore let runCmd (tag : string) = backgroundTask { cmd.Parameters["@tag"].Value <- tag @@ -150,86 +133,6 @@ type SQLitePostData (conn : SqliteConnection) = |> ignore } - /// Update an episode - let updatePostEpisode (post : Post) = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT COUNT(post_id) FROM post_episode WHERE post_id = @postId" - cmd.Parameters.AddWithValue ("@postId", PostId.toString post.Id) |> ignore - let! count = count cmd - if count = 1 then - match post.Episode with - | Some ep -> - cmd.CommandText <- - "UPDATE post_episode - SET media = @media, - length = @length, - duration = @duration, - media_type = @mediaType, - image_url = @imageUrl, - subtitle = @subtitle, - explicit = @explicit, - chapter_file = @chapterFile, - chapter_type = @chapterType, - transcript_url = @transcriptUrl, - transcript_type = @transcriptType, - transcript_lang = @transcriptLang, - transcript_captions = @transcriptCaptions, - season_number = @seasonNumber, - season_description = @seasonDescription, - episode_number = @episodeNumber, - episode_description = @episodeDescription - WHERE post_id = @postId" - addEpisodeParameters cmd ep - do! write cmd - | None -> - cmd.CommandText <- "DELETE FROM post_episode WHERE post_id = @postId" - do! write cmd - else - match post.Episode with - | Some ep -> - cmd.CommandText <- - "INSERT INTO post_episode ( - post_id, media, length, duration, media_type, image_url, subtitle, explicit, chapter_file, - chapter_type, transcript_url, transcript_type, transcript_lang, transcript_captions, - season_number, season_description, episode_number, episode_description - ) VALUES ( - @postId, @media, @length, @duration, @mediaType, @imageUrl, @subtitle, @explicit, @chapterFile, - @chapterType, @transcriptUrl, @transcriptType, @transcriptLang, @transcriptCaptions, - @seasonNumber, @seasonDescription, @episodeNumber, @episodeDescription - )" - addEpisodeParameters cmd ep - do! write cmd - | None -> () - } - - /// Update a post's metadata items - let updatePostMeta postId oldItems newItems = backgroundTask { - let toDelete, toAdd = Utils.diffMetaItems oldItems newItems - if List.isEmpty toDelete && List.isEmpty toAdd then - return () - else - use cmd = conn.CreateCommand () - [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) - cmd.Parameters.Add ("@name", SqliteType.Text) - cmd.Parameters.Add ("@value", SqliteType.Text) - ] |> ignore - let runCmd (item : MetaItem) = backgroundTask { - cmd.Parameters["@name" ].Value <- item.Name - cmd.Parameters["@value"].Value <- item.Value - do! write cmd - } - cmd.CommandText <- "DELETE FROM post_meta WHERE post_id = @postId AND name = @name AND value = @value" - toDelete - |> List.map runCmd - |> Task.WhenAll - |> ignore - cmd.CommandText <- "INSERT INTO post_meta VALUES (@postId, @name, @value)" - toAdd - |> List.map runCmd - |> Task.WhenAll - |> ignore - } - /// Update a post's prior permalinks let updatePostPermalinks postId oldLinks newLinks = backgroundTask { let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks @@ -237,8 +140,8 @@ type SQLitePostData (conn : SqliteConnection) = return () else use cmd = conn.CreateCommand () - [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) - cmd.Parameters.Add ("@link", SqliteType.Text) + [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) + cmd.Parameters.Add ("@link", SqliteType.Text) ] |> ignore let runCmd link = backgroundTask { cmd.Parameters["@link"].Value <- Permalink.toString link @@ -265,8 +168,8 @@ type SQLitePostData (conn : SqliteConnection) = use cmd = conn.CreateCommand () let runCmd withText rev = backgroundTask { cmd.Parameters.Clear () - [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) - cmd.Parameters.AddWithValue ("@asOf", rev.AsOf) + [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) + cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf) ] |> ignore if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore do! write cmd @@ -290,16 +193,16 @@ type SQLitePostData (conn : SqliteConnection) = use cmd = conn.CreateCommand () cmd.CommandText <- "INSERT INTO post ( - id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text + id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text, + episode, meta_items ) VALUES ( - @id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text + @id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text, + @episode, @metaItems )" addPostParameters cmd post do! write cmd do! updatePostCategories post.Id [] post.CategoryIds do! updatePostTags post.Id [] post.Tags - do! updatePostEpisode post - do! updatePostMeta post.Id [] post.Metadata do! updatePostPermalinks post.Id [] post.PriorPermalinks do! updatePostRevisions post.Id [] post.Revisions } @@ -317,7 +220,7 @@ type SQLitePostData (conn : SqliteConnection) = let findById postId webLogId = backgroundTask { match! findPostById postId webLogId with | Some post -> - let! post = appendPostCategoryTagAndMeta post + let! post = appendPostCategoryAndTag post return Some post | None -> return None } @@ -330,7 +233,7 @@ type SQLitePostData (conn : SqliteConnection) = cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore use! rdr = cmd.ExecuteReaderAsync () if rdr.Read () then - let! post = appendPostCategoryTagAndMeta (Map.toPost rdr) + let! post = appendPostCategoryAndTag (toPost rdr) return Some post else return None @@ -354,10 +257,9 @@ type SQLitePostData (conn : SqliteConnection) = cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @id; DELETE FROM post_permalink WHERE post_id = @id; - DELETE FROM post_meta WHERE post_id = @id; - DELETE FROM post_episode WHERE post_id = @id; DELETE FROM post_tag WHERE post_id = @id; DELETE FROM post_category WHERE post_id = @id; + DELETE FROM post_comment WHERE post_id = @id; DELETE FROM post WHERE id = @id" do! write cmd return true @@ -367,19 +269,15 @@ type SQLitePostData (conn : SqliteConnection) = /// Find the current permalink from a list of potential prior permalinks for the given web log let findCurrentPermalink permalinks webLogId = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- - "SELECT p.permalink + let linkSql, linkParams = inClause "AND pp.permalink" "link" Permalink.toString permalinks + cmd.CommandText <- $" + SELECT p.permalink FROM post p INNER JOIN post_permalink pp ON pp.post_id = p.id WHERE p.web_log_id = @webLogId - AND pp.permalink IN (" - permalinks - |> List.iteri (fun idx link -> - if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " - cmd.CommandText <- $"{cmd.CommandText}@link{idx}" - cmd.Parameters.AddWithValue ($"@link{idx}", Permalink.toString link) |> ignore) - cmd.CommandText <- $"{cmd.CommandText})" + {linkSql}" addWebLogId cmd webLogId + cmd.Parameters.AddRange linkParams use! rdr = cmd.ExecuteReaderAsync () return if rdr.Read () then Some (Map.toPermalink rdr) else None } @@ -391,9 +289,9 @@ type SQLitePostData (conn : SqliteConnection) = addWebLogId cmd webLogId use! rdr = cmd.ExecuteReaderAsync () let! posts = - toList Map.toPost rdr + toList toPost rdr |> List.map (fun post -> backgroundTask { - let! post = appendPostCategoryTagAndMeta post + let! post = appendPostCategoryAndTag post return! appendPostRevisionsAndPermalinks post }) |> Task.WhenAll @@ -403,26 +301,22 @@ type SQLitePostData (conn : SqliteConnection) = /// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks) let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask { use cmd = conn.CreateCommand () + let catSql, catParams = inClause "AND pc.category_id" "catId" CategoryId.toString categoryIds cmd.CommandText <- $" {selectPost} 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 (" - categoryIds - |> List.iteri (fun idx catId -> - if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " - cmd.CommandText <- $"{cmd.CommandText}@catId{idx}" - cmd.Parameters.AddWithValue ($"@catId{idx}", CategoryId.toString catId) |> ignore) - cmd.CommandText <- $"{cmd.CommandText}) + {catSql} ORDER BY published_on DESC LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" addWebLogId cmd webLogId cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore + cmd.Parameters.AddRange catParams use! rdr = cmd.ExecuteReaderAsync () let! posts = - toList Map.toPost rdr - |> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post }) + toList toPost rdr + |> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post }) |> Task.WhenAll return List.ofArray posts } @@ -439,7 +333,7 @@ type SQLitePostData (conn : SqliteConnection) = use! rdr = cmd.ExecuteReaderAsync () let! posts = toList postWithoutText rdr - |> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post }) + |> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post }) |> Task.WhenAll return List.ofArray posts } @@ -457,8 +351,8 @@ type SQLitePostData (conn : SqliteConnection) = cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore use! rdr = cmd.ExecuteReaderAsync () let! posts = - toList Map.toPost rdr - |> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post }) + toList toPost rdr + |> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post }) |> Task.WhenAll return List.ofArray posts } @@ -480,8 +374,8 @@ type SQLitePostData (conn : SqliteConnection) = ] |> ignore use! rdr = cmd.ExecuteReaderAsync () let! posts = - toList Map.toPost rdr - |> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post }) + toList toPost rdr + |> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post }) |> Task.WhenAll return List.ofArray posts } @@ -497,13 +391,13 @@ type SQLitePostData (conn : SqliteConnection) = ORDER BY p.published_on DESC LIMIT 1" addWebLogId cmd webLogId - [ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) - cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn) + [ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) + cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn) ] |> ignore use! rdr = cmd.ExecuteReaderAsync () let! older = backgroundTask { if rdr.Read () then - let! post = appendPostCategoryTagAndMeta (postWithoutText rdr) + let! post = appendPostCategoryAndTag (postWithoutText rdr) return Some post else return None @@ -519,7 +413,7 @@ type SQLitePostData (conn : SqliteConnection) = use! rdr = cmd.ExecuteReaderAsync () let! newer = backgroundTask { if rdr.Read () then - let! post = appendPostCategoryTagAndMeta (postWithoutText rdr) + let! post = appendPostCategoryAndTag (postWithoutText rdr) return Some post else return None @@ -547,15 +441,15 @@ type SQLitePostData (conn : SqliteConnection) = published_on = @publishedOn, updated_on = @updatedOn, template = @template, - post_text = @text + post_text = @text, + episode = @episode, + meta_items = @metaItems WHERE id = @id AND web_log_id = @webLogId" addPostParameters cmd post do! write cmd do! updatePostCategories post.Id oldPost.CategoryIds post.CategoryIds do! updatePostTags post.Id oldPost.Tags post.Tags - do! updatePostEpisode post - do! updatePostMeta post.Id oldPost.Metadata post.Metadata do! updatePostPermalinks post.Id oldPost.PriorPermalinks post.PriorPermalinks do! updatePostRevisions post.Id oldPost.Revisions post.Revisions | None -> return () diff --git a/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs b/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs index 2adc75c..00de07b 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs @@ -50,18 +50,14 @@ type SQLiteTagMapData (conn : SqliteConnection) = /// Find any tag mappings in a list of tags for the given web log let findMappingForTags (tags : string list) webLogId = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- - "SELECT * + let mapSql, mapParams = inClause "AND tag" "tag" id tags + cmd.CommandText <- $" + SELECT * FROM tag_map WHERE web_log_id = @webLogId - AND tag IN (" - tags - |> List.iteri (fun idx tag -> - if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " - cmd.CommandText <- $"{cmd.CommandText}@tag{idx}" - cmd.Parameters.AddWithValue ($"@tag{idx}", tag) |> ignore) - cmd.CommandText <- $"{cmd.CommandText})" + {mapSql}" addWebLogId cmd webLogId + cmd.Parameters.AddRange mapParams use! rdr = cmd.ExecuteReaderAsync () return toList Map.toTagMap rdr } @@ -85,9 +81,9 @@ type SQLiteTagMapData (conn : SqliteConnection) = @id, @webLogId, @tag, @urlValue )" addWebLogId cmd tagMap.WebLogId - [ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id) - cmd.Parameters.AddWithValue ("@tag", tagMap.Tag) - cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue) + [ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id) + cmd.Parameters.AddWithValue ("@tag", tagMap.Tag) + cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue) ] |> ignore do! write cmd } diff --git a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs index 3218667..dd3d81b 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs @@ -17,13 +17,13 @@ type SQLiteThemeData (conn : SqliteConnection) = do! rdr.CloseAsync () cmd.CommandText <- "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name" use! rdr = cmd.ExecuteReaderAsync () - let mutable templates = [] - while rdr.Read () do - templates <- (ThemeId (Map.getString "theme_id" rdr), Map.toThemeTemplate false rdr) :: templates + let templates = + seq { while rdr.Read () do ThemeId (Map.getString "theme_id" rdr), Map.toThemeTemplate false rdr } + |> List.ofSeq return themes |> List.map (fun t -> - { t with Templates = templates |> List.filter (fun tt -> fst tt = t.Id) |> List.map snd }) + { t with Templates = templates |> List.filter (fun (themeId, _) -> themeId = t.Id) |> List.map snd }) } /// Does a given theme exist? @@ -85,9 +85,9 @@ type SQLiteThemeData (conn : SqliteConnection) = match oldTheme with | Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id" | None -> "INSERT INTO theme VALUES (@id, @name, @version)" - [ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.Id) - cmd.Parameters.AddWithValue ("@name", theme.Name) - cmd.Parameters.AddWithValue ("@version", theme.Version) + [ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.Id) + cmd.Parameters.AddWithValue ("@name", theme.Name) + cmd.Parameters.AddWithValue ("@version", theme.Version) ] |> ignore do! write cmd @@ -102,9 +102,9 @@ type SQLiteThemeData (conn : SqliteConnection) = cmd.CommandText <- "UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name" cmd.Parameters.Clear () - [ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.Id) - cmd.Parameters.Add ("@name", SqliteType.Text) - cmd.Parameters.Add ("@template", SqliteType.Text) + [ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.Id) + cmd.Parameters.Add ("@name", SqliteType.Text) + cmd.Parameters.Add ("@template", SqliteType.Text) ] |> ignore toUpdate |> List.map (fun template -> backgroundTask { @@ -169,8 +169,8 @@ type SQLiteThemeAssetData (conn : SqliteConnection) = use cmd = conn.CreateCommand () cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path" let (ThemeAssetId (ThemeId themeId, path)) = assetId - [ cmd.Parameters.AddWithValue ("@themeId", themeId) - cmd.Parameters.AddWithValue ("@path", path) + [ cmd.Parameters.AddWithValue ("@themeId", themeId) + cmd.Parameters.AddWithValue ("@path", path) ] |> ignore use! rdr = cmd.ExecuteReaderAsync () return if rdr.Read () then Some (Map.toThemeAsset true rdr) else None @@ -200,8 +200,8 @@ type SQLiteThemeAssetData (conn : SqliteConnection) = sideCmd.CommandText <- "SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path" let (ThemeAssetId (ThemeId themeId, path)) = asset.Id - [ sideCmd.Parameters.AddWithValue ("@themeId", themeId) - sideCmd.Parameters.AddWithValue ("@path", path) + [ sideCmd.Parameters.AddWithValue ("@themeId", themeId) + sideCmd.Parameters.AddWithValue ("@path", path) ] |> ignore let! exists = count sideCmd @@ -219,10 +219,10 @@ type SQLiteThemeAssetData (conn : SqliteConnection) = ) VALUES ( @themeId, @path, @updatedOn, ZEROBLOB(@dataLength) )" - [ cmd.Parameters.AddWithValue ("@themeId", themeId) - cmd.Parameters.AddWithValue ("@path", path) - cmd.Parameters.AddWithValue ("@updatedOn", instantParam asset.UpdatedOn) - cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length) + [ cmd.Parameters.AddWithValue ("@themeId", themeId) + cmd.Parameters.AddWithValue ("@path", path) + cmd.Parameters.AddWithValue ("@updatedOn", instantParam asset.UpdatedOn) + cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length) ] |> ignore do! write cmd diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs index 7203ac9..aa34719 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs @@ -4,12 +4,13 @@ open System.Threading.Tasks open Microsoft.Data.Sqlite open MyWebLog open MyWebLog.Data +open Newtonsoft.Json // The web log podcast insert loop is not statically compilable; this is OK #nowarn "3511" /// SQLite myWebLog web log data implementation -type SQLiteWebLogData (conn : SqliteConnection) = +type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) = // SUPPORT FUNCTIONS @@ -45,41 +46,22 @@ type SQLiteWebLogData (conn : SqliteConnection) = cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source) cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path) + cmd.Parameters.AddWithValue ("@podcast", maybe (if Option.isSome feed.Podcast then + Some (Utils.serialize ser feed.Podcast) + else None)) ] |> ignore - /// Add parameters for podcast INSERT or UPDATE statements - let addPodcastParameters (cmd : SqliteCommand) feedId (podcast : PodcastOptions) = - [ cmd.Parameters.AddWithValue ("@feedId", CustomFeedId.toString feedId) - cmd.Parameters.AddWithValue ("@title", podcast.Title) - cmd.Parameters.AddWithValue ("@subtitle", maybe podcast.Subtitle) - cmd.Parameters.AddWithValue ("@itemsInFeed", podcast.ItemsInFeed) - cmd.Parameters.AddWithValue ("@summary", podcast.Summary) - cmd.Parameters.AddWithValue ("@displayedAuthor", podcast.DisplayedAuthor) - cmd.Parameters.AddWithValue ("@email", podcast.Email) - cmd.Parameters.AddWithValue ("@imageUrl", Permalink.toString podcast.ImageUrl) - cmd.Parameters.AddWithValue ("@appleCategory", podcast.AppleCategory) - cmd.Parameters.AddWithValue ("@appleSubcategory", maybe podcast.AppleSubcategory) - cmd.Parameters.AddWithValue ("@explicit", ExplicitRating.toString podcast.Explicit) - cmd.Parameters.AddWithValue ("@defaultMediaType", maybe podcast.DefaultMediaType) - cmd.Parameters.AddWithValue ("@mediaBaseUrl", maybe podcast.MediaBaseUrl) - cmd.Parameters.AddWithValue ("@podcastGuid", maybe podcast.PodcastGuid) - cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.FundingUrl) - cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.FundingText) - cmd.Parameters.AddWithValue ("@medium", maybe (podcast.Medium - |> Option.map PodcastMedium.toString)) - ] |> ignore - + /// Shorthand to map a data reader to a custom feed + let toCustomFeed = + Map.toCustomFeed ser + /// Get the current custom feeds for a web log let getCustomFeeds (webLog : WebLog) = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- - "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" + cmd.CommandText <- "SELECT * FROM web_log_feed WHERE web_log_id = @webLogId" addWebLogId cmd webLog.Id use! rdr = cmd.ExecuteReaderAsync () - return toList Map.toCustomFeed rdr + return toList toCustomFeed rdr } /// Append custom feeds to a web log @@ -88,23 +70,6 @@ type SQLiteWebLogData (conn : SqliteConnection) = return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } } } - /// Add a podcast to a custom feed - let addPodcast feedId (podcast : PodcastOptions) = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- - "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 - )" - addPodcastParameters cmd feedId podcast - do! write cmd - } - /// Update the custom feeds for a web log let updateCustomFeeds (webLog : WebLog) = backgroundTask { let! feeds = getCustomFeeds webLog @@ -118,9 +83,7 @@ type SQLiteWebLogData (conn : SqliteConnection) = 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.CommandText <- "DELETE FROM web_log_feed WHERE id = @id" cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id do! write cmd }) @@ -131,16 +94,13 @@ type SQLiteWebLogData (conn : SqliteConnection) = |> List.map (fun it -> backgroundTask { cmd.CommandText <- "INSERT INTO web_log_feed ( - id, web_log_id, source, path + id, web_log_id, source, path, podcast ) VALUES ( - @id, @webLogId, @source, @path + @id, @webLogId, @source, @path, @podcast )" 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 @@ -148,49 +108,14 @@ type SQLiteWebLogData (conn : SqliteConnection) = |> List.map (fun it -> backgroundTask { cmd.CommandText <- "UPDATE web_log_feed - SET source = @source, - path = @path + SET source = @source, + path = @path, + podcast = @podcast 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 -> - if hadPodcast then - cmd.CommandText <- - "UPDATE web_log_feed_podcast - SET title = @title, - subtitle = @subtitle, - items_in_feed = @itemsInFeed, - summary = @summary, - displayed_author = @displayedAuthor, - email = @email, - image_url = @imageUrl, - apple_category = @appleCategory, - apple_subcategory = @appleSubcategory, - explicit = @explicit, - default_media_type = @defaultMediaType, - media_base_url = @mediaBaseUrl, - podcast_guid = @podcastGuid, - funding_url = @fundingUrl, - funding_text = @fundingText, - medium = @medium - WHERE feed_id = @feedId" - cmd.Parameters.Clear () - addPodcastParameters cmd it.Id podcast - do! write cmd - else - do! addPodcast 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 @@ -233,26 +158,22 @@ type SQLiteWebLogData (conn : SqliteConnection) = let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)" let postSubQuery = subQuery "post" let pageSubQuery = subQuery "page" - cmd.CommandText <- $""" - DELETE FROM post_comment WHERE post_id IN {postSubQuery}; - DELETE FROM post_revision WHERE post_id IN {postSubQuery}; - DELETE FROM post_permalink WHERE post_id IN {postSubQuery}; - DELETE FROM post_episode WHERE post_id IN {postSubQuery}; - DELETE FROM post_tag WHERE post_id IN {postSubQuery}; - DELETE FROM post_category WHERE post_id IN {postSubQuery}; - DELETE FROM post_meta WHERE post_id IN {postSubQuery}; - DELETE FROM post WHERE web_log_id = @webLogId; - DELETE FROM page_revision WHERE page_id IN {pageSubQuery}; - DELETE FROM page_permalink WHERE page_id IN {pageSubQuery}; - DELETE FROM page_meta WHERE page_id IN {pageSubQuery}; - DELETE FROM page WHERE web_log_id = @webLogId; - DELETE FROM category WHERE web_log_id = @webLogId; - DELETE FROM tag_map WHERE web_log_id = @webLogId; - DELETE FROM upload WHERE web_log_id = @webLogId; - DELETE FROM web_log_user WHERE web_log_id = @webLogId; - DELETE FROM web_log_feed_podcast WHERE feed_id IN {subQuery "web_log_feed"}; - DELETE FROM web_log_feed WHERE web_log_id = @webLogId; - DELETE FROM web_log WHERE id = @webLogId""" + cmd.CommandText <- $" + DELETE FROM post_comment WHERE post_id IN {postSubQuery}; + DELETE FROM post_revision WHERE post_id IN {postSubQuery}; + DELETE FROM post_permalink WHERE post_id IN {postSubQuery}; + DELETE FROM post_tag WHERE post_id IN {postSubQuery}; + DELETE FROM post_category WHERE post_id IN {postSubQuery}; + DELETE FROM post WHERE web_log_id = @webLogId; + DELETE FROM page_revision WHERE page_id IN {pageSubQuery}; + DELETE FROM page_permalink WHERE page_id IN {pageSubQuery}; + DELETE FROM page WHERE web_log_id = @webLogId; + DELETE FROM category WHERE web_log_id = @webLogId; + DELETE FROM tag_map WHERE web_log_id = @webLogId; + DELETE FROM upload WHERE web_log_id = @webLogId; + DELETE FROM web_log_user WHERE web_log_id = @webLogId; + DELETE FROM web_log_feed WHERE web_log_id = @webLogId; + DELETE FROM web_log WHERE id = @webLogId" do! write cmd } diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs index 262be7e..fd9ccd8 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs @@ -92,14 +92,10 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = /// Find the names of users by their IDs for the given web log let findNames webLogId userIds = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND id IN (" - userIds - |> List.iteri (fun idx userId -> - if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " - cmd.CommandText <- $"{cmd.CommandText}@id{idx}" - cmd.Parameters.AddWithValue ($"@id{idx}", WebLogUserId.toString userId) |> ignore) - cmd.CommandText <- $"{cmd.CommandText})" + let nameSql, nameParams = inClause "AND id" "id" WebLogUserId.toString userIds + cmd.CommandText <- $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {nameSql}" addWebLogId cmd webLogId + cmd.Parameters.AddRange nameParams use! rdr = cmd.ExecuteReaderAsync () return toList Map.toWebLogUser rdr @@ -121,8 +117,8 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = WHERE id = @id AND web_log_id = @webLogId" addWebLogId cmd webLogId - [ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) - cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Noda.now ())) + [ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) + cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Noda.now ())) ] |> ignore let! _ = cmd.ExecuteNonQueryAsync () () diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index a142a5c..00c4808 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -2,12 +2,371 @@ namespace MyWebLog.Data open Microsoft.Data.Sqlite open Microsoft.Extensions.Logging +open MyWebLog open MyWebLog.Data.SQLite open Newtonsoft.Json +open NodaTime /// SQLite myWebLog data implementation type SQLiteData (conn : SqliteConnection, log : ILogger, ser : JsonSerializer) = + let ensureTables () = backgroundTask { + + use cmd = conn.CreateCommand () + + let! tables = backgroundTask { + cmd.CommandText <- "SELECT name FROM sqlite_master WHERE type = 'table'" + let! rdr = cmd.ExecuteReaderAsync () + let mutable tableList = [] + while rdr.Read() do + tableList <- Map.getString "name" rdr :: tableList + do! rdr.CloseAsync () + return tableList + } + let needsTable table = + List.contains table tables + seq { + // Theme tables + if needsTable "theme" then + "CREATE TABLE theme ( + id TEXT 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))" + if needsTable "theme_asset" then + "CREATE TABLE theme_asset ( + theme_id TEXT NOT NULL REFERENCES theme (id), + path TEXT NOT NULL, + updated_on TEXT NOT NULL, + data BLOB NOT NULL, + PRIMARY KEY (theme_id, path))" + + // Web log tables + if needsTable "web_log" then + "CREATE TABLE web_log ( + id TEXT 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 INTEGER NOT NULL DEFAULT 0, + uploads TEXT NOT NULL, + is_feed_enabled INTEGER NOT NULL DEFAULT 0, + feed_name TEXT NOT NULL, + items_in_feed INTEGER, + is_category_enabled INTEGER NOT NULL DEFAULT 0, + is_tag_enabled INTEGER NOT NULL DEFAULT 0, + 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 PRIMARY KEY, + web_log_id TEXT NOT NULL REFERENCES web_log (id), + source TEXT NOT NULL, + path TEXT NOT NULL, + podcast TEXT); + CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)" + + // Category table + if needsTable "category" then + "CREATE TABLE category ( + id TEXT 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 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 TEXT NOT NULL, + last_seen_on TEXT); + 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 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, + published_on TEXT NOT NULL, + updated_on TEXT NOT NULL, + is_in_page_list INTEGER NOT NULL DEFAULT 0, + template TEXT, + page_text TEXT NOT NULL, + meta_items TEXT); + 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_permalink" then + "CREATE TABLE page_permalink ( + page_id TEXT NOT NULL REFERENCES page (id), + permalink TEXT NOT NULL, + PRIMARY KEY (page_id, permalink))" + if needsTable "page_revision" then + "CREATE TABLE page_revision ( + page_id TEXT NOT NULL REFERENCES page (id), + as_of TEXT NOT NULL, + revision_text TEXT NOT NULL, + PRIMARY KEY (page_id, as_of))" + + // Post tables + if needsTable "post" then + "CREATE TABLE post ( + id TEXT 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, + published_on TEXT, + updated_on TEXT NOT NULL, + template TEXT, + post_text TEXT NOT NULL, + meta_items TEXT, + episode TEXT); + 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)" + if needsTable "post_tag" then + "CREATE TABLE post_tag ( + post_id TEXT NOT NULL REFERENCES post (id), + tag TEXT NOT NULL, + PRIMARY KEY (post_id, tag))" + if needsTable "post_permalink" then + "CREATE TABLE post_permalink ( + post_id TEXT NOT NULL REFERENCES post (id), + permalink TEXT NOT NULL, + PRIMARY KEY (post_id, permalink))" + if needsTable "post_revision" then + "CREATE TABLE post_revision ( + post_id TEXT NOT NULL REFERENCES post (id), + as_of TEXT NOT NULL, + revision_text TEXT NOT NULL, + PRIMARY KEY (post_id, as_of))" + if needsTable "post_comment" then + "CREATE TABLE post_comment ( + id TEXT 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 TEXT 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 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 PRIMARY KEY, + web_log_id TEXT NOT NULL REFERENCES web_log (id), + path TEXT NOT NULL, + updated_on TEXT NOT NULL, + data BLOB NOT NULL); + CREATE INDEX upload_web_log_idx ON upload (web_log_id); + CREATE INDEX upload_path_idx ON upload (web_log_id, path)" + + // Database version table + if needsTable "db_version" then + "CREATE TABLE db_version (id TEXT PRIMARY KEY); + INSERT INTO db_version VALUES ('v2-rc1')" + } + |> Seq.map (fun sql -> + log.LogInformation $"Creating {(sql.Split ' ')[2]} table..." + cmd.CommandText <- sql + write cmd |> Async.AwaitTask |> Async.RunSynchronously) + |> List.ofSeq + |> ignore + } + + /// Set the database version to the specified version + let setDbVersion version = backgroundTask { + use cmd = conn.CreateCommand () + cmd.CommandText <- $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')" + do! write cmd + } + + /// Log a migration step + let logMigrationStep migration message = + log.LogInformation $"[%s{migration}] %s{message}" + + /// Implement the changes between v2-rc1 and v2-rc2 + let migrateV2Rc1ToV2Rc2 () = backgroundTask { + let logStep = logMigrationStep "v2-rc1 to v2-rc2" + // Move meta items, podcast settings, and episode details to JSON-encoded text fields + use cmd = conn.CreateCommand () + logStep "Adding new columns" + cmd.CommandText <- + "ALTER TABLE web_log_feed ADD COLUMN podcast TEXT; + ALTER TABLE page ADD COLUMN meta_items TEXT; + ALTER TABLE post ADD COLUMN meta_items TEXT; + ALTER TABLE post ADD COLUMN episode TEXT" + do! write cmd + logStep "Migrating meta items" + let migrateMeta entity = backgroundTask { + cmd.CommandText <- $"SELECT * FROM %s{entity}_meta" + use! metaRdr = cmd.ExecuteReaderAsync () + let allMetas = + seq { + while metaRdr.Read () do + Map.getString $"{entity}_id" metaRdr, + { Name = Map.getString "name" metaRdr; Value = Map.getString "value" metaRdr } + } |> List.ofSeq + metaRdr.Close () + let metas = + allMetas + |> List.map fst + |> List.distinct + |> List.map (fun it -> it, allMetas |> List.filter (fun meta -> fst meta = it)) + metas + |> List.iter (fun (entityId, items) -> + cmd.CommandText <- + "UPDATE post + SET meta_items = @metaItems + WHERE id = @postId" + [ cmd.Parameters.AddWithValue ("@metaItems", Utils.serialize ser items) + cmd.Parameters.AddWithValue ("@id", entityId) ] |> ignore + let _ = cmd.ExecuteNonQuery () + cmd.Parameters.Clear ()) + } + do! migrateMeta "page" + do! migrateMeta "post" + logStep "Migrating podcasts and episodes" + cmd.CommandText <- "SELECT * FROM web_log_feed_podcast" + use! podcastRdr = cmd.ExecuteReaderAsync () + let podcasts = + seq { + while podcastRdr.Read () do + CustomFeedId (Map.getString "feed_id" podcastRdr), + { Title = Map.getString "title" podcastRdr + Subtitle = Map.tryString "subtitle" podcastRdr + ItemsInFeed = Map.getInt "items_in_feed" podcastRdr + Summary = Map.getString "summary" podcastRdr + DisplayedAuthor = Map.getString "displayed_author" podcastRdr + Email = Map.getString "email" podcastRdr + ImageUrl = Map.getString "image_url" podcastRdr |> Permalink + AppleCategory = Map.getString "apple_category" podcastRdr + AppleSubcategory = Map.tryString "apple_subcategory" podcastRdr + Explicit = Map.getString "explicit" podcastRdr |> ExplicitRating.parse + DefaultMediaType = Map.tryString "default_media_type" podcastRdr + MediaBaseUrl = Map.tryString "media_base_url" podcastRdr + PodcastGuid = Map.tryGuid "podcast_guid" podcastRdr + FundingUrl = Map.tryString "funding_url" podcastRdr + FundingText = Map.tryString "funding_text" podcastRdr + Medium = Map.tryString "medium" podcastRdr + |> Option.map PodcastMedium.parse + } + } |> List.ofSeq + podcastRdr.Close () + podcasts + |> List.iter (fun (feedId, podcast) -> + cmd.CommandText <- "UPDATE web_log_feed SET podcast = @podcast WHERE id = @id" + [ cmd.Parameters.AddWithValue ("@podcast", Utils.serialize ser podcast) + cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feedId) ] |> ignore + let _ = cmd.ExecuteNonQuery () + cmd.Parameters.Clear ()) + cmd.CommandText <- "SELECT * FROM post_episode" + use! epRdr = cmd.ExecuteReaderAsync () + let episodes = + seq { + while epRdr.Read () do + PostId (Map.getString "post_id" epRdr), + { Media = Map.getString "media" epRdr + Length = Map.getLong "length" epRdr + Duration = Map.tryTimeSpan "duration" epRdr + |> Option.map Duration.FromTimeSpan + MediaType = Map.tryString "media_type" epRdr + ImageUrl = Map.tryString "image_url" epRdr + Subtitle = Map.tryString "subtitle" epRdr + Explicit = Map.tryString "explicit" epRdr + |> Option.map ExplicitRating.parse + ChapterFile = Map.tryString "chapter_file" epRdr + ChapterType = Map.tryString "chapter_type" epRdr + TranscriptUrl = Map.tryString "transcript_url" epRdr + TranscriptType = Map.tryString "transcript_type" epRdr + TranscriptLang = Map.tryString "transcript_lang" epRdr + TranscriptCaptions = Map.tryBoolean "transcript_captions" epRdr + SeasonNumber = Map.tryInt "season_number" epRdr + SeasonDescription = Map.tryString "season_description" epRdr + EpisodeNumber = Map.tryString "episode_number" epRdr + |> Option.map System.Double.Parse + EpisodeDescription = Map.tryString "episode_description" epRdr + } + } |> List.ofSeq + episodes + |> List.iter (fun (postId, episode) -> + cmd.CommandText <- "UPDATE post SET episode = @episode WHERE id = @id" + [ cmd.Parameters.AddWithValue ("@episode", Utils.serialize ser episode) + cmd.Parameters.AddWithValue ("@id", PostId.toString postId) ] |> ignore + let _ = cmd.ExecuteNonQuery () + cmd.Parameters.Clear ()) + + logStep "Dropping old tables" + cmd.CommandText <- + "DROP TABLE post_episode; + DROP TABLE post_meta; + DROP TABLE page_meta; + DROP TABLE web_log_podcast" + do! write cmd + + logStep "Setting database version" + do! setDbVersion "v2-rc2" + } + + /// Migrate data among versions (up only) + let migrate version = backgroundTask { + + match version with + | Some v when v = "v2-rc2" -> () + | Some v when v = "v2-rc1" -> do! migrateV2Rc1ToV2Rc2 () + | Some _ + | None -> + log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}" + do! setDbVersion Utils.currentDbVersion + } + /// The connection for this instance member _.Conn = conn @@ -23,266 +382,26 @@ type SQLiteData (conn : SqliteConnection, log : ILogger, ser : JsonS interface IData with member _.Category = SQLiteCategoryData conn - member _.Page = SQLitePageData conn - member _.Post = SQLitePostData conn + member _.Page = SQLitePageData (conn, ser) + member _.Post = SQLitePostData (conn, ser) member _.TagMap = SQLiteTagMapData conn member _.Theme = SQLiteThemeData conn member _.ThemeAsset = SQLiteThemeAssetData conn member _.Upload = SQLiteUploadData conn - member _.WebLog = SQLiteWebLogData conn + member _.WebLog = SQLiteWebLogData (conn, ser) member _.WebLogUser = SQLiteWebLogUserData conn member _.Serializer = ser member _.StartUp () = backgroundTask { - - use cmd = conn.CreateCommand () + do! ensureTables () - let! tables = backgroundTask { - cmd.CommandText <- "SELECT name FROM sqlite_master WHERE type = 'table'" - let! rdr = cmd.ExecuteReaderAsync () - let mutable tableList = [] - while rdr.Read() do - tableList <- Map.getString "name" rdr :: tableList - do! rdr.CloseAsync () - return tableList - } - let needsTable table = - List.contains table tables - seq { - // Theme tables - if needsTable "theme" then - "CREATE TABLE theme ( - id TEXT 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))" - if needsTable "theme_asset" then - "CREATE TABLE theme_asset ( - theme_id TEXT NOT NULL REFERENCES theme (id), - path TEXT NOT NULL, - updated_on TEXT NOT NULL, - data BLOB NOT NULL, - PRIMARY KEY (theme_id, path))" - - // Web log tables - if needsTable "web_log" then - "CREATE TABLE web_log ( - id TEXT 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 INTEGER NOT NULL DEFAULT 0, - uploads TEXT NOT NULL, - is_feed_enabled INTEGER NOT NULL DEFAULT 0, - feed_name TEXT NOT NULL, - items_in_feed INTEGER, - is_category_enabled INTEGER NOT NULL DEFAULT 0, - is_tag_enabled INTEGER NOT NULL DEFAULT 0, - 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 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 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 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 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 TEXT NOT NULL, - last_seen_on TEXT); - 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 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, - published_on TEXT NOT NULL, - updated_on TEXT NOT NULL, - is_in_page_list INTEGER NOT NULL DEFAULT 0, - template TEXT, - page_text TEXT NOT NULL); - 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_meta" then - "CREATE TABLE page_meta ( - page_id TEXT NOT NULL REFERENCES page (id), - name TEXT NOT NULL, - value TEXT NOT NULL, - PRIMARY KEY (page_id, name, value))" - if needsTable "page_permalink" then - "CREATE TABLE page_permalink ( - page_id TEXT NOT NULL REFERENCES page (id), - permalink TEXT NOT NULL, - PRIMARY KEY (page_id, permalink))" - if needsTable "page_revision" then - "CREATE TABLE page_revision ( - page_id TEXT NOT NULL REFERENCES page (id), - as_of TEXT NOT NULL, - revision_text TEXT NOT NULL, - PRIMARY KEY (page_id, as_of))" - - // Post tables - if needsTable "post" then - "CREATE TABLE post ( - id TEXT 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, - published_on TEXT, - updated_on TEXT NOT NULL, - template TEXT, - post_text TEXT NOT NULL); - 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)" - if needsTable "post_episode" then - "CREATE TABLE post_episode ( - post_id TEXT PRIMARY KEY REFERENCES post(id), - media TEXT NOT NULL, - length INTEGER NOT NULL, - duration TEXT, - media_type TEXT, - image_url TEXT, - subtitle TEXT, - explicit TEXT, - chapter_file TEXT, - chapter_type TEXT, - transcript_url TEXT, - transcript_type TEXT, - transcript_lang TEXT, - transcript_captions INTEGER, - season_number INTEGER, - season_description TEXT, - episode_number TEXT, - episode_description TEXT)" - if needsTable "post_tag" then - "CREATE TABLE post_tag ( - post_id TEXT NOT NULL REFERENCES post (id), - tag TEXT NOT NULL, - PRIMARY KEY (post_id, tag))" - if needsTable "post_meta" then - "CREATE TABLE post_meta ( - post_id TEXT NOT NULL REFERENCES post (id), - name TEXT NOT NULL, - value TEXT NOT NULL, - PRIMARY KEY (post_id, name, value))" - if needsTable "post_permalink" then - "CREATE TABLE post_permalink ( - post_id TEXT NOT NULL REFERENCES post (id), - permalink TEXT NOT NULL, - PRIMARY KEY (post_id, permalink))" - if needsTable "post_revision" then - "CREATE TABLE post_revision ( - post_id TEXT NOT NULL REFERENCES post (id), - as_of TEXT NOT NULL, - revision_text TEXT NOT NULL, - PRIMARY KEY (post_id, as_of))" - if needsTable "post_comment" then - "CREATE TABLE post_comment ( - id TEXT 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 TEXT 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 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 PRIMARY KEY, - web_log_id TEXT NOT NULL REFERENCES web_log (id), - path TEXT NOT NULL, - updated_on TEXT NOT NULL, - data BLOB 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.map (fun sql -> - log.LogInformation $"Creating {(sql.Split ' ')[2]} table..." - cmd.CommandText <- sql - write cmd |> Async.AwaitTask |> Async.RunSynchronously) - |> List.ofSeq - |> ignore + use cmd = conn.CreateCommand () + cmd.CommandText <- "SELECT id FROM db_version" + use! rdr = cmd.ExecuteReaderAsync () + let version = if rdr.Read () then Some (Map.getString "id" rdr) else None + match version with + | Some v when v = "v2-rc2" -> () + | Some _ + | None -> do! migrate version } diff --git a/src/MyWebLog.Data/Utils.fs b/src/MyWebLog.Data/Utils.fs index 50c68c1..fcc3584 100644 --- a/src/MyWebLog.Data/Utils.fs +++ b/src/MyWebLog.Data/Utils.fs @@ -5,6 +5,9 @@ module internal MyWebLog.Data.Utils open MyWebLog open MyWebLog.ViewModels +/// The current database version +let currentDbVersion = "v2-rc2" + /// Create a category hierarchy from the given list of categories let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq { for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do -- 2.45.1 From e0e2d97ac22333fd319432ba22d90cf5f79bafb8 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sun, 21 Aug 2022 00:31:34 -0400 Subject: [PATCH 10/13] Finish SQLite v2-rc2 migration --- src/MyWebLog.Data/SQLite/Helpers.fs | 18 +- src/MyWebLog.Data/SQLite/SQLitePageData.fs | 2 +- src/MyWebLog.Data/SQLiteData.fs | 184 ++++++++++++++++++++- src/MyWebLog.Domain/SupportTypes.fs | 7 +- src/MyWebLog/Maintenance.fs | 4 +- 5 files changed, 198 insertions(+), 17 deletions(-) diff --git a/src/MyWebLog.Data/SQLite/Helpers.fs b/src/MyWebLog.Data/SQLite/Helpers.fs index c68f926..1513987 100644 --- a/src/MyWebLog.Data/SQLite/Helpers.fs +++ b/src/MyWebLog.Data/SQLite/Helpers.fs @@ -32,21 +32,24 @@ let write (cmd : SqliteCommand) = backgroundTask { () } +/// Add a possibly-missing parameter, substituting null for None +let maybe<'T> (it : 'T option) : obj = match it with Some x -> x :> obj | None -> DBNull.Value + /// Create a value for a Duration let durationParam = DurationPattern.Roundtrip.Format /// Create a value for an Instant let instantParam = - InstantPattern.ExtendedIso.Format + InstantPattern.General.Format /// Create an optional value for a Duration let maybeDuration = - Option.map durationParam + Option.map durationParam >> maybe /// Create an optional value for an Instant let maybeInstant = - Option.map instantParam + Option.map instantParam >> maybe /// Create the SQL and parameters for an IN clause let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) = @@ -260,9 +263,9 @@ module Map = dataStream.ToArray () else [||] - { Id = getString "id" rdr |> UploadId - WebLogId = getString "web_log_id" rdr |> WebLogId - Path = getString "path" rdr |> Permalink + { Id = getString "id" rdr |> UploadId + WebLogId = getString "web_log_id" rdr |> WebLogId + Path = getString "path" rdr |> Permalink UpdatedOn = getInstant "updated_on" rdr Data = data } @@ -307,9 +310,6 @@ module Map = LastSeenOn = tryInstant "last_seen_on" rdr } -/// Add a possibly-missing parameter, substituting null for None -let maybe<'T> (it : 'T option) : obj = match it with Some x -> x :> obj | None -> DBNull.Value - /// Add a web log ID parameter let addWebLogId (cmd : SqliteCommand) webLogId = cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore diff --git a/src/MyWebLog.Data/SQLite/SQLitePageData.fs b/src/MyWebLog.Data/SQLite/SQLitePageData.fs index 1854cb5..5562bcc 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePageData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePageData.fs @@ -115,7 +115,7 @@ type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) = page_text, meta_items ) VALUES ( @id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template, - @text, @meta_items + @text, @metaItems )" addPageParameters cmd page do! write cmd diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index 00c4808..7b732c6 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -24,7 +24,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger, ser : JsonS return tableList } let needsTable table = - List.contains table tables + not (List.contains table tables) seq { // Theme tables if needsTable "theme" then @@ -230,7 +230,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger, ser : JsonS /// Log a migration step let logMigrationStep migration message = - log.LogInformation $"[%s{migration}] %s{message}" + log.LogInformation $"Migrating %s{migration}: %s{message}" /// Implement the changes between v2-rc1 and v2-rc2 let migrateV2Rc1ToV2Rc2 () = backgroundTask { @@ -335,6 +335,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger, ser : JsonS EpisodeDescription = Map.tryString "episode_description" epRdr } } |> List.ofSeq + epRdr.Close () episodes |> List.iter (fun (postId, episode) -> cmd.CommandText <- "UPDATE post SET episode = @episode WHERE id = @id" @@ -343,12 +344,189 @@ type SQLiteData (conn : SqliteConnection, log : ILogger, ser : JsonS let _ = cmd.ExecuteNonQuery () cmd.Parameters.Clear ()) + logStep "Migrating dates/times" + let inst (dt : System.DateTime) = + System.DateTime (dt.Ticks, System.DateTimeKind.Utc) + |> (Instant.FromDateTimeUtc >> Noda.toSecondsPrecision) + // page.updated_on, page.published_on + cmd.CommandText <- "SELECT id, updated_on, published_on FROM page" + use! pageRdr = cmd.ExecuteReaderAsync () + let toUpdate = + seq { + while pageRdr.Read () do + Map.getString "id" pageRdr, + inst (Map.getDateTime "updated_on" pageRdr), + inst (Map.getDateTime "published_on" pageRdr) + } |> List.ofSeq + pageRdr.Close () + cmd.CommandText <- "UPDATE page SET updated_on = @updatedOn, published_on = @publishedOn WHERE id = @id" + [ cmd.Parameters.Add ("@id", SqliteType.Text) + cmd.Parameters.Add ("@updatedOn", SqliteType.Text) + cmd.Parameters.Add ("@publishedOn", SqliteType.Text) + ] |> ignore + toUpdate + |> List.iter (fun (pageId, updatedOn, publishedOn) -> + cmd.Parameters["@id" ].Value <- pageId + cmd.Parameters["@updatedOn" ].Value <- instantParam updatedOn + cmd.Parameters["@publishedOn"].Value <- instantParam publishedOn + let _ = cmd.ExecuteNonQuery () + ()) + cmd.Parameters.Clear () + // page_revision.as_of + cmd.CommandText <- "SELECT * FROM page_revision" + use! pageRevRdr = cmd.ExecuteReaderAsync () + let toUpdate = + seq { + while pageRevRdr.Read () do + let asOf = Map.getDateTime "as_of" pageRevRdr + Map.getString "page_id" pageRevRdr, asOf, inst asOf, Map.getString "revision_text" pageRevRdr + } |> List.ofSeq + pageRevRdr.Close () + cmd.CommandText <- + "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @oldAsOf; + INSERT INTO page_revision (page_id, as_of, revision_text) VALUES (@pageId, @asOf, @text)" + [ cmd.Parameters.Add ("@pageId", SqliteType.Text) + cmd.Parameters.Add ("@oldAsOf", SqliteType.Text) + cmd.Parameters.Add ("@asOf", SqliteType.Text) + cmd.Parameters.Add ("@text", SqliteType.Text) + ] |> ignore + toUpdate + |> List.iter (fun (pageId, oldAsOf, asOf, text) -> + cmd.Parameters["@pageId" ].Value <- pageId + cmd.Parameters["@oldAsOf"].Value <- oldAsOf + cmd.Parameters["@asOf" ].Value <- instantParam asOf + cmd.Parameters["@text" ].Value <- text + let _ = cmd.ExecuteNonQuery () + ()) + cmd.Parameters.Clear () + // post.updated_on, post.published_on (opt) + cmd.CommandText <- "SELECT id, updated_on, published_on FROM post" + use! postRdr = cmd.ExecuteReaderAsync () + let toUpdate = + seq { + while postRdr.Read () do + Map.getString "id" postRdr, + inst (Map.getDateTime "updated_on" postRdr), + (Map.tryDateTime "published_on" postRdr |> Option.map inst) + } |> List.ofSeq + postRdr.Close () + cmd.CommandText <- "UPDATE post SET updated_on = @updatedOn, published_on = @publishedOn WHERE id = @id" + [ cmd.Parameters.Add ("@id", SqliteType.Text) + cmd.Parameters.Add ("@updatedOn", SqliteType.Text) + cmd.Parameters.Add ("@publishedOn", SqliteType.Text) + ] |> ignore + toUpdate + |> List.iter (fun (postId, updatedOn, publishedOn) -> + cmd.Parameters["@id" ].Value <- postId + cmd.Parameters["@updatedOn" ].Value <- instantParam updatedOn + cmd.Parameters["@publishedOn"].Value <- maybeInstant publishedOn + let _ = cmd.ExecuteNonQuery () + ()) + cmd.Parameters.Clear () + // post_revision.as_of + cmd.CommandText <- "SELECT * FROM post_revision" + use! postRevRdr = cmd.ExecuteReaderAsync () + let toUpdate = + seq { + while postRevRdr.Read () do + let asOf = Map.getDateTime "as_of" postRevRdr + Map.getString "post_id" postRevRdr, asOf, inst asOf, Map.getString "revision_text" postRevRdr + } |> List.ofSeq + postRevRdr.Close () + cmd.CommandText <- + "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @oldAsOf; + INSERT INTO post_revision (post_id, as_of, revision_text) VALUES (@postId, @asOf, @text)" + [ cmd.Parameters.Add ("@postId", SqliteType.Text) + cmd.Parameters.Add ("@oldAsOf", SqliteType.Text) + cmd.Parameters.Add ("@asOf", SqliteType.Text) + cmd.Parameters.Add ("@text", SqliteType.Text) + ] |> ignore + toUpdate + |> List.iter (fun (postId, oldAsOf, asOf, text) -> + cmd.Parameters["@postId" ].Value <- postId + cmd.Parameters["@oldAsOf"].Value <- oldAsOf + cmd.Parameters["@asOf" ].Value <- instantParam asOf + cmd.Parameters["@text" ].Value <- text + let _ = cmd.ExecuteNonQuery () + ()) + cmd.Parameters.Clear () + // theme_asset.updated_on + cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset" + use! assetRdr = cmd.ExecuteReaderAsync () + let toUpdate = + seq { + while assetRdr.Read () do + Map.getString "theme_id" assetRdr, Map.getString "path" assetRdr, + inst (Map.getDateTime "updated_on" assetRdr) + } |> List.ofSeq + assetRdr.Close () + cmd.CommandText <- "UPDATE theme_asset SET updated_on = @updatedOn WHERE theme_id = @themeId AND path = @path" + [ cmd.Parameters.Add ("@updatedOn", SqliteType.Text) + cmd.Parameters.Add ("@themeId", SqliteType.Text) + cmd.Parameters.Add ("@path", SqliteType.Text) + ] |> ignore + toUpdate + |> List.iter (fun (themeId, path, updatedOn) -> + cmd.Parameters["@themeId" ].Value <- themeId + cmd.Parameters["@path" ].Value <- path + cmd.Parameters["@updatedOn"].Value <- instantParam updatedOn + let _ = cmd.ExecuteNonQuery () + ()) + cmd.Parameters.Clear () + // upload.updated_on + cmd.CommandText <- "SELECT id, updated_on FROM upload" + use! upRdr = cmd.ExecuteReaderAsync () + let toUpdate = + seq { + while upRdr.Read () do + Map.getString "id" upRdr, inst (Map.getDateTime "updated_on" upRdr) + } |> List.ofSeq + upRdr.Close () + cmd.CommandText <- "UPDATE upload SET updated_on = @updatedOn WHERE id = @id" + [ cmd.Parameters.Add ("@updatedOn", SqliteType.Text) + cmd.Parameters.Add ("@id", SqliteType.Text) + ] |> ignore + toUpdate + |> List.iter (fun (upId, updatedOn) -> + cmd.Parameters["@id" ].Value <- upId + cmd.Parameters["@updatedOn"].Value <- instantParam updatedOn + let _ = cmd.ExecuteNonQuery () + ()) + cmd.Parameters.Clear () + // web_log_user.created_on, web_log_user.last_seen_on (opt) + cmd.CommandText <- "SELECT id, created_on, last_seen_on FROM web_log_user" + use! userRdr = cmd.ExecuteReaderAsync () + let toUpdate = + seq { + while userRdr.Read () do + Map.getString "id" userRdr, + inst (Map.getDateTime "created_on" userRdr), + (Map.tryDateTime "last_seen_on" userRdr |> Option.map inst) + } |> List.ofSeq + userRdr.Close () + cmd.CommandText <- "UPDATE web_log_user SET created_on = @createdOn, last_seen_on = @lastSeenOn WHERE id = @id" + [ cmd.Parameters.Add ("@id", SqliteType.Text) + cmd.Parameters.Add ("@createdOn", SqliteType.Text) + cmd.Parameters.Add ("@lastSeenOn", SqliteType.Text) + ] |> ignore + toUpdate + |> List.iter (fun (userId, createdOn, lastSeenOn) -> + cmd.Parameters["@id" ].Value <- userId + cmd.Parameters["@createdOn" ].Value <- instantParam createdOn + cmd.Parameters["@lastSeenOn"].Value <- maybeInstant lastSeenOn + let _ = cmd.ExecuteNonQuery () + ()) + cmd.Parameters.Clear () + + conn.Close () + conn.Open () + logStep "Dropping old tables" cmd.CommandText <- "DROP TABLE post_episode; DROP TABLE post_meta; DROP TABLE page_meta; - DROP TABLE web_log_podcast" + DROP TABLE web_log_feed_podcast" do! write cmd logStep "Setting database version" diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index 3785293..49bb09c 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -22,8 +22,13 @@ module Noda = /// The Unix epoch let epoch = Instant.FromUnixTimeSeconds 0L + /// Truncate an instant to remove fractional seconds + let toSecondsPrecision (value : Instant) = + Instant.FromUnixTimeSeconds (value.ToUnixTimeSeconds ()) + /// The current Instant, with fractional seconds truncated - let now () = Instant.FromUnixTimeSeconds (clock.GetCurrentInstant().ToUnixTimeSeconds ()) + let now () = + toSecondsPrecision (clock.GetCurrentInstant ()) /// A user's access level diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 4d4fbe9..9fb32d8 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -397,9 +397,7 @@ module Backup = if not (List.isEmpty restore.Categories) then do! data.Category.Restore restore.Categories printfn "- Restoring pages..." - if not (List.isEmpty restore.Pages) then - printfn "here" - do! data.Page.Restore restore.Pages + if not (List.isEmpty restore.Pages) then do! data.Page.Restore restore.Pages printfn "- Restoring posts..." if not (List.isEmpty restore.Posts) then do! data.Post.Restore restore.Posts -- 2.45.1 From 2f8ec5a54bc05fc8d0e4e4b6d7988ecbac42d411 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sun, 21 Aug 2022 15:50:34 -0400 Subject: [PATCH 11/13] Punt RethinkDB migration - Backup/restore works; otherwise, it would have required near full replacement of several document types. Backup/restore is well-tested and less error-prone. --- src/MyWebLog.Data/RethinkDbData.fs | 44 +++++++++++++++++++++-------- src/MyWebLog.Data/SQLiteData.fs | 8 ++---- src/MyWebLog.Data/Utils.fs | 6 ++++ src/MyWebLog.Domain/SupportTypes.fs | 5 ++++ 4 files changed, 46 insertions(+), 17 deletions(-) diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index beefab9..c5d7d91 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -84,10 +84,6 @@ module private RethinkHelpers = /// Cast a strongly-typed list to an object list let objList<'T> (objects : 'T list) = objects |> List.map (fun it -> it :> obj) - - /// A simple type for the database version table - [] - type DbVersion = { Id : string } open System @@ -204,11 +200,32 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger () + | Some v when v = "v2-rc1" -> do! migrateV2Rc1ToV2Rc2 () + | Some _ + | None -> + log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}" + do! setDbVersion Utils.currentDbVersion + } + /// The connection for this instance member _.Conn = conn @@ -1138,6 +1155,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + let! version = rethink<{| Id : string |} list> { withTable Table.DbVersion + limit 1 result; withRetryOnce conn } match List.tryHead version with | Some v when v.Id = "v2-rc2" -> () - // Future migrations will be checked here - | Some _ - | None -> - log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}" - do! setDbVersion Utils.currentDbVersion + | it -> do! migrate (it |> Option.map (fun x -> x.Id)) } diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index 7b732c6..3b33874 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -228,13 +228,9 @@ type SQLiteData (conn : SqliteConnection, log : ILogger, ser : JsonS do! write cmd } - /// Log a migration step - let logMigrationStep migration message = - log.LogInformation $"Migrating %s{migration}: %s{message}" - /// Implement the changes between v2-rc1 and v2-rc2 let migrateV2Rc1ToV2Rc2 () = backgroundTask { - let logStep = logMigrationStep "v2-rc1 to v2-rc2" + let logStep = Utils.logMigrationStep log "v2-rc1 to v2-rc2" // Move meta items, podcast settings, and episode details to JSON-encoded text fields use cmd = conn.CreateCommand () logStep "Adding new columns" @@ -529,7 +525,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger, ser : JsonS DROP TABLE web_log_feed_podcast" do! write cmd - logStep "Setting database version" + logStep "Setting database version to v2-rc2" do! setDbVersion "v2-rc2" } diff --git a/src/MyWebLog.Data/Utils.fs b/src/MyWebLog.Data/Utils.fs index fcc3584..59ad5dc 100644 --- a/src/MyWebLog.Data/Utils.fs +++ b/src/MyWebLog.Data/Utils.fs @@ -50,3 +50,9 @@ let serialize<'T> ser (item : 'T) = /// Deserialize a JSON string let deserialize<'T> (ser : JsonSerializer) value = JsonConvert.DeserializeObject<'T> (value, Json.settings ser) + +open Microsoft.Extensions.Logging + +/// Log a migration step +let logMigrationStep<'T> (log : ILogger<'T>) migration message = + log.LogInformation $"Migrating %s{migration}: %s{message}" diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index 49bb09c..4753583 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -22,6 +22,7 @@ module Noda = /// The Unix epoch let epoch = Instant.FromUnixTimeSeconds 0L + /// Truncate an instant to remove fractional seconds let toSecondsPrecision (value : Instant) = Instant.FromUnixTimeSeconds (value.ToUnixTimeSeconds ()) @@ -29,6 +30,10 @@ module Noda = /// The current Instant, with fractional seconds truncated let now () = toSecondsPrecision (clock.GetCurrentInstant ()) + + /// Convert a date/time to an Instant with whole seconds + let fromDateTime (dt : DateTime) = + toSecondsPrecision (Instant.FromDateTimeUtc (DateTime (dt.Ticks, DateTimeKind.Utc))) /// A user's access level -- 2.45.1 From a4913615fe676b152df52e2b9ccaca7b75904063 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sun, 21 Aug 2022 17:15:02 -0400 Subject: [PATCH 12/13] Convert to ASP.NET password hashing --- src/MyWebLog.Data/Postgres/PostgresHelpers.fs | 1 - .../Postgres/PostgresWebLogUserData.fs | 24 ++++----- src/MyWebLog.Data/PostgresData.fs | 3 +- src/MyWebLog.Data/RethinkDbData.fs | 1 - src/MyWebLog.Data/SQLite/Helpers.fs | 1 - .../SQLite/SQLiteWebLogUserData.fs | 6 +-- src/MyWebLog.Data/SQLiteData.fs | 12 ++--- src/MyWebLog.Domain/DataTypes.fs | 4 -- src/MyWebLog/Handlers/User.fs | 54 ++++++++++--------- src/MyWebLog/Maintenance.fs | 52 +++++++++++------- src/MyWebLog/Program.fs | 2 + 11 files changed, 86 insertions(+), 74 deletions(-) diff --git a/src/MyWebLog.Data/Postgres/PostgresHelpers.fs b/src/MyWebLog.Data/Postgres/PostgresHelpers.fs index 32c90fb..4f289ab 100644 --- a/src/MyWebLog.Data/Postgres/PostgresHelpers.fs +++ b/src/MyWebLog.Data/Postgres/PostgresHelpers.fs @@ -233,7 +233,6 @@ module Map = 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.fieldValue "created_on" diff --git a/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs b/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs index 87d4f4b..333f5ec 100644 --- a/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs @@ -11,25 +11,24 @@ type PostgresWebLogUserData (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, + id, web_log_id, email, first_name, last_name, preferred_name, password_hash, url, access_level, created_on, last_seen_on ) VALUES ( - @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel, + @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @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) + "@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 + "@url", Sql.stringOrNone user.Url + "@accessLevel", Sql.string (AccessLevel.toString user.AccessLevel) typedParam "createdOn" user.CreatedOn optParam "lastSeenOn" user.LastSeenOn ] @@ -128,7 +127,6 @@ type PostgresWebLogUserData (conn : NpgsqlConnection) = last_name = @lastName, preferred_name = @preferredName, password_hash = @passwordHash, - salt = @salt, url = @url, access_level = @accessLevel, created_on = @createdOn, diff --git a/src/MyWebLog.Data/PostgresData.fs b/src/MyWebLog.Data/PostgresData.fs index 98df821..223efc5 100644 --- a/src/MyWebLog.Data/PostgresData.fs +++ b/src/MyWebLog.Data/PostgresData.fs @@ -93,7 +93,6 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger, ser : J last_name TEXT NOT NULL, preferred_name TEXT NOT NULL, password_hash TEXT NOT NULL, - salt UUID NOT NULL, url TEXT, access_level TEXT NOT NULL, created_on TIMESTAMPTZ NOT NULL, @@ -194,7 +193,7 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger, ser : J // Database version table if needsTable "db_version" then - "CREATE TABLE db_version (id TEXT NOT NULL PRIMARY KEY" + "CREATE TABLE db_version (id TEXT NOT NULL PRIMARY KEY)" $"INSERT INTO db_version VALUES ('{Utils.currentDbVersion}')" } diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index c5d7d91..475923d 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -1132,7 +1132,6 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger AccessLevel.parse CreatedOn = getInstant "created_on" rdr diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs index fd9ccd8..8eb8cd9 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs @@ -18,7 +18,6 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = cmd.Parameters.AddWithValue ("@lastName", user.LastName) cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName) cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash) - cmd.Parameters.AddWithValue ("@salt", user.Salt) cmd.Parameters.AddWithValue ("@url", maybe user.Url) cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel) cmd.Parameters.AddWithValue ("@createdOn", instantParam user.CreatedOn) @@ -32,10 +31,10 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = use cmd = conn.CreateCommand () cmd.CommandText <- "INSERT INTO web_log_user ( - id, web_log_id, email, first_name, last_name, preferred_name, password_hash, salt, url, access_level, + id, web_log_id, email, first_name, last_name, preferred_name, password_hash, url, access_level, created_on, last_seen_on ) VALUES ( - @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel, + @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @url, @accessLevel, @createdOn, @lastSeenOn )" addWebLogUserParameters cmd user @@ -134,7 +133,6 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = last_name = @lastName, preferred_name = @preferredName, password_hash = @passwordHash, - salt = @salt, url = @url, access_level = @accessLevel, created_on = @createdOn, diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index 3b33874..3c3bf91 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -97,7 +97,6 @@ type SQLiteData (conn : SqliteConnection, log : ILogger, ser : JsonS 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 TEXT NOT NULL, @@ -517,12 +516,13 @@ type SQLiteData (conn : SqliteConnection, log : ILogger, ser : JsonS conn.Close () conn.Open () - logStep "Dropping old tables" + logStep "Dropping old tables and columns" cmd.CommandText <- - "DROP TABLE post_episode; - DROP TABLE post_meta; - DROP TABLE page_meta; - DROP TABLE web_log_feed_podcast" + "ALTER TABLE web_log_user DROP COLUMN salt; + DROP TABLE post_episode; + DROP TABLE post_meta; + DROP TABLE page_meta; + DROP TABLE web_log_feed_podcast" do! write cmd logStep "Setting database version to v2-rc2" diff --git a/src/MyWebLog.Domain/DataTypes.fs b/src/MyWebLog.Domain/DataTypes.fs index 42f9793..87b9a1c 100644 --- a/src/MyWebLog.Domain/DataTypes.fs +++ b/src/MyWebLog.Domain/DataTypes.fs @@ -442,9 +442,6 @@ type WebLogUser = /// The hash of the user's password PasswordHash : string - /// Salt used to calculate the user's password hash - Salt : Guid - /// The URL of the user's personal site Url : string option @@ -470,7 +467,6 @@ module WebLogUser = LastName = "" PreferredName = "" PasswordHash = "" - Salt = Guid.Empty Url = None AccessLevel = Author CreatedOn = Noda.epoch diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index bbfd4ee..6a67a61 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -2,20 +2,32 @@ module MyWebLog.Handlers.User open System -open System.Security.Cryptography -open System.Text +open Microsoft.AspNetCore.Http +open Microsoft.AspNetCore.Identity +open MyWebLog open NodaTime // ~~ LOG ON / LOG OFF ~~ -/// Hash a password for a given user -let hashedPassword (plainText : string) (email : string) (salt : Guid) = - let allSalt = Array.concat [ salt.ToByteArray (); Encoding.UTF8.GetBytes email ] - use alg = new Rfc2898DeriveBytes (plainText, allSalt, 2_048) - Convert.ToBase64String (alg.GetBytes 64) +/// Create a password hash a password for a given user +let createPasswordHash user password = + PasswordHasher().HashPassword (user, password) + +/// Verify whether a password is valid +let verifyPassword user password (ctx : HttpContext) = backgroundTask { + match user with + | Some usr -> + let hasher = PasswordHasher () + match hasher.VerifyHashedPassword (usr, usr.PasswordHash, password) with + | PasswordVerificationResult.Success -> return Ok () + | PasswordVerificationResult.SuccessRehashNeeded -> + do! ctx.Data.WebLogUser.Update { usr with PasswordHash = hasher.HashPassword (usr, password) } + return Ok () + | _ -> return Error "Log on attempt unsuccessful" + | None -> return Error "Log on attempt unsuccessful" +} open Giraffe -open MyWebLog open MyWebLog.ViewModels // GET /user/log-on @@ -36,10 +48,12 @@ open Microsoft.AspNetCore.Authentication.Cookies // POST /user/log-on let doLogOn : HttpHandler = fun next ctx -> task { - let! model = ctx.BindFormAsync () - let data = ctx.Data - match! data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id with - | Some user when user.PasswordHash = hashedPassword model.Password user.Email user.Salt -> + let! model = ctx.BindFormAsync () + let data = ctx.Data + let! tryUser = data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id + match! verifyPassword tryUser model.Password ctx with + | Ok _ -> + let user = tryUser.Value let claims = seq { Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id) Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}") @@ -60,8 +74,8 @@ let doLogOn : HttpHandler = fun next ctx -> task { match model.ReturnTo with | Some url -> redirectTo false url next ctx | None -> redirectToGet "admin/dashboard" next ctx - | _ -> - do! addMessage ctx { UserMessage.error with Message = "Log on attempt unsuccessful" } + | Error msg -> + do! addMessage ctx { UserMessage.error with Message = msg } return! logOn model.ReturnTo next ctx } @@ -167,19 +181,13 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task { let data = ctx.Data match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with | Some user when model.NewPassword = model.NewPasswordConfirm -> - let pw, salt = - if model.NewPassword = "" then - user.PasswordHash, user.Salt - else - let newSalt = Guid.NewGuid () - hashedPassword model.NewPassword user.Email newSalt, newSalt + let pw = if model.NewPassword = "" then user.PasswordHash else createPasswordHash user model.NewPassword let user = { user with FirstName = model.FirstName LastName = model.LastName PreferredName = model.PreferredName PasswordHash = pw - Salt = salt } do! data.WebLogUser.Update user let pwMsg = if model.NewPassword = "" then "" else " and updated your password" @@ -214,9 +222,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { else let toUpdate = if model.Password = "" then updatedUser - else - let salt = Guid.NewGuid () - { updatedUser with PasswordHash = hashedPassword model.Password model.Email salt; Salt = salt } + else { updatedUser with PasswordHash = createPasswordHash updatedUser model.Password } do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate do! addMessage ctx { UserMessage.success with diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 9fb32d8..544de4f 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -42,22 +42,19 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { } // Create the admin user - let salt = Guid.NewGuid () - let now = SystemClock.Instance.GetCurrentInstant () - - do! data.WebLogUser.Add - { WebLogUser.empty with - Id = userId - WebLogId = webLogId - Email = args[3] - FirstName = "Admin" - LastName = "User" - PreferredName = "Admin" - PasswordHash = Handlers.User.hashedPassword args[4] args[3] salt - Salt = salt - AccessLevel = accessLevel - CreatedOn = now - } + let now = Noda.now () + let user = + { WebLogUser.empty with + Id = userId + WebLogId = webLogId + Email = args[3] + FirstName = "Admin" + LastName = "User" + PreferredName = "Admin" + AccessLevel = accessLevel + CreatedOn = now + } + do! data.WebLogUser.Add { user with PasswordHash = Handlers.User.createPasswordHash user args[4] } // Create the default home page do! data.Page.Add @@ -71,8 +68,8 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { UpdatedOn = now Text = "

This is your default home page.

" Revisions = [ - { AsOf = now - Text = Html "

This is your default home page.

" + { AsOf = now + Text = Html "

This is your default home page.

" } ] } @@ -491,3 +488,22 @@ let upgradeUser (args : string[]) (sp : IServiceProvider) = task { | 3 -> do! doUserUpgrade args[1] args[2] (sp.GetRequiredService ()) | _ -> eprintfn "Usage: myWebLog upgrade-user [web-log-url-base] [email-address]" } + +/// Set a user's password +let doSetPassword urlBase email password (data : IData) = task { + match! data.WebLog.FindByHost urlBase with + | Some webLog -> + match! data.WebLogUser.FindByEmail email webLog.Id with + | Some user -> + do! data.WebLogUser.Update { user with PasswordHash = Handlers.User.createPasswordHash user password } + printfn $"Password for user {email} at {webLog.Name} set successfully" + | None -> eprintfn $"ERROR: no user {email} found at {urlBase}" + | None -> eprintfn $"ERROR: no web log found for {urlBase}" +} + +/// Set a user's password if the command-line arguments are good +let setPassword (args : string[]) (sp : IServiceProvider) = task { + match args.Length with + | 4 -> do! doSetPassword args[1] args[2] args[3] (sp.GetRequiredService ()) + | _ -> eprintfn "Usage: myWebLog set-password [web-log-url-base] [email-address] [password]" +} diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 0aa0d85..a9fecf4 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -85,6 +85,7 @@ let showHelp () = printfn "init Initializes a new web log" printfn "load-theme Load a theme" printfn "restore Restore a JSON file backup (prompt before overwriting)" + printfn "set-password Set a password for a specific user" printfn "upgrade-user Upgrade a WebLogAdmin user to a full Administrator" printfn " " printfn "For more information on a particular command, run it with no options." @@ -183,6 +184,7 @@ let rec main args = | Some it when it = "restore" -> Maintenance.Backup.restoreFromBackup args app.Services | Some it when it = "do-restore" -> Maintenance.Backup.restoreFromBackup args app.Services | Some it when it = "upgrade-user" -> Maintenance.upgradeUser args app.Services + | Some it when it = "set-password" -> Maintenance.setPassword args app.Services | Some it when it = "help" -> showHelp () | Some it -> printfn $"""Unrecognized command "{it}" - valid commands are:""" -- 2.45.1 From 6c3afd7ece908a5854cd5cd170cb7345cbbcfe8c Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sun, 21 Aug 2022 18:51:59 -0400 Subject: [PATCH 13/13] Bump versions to v2-rc2 --- src/Directory.Build.props | 2 +- src/MyWebLog/appsettings.json | 2 +- src/admin-theme/version.txt | 2 +- src/default-theme/version.txt | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Directory.Build.props b/src/Directory.Build.props index b50ea6d..b9690f2 100644 --- a/src/Directory.Build.props +++ b/src/Directory.Build.props @@ -5,6 +5,6 @@ 2.0.0.0 2.0.0.0 2.0.0 - rc1 + rc2 diff --git a/src/MyWebLog/appsettings.json b/src/MyWebLog/appsettings.json index 6c0b98c..62fa309 100644 --- a/src/MyWebLog/appsettings.json +++ b/src/MyWebLog/appsettings.json @@ -1,5 +1,5 @@ { - "Generator": "myWebLog 2.0-rc1", + "Generator": "myWebLog 2.0-rc2", "Logging": { "LogLevel": { "MyWebLog.Handlers": "Information" diff --git a/src/admin-theme/version.txt b/src/admin-theme/version.txt index 18c98a2..80104df 100644 --- a/src/admin-theme/version.txt +++ b/src/admin-theme/version.txt @@ -1,2 +1,2 @@ myWebLog Admin -2.0.0-rc1 \ No newline at end of file +2.0.0-rc2 \ No newline at end of file diff --git a/src/default-theme/version.txt b/src/default-theme/version.txt index 74f4501..9757c99 100644 --- a/src/default-theme/version.txt +++ b/src/default-theme/version.txt @@ -1,2 +1,2 @@ myWebLog Default Theme -2.0.0-rc1 \ No newline at end of file +2.0.0-rc2 \ No newline at end of file -- 2.45.1