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