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 ->