bit-badger/myWebLog
1
0
Fork 0
Code Issues 2 Pull Requests Packages Projects Releases 11 Activity

WIP on NodaTime implementation

Browse Source
This commit is contained in:
Daniel J. Summers 2022-08-19 22:51:43 -04:00
parent bed08b81ee
commit 0b2a17d4c8
28 changed files with 758 additions and 785 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/MyWebLog.Data/Converters.fs
View File

@ -122,12 +122,13 @@ module Json =
(string >> WebLogUserId) reader.Value (string >> WebLogUserId) reader.Value
open Microsoft.FSharpLu.Json open Microsoft.FSharpLu.Json
open NodaTime
open NodaTime.Serialization.JsonNet
/// All converters to use for data conversion /// Configure a serializer to use these converters
let all () : JsonConverter seq = let configure (ser : JsonSerializer) =
seq {
// Our converters // Our converters
CategoryIdConverter () [ CategoryIdConverter () :> JsonConverter
CommentIdConverter () CommentIdConverter ()
CustomFeedIdConverter () CustomFeedIdConverter ()
CustomFeedSourceConverter () CustomFeedSourceConverter ()
@ -143,6 +144,9 @@ module Json =
UploadIdConverter () UploadIdConverter ()
WebLogIdConverter () WebLogIdConverter ()
WebLogUserIdConverter () WebLogUserIdConverter ()
] |> List.iter ser.Converters.Add
// NodaTime
let _ = ser.ConfigureForNodaTime DateTimeZoneProviders.Tzdb
// Handles DUs with no associated data, as well as option fields // Handles DUs with no associated data, as well as option fields
CompactUnionJsonConverter () ser.Converters.Add (CompactUnionJsonConverter ())
} ser

4
src/MyWebLog.Data/MyWebLog.Data.fsproj
View File

@ -5,14 +5,16 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.7" /> <PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.8" />
<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="6.0.0" /> <PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="6.0.0" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" /> <PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" />
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" /> <PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" /> <PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
<PackageReference Include="NodaTime" Version="3.1.2" /> <PackageReference Include="NodaTime" Version="3.1.2" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" />
<PackageReference Include="Npgsql" Version="6.0.6" /> <PackageReference Include="Npgsql" Version="6.0.6" />
<PackageReference Include="Npgsql.FSharp" Version="5.3.0" /> <PackageReference Include="Npgsql.FSharp" Version="5.3.0" />
<PackageReference Include="Npgsql.NodaTime" Version="6.0.6" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" /> <PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" /> <PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
<PackageReference Update="FSharp.Core" Version="6.0.5" /> <PackageReference Update="FSharp.Core" Version="6.0.5" />

12
src/MyWebLog.Data/Postgres/PostgresCache.fs
View File

@ -4,7 +4,6 @@ open System.Threading
open System.Threading.Tasks open System.Threading.Tasks
open Microsoft.Extensions.Caching.Distributed open Microsoft.Extensions.Caching.Distributed
open NodaTime open NodaTime
open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// Helper types and functions for the cache /// Helper types and functions for the cache
@ -36,13 +35,8 @@ module private Helpers =
let getNow () = SystemClock.Instance.GetCurrentInstant () let getNow () = SystemClock.Instance.GetCurrentInstant ()
/// Create a parameter for the expire-at time /// Create a parameter for the expire-at time
let expireParam (it : Instant) = let expireParam =
"@expireAt", Sql.parameter (NpgsqlParameter ("@expireAt", it)) typedParam "@expireAt"
/// Create a parameter for a possibly-missing NodaTime type
let optParam<'T> name (it : 'T option) =
let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else null)
p.ParameterName, Sql.parameter p
/// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog /// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog
@ -65,7 +59,7 @@ type DistributedCache (connStr : string) =
|> Sql.query |> Sql.query
"CREATE TABLE session ( "CREATE TABLE session (
id TEXT NOT NULL PRIMARY KEY, id TEXT NOT NULL PRIMARY KEY,
payload BYETA NOT NULL, payload BYTEA NOT NULL,
expire_at TIMESTAMPTZ NOT NULL, expire_at TIMESTAMPTZ NOT NULL,
sliding_expiration INTERVAL, sliding_expiration INTERVAL,
absolute_expiration TIMESTAMPTZ); absolute_expiration TIMESTAMPTZ);

33
src/MyWebLog.Data/Postgres/PostgresHelpers.fs
View File

@ -2,9 +2,12 @@
[<AutoOpen>] [<AutoOpen>]
module MyWebLog.Data.Postgres.PostgresHelpers module MyWebLog.Data.Postgres.PostgresHelpers
open System
open System.Threading.Tasks open System.Threading.Tasks
open MyWebLog open MyWebLog
open Newtonsoft.Json open Newtonsoft.Json
open NodaTime
open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// Create a SQL parameter for the web log ID /// Create a SQL parameter for the web log ID
@ -49,6 +52,15 @@ let tryHead<'T> (query : Task<'T list>) = backgroundTask {
return List.tryHead results 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 /// Mapping functions for SQL queries
module Map = module Map =
@ -122,8 +134,8 @@ module Map =
Title = row.string "title" Title = row.string "title"
Permalink = toPermalink row Permalink = toPermalink row
PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray
PublishedOn = row.dateTime "published_on" PublishedOn = row.fieldValue<Instant> "published_on"
UpdatedOn = row.dateTime "updated_on" UpdatedOn = row.fieldValue<Instant> "updated_on"
IsInPageList = row.bool "is_in_page_list" IsInPageList = row.bool "is_in_page_list"
Template = row.stringOrNone "template" Template = row.stringOrNone "template"
Text = row.string "page_text" Text = row.string "page_text"
@ -142,8 +154,8 @@ module Map =
Title = row.string "title" Title = row.string "title"
Permalink = toPermalink row Permalink = toPermalink row
PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray
PublishedOn = row.dateTimeOrNone "published_on" PublishedOn = row.fieldValueOrNone<Instant> "published_on"
UpdatedOn = row.dateTime "updated_on" UpdatedOn = row.fieldValue<Instant> "updated_on"
Template = row.stringOrNone "template" Template = row.stringOrNone "template"
Text = row.string "post_text" Text = row.string "post_text"
CategoryIds = row.stringArrayOrNone "category_ids" CategoryIds = row.stringArrayOrNone "category_ids"
@ -155,12 +167,13 @@ module Map =
Metadata = row.stringOrNone "meta_items" Metadata = row.stringOrNone "meta_items"
|> Option.map JsonConvert.DeserializeObject<MetaItem list> |> Option.map JsonConvert.DeserializeObject<MetaItem list>
|> Option.defaultValue [] |> Option.defaultValue []
Episode = row.stringOrNone "episode" |> Option.map JsonConvert.DeserializeObject<Episode> Episode = row.stringOrNone "episode"
|> Option.map JsonConvert.DeserializeObject<Episode>
} }
/// Create a revision from the current row /// Create a revision from the current row
let toRevision (row : RowReader) : Revision = let toRevision (row : RowReader) : Revision =
{ AsOf = row.dateTime "as_of" { AsOf = row.fieldValue<Instant> "as_of"
Text = row.string "revision_text" |> MarkupText.parse Text = row.string "revision_text" |> MarkupText.parse
} }
@ -183,7 +196,7 @@ module Map =
/// Create a theme asset from the current row /// Create a theme asset from the current row
let toThemeAsset includeData (row : RowReader) : ThemeAsset = let toThemeAsset includeData (row : RowReader) : ThemeAsset =
{ Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path") { Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
UpdatedOn = row.dateTime "updated_on" UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||] Data = if includeData then row.bytea "data" else [||]
} }
@ -198,7 +211,7 @@ module Map =
{ Id = row.string "id" |> UploadId { Id = row.string "id" |> UploadId
WebLogId = row.string "web_log_id" |> WebLogId WebLogId = row.string "web_log_id" |> WebLogId
Path = row.string "path" |> Permalink Path = row.string "path" |> Permalink
UpdatedOn = row.dateTime "updated_on" UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||] Data = if includeData then row.bytea "data" else [||]
} }
@ -238,6 +251,6 @@ module Map =
Salt = row.uuid "salt" Salt = row.uuid "salt"
Url = row.stringOrNone "url" Url = row.stringOrNone "url"
AccessLevel = row.string "access_level" |> AccessLevel.parse AccessLevel = row.string "access_level" |> AccessLevel.parse
CreatedOn = row.dateTime "created_on" CreatedOn = row.fieldValue<Instant> "created_on"
LastSeenOn = row.dateTimeOrNone "last_seen_on" LastSeenOn = row.fieldValueOrNone<Instant> "last_seen_on"
} }

8
src/MyWebLog.Data/Postgres/PostgresPageData.fs
View File

@ -30,8 +30,8 @@ type PostgresPageData (conn : NpgsqlConnection) =
/// Parameters for a revision INSERT statement /// Parameters for a revision INSERT statement
let revParams pageId rev = [ let revParams pageId rev = [
typedParam "@asOf" rev.AsOf
"@pageId", Sql.string (PageId.toString pageId) "@pageId", Sql.string (PageId.toString pageId)
"@asOf", Sql.timestamptz rev.AsOf
"@text", Sql.string (MarkupText.toString rev.Text) "@text", Sql.string (MarkupText.toString rev.Text)
] ]
@ -47,7 +47,7 @@ type PostgresPageData (conn : NpgsqlConnection) =
toDelete toDelete
|> List.map (fun it -> [ |> List.map (fun it -> [
"@pageId", Sql.string (PageId.toString pageId) "@pageId", Sql.string (PageId.toString pageId)
"@asOf", Sql.timestamptz it.AsOf typedParam "@asOf" it.AsOf
]) ])
if not (List.isEmpty toAdd) then if not (List.isEmpty toAdd) then
revInsert, toAdd |> List.map (revParams pageId) revInsert, toAdd |> List.map (revParams pageId)
@ -201,13 +201,13 @@ type PostgresPageData (conn : NpgsqlConnection) =
"@authorId", Sql.string (WebLogUserId.toString page.AuthorId) "@authorId", Sql.string (WebLogUserId.toString page.AuthorId)
"@title", Sql.string page.Title "@title", Sql.string page.Title
"@permalink", Sql.string (Permalink.toString page.Permalink) "@permalink", Sql.string (Permalink.toString page.Permalink)
"@publishedOn", Sql.timestamptz page.PublishedOn
"@updatedOn", Sql.timestamptz page.UpdatedOn
"@isInPageList", Sql.bool page.IsInPageList "@isInPageList", Sql.bool page.IsInPageList
"@template", Sql.stringOrNone page.Template "@template", Sql.stringOrNone page.Template
"@text", Sql.string page.Text "@text", Sql.string page.Text
"@metaItems", Sql.jsonb (JsonConvert.SerializeObject page.Metadata) "@metaItems", Sql.jsonb (JsonConvert.SerializeObject page.Metadata)
"@priorPermalinks", Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) "@priorPermalinks", Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
typedParam "@publishedOn" page.PublishedOn
typedParam "@updatedOn" page.UpdatedOn
] ]
/// Restore pages from a backup /// Restore pages from a backup

8
src/MyWebLog.Data/Postgres/PostgresPostData.fs
View File

@ -61,8 +61,8 @@ type PostgresPostData (conn : NpgsqlConnection) =
/// The parameters for adding a post revision /// The parameters for adding a post revision
let revParams postId rev = [ let revParams postId rev = [
typedParam "@asOf" rev.AsOf
"@postId", Sql.string (PostId.toString postId) "@postId", Sql.string (PostId.toString postId)
"@asOf", Sql.timestamptz rev.AsOf
"@text", Sql.string (MarkupText.toString rev.Text) "@text", Sql.string (MarkupText.toString rev.Text)
] ]
@ -78,7 +78,7 @@ type PostgresPostData (conn : NpgsqlConnection) =
toDelete toDelete
|> List.map (fun it -> [ |> List.map (fun it -> [
"@postId", Sql.string (PostId.toString postId) "@postId", Sql.string (PostId.toString postId)
"@asOf", Sql.timestamptz it.AsOf typedParam "@asOf" it.AsOf
]) ])
if not (List.isEmpty toAdd) then if not (List.isEmpty toAdd) then
revInsert, toAdd |> List.map (revParams postId) revInsert, toAdd |> List.map (revParams postId)
@ -287,8 +287,6 @@ type PostgresPostData (conn : NpgsqlConnection) =
"@status", Sql.string (PostStatus.toString post.Status) "@status", Sql.string (PostStatus.toString post.Status)
"@title", Sql.string post.Title "@title", Sql.string post.Title
"@permalink", Sql.string (Permalink.toString post.Permalink) "@permalink", Sql.string (Permalink.toString post.Permalink)
"@publishedOn", Sql.timestamptzOrNone post.PublishedOn
"@updatedOn", Sql.timestamptz post.UpdatedOn
"@template", Sql.stringOrNone post.Template "@template", Sql.stringOrNone post.Template
"@text", Sql.string post.Text "@text", Sql.string post.Text
"@episode", Sql.jsonbOrNone (post.Episode |> Option.map JsonConvert.SerializeObject) "@episode", Sql.jsonbOrNone (post.Episode |> Option.map JsonConvert.SerializeObject)
@ -297,6 +295,8 @@ type PostgresPostData (conn : NpgsqlConnection) =
"@metaItems", "@metaItems",
if List.isEmpty post.Metadata then None else Some (JsonConvert.SerializeObject post.Metadata) if List.isEmpty post.Metadata then None else Some (JsonConvert.SerializeObject post.Metadata)
|> Sql.jsonbOrNone |> Sql.jsonbOrNone
optParam "@publishedOn" post.PublishedOn
typedParam "@updatedOn" post.UpdatedOn
] ]
/// Save a post /// Save a post

4
src/MyWebLog.Data/Postgres/PostgresThemeData.fs
View File

@ -192,8 +192,8 @@ type PostgresThemeAssetData (conn : NpgsqlConnection) =
|> Sql.parameters |> Sql.parameters
[ "@themeId", Sql.string themeId [ "@themeId", Sql.string themeId
"@path", Sql.string path "@path", Sql.string path
"@updatedOn", Sql.timestamptz asset.UpdatedOn "@data", Sql.bytea asset.Data
"@data", Sql.bytea asset.Data ] typedParam "@updatedOn" asset.UpdatedOn ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
() ()
} }

2
src/MyWebLog.Data/Postgres/PostgresUploadData.fs
View File

@ -19,9 +19,9 @@ type PostgresUploadData (conn : NpgsqlConnection) =
/// Parameters for adding an uploaded file /// Parameters for adding an uploaded file
let upParams (upload : Upload) = [ let upParams (upload : Upload) = [
webLogIdParam upload.WebLogId webLogIdParam upload.WebLogId
typedParam "@updatedOn" upload.UpdatedOn
"@id", Sql.string (UploadId.toString upload.Id) "@id", Sql.string (UploadId.toString upload.Id)
"@path", Sql.string (Permalink.toString upload.Path) "@path", Sql.string (Permalink.toString upload.Path)
"@updatedOn", Sql.timestamptz upload.UpdatedOn
"@data", Sql.bytea upload.Data "@data", Sql.bytea upload.Data
] ]

8
src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs
View File

@ -30,8 +30,8 @@ type PostgresWebLogUserData (conn : NpgsqlConnection) =
"@salt", Sql.uuid user.Salt "@salt", Sql.uuid user.Salt
"@url", Sql.stringOrNone user.Url "@url", Sql.stringOrNone user.Url
"@accessLevel", Sql.string (AccessLevel.toString user.AccessLevel) "@accessLevel", Sql.string (AccessLevel.toString user.AccessLevel)
"@createdOn", Sql.timestamptz user.CreatedOn typedParam "@createdOn" user.CreatedOn
"@lastSeenOn", Sql.timestamptzOrNone user.LastSeenOn optParam "@lastSeenOn" user.LastSeenOn
] ]
/// Find a user by their ID for the given web log /// 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.query "UPDATE web_log_user SET last_seen_on = @lastSeenOn WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters |> Sql.parameters
[ webLogIdParam webLogId [ webLogIdParam webLogId
"@id", Sql.string (WebLogUserId.toString userId) typedParam "@lastSeenOn" (Utils.now ())
"@lastSeenOn", Sql.timestamptz System.DateTime.UtcNow ] "@id", Sql.string (WebLogUserId.toString userId) ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
() ()
} }

61
src/MyWebLog.Data/PostgresData.fs
View File

@ -22,6 +22,8 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>) =
member _.StartUp () = backgroundTask { member _.StartUp () = backgroundTask {
let _ = NpgsqlConnection.GlobalTypeMapper.UseNodaTime ()
let! tables = let! tables =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'" |> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'"
@ -68,15 +70,15 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>) =
items_in_feed INTEGER, items_in_feed INTEGER,
is_category_enabled BOOLEAN NOT NULL DEFAULT FALSE, is_category_enabled BOOLEAN NOT NULL DEFAULT FALSE,
is_tag_enabled BOOLEAN NOT NULL DEFAULT FALSE, is_tag_enabled BOOLEAN NOT NULL DEFAULT FALSE,
copyright TEXT); copyright TEXT)"
CREATE INDEX web_log_theme_idx ON web_log (theme_id)" "CREATE INDEX web_log_theme_idx ON web_log (theme_id)"
if needsTable "web_log_feed" then if needsTable "web_log_feed" then
"CREATE TABLE web_log_feed ( "CREATE TABLE web_log_feed (
id TEXT NOT NULL PRIMARY KEY, id TEXT NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
source TEXT NOT NULL, source TEXT NOT NULL,
path TEXT NOT NULL); path TEXT NOT NULL)"
CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)" "CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"
if needsTable "web_log_feed_podcast" then if needsTable "web_log_feed_podcast" then
"CREATE TABLE web_log_feed_podcast ( "CREATE TABLE web_log_feed_podcast (
feed_id TEXT NOT NULL PRIMARY KEY REFERENCES web_log_feed (id), feed_id TEXT NOT NULL PRIMARY KEY REFERENCES web_log_feed (id),
@ -105,8 +107,8 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>) =
name TEXT NOT NULL, name TEXT NOT NULL,
slug TEXT NOT NULL, slug TEXT NOT NULL,
description TEXT, description TEXT,
parent_id TEXT); parent_id TEXT)"
CREATE INDEX category_web_log_idx ON category (web_log_id)" "CREATE INDEX category_web_log_idx ON category (web_log_id)"
// Web log user table // Web log user table
if needsTable "web_log_user" then if needsTable "web_log_user" then
@ -122,9 +124,9 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>) =
url TEXT, url TEXT,
access_level TEXT NOT NULL, access_level TEXT NOT NULL,
created_on TIMESTAMPTZ NOT NULL, created_on TIMESTAMPTZ NOT NULL,
last_seen_on TIMESTAMPTZ); last_seen_on TIMESTAMPTZ)"
CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id); "CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id)"
CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)" "CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)"
// Page tables // Page tables
if needsTable "page" then if needsTable "page" then
@ -139,11 +141,11 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>) =
updated_on TIMESTAMPTZ NOT NULL, updated_on TIMESTAMPTZ NOT NULL,
is_in_page_list BOOLEAN NOT NULL DEFAULT FALSE, is_in_page_list BOOLEAN NOT NULL DEFAULT FALSE,
template TEXT, template TEXT,
page_text TEXT NOT NULL page_text TEXT NOT NULL,
meta_items JSONB); meta_items JSONB)"
CREATE INDEX page_web_log_idx ON page (web_log_id); "CREATE INDEX page_web_log_idx ON page (web_log_id)"
CREATE INDEX page_author_idx ON page (author_id); "CREATE INDEX page_author_idx ON page (author_id)"
CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)" "CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)"
if needsTable "page_revision" then if needsTable "page_revision" then
"CREATE TABLE page_revision ( "CREATE TABLE page_revision (
page_id TEXT NOT NULL REFERENCES page (id), page_id TEXT NOT NULL REFERENCES page (id),
@ -167,17 +169,17 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>) =
post_text TEXT NOT NULL, post_text TEXT NOT NULL,
tags TEXT[], tags TEXT[],
meta_items JSONB, meta_items JSONB,
episode JSONB); episode JSONB)"
CREATE INDEX post_web_log_idx ON post (web_log_id); "CREATE INDEX post_web_log_idx ON post (web_log_id)"
CREATE INDEX post_author_idx ON post (author_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_status_idx ON post (web_log_id, status, updated_on)"
CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)" "CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)"
if needsTable "post_category" then if needsTable "post_category" then
"CREATE TABLE post_category ( "CREATE TABLE post_category (
post_id TEXT NOT NULL REFERENCES post (id), post_id TEXT NOT NULL REFERENCES post (id),
category_id TEXT NOT NULL REFERENCES category (id), category_id TEXT NOT NULL REFERENCES category (id),
PRIMARY KEY (post_id, category_id)); PRIMARY KEY (post_id, category_id))"
CREATE INDEX post_category_category_idx ON post_category (category_id)" "CREATE INDEX post_category_category_idx ON post_category (category_id)"
if needsTable "post_revision" then if needsTable "post_revision" then
"CREATE TABLE post_revision ( "CREATE TABLE post_revision (
post_id TEXT NOT NULL REFERENCES post (id), post_id TEXT NOT NULL REFERENCES post (id),
@ -194,8 +196,8 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>) =
url TEXT, url TEXT,
status TEXT NOT NULL, status TEXT NOT NULL,
posted_on TIMESTAMPTZ NOT NULL, posted_on TIMESTAMPTZ NOT NULL,
comment_text TEXT NOT NULL); comment_text TEXT NOT NULL)"
CREATE INDEX post_comment_post_idx ON post_comment (post_id)" "CREATE INDEX post_comment_post_idx ON post_comment (post_id)"
// Tag map table // Tag map table
if needsTable "tag_map" then if needsTable "tag_map" then
@ -203,8 +205,8 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>) =
id TEXT NOT NULL PRIMARY KEY, id TEXT NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
tag TEXT NOT NULL, tag TEXT NOT NULL,
url_value TEXT NOT NULL); url_value TEXT NOT NULL)"
CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)" "CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)"
// Uploaded file table // Uploaded file table
if needsTable "upload" then if needsTable "upload" then
@ -213,16 +215,17 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>) =
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
path TEXT NOT NULL, path TEXT NOT NULL,
updated_on TIMESTAMPTZ NOT NULL, updated_on TIMESTAMPTZ NOT NULL,
data BYTEA NOT NULL); data BYTEA NOT NULL)"
CREATE INDEX upload_web_log_idx ON upload (web_log_id); "CREATE INDEX upload_web_log_idx ON upload (web_log_id)"
CREATE INDEX upload_path_idx ON upload (web_log_id, path)" "CREATE INDEX upload_path_idx ON upload (web_log_id, path)"
} }
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.executeTransactionAsync |> Sql.executeTransactionAsync
(sql (sql
|> Seq.map (fun s -> |> Seq.map (fun s ->
log.LogInformation $"Creating {(s.Split ' ')[2]} table..." let parts = s.Split ' '
log.LogInformation $"Creating {parts[2]} {parts[1].ToLower()}..."
s, [ [] ]) s, [ [] ])
|> List.ofSeq) |> List.ofSeq)
|> Async.AwaitTask |> Async.AwaitTask

2
src/MyWebLog.Data/RethinkDbData.fs
View File

@ -1079,7 +1079,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink { do! rethink {
withTable Table.WebLogUser withTable Table.WebLogUser
get userId get userId
update [ nameof WebLogUser.empty.LastSeenOn, DateTime.UtcNow :> obj ] update [ nameof WebLogUser.empty.LastSeenOn, Utils.now () :> obj ]
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
| None -> () | None -> ()

66
src/MyWebLog.Data/SQLite/Helpers.fs
View File

@ -5,6 +5,7 @@ module MyWebLog.Data.SQLite.Helpers
open System open System
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open MyWebLog open MyWebLog
open NodaTime.Text
/// Run a command that returns a count /// Run a command that returns a count
let count (cmd : SqliteCommand) = backgroundTask { 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 /// Functions to map domain items from a data reader
module Map = module Map =
@ -56,6 +74,26 @@ module Map =
/// Get a string value from a data reader /// Get a string value from a data reader
let getString col (rdr : SqliteDataReader) = rdr.GetString (rdr.GetOrdinal col) 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 /// Get a timespan value from a data reader
let getTimeSpan col (rdr : SqliteDataReader) = rdr.GetTimeSpan (rdr.GetOrdinal col) let getTimeSpan col (rdr : SqliteDataReader) = rdr.GetTimeSpan (rdr.GetOrdinal col)
@ -79,6 +117,14 @@ module Map =
let tryString col (rdr : SqliteDataReader) = let tryString col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr) 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 /// Get a possibly null timespan value from a data reader
let tryTimeSpan col (rdr : SqliteDataReader) = let tryTimeSpan col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr) 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 AuthorId = getString "author_id" rdr |> WebLogUserId
Title = getString "title" rdr Title = getString "title" rdr
Permalink = toPermalink rdr Permalink = toPermalink rdr
PublishedOn = getDateTime "published_on" rdr PublishedOn = getInstant "published_on" rdr
UpdatedOn = getDateTime "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
IsInPageList = getBoolean "is_in_page_list" rdr IsInPageList = getBoolean "is_in_page_list" rdr
Template = tryString "template" rdr Template = tryString "template" rdr
Text = getString "page_text" rdr Text = getString "page_text" rdr
@ -158,8 +204,8 @@ module Map =
Status = getString "status" rdr |> PostStatus.parse Status = getString "status" rdr |> PostStatus.parse
Title = getString "title" rdr Title = getString "title" rdr
Permalink = toPermalink rdr Permalink = toPermalink rdr
PublishedOn = tryDateTime "published_on" rdr PublishedOn = tryInstant "published_on" rdr
UpdatedOn = getDateTime "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
Template = tryString "template" rdr Template = tryString "template" rdr
Text = getString "post_text" rdr Text = getString "post_text" rdr
Episode = Episode =
@ -168,7 +214,7 @@ module Map =
Some { Some {
Media = media Media = media
Length = getLong "length" rdr Length = getLong "length" rdr
Duration = tryTimeSpan "duration" rdr Duration = tryDuration "duration" rdr
MediaType = tryString "media_type" rdr MediaType = tryString "media_type" rdr
ImageUrl = tryString "image_url" rdr ImageUrl = tryString "image_url" rdr
Subtitle = tryString "subtitle" rdr Subtitle = tryString "subtitle" rdr
@ -189,7 +235,7 @@ module Map =
/// Create a revision from the current row in the given data reader /// Create a revision from the current row in the given data reader
let toRevision rdr : Revision = let toRevision rdr : Revision =
{ AsOf = getDateTime "as_of" rdr { AsOf = getInstant "as_of" rdr
Text = getString "revision_text" rdr |> MarkupText.parse Text = getString "revision_text" rdr |> MarkupText.parse
} }
@ -220,7 +266,7 @@ module Map =
else else
[||] [||]
{ Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr) { Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
UpdatedOn = getDateTime "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
Data = assetData Data = assetData
} }
@ -243,7 +289,7 @@ module Map =
{ Id = getString "id" rdr |> UploadId { Id = getString "id" rdr |> UploadId
WebLogId = getString "web_log_id" rdr |> WebLogId WebLogId = getString "web_log_id" rdr |> WebLogId
Path = getString "path" rdr |> Permalink Path = getString "path" rdr |> Permalink
UpdatedOn = getDateTime "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
Data = data Data = data
} }
@ -283,8 +329,8 @@ module Map =
Salt = getGuid "salt" rdr Salt = getGuid "salt" rdr
Url = tryString "url" rdr Url = tryString "url" rdr
AccessLevel = getString "access_level" rdr |> AccessLevel.parse AccessLevel = getString "access_level" rdr |> AccessLevel.parse
CreatedOn = getDateTime "created_on" rdr CreatedOn = getInstant "created_on" rdr
LastSeenOn = tryDateTime "last_seen_on" rdr LastSeenOn = tryInstant "last_seen_on" rdr
} }
/// Add a possibly-missing parameter, substituting null for None /// Add a possibly-missing parameter, substituting null for None

36
src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs
View File

@ -21,12 +21,12 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Add a category /// Add a category
let add cat = backgroundTask { let add cat = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO category ( "INSERT INTO category (
id, web_log_id, name, slug, description, parent_id id, web_log_id, name, slug, description, parent_id
) VALUES ( ) VALUES (
@id, @webLogId, @name, @slug, @description, @parentId @id, @webLogId, @name, @slug, @description, @parentId
)""" )"
addCategoryParameters cmd cat addCategoryParameters cmd cat
let! _ = cmd.ExecuteNonQueryAsync () let! _ = cmd.ExecuteNonQueryAsync ()
() ()
@ -70,13 +70,13 @@ type SQLiteCategoryData (conn : SqliteConnection) =
// Parent category post counts include posts in subcategories // Parent category post counts include posts in subcategories
cmd.Parameters.Clear () cmd.Parameters.Clear ()
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.CommandText <- """ cmd.CommandText <-
SELECT COUNT(DISTINCT p.id) "SELECT COUNT(DISTINCT p.id)
FROM post p FROM post p
INNER JOIN post_category pc ON pc.post_id = p.id INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = 'Published' AND p.status = 'Published'
AND pc.category_id IN (""" AND pc.category_id IN ("
ordered ordered
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name) |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|> Seq.map (fun cat -> cat.Id) |> 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)) cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
|> ignore |> ignore
do! write cmd do! write cmd
// Delete the category off all posts where it is assigned // Delete the category off all posts where it is assigned, and the category itself
cmd.CommandText <- """ cmd.CommandText <-
DELETE FROM post_category "DELETE FROM post_category
WHERE category_id = @id WHERE category_id = @id
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)""" AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId);
DELETE FROM category WHERE id = @id"
cmd.Parameters.Clear () cmd.Parameters.Clear ()
let catIdParameter = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) let _ = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore addWebLogId cmd webLogId
do! write cmd
// Delete the category itself
cmd.CommandText <- "DELETE FROM category WHERE id = @id"
cmd.Parameters.Clear ()
cmd.Parameters.Add catIdParameter |> ignore
do! write cmd do! write cmd
return if children = 0 then CategoryDeleted else ReassignedChildCategories return if children = 0 then CategoryDeleted else ReassignedChildCategories
| None -> return CategoryNotFound | None -> return CategoryNotFound
@ -160,14 +156,14 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Update a category /// Update a category
let update cat = backgroundTask { let update cat = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
UPDATE category "UPDATE category
SET name = @name, SET name = @name,
slug = @slug, slug = @slug,
description = @description, description = @description,
parent_id = @parentId parent_id = @parentId
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId""" AND web_log_id = @webLogId"
addCategoryParameters cmd cat addCategoryParameters cmd cat
do! write cmd do! write cmd
} }

46
src/MyWebLog.Data/SQLite/SQLitePageData.fs
View File

@ -17,8 +17,8 @@ type SQLitePageData (conn : SqliteConnection) =
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId) cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId)
cmd.Parameters.AddWithValue ("@title", page.Title) cmd.Parameters.AddWithValue ("@title", page.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink) cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", page.PublishedOn) cmd.Parameters.AddWithValue ("@publishedOn", instantParam page.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", page.UpdatedOn) cmd.Parameters.AddWithValue ("@updatedOn", instantParam page.UpdatedOn)
cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList) cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
cmd.Parameters.AddWithValue ("@template", maybe page.Template) cmd.Parameters.AddWithValue ("@template", maybe page.Template)
cmd.Parameters.AddWithValue ("@text", page.Text) cmd.Parameters.AddWithValue ("@text", page.Text)
@ -139,14 +139,14 @@ type SQLitePageData (conn : SqliteConnection) =
let add page = backgroundTask { let add page = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
// The page itself // The page itself
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO page ( "INSERT INTO page (
id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template, id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template,
page_text page_text
) VALUES ( ) VALUES (
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template, @id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template,
@text @text
)""" )"
addPageParameters cmd page addPageParameters cmd page
do! write cmd do! write cmd
do! updatePageMeta page.Id [] page.Metadata 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 /// Count all pages shown in the page list for the given web log
let countListed webLogId = backgroundTask { let countListed webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
SELECT COUNT(id) "SELECT COUNT(id)
FROM page FROM page
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
AND is_in_page_list = @isInPageList""" AND is_in_page_list = @isInPageList"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
return! count cmd return! count cmd
@ -211,11 +211,11 @@ type SQLitePageData (conn : SqliteConnection) =
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
cmd.CommandText <- """ cmd.CommandText <-
DELETE FROM page_revision WHERE page_id = @id; "DELETE FROM page_revision WHERE page_id = @id;
DELETE FROM page_permalink WHERE page_id = @id; DELETE FROM page_permalink WHERE page_id = @id;
DELETE FROM page_meta WHERE page_id = @id; DELETE FROM page_meta WHERE page_id = @id;
DELETE FROM page WHERE id = @id""" DELETE FROM page WHERE id = @id"
do! write cmd do! write cmd
return true return true
| None -> return false | 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 /// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask { let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
SELECT p.permalink "SELECT p.permalink
FROM page p FROM page p
INNER JOIN page_permalink pp ON pp.page_id = p.id INNER JOIN page_permalink pp ON pp.page_id = p.id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND pp.permalink IN (""" AND pp.permalink IN ("
permalinks permalinks
|> List.iteri (fun idx link -> |> List.iteri (fun idx link ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " 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) /// Get all listed pages for the given web log (without revisions, prior permalinks, or text)
let findListed webLogId = backgroundTask { let findListed webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
SELECT * "SELECT *
FROM page FROM page
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
AND is_in_page_list = @isInPageList AND is_in_page_list = @isInPageList
ORDER BY LOWER(title)""" ORDER BY LOWER(title)"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
use! rdr = cmd.ExecuteReaderAsync () 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) /// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata)
let findPageOfPages webLogId pageNbr = backgroundTask { let findPageOfPages webLogId pageNbr = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
SELECT * "SELECT *
FROM page FROM page
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
ORDER BY LOWER(title) ORDER BY LOWER(title)
LIMIT @pageSize OFFSET @toSkip""" LIMIT @pageSize OFFSET @toSkip"
addWebLogId cmd webLogId addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@pageSize", 26) [ cmd.Parameters.AddWithValue ("@pageSize", 26)
cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25) cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25)
@ -318,8 +318,8 @@ type SQLitePageData (conn : SqliteConnection) =
match! findFullById page.Id page.WebLogId with match! findFullById page.Id page.WebLogId with
| Some oldPage -> | Some oldPage ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
UPDATE page "UPDATE page
SET author_id = @authorId, SET author_id = @authorId,
title = @title, title = @title,
permalink = @permalink, permalink = @permalink,
@ -329,7 +329,7 @@ type SQLitePageData (conn : SqliteConnection) =
template = @template, template = @template,
page_text = @text page_text = @text
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId""" AND web_log_id = @webLogId"
addPageParameters cmd page addPageParameters cmd page
do! write cmd do! write cmd
do! updatePageMeta page.Id oldPage.Metadata page.Metadata do! updatePageMeta page.Id oldPage.Metadata page.Metadata

74
src/MyWebLog.Data/SQLite/SQLitePostData.fs
View File

@ -19,8 +19,8 @@ type SQLitePostData (conn : SqliteConnection) =
cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status) cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status)
cmd.Parameters.AddWithValue ("@title", post.Title) cmd.Parameters.AddWithValue ("@title", post.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink) cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", maybe post.PublishedOn) cmd.Parameters.AddWithValue ("@publishedOn", maybeInstant post.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", post.UpdatedOn) cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn)
cmd.Parameters.AddWithValue ("@template", maybe post.Template) cmd.Parameters.AddWithValue ("@template", maybe post.Template)
cmd.Parameters.AddWithValue ("@text", post.Text) cmd.Parameters.AddWithValue ("@text", post.Text)
] |> ignore ] |> ignore
@ -29,11 +29,12 @@ type SQLitePostData (conn : SqliteConnection) =
let addEpisodeParameters (cmd : SqliteCommand) (ep : Episode) = let addEpisodeParameters (cmd : SqliteCommand) (ep : Episode) =
[ cmd.Parameters.AddWithValue ("@media", ep.Media) [ cmd.Parameters.AddWithValue ("@media", ep.Media)
cmd.Parameters.AddWithValue ("@length", ep.Length) cmd.Parameters.AddWithValue ("@length", ep.Length)
cmd.Parameters.AddWithValue ("@duration", maybe ep.Duration) cmd.Parameters.AddWithValue ("@duration", maybeDuration ep.Duration)
cmd.Parameters.AddWithValue ("@mediaType", maybe ep.MediaType) cmd.Parameters.AddWithValue ("@mediaType", maybe ep.MediaType)
cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.ImageUrl) cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.ImageUrl)
cmd.Parameters.AddWithValue ("@subtitle", maybe ep.Subtitle) cmd.Parameters.AddWithValue ("@subtitle", maybe ep.Subtitle)
cmd.Parameters.AddWithValue ("@explicit", maybe (ep.Explicit |> Option.map ExplicitRating.toString)) cmd.Parameters.AddWithValue ("@explicit", maybe (ep.Explicit
|> Option.map ExplicitRating.toString))
cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.ChapterFile) cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.ChapterFile)
cmd.Parameters.AddWithValue ("@chapterType", maybe ep.ChapterType) cmd.Parameters.AddWithValue ("@chapterType", maybe ep.ChapterType)
cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.TranscriptUrl) cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.TranscriptUrl)
@ -158,8 +159,8 @@ type SQLitePostData (conn : SqliteConnection) =
if count = 1 then if count = 1 then
match post.Episode with match post.Episode with
| Some ep -> | Some ep ->
cmd.CommandText <- """ cmd.CommandText <-
UPDATE post_episode "UPDATE post_episode
SET media = @media, SET media = @media,
length = @length, length = @length,
duration = @duration, duration = @duration,
@ -177,7 +178,7 @@ type SQLitePostData (conn : SqliteConnection) =
season_description = @seasonDescription, season_description = @seasonDescription,
episode_number = @episodeNumber, episode_number = @episodeNumber,
episode_description = @episodeDescription episode_description = @episodeDescription
WHERE post_id = @postId""" WHERE post_id = @postId"
addEpisodeParameters cmd ep addEpisodeParameters cmd ep
do! write cmd do! write cmd
| None -> | None ->
@ -186,8 +187,8 @@ type SQLitePostData (conn : SqliteConnection) =
else else
match post.Episode with match post.Episode with
| Some ep -> | Some ep ->
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO post_episode ( "INSERT INTO post_episode (
post_id, media, length, duration, media_type, image_url, subtitle, explicit, chapter_file, post_id, media, length, duration, media_type, image_url, subtitle, explicit, chapter_file,
chapter_type, transcript_url, transcript_type, transcript_lang, transcript_captions, chapter_type, transcript_url, transcript_type, transcript_lang, transcript_captions,
season_number, season_description, episode_number, episode_description 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, @postId, @media, @length, @duration, @mediaType, @imageUrl, @subtitle, @explicit, @chapterFile,
@chapterType, @transcriptUrl, @transcriptType, @transcriptLang, @transcriptCaptions, @chapterType, @transcriptUrl, @transcriptType, @transcriptLang, @transcriptCaptions,
@seasonNumber, @seasonDescription, @episodeNumber, @episodeDescription @seasonNumber, @seasonDescription, @episodeNumber, @episodeDescription
)""" )"
addEpisodeParameters cmd ep addEpisodeParameters cmd ep
do! write cmd do! write cmd
| None -> () | None -> ()
@ -287,12 +288,12 @@ type SQLitePostData (conn : SqliteConnection) =
/// Add a post /// Add a post
let add post = backgroundTask { let add post = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO post ( "INSERT INTO post (
id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text
) VALUES ( ) VALUES (
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text @id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text
)""" )"
addPostParameters cmd post addPostParameters cmd post
do! write cmd do! write cmd
do! updatePostCategories post.Id [] post.CategoryIds do! updatePostCategories post.Id [] post.CategoryIds
@ -350,14 +351,14 @@ type SQLitePostData (conn : SqliteConnection) =
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
cmd.CommandText <- """ cmd.CommandText <-
DELETE FROM post_revision WHERE post_id = @id; "DELETE FROM post_revision WHERE post_id = @id;
DELETE FROM post_permalink WHERE post_id = @id; DELETE FROM post_permalink WHERE post_id = @id;
DELETE FROM post_meta WHERE post_id = @id; DELETE FROM post_meta WHERE post_id = @id;
DELETE FROM post_episode WHERE post_id = @id; DELETE FROM post_episode WHERE post_id = @id;
DELETE FROM post_tag WHERE post_id = @id; DELETE FROM post_tag WHERE post_id = @id;
DELETE FROM post_category WHERE post_id = @id; DELETE FROM post_category WHERE post_id = @id;
DELETE FROM post WHERE id = @id""" DELETE FROM post WHERE id = @id"
do! write cmd do! write cmd
return true return true
| None -> return false | 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 /// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask { let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
SELECT p.permalink "SELECT p.permalink
FROM post p FROM post p
INNER JOIN post_permalink pp ON pp.post_id = p.id INNER JOIN post_permalink pp ON pp.post_id = p.id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND pp.permalink IN (""" AND pp.permalink IN ("
permalinks permalinks
|> List.iteri (fun idx link -> |> List.iteri (fun idx link ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " 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) /// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask { let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- $""" cmd.CommandText <- $"
{selectPost} {selectPost}
INNER JOIN post_category pc ON pc.post_id = p.id INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = @status AND p.status = @status
AND pc.category_id IN (""" AND pc.category_id IN ("
categoryIds categoryIds
|> List.iteri (fun idx catId -> |> List.iteri (fun idx catId ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@catId{idx}" cmd.CommandText <- $"{cmd.CommandText}@catId{idx}"
cmd.Parameters.AddWithValue ($"@catId{idx}", CategoryId.toString catId) |> ignore) cmd.Parameters.AddWithValue ($"@catId{idx}", CategoryId.toString catId) |> ignore)
cmd.CommandText <- cmd.CommandText <- $"{cmd.CommandText})
$"""{cmd.CommandText})
ORDER BY published_on DESC ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
use! rdr = cmd.ExecuteReaderAsync () 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) /// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks)
let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask { let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- $""" cmd.CommandText <- $"
{selectPost} {selectPost}
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
ORDER BY p.published_on DESC NULLS FIRST, p.updated_on ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! posts = 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) /// Get a page of published posts for the given web log (excludes revisions and prior permalinks)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask { let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- $""" cmd.CommandText <- $"
{selectPost} {selectPost}
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = @status AND p.status = @status
ORDER BY p.published_on DESC ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
use! rdr = cmd.ExecuteReaderAsync () 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) /// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask { let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- $""" cmd.CommandText <- $"
{selectPost} {selectPost}
INNER JOIN post_tag pt ON pt.post_id = p.id INNER JOIN post_tag pt ON pt.post_id = p.id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = @status AND p.status = @status
AND pt.tag = @tag AND pt.tag = @tag
ORDER BY p.published_on DESC ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) [ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
cmd.Parameters.AddWithValue ("@tag", tag) 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 /// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask { let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- $""" cmd.CommandText <- $"
{selectPost} {selectPost}
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = @status AND p.status = @status
AND p.published_on < @publishedOn AND p.published_on < @publishedOn
ORDER BY p.published_on DESC ORDER BY p.published_on DESC
LIMIT 1""" LIMIT 1"
addWebLogId cmd webLogId addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) [ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
cmd.Parameters.AddWithValue ("@publishedOn", publishedOn) cmd.Parameters.AddWithValue ("@publishedOn", publishedOn)
@ -509,13 +509,13 @@ type SQLitePostData (conn : SqliteConnection) =
return None return None
} }
do! rdr.CloseAsync () do! rdr.CloseAsync ()
cmd.CommandText <- $""" cmd.CommandText <- $"
{selectPost} {selectPost}
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = @status AND p.status = @status
AND p.published_on > @publishedOn AND p.published_on > @publishedOn
ORDER BY p.published_on ORDER BY p.published_on
LIMIT 1""" LIMIT 1"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! newer = backgroundTask { let! newer = backgroundTask {
if rdr.Read () then if rdr.Read () then
@ -538,8 +538,8 @@ type SQLitePostData (conn : SqliteConnection) =
match! findFullById post.Id post.WebLogId with match! findFullById post.Id post.WebLogId with
| Some oldPost -> | Some oldPost ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
UPDATE post "UPDATE post
SET author_id = @authorId, SET author_id = @authorId,
status = @status, status = @status,
title = @title, title = @title,
@ -549,7 +549,7 @@ type SQLitePostData (conn : SqliteConnection) =
template = @template, template = @template,
post_text = @text post_text = @text
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId""" AND web_log_id = @webLogId"
addPostParameters cmd post addPostParameters cmd post
do! write cmd do! write cmd
do! updatePostCategories post.Id oldPost.CategoryIds post.CategoryIds do! updatePostCategories post.Id oldPost.CategoryIds post.CategoryIds

18
src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs
View File

@ -50,11 +50,11 @@ type SQLiteTagMapData (conn : SqliteConnection) =
/// Find any tag mappings in a list of tags for the given web log /// Find any tag mappings in a list of tags for the given web log
let findMappingForTags (tags : string list) webLogId = backgroundTask { let findMappingForTags (tags : string list) webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
SELECT * "SELECT *
FROM tag_map FROM tag_map
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
AND tag IN (""" AND tag IN ("
tags tags
|> List.iteri (fun idx tag -> |> List.iteri (fun idx tag ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
@ -71,19 +71,19 @@ type SQLiteTagMapData (conn : SqliteConnection) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
match! findById tagMap.Id tagMap.WebLogId with match! findById tagMap.Id tagMap.WebLogId with
| Some _ -> | Some _ ->
cmd.CommandText <- """ cmd.CommandText <-
UPDATE tag_map "UPDATE tag_map
SET tag = @tag, SET tag = @tag,
url_value = @urlValue url_value = @urlValue
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId""" AND web_log_id = @webLogId"
| None -> | None ->
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO tag_map ( "INSERT INTO tag_map (
id, web_log_id, tag, url_value id, web_log_id, tag, url_value
) VALUES ( ) VALUES (
@id, @webLogId, @tag, @urlValue @id, @webLogId, @tag, @urlValue
)""" )"
addWebLogId cmd tagMap.WebLogId addWebLogId cmd tagMap.WebLogId
[ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id) [ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id)
cmd.Parameters.AddWithValue ("@tag", tagMap.Tag) cmd.Parameters.AddWithValue ("@tag", tagMap.Tag)

16
src/MyWebLog.Data/SQLite/SQLiteThemeData.fs
View File

@ -67,10 +67,10 @@ type SQLiteThemeData (conn : SqliteConnection) =
match! findByIdWithoutText themeId with match! findByIdWithoutText themeId with
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
DELETE FROM theme_asset WHERE theme_id = @id; "DELETE FROM theme_asset WHERE theme_id = @id;
DELETE FROM theme_template WHERE theme_id = @id; DELETE FROM theme_template WHERE theme_id = @id;
DELETE FROM theme WHERE id = @id""" DELETE FROM theme WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
do! write cmd do! write cmd
return true return true
@ -208,20 +208,20 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <-
if exists = 1 then if exists = 1 then
"""UPDATE theme_asset "UPDATE theme_asset
SET updated_on = @updatedOn, SET updated_on = @updatedOn,
data = ZEROBLOB(@dataLength) data = ZEROBLOB(@dataLength)
WHERE theme_id = @themeId WHERE theme_id = @themeId
AND path = @path""" AND path = @path"
else else
"""INSERT INTO theme_asset ( "INSERT INTO theme_asset (
theme_id, path, updated_on, data theme_id, path, updated_on, data
) VALUES ( ) VALUES (
@themeId, @path, @updatedOn, ZEROBLOB(@dataLength) @themeId, @path, @updatedOn, ZEROBLOB(@dataLength)
)""" )"
[ cmd.Parameters.AddWithValue ("@themeId", themeId) [ cmd.Parameters.AddWithValue ("@themeId", themeId)
cmd.Parameters.AddWithValue ("@path", path) 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) cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length)
] |> ignore ] |> ignore
do! write cmd do! write cmd

14
src/MyWebLog.Data/SQLite/SQLiteUploadData.fs
View File

@ -13,19 +13,19 @@ type SQLiteUploadData (conn : SqliteConnection) =
[ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id) [ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId)
cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.Path) cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.Path)
cmd.Parameters.AddWithValue ("@updatedOn", upload.UpdatedOn) cmd.Parameters.AddWithValue ("@updatedOn", instantParam upload.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length) cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length)
] |> ignore ] |> ignore
/// Save an uploaded file /// Save an uploaded file
let add upload = backgroundTask { let add upload = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO upload ( "INSERT INTO upload (
id, web_log_id, path, updated_on, data id, web_log_id, path, updated_on, data
) VALUES ( ) VALUES (
@id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength) @id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength)
)""" )"
addUploadParameters cmd upload addUploadParameters cmd upload
do! write cmd do! write cmd
@ -40,11 +40,11 @@ type SQLiteUploadData (conn : SqliteConnection) =
/// Delete an uploaded file by its ID /// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask { let delete uploadId webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
SELECT id, web_log_id, path, updated_on "SELECT id, web_log_id, path, updated_on
FROM upload FROM upload
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId""" AND web_log_id = @webLogId"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@id", UploadId.toString uploadId) |> ignore cmd.Parameters.AddWithValue ("@id", UploadId.toString uploadId) |> ignore
let! rdr = cmd.ExecuteReaderAsync () let! rdr = cmd.ExecuteReaderAsync ()

57
src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs
View File

@ -65,17 +65,18 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.Parameters.AddWithValue ("@podcastGuid", maybe podcast.PodcastGuid) cmd.Parameters.AddWithValue ("@podcastGuid", maybe podcast.PodcastGuid)
cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.FundingUrl) cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.FundingUrl)
cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.FundingText) cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.FundingText)
cmd.Parameters.AddWithValue ("@medium", maybe (podcast.Medium |> Option.map PodcastMedium.toString)) cmd.Parameters.AddWithValue ("@medium", maybe (podcast.Medium
|> Option.map PodcastMedium.toString))
] |> ignore ] |> ignore
/// Get the current custom feeds for a web log /// Get the current custom feeds for a web log
let getCustomFeeds (webLog : WebLog) = backgroundTask { let getCustomFeeds (webLog : WebLog) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
SELECT f.*, p.* "SELECT f.*, p.*
FROM web_log_feed f FROM web_log_feed f
LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id
WHERE f.web_log_id = @webLogId""" WHERE f.web_log_id = @webLogId"
addWebLogId cmd webLog.Id addWebLogId cmd webLog.Id
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toCustomFeed rdr return toList Map.toCustomFeed rdr
@ -90,8 +91,8 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Add a podcast to a custom feed /// Add a podcast to a custom feed
let addPodcast feedId (podcast : PodcastOptions) = backgroundTask { let addPodcast feedId (podcast : PodcastOptions) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO web_log_feed_podcast ( "INSERT INTO web_log_feed_podcast (
feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url, 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, apple_category, apple_subcategory, explicit, default_media_type, media_base_url, podcast_guid,
funding_url, funding_text, medium funding_url, funding_text, medium
@ -99,7 +100,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl, @feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl,
@appleCategory, @appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @podcastGuid, @appleCategory, @appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @podcastGuid,
@fundingUrl, @fundingText, @medium @fundingUrl, @fundingText, @medium
)""" )"
addPodcastParameters cmd feedId podcast addPodcastParameters cmd feedId podcast
do! write cmd do! write cmd
} }
@ -117,9 +118,9 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
toDelete toDelete
|> List.map (fun it -> backgroundTask { |> List.map (fun it -> backgroundTask {
cmd.CommandText <- """ cmd.CommandText <-
DELETE FROM web_log_feed_podcast WHERE feed_id = @id; "DELETE FROM web_log_feed_podcast WHERE feed_id = @id;
DELETE FROM web_log_feed WHERE id = @id""" DELETE FROM web_log_feed WHERE id = @id"
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id
do! write cmd do! write cmd
}) })
@ -128,12 +129,12 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.Parameters.Clear () cmd.Parameters.Clear ()
toAdd toAdd
|> List.map (fun it -> backgroundTask { |> List.map (fun it -> backgroundTask {
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO web_log_feed ( "INSERT INTO web_log_feed (
id, web_log_id, source, path id, web_log_id, source, path
) VALUES ( ) VALUES (
@id, @webLogId, @source, @path @id, @webLogId, @source, @path
)""" )"
cmd.Parameters.Clear () cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.Id it addCustomFeedParameters cmd webLog.Id it
do! write cmd do! write cmd
@ -145,12 +146,12 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|> ignore |> ignore
toUpdate toUpdate
|> List.map (fun it -> backgroundTask { |> List.map (fun it -> backgroundTask {
cmd.CommandText <- """ cmd.CommandText <-
UPDATE web_log_feed "UPDATE web_log_feed
SET source = @source, SET source = @source,
path = @path path = @path
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId""" AND web_log_id = @webLogId"
cmd.Parameters.Clear () cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.Id it addCustomFeedParameters cmd webLog.Id it
do! write cmd do! write cmd
@ -158,8 +159,8 @@ type SQLiteWebLogData (conn : SqliteConnection) =
match it.Podcast with match it.Podcast with
| Some podcast -> | Some podcast ->
if hadPodcast then if hadPodcast then
cmd.CommandText <- """ cmd.CommandText <-
UPDATE web_log_feed_podcast "UPDATE web_log_feed_podcast
SET title = @title, SET title = @title,
subtitle = @subtitle, subtitle = @subtitle,
items_in_feed = @itemsInFeed, items_in_feed = @itemsInFeed,
@ -176,7 +177,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
funding_url = @fundingUrl, funding_url = @fundingUrl,
funding_text = @fundingText, funding_text = @fundingText,
medium = @medium medium = @medium
WHERE feed_id = @feedId""" WHERE feed_id = @feedId"
cmd.Parameters.Clear () cmd.Parameters.Clear ()
addPodcastParameters cmd it.Id podcast addPodcastParameters cmd it.Id podcast
do! write cmd do! write cmd
@ -200,14 +201,14 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Add a web log /// Add a web log
let add webLog = backgroundTask { let add webLog = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO web_log ( "INSERT INTO web_log (
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx, 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 uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright
) VALUES ( ) VALUES (
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx, @id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
@uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright @uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
)""" )"
addWebLogParameters cmd webLog addWebLogParameters cmd webLog
do! write cmd do! write cmd
do! updateCustomFeeds webLog do! updateCustomFeeds webLog
@ -284,8 +285,8 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Update settings for a web log /// Update settings for a web log
let updateSettings webLog = backgroundTask { let updateSettings webLog = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
UPDATE web_log "UPDATE web_log
SET name = @name, SET name = @name,
slug = @slug, slug = @slug,
subtitle = @subtitle, subtitle = @subtitle,
@ -302,7 +303,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
is_category_enabled = @isCategoryEnabled, is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled, is_tag_enabled = @isTagEnabled,
copyright = @copyright copyright = @copyright
WHERE id = @id""" WHERE id = @id"
addWebLogParameters cmd webLog addWebLogParameters cmd webLog
do! write cmd do! write cmd
} }
@ -310,15 +311,15 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Update RSS options for a web log /// Update RSS options for a web log
let updateRssOptions webLog = backgroundTask { let updateRssOptions webLog = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
UPDATE web_log "UPDATE web_log
SET is_feed_enabled = @isFeedEnabled, SET is_feed_enabled = @isFeedEnabled,
feed_name = @feedName, feed_name = @feedName,
items_in_feed = @itemsInFeed, items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled, is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled, is_tag_enabled = @isTagEnabled,
copyright = @copyright copyright = @copyright
WHERE id = @id""" WHERE id = @id"
addWebLogRssParameters cmd webLog addWebLogRssParameters cmd webLog
cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) |> ignore cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) |> ignore
do! write cmd do! write cmd

25
src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs
View File

@ -1,6 +1,5 @@
namespace MyWebLog.Data.SQLite namespace MyWebLog.Data.SQLite
open System
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
@ -22,8 +21,8 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
cmd.Parameters.AddWithValue ("@salt", user.Salt) cmd.Parameters.AddWithValue ("@salt", user.Salt)
cmd.Parameters.AddWithValue ("@url", maybe user.Url) cmd.Parameters.AddWithValue ("@url", maybe user.Url)
cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel) cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel)
cmd.Parameters.AddWithValue ("@createdOn", user.CreatedOn) cmd.Parameters.AddWithValue ("@createdOn", instantParam user.CreatedOn)
cmd.Parameters.AddWithValue ("@lastSeenOn", maybe user.LastSeenOn) cmd.Parameters.AddWithValue ("@lastSeenOn", maybeInstant user.LastSeenOn)
] |> ignore ] |> ignore
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
@ -31,14 +30,14 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Add a user /// Add a user
let add user = backgroundTask { let add user = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
INSERT INTO web_log_user ( "INSERT INTO web_log_user (
id, web_log_id, email, first_name, last_name, preferred_name, password_hash, salt, url, access_level, id, web_log_id, email, first_name, last_name, preferred_name, password_hash, salt, url, access_level,
created_on, last_seen_on created_on, last_seen_on
) VALUES ( ) VALUES (
@id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel, @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel,
@createdOn, @lastSeenOn @createdOn, @lastSeenOn
)""" )"
addWebLogUserParameters cmd user addWebLogUserParameters cmd user
do! write cmd do! write cmd
} }
@ -116,14 +115,14 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Set a user's last seen date/time to now /// Set a user's last seen date/time to now
let setLastSeen userId webLogId = backgroundTask { let setLastSeen userId webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
UPDATE web_log_user "UPDATE web_log_user
SET last_seen_on = @lastSeenOn SET last_seen_on = @lastSeenOn
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId""" AND web_log_id = @webLogId"
addWebLogId cmd webLogId addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) [ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId)
cmd.Parameters.AddWithValue ("@lastSeenOn", DateTime.UtcNow) cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Utils.now ()))
] |> ignore ] |> ignore
let! _ = cmd.ExecuteNonQueryAsync () let! _ = cmd.ExecuteNonQueryAsync ()
() ()
@ -132,8 +131,8 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Update a user /// Update a user
let update user = backgroundTask { let update user = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- """ cmd.CommandText <-
UPDATE web_log_user "UPDATE web_log_user
SET email = @email, SET email = @email,
first_name = @firstName, first_name = @firstName,
last_name = @lastName, last_name = @lastName,
@ -145,7 +144,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
created_on = @createdOn, created_on = @createdOn,
last_seen_on = @lastSeenOn last_seen_on = @lastSeenOn
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId""" AND web_log_id = @webLogId"
addWebLogUserParameters cmd user addWebLogUserParameters cmd user
do! write cmd do! write cmd
} }

270
src/MyWebLog.Data/SQLiteData.fs
View File

@ -7,15 +7,6 @@ open MyWebLog.Data.SQLite
/// SQLite myWebLog data implementation /// SQLite myWebLog data implementation
type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) = type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
/// 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 /// The connection for this instance
member _.Conn = conn member _.Conn = conn
@ -44,48 +35,41 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
let! tables = backgroundTask {
cmd.CommandText <- "SELECT name FROM sqlite_master WHERE type = 'table'"
let! rdr = cmd.ExecuteReaderAsync ()
let mutable tableList = []
while rdr.Read() do
tableList <- Map.getString "name" rdr :: tableList
do! rdr.CloseAsync ()
return tableList
}
let needsTable table =
List.contains table tables
seq {
// Theme tables // Theme tables
match! tableExists "theme" with if needsTable "theme" then
| true -> () "CREATE TABLE theme (
| false ->
log.LogInformation "Creating theme table..."
cmd.CommandText <- """
CREATE TABLE theme (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
name TEXT NOT NULL, name TEXT NOT NULL,
version TEXT NOT NULL)""" version TEXT NOT NULL)"
do! write cmd if needsTable "theme_template" then
match! tableExists "theme_template" with "CREATE TABLE theme_template (
| true -> ()
| false ->
log.LogInformation "Creating theme_template table..."
cmd.CommandText <- """
CREATE TABLE theme_template (
theme_id TEXT NOT NULL REFERENCES theme (id), theme_id TEXT NOT NULL REFERENCES theme (id),
name TEXT NOT NULL, name TEXT NOT NULL,
template TEXT NOT NULL, template TEXT NOT NULL,
PRIMARY KEY (theme_id, name))""" PRIMARY KEY (theme_id, name))"
do! write cmd if needsTable "theme_asset" then
match! tableExists "theme_asset" with "CREATE TABLE theme_asset (
| true -> ()
| false ->
log.LogInformation "Creating theme_asset table..."
cmd.CommandText <- """
CREATE TABLE theme_asset (
theme_id TEXT NOT NULL REFERENCES theme (id), theme_id TEXT NOT NULL REFERENCES theme (id),
path TEXT NOT NULL, path TEXT NOT NULL,
updated_on TEXT NOT NULL, updated_on TEXT NOT NULL,
data BLOB NOT NULL, data BLOB NOT NULL,
PRIMARY KEY (theme_id, path))""" PRIMARY KEY (theme_id, path))"
do! write cmd
// Web log tables // Web log tables
match! tableExists "web_log" with if needsTable "web_log" then
| true -> () "CREATE TABLE web_log (
| false ->
log.LogInformation "Creating web_log table..."
cmd.CommandText <- """
CREATE TABLE web_log (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
name TEXT NOT NULL, name TEXT NOT NULL,
slug TEXT NOT NULL, slug TEXT NOT NULL,
@ -103,26 +87,16 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
is_category_enabled INTEGER NOT NULL DEFAULT 0, is_category_enabled INTEGER NOT NULL DEFAULT 0,
is_tag_enabled INTEGER NOT NULL DEFAULT 0, is_tag_enabled INTEGER NOT NULL DEFAULT 0,
copyright TEXT); copyright TEXT);
CREATE INDEX web_log_theme_idx ON web_log (theme_id)""" CREATE INDEX web_log_theme_idx ON web_log (theme_id)"
do! write cmd if needsTable "web_log_feed" then
match! tableExists "web_log_feed" with "CREATE TABLE web_log_feed (
| true -> ()
| false ->
log.LogInformation "Creating web_log_feed table..."
cmd.CommandText <- """
CREATE TABLE web_log_feed (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
source TEXT NOT NULL, source TEXT NOT NULL,
path TEXT NOT NULL); path TEXT NOT NULL);
CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)""" CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"
do! write cmd if needsTable "web_log_feed_podcast" then
match! tableExists "web_log_feed_podcast" with "CREATE TABLE web_log_feed_podcast (
| true -> ()
| false ->
log.LogInformation "Creating web_log_feed_podcast table..."
cmd.CommandText <- """
CREATE TABLE web_log_feed_podcast (
feed_id TEXT PRIMARY KEY REFERENCES web_log_feed (id), feed_id TEXT PRIMARY KEY REFERENCES web_log_feed (id),
title TEXT NOT NULL, title TEXT NOT NULL,
subtitle TEXT, subtitle TEXT,
@ -139,32 +113,22 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
podcast_guid TEXT, podcast_guid TEXT,
funding_url TEXT, funding_url TEXT,
funding_text TEXT, funding_text TEXT,
medium TEXT)""" medium TEXT)"
do! write cmd
// Category table // Category table
match! tableExists "category" with if needsTable "category" then
| true -> () "CREATE TABLE category (
| false ->
log.LogInformation "Creating category table..."
cmd.CommandText <- """
CREATE TABLE category (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
name TEXT NOT NULL, name TEXT NOT NULL,
slug TEXT NOT NULL, slug TEXT NOT NULL,
description TEXT, description TEXT,
parent_id TEXT); parent_id TEXT);
CREATE INDEX category_web_log_idx ON category (web_log_id)""" CREATE INDEX category_web_log_idx ON category (web_log_id)"
do! write cmd
// Web log user table // Web log user table
match! tableExists "web_log_user" with if needsTable "web_log_user" then
| true -> () "CREATE TABLE web_log_user (
| false ->
log.LogInformation "Creating web_log_user table..."
cmd.CommandText <- """
CREATE TABLE web_log_user (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
email TEXT NOT NULL, email TEXT NOT NULL,
@ -178,16 +142,11 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
created_on TEXT NOT NULL, created_on TEXT NOT NULL,
last_seen_on TEXT); last_seen_on TEXT);
CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id); CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id);
CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)""" CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)"
do! write cmd
// Page tables // Page tables
match! tableExists "page" with if needsTable "page" then
| true -> () "CREATE TABLE page (
| false ->
log.LogInformation "Creating page table..."
cmd.CommandText <- """
CREATE TABLE page (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id), author_id TEXT NOT NULL REFERENCES web_log_user (id),
@ -200,48 +159,28 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
page_text TEXT NOT NULL); page_text TEXT NOT NULL);
CREATE INDEX page_web_log_idx ON page (web_log_id); CREATE INDEX page_web_log_idx ON page (web_log_id);
CREATE INDEX page_author_idx ON page (author_id); CREATE INDEX page_author_idx ON page (author_id);
CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)""" CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)"
do! write cmd if needsTable "page_meta" then
match! tableExists "page_meta" with "CREATE TABLE page_meta (
| true -> ()
| false ->
log.LogInformation "Creating page_meta table..."
cmd.CommandText <- """
CREATE TABLE page_meta (
page_id TEXT NOT NULL REFERENCES page (id), page_id TEXT NOT NULL REFERENCES page (id),
name TEXT NOT NULL, name TEXT NOT NULL,
value TEXT NOT NULL, value TEXT NOT NULL,
PRIMARY KEY (page_id, name, value))""" PRIMARY KEY (page_id, name, value))"
do! write cmd if needsTable "page_permalink" then
match! tableExists "page_permalink" with "CREATE TABLE page_permalink (
| true -> ()
| false ->
log.LogInformation "Creating page_permalink table..."
cmd.CommandText <- """
CREATE TABLE page_permalink (
page_id TEXT NOT NULL REFERENCES page (id), page_id TEXT NOT NULL REFERENCES page (id),
permalink TEXT NOT NULL, permalink TEXT NOT NULL,
PRIMARY KEY (page_id, permalink))""" PRIMARY KEY (page_id, permalink))"
do! write cmd if needsTable "page_revision" then
match! tableExists "page_revision" with "CREATE TABLE page_revision (
| true -> ()
| false ->
log.LogInformation "Creating page_revision table..."
cmd.CommandText <- """
CREATE TABLE page_revision (
page_id TEXT NOT NULL REFERENCES page (id), page_id TEXT NOT NULL REFERENCES page (id),
as_of TEXT NOT NULL, as_of TEXT NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (page_id, as_of))""" PRIMARY KEY (page_id, as_of))"
do! write cmd
// Post tables // Post tables
match! tableExists "post" with if needsTable "post" then
| true -> () "CREATE TABLE post (
| false ->
log.LogInformation "Creating post table..."
cmd.CommandText <- """
CREATE TABLE post (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id), author_id TEXT NOT NULL REFERENCES web_log_user (id),
@ -255,25 +194,15 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
CREATE INDEX post_web_log_idx ON post (web_log_id); CREATE INDEX post_web_log_idx ON post (web_log_id);
CREATE INDEX post_author_idx ON post (author_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_status_idx ON post (web_log_id, status, updated_on);
CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)""" CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)"
do! write cmd if needsTable "post_category" then
match! tableExists "post_category" with "CREATE TABLE post_category (
| true -> ()
| false ->
log.LogInformation "Creating post_category table..."
cmd.CommandText <- """
CREATE TABLE post_category (
post_id TEXT NOT NULL REFERENCES post (id), post_id TEXT NOT NULL REFERENCES post (id),
category_id TEXT NOT NULL REFERENCES category (id), category_id TEXT NOT NULL REFERENCES category (id),
PRIMARY KEY (post_id, category_id)); PRIMARY KEY (post_id, category_id));
CREATE INDEX post_category_category_idx ON post_category (category_id)""" CREATE INDEX post_category_category_idx ON post_category (category_id)"
do! write cmd if needsTable "post_episode" then
match! tableExists "post_episode" with "CREATE TABLE post_episode (
| true -> ()
| false ->
log.LogInformation "Creating post_episode table..."
cmd.CommandText <- """
CREATE TABLE post_episode (
post_id TEXT PRIMARY KEY REFERENCES post(id), post_id TEXT PRIMARY KEY REFERENCES post(id),
media TEXT NOT NULL, media TEXT NOT NULL,
length INTEGER NOT NULL, length INTEGER NOT NULL,
@ -291,56 +220,31 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
season_number INTEGER, season_number INTEGER,
season_description TEXT, season_description TEXT,
episode_number TEXT, episode_number TEXT,
episode_description TEXT)""" episode_description TEXT)"
do! write cmd if needsTable "post_tag" then
match! tableExists "post_tag" with "CREATE TABLE post_tag (
| true -> ()
| false ->
log.LogInformation "Creating post_tag table..."
cmd.CommandText <- """
CREATE TABLE post_tag (
post_id TEXT NOT NULL REFERENCES post (id), post_id TEXT NOT NULL REFERENCES post (id),
tag TEXT NOT NULL, tag TEXT NOT NULL,
PRIMARY KEY (post_id, tag))""" PRIMARY KEY (post_id, tag))"
do! write cmd if needsTable "post_meta" then
match! tableExists "post_meta" with "CREATE TABLE post_meta (
| true -> ()
| false ->
log.LogInformation "Creating post_meta table..."
cmd.CommandText <- """
CREATE TABLE post_meta (
post_id TEXT NOT NULL REFERENCES post (id), post_id TEXT NOT NULL REFERENCES post (id),
name TEXT NOT NULL, name TEXT NOT NULL,
value TEXT NOT NULL, value TEXT NOT NULL,
PRIMARY KEY (post_id, name, value))""" PRIMARY KEY (post_id, name, value))"
do! write cmd if needsTable "post_permalink" then
match! tableExists "post_permalink" with "CREATE TABLE post_permalink (
| true -> ()
| false ->
log.LogInformation "Creating post_permalink table..."
cmd.CommandText <- """
CREATE TABLE post_permalink (
post_id TEXT NOT NULL REFERENCES post (id), post_id TEXT NOT NULL REFERENCES post (id),
permalink TEXT NOT NULL, permalink TEXT NOT NULL,
PRIMARY KEY (post_id, permalink))""" PRIMARY KEY (post_id, permalink))"
do! write cmd if needsTable "post_revision" then
match! tableExists "post_revision" with "CREATE TABLE post_revision (
| true -> ()
| false ->
log.LogInformation "Creating post_revision table..."
cmd.CommandText <- """
CREATE TABLE post_revision (
post_id TEXT NOT NULL REFERENCES post (id), post_id TEXT NOT NULL REFERENCES post (id),
as_of TEXT NOT NULL, as_of TEXT NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (post_id, as_of))""" PRIMARY KEY (post_id, as_of))"
do! write cmd if needsTable "post_comment" then
match! tableExists "post_comment" with "CREATE TABLE post_comment (
| true -> ()
| false ->
log.LogInformation "Creating post_comment table..."
cmd.CommandText <- """
CREATE TABLE post_comment (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
post_id TEXT NOT NULL REFERENCES post(id), post_id TEXT NOT NULL REFERENCES post(id),
in_reply_to_id TEXT, in_reply_to_id TEXT,
@ -350,36 +254,32 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
status TEXT NOT NULL, status TEXT NOT NULL,
posted_on TEXT NOT NULL, posted_on TEXT NOT NULL,
comment_text TEXT NOT NULL); comment_text TEXT NOT NULL);
CREATE INDEX post_comment_post_idx ON post_comment (post_id)""" CREATE INDEX post_comment_post_idx ON post_comment (post_id)"
do! write cmd
// Tag map table // Tag map table
match! tableExists "tag_map" with if needsTable "tag_map" then
| true -> () "CREATE TABLE tag_map (
| false ->
log.LogInformation "Creating tag_map table..."
cmd.CommandText <- """
CREATE TABLE tag_map (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
tag TEXT NOT NULL, tag TEXT NOT NULL,
url_value TEXT NOT NULL); url_value TEXT NOT NULL);
CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)""" CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)"
do! write cmd
// Uploaded file table // Uploaded file table
match! tableExists "upload" with if needsTable "upload" then
| true -> () "CREATE TABLE upload (
| false ->
log.LogInformation "Creating upload table..."
cmd.CommandText <- """
CREATE TABLE upload (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
path TEXT NOT NULL, path TEXT NOT NULL,
updated_on TEXT NOT NULL, updated_on TEXT NOT NULL,
data BLOB NOT NULL); data BLOB NOT NULL);
CREATE INDEX upload_web_log_idx ON upload (web_log_id); CREATE INDEX upload_web_log_idx ON upload (web_log_id);
CREATE INDEX upload_path_idx ON upload (web_log_id, path)""" CREATE INDEX upload_path_idx ON upload (web_log_id, path)"
do! write cmd }
|> Seq.map (fun sql ->
log.LogInformation $"Creating {(sql.Split ' ')[2]} table..."
cmd.CommandText <- sql
write cmd |> Async.AwaitTask |> Async.RunSynchronously)
|> List.ofSeq
|> ignore
} }

5
src/MyWebLog.Data/Utils.fs
View File

@ -35,5 +35,8 @@ let diffPermalinks oldLinks newLinks =
/// Find the revisions added and removed /// Find the revisions added and removed
let diffRevisions oldRevs newRevs = 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 ()

42
src/MyWebLog.Domain/DataTypes.fs
View File

@ -2,6 +2,7 @@
open System open System
open MyWebLog open MyWebLog
open NodaTime
/// A category under which a post may be identified /// A category under which a post may be identified
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
@ -64,7 +65,7 @@ type Comment =
Status : CommentStatus Status : CommentStatus
/// When the comment was posted /// When the comment was posted
PostedOn : DateTime PostedOn : Instant
/// The text of the comment /// The text of the comment
Text : string Text : string
@ -82,7 +83,7 @@ module Comment =
Email = "" Email = ""
Url = None Url = None
Status = Pending Status = Pending
PostedOn = DateTime.UtcNow PostedOn = Instant.MinValue
Text = "" Text = ""
} }
@ -106,10 +107,10 @@ type Page =
Permalink : Permalink Permalink : Permalink
/// When this page was published /// When this page was published
PublishedOn : DateTime PublishedOn : Instant
/// When this page was last updated /// When this page was last updated
UpdatedOn : DateTime UpdatedOn : Instant
/// Whether this page shows as part of the web log's navigation /// Whether this page shows as part of the web log's navigation
IsInPageList : bool IsInPageList : bool
@ -140,8 +141,8 @@ module Page =
AuthorId = WebLogUserId.empty AuthorId = WebLogUserId.empty
Title = "" Title = ""
Permalink = Permalink.empty Permalink = Permalink.empty
PublishedOn = DateTime.MinValue PublishedOn = Instant.MinValue
UpdatedOn = DateTime.MinValue UpdatedOn = Instant.MinValue
IsInPageList = false IsInPageList = false
Template = None Template = None
Text = "" Text = ""
@ -173,10 +174,10 @@ type Post =
Permalink : Permalink Permalink : Permalink
/// The instant on which the post was originally published /// The instant on which the post was originally published
PublishedOn : DateTime option PublishedOn : Instant option
/// The instant on which the post was last updated /// The instant on which the post was last updated
UpdatedOn : DateTime UpdatedOn : Instant
/// The template to use in displaying the post /// The template to use in displaying the post
Template : string option Template : string option
@ -215,7 +216,7 @@ module Post =
Title = "" Title = ""
Permalink = Permalink.empty Permalink = Permalink.empty
PublishedOn = None PublishedOn = None
UpdatedOn = DateTime.MinValue UpdatedOn = Instant.MinValue
Text = "" Text = ""
Template = None Template = None
CategoryIds = [] CategoryIds = []
@ -288,7 +289,7 @@ type ThemeAsset =
Id : ThemeAssetId Id : ThemeAssetId
/// The updated date (set from the file date from the ZIP archive) /// The updated date (set from the file date from the ZIP archive)
UpdatedOn : DateTime UpdatedOn : Instant
/// The data for the asset /// The data for the asset
Data : byte[] Data : byte[]
@ -300,7 +301,7 @@ module ThemeAsset =
/// An empty theme asset /// An empty theme asset
let empty = let empty =
{ Id = ThemeAssetId (ThemeId "", "") { Id = ThemeAssetId (ThemeId "", "")
UpdatedOn = DateTime.MinValue UpdatedOn = Instant.MinValue
Data = [||] Data = [||]
} }
@ -317,7 +318,7 @@ type Upload =
Path : Permalink Path : Permalink
/// The updated date/time for this upload /// The updated date/time for this upload
UpdatedOn : DateTime UpdatedOn : Instant
/// The data for the upload /// The data for the upload
Data : byte[] Data : byte[]
@ -331,7 +332,7 @@ module Upload =
{ Id = UploadId.empty { Id = UploadId.empty
WebLogId = WebLogId.empty WebLogId = WebLogId.empty
Path = Permalink.empty Path = Permalink.empty
UpdatedOn = DateTime.MinValue UpdatedOn = Instant.MinValue
Data = [||] Data = [||]
} }
@ -410,10 +411,11 @@ module WebLog =
let _, leadPath = hostAndPath webLog let _, leadPath = hostAndPath webLog
$"{leadPath}/{Permalink.toString permalink}" $"{leadPath}/{Permalink.toString permalink}"
/// Convert a UTC date/time to the web log's local date/time /// Convert an Instant (UTC reference) to the web log's local date/time
let localTime webLog (date : DateTime) = let localTime webLog (date : Instant) =
TimeZoneInfo.ConvertTimeFromUtc match DateTimeZoneProviders.Tzdb[webLog.TimeZone] with
(DateTime (date.Ticks, DateTimeKind.Utc), TimeZoneInfo.FindSystemTimeZoneById webLog.TimeZone) | null -> date.ToDateTimeUtc ()
| tz -> date.InZone(tz).ToDateTimeUnspecified ()
/// A user of the web log /// A user of the web log
@ -450,10 +452,10 @@ type WebLogUser =
AccessLevel : AccessLevel AccessLevel : AccessLevel
/// When the user was created /// When the user was created
CreatedOn : DateTime CreatedOn : Instant
/// When the user last logged on /// When the user last logged on
LastSeenOn : DateTime option LastSeenOn : Instant option
} }
/// Functions to support web log users /// Functions to support web log users
@ -471,7 +473,7 @@ module WebLogUser =
Salt = Guid.Empty Salt = Guid.Empty
Url = None Url = None
AccessLevel = Author AccessLevel = Author
CreatedOn = DateTime.UnixEpoch CreatedOn = Instant.FromUnixTimeSeconds 0L
LastSeenOn = None LastSeenOn = None
} }

3
src/MyWebLog.Domain/MyWebLog.Domain.fsproj
View File

@ -7,9 +7,10 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Markdig" Version="0.30.2" /> <PackageReference Include="Markdig" Version="0.30.3" />
<PackageReference Update="FSharp.Core" Version="6.0.5" /> <PackageReference Update="FSharp.Core" Version="6.0.5" />
<PackageReference Include="Markdown.ColorCode" Version="1.0.1" /> <PackageReference Include="Markdown.ColorCode" Version="1.0.1" />
<PackageReference Include="NodaTime" Version="3.1.2" />
</ItemGroup> </ItemGroup>
</Project> </Project>

8
src/MyWebLog.Domain/SupportTypes.fs
View File

@ -1,6 +1,7 @@
namespace MyWebLog namespace MyWebLog
open System open System
open NodaTime
/// Support functions for domain definition /// Support functions for domain definition
[<AutoOpen>] [<AutoOpen>]
@ -146,7 +147,7 @@ type Episode =
Length : int64 Length : int64
/// The duration of the episode /// The duration of the episode
Duration : TimeSpan option Duration : Duration option
/// The media type of the file (overrides podcast default if present) /// The media type of the file (overrides podcast default if present)
MediaType : string option MediaType : string option
@ -269,12 +270,11 @@ module MetaItem =
let empty = let empty =
{ Name = ""; Value = "" } { Name = ""; Value = "" }
/// A revision of a page or post /// A revision of a page or post
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Revision = type Revision =
{ /// When this revision was saved { /// When this revision was saved
AsOf : DateTime AsOf : Instant
/// The text of the revision /// The text of the revision
Text : MarkupText Text : MarkupText
@ -285,7 +285,7 @@ module Revision =
/// An empty revision /// An empty revision
let empty = let empty =
{ AsOf = DateTime.UtcNow { AsOf = Instant.MinValue
Text = Html "" Text = Html ""
} }

18
src/MyWebLog.Domain/ViewModels.fs
View File

@ -2,6 +2,8 @@
open System open System
open MyWebLog open MyWebLog
open NodaTime
open NodaTime.Text
/// Helper functions for view models /// Helper functions for view models
[<AutoOpen>] [<AutoOpen>]
@ -138,8 +140,8 @@ type DisplayPage =
AuthorId = WebLogUserId.toString page.AuthorId AuthorId = WebLogUserId.toString page.AuthorId
Title = page.Title Title = page.Title
Permalink = Permalink.toString page.Permalink Permalink = Permalink.toString page.Permalink
PublishedOn = page.PublishedOn PublishedOn = WebLog.localTime webLog page.PublishedOn
UpdatedOn = page.UpdatedOn UpdatedOn = WebLog.localTime webLog page.UpdatedOn
IsInPageList = page.IsInPageList IsInPageList = page.IsInPageList
IsDefault = pageId = webLog.DefaultPage IsDefault = pageId = webLog.DefaultPage
Text = "" Text = ""
@ -154,8 +156,8 @@ type DisplayPage =
AuthorId = WebLogUserId.toString page.AuthorId AuthorId = WebLogUserId.toString page.AuthorId
Title = page.Title Title = page.Title
Permalink = Permalink.toString page.Permalink Permalink = Permalink.toString page.Permalink
PublishedOn = page.PublishedOn PublishedOn = WebLog.localTime webLog page.PublishedOn
UpdatedOn = page.UpdatedOn UpdatedOn = WebLog.localTime webLog page.UpdatedOn
IsInPageList = page.IsInPageList IsInPageList = page.IsInPageList
IsDefault = pageId = webLog.DefaultPage IsDefault = pageId = webLog.DefaultPage
Text = addBaseToRelativeUrls extra page.Text Text = addBaseToRelativeUrls extra page.Text
@ -179,7 +181,7 @@ with
/// Create a display revision from an actual revision /// Create a display revision from an actual revision
static member fromRevision webLog (rev : Revision) = static member fromRevision webLog (rev : Revision) =
{ AsOf = rev.AsOf { AsOf = rev.AsOf.ToDateTimeUtc ()
AsOfLocal = WebLog.localTime webLog rev.AsOf AsOfLocal = WebLog.localTime webLog rev.AsOf
Format = MarkupText.sourceType rev.Text Format = MarkupText.sourceType rev.Text
} }
@ -704,6 +706,7 @@ type EditPostModel =
| Some rev -> rev | Some rev -> rev
| None -> Revision.empty | 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 let episode = defaultArg post.Episode Episode.empty
{ PostId = PostId.toString post.Id { PostId = PostId.toString post.Id
Title = post.Title Title = post.Title
@ -723,7 +726,7 @@ type EditPostModel =
IsEpisode = Option.isSome post.Episode IsEpisode = Option.isSome post.Episode
Media = episode.Media Media = episode.Media
Length = episode.Length 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 "" MediaType = defaultArg episode.MediaType ""
ImageUrl = defaultArg episode.ImageUrl "" ImageUrl = defaultArg episode.ImageUrl ""
Subtitle = defaultArg episode.Subtitle "" Subtitle = defaultArg episode.Subtitle ""
@ -781,7 +784,8 @@ type EditPostModel =
Some { Some {
Media = this.Media Media = this.Media
Length = this.Length 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 MediaType = noneIfBlank this.MediaType
ImageUrl = noneIfBlank this.ImageUrl ImageUrl = noneIfBlank this.ImageUrl
Subtitle = noneIfBlank this.Subtitle Subtitle = noneIfBlank this.Subtitle

3
src/MyWebLog/Maintenance.fs
View File

@ -253,8 +253,7 @@ module Backup =
/// Create a JSON serializer (uses RethinkDB data implementation's JSON converters) /// Create a JSON serializer (uses RethinkDB data implementation's JSON converters)
let private getSerializer prettyOutput = let private getSerializer prettyOutput =
let serializer = JsonSerializer.CreateDefault () let serializer = Json.configure (JsonSerializer.CreateDefault ())
Json.all () |> Seq.iter serializer.Converters.Add
if prettyOutput then serializer.Formatting <- Formatting.Indented if prettyOutput then serializer.Formatting <- Formatting.Indented
serializer serializer

44
src/MyWebLog/Program.fs
View File

@ -3,6 +3,7 @@ open Microsoft.Data.Sqlite
open Microsoft.Extensions.Configuration open Microsoft.Extensions.Configuration
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open Newtonsoft.Json
open Npgsql open Npgsql
/// Middleware to derive the current web log /// Middleware to derive the current web log
@ -39,33 +40,33 @@ module DataImplementation =
open RethinkDb.Driver.Net open RethinkDb.Driver.Net
/// Get the configured data implementation /// Get the configured data implementation
let get (sp : IServiceProvider) : IData = let get (sp : IServiceProvider) : IData * JsonSerializer =
let config = sp.GetRequiredService<IConfiguration> () let config = sp.GetRequiredService<IConfiguration> ()
let await it = (Async.AwaitTask >> Async.RunSynchronously) it let await it = (Async.AwaitTask >> Async.RunSynchronously) it
let connStr name = config.GetConnectionString name let connStr name = config.GetConnectionString name
let hasConnStr name = (connStr >> isNull >> not) name let hasConnStr name = (connStr >> isNull >> not) name
let createSQLite connStr = let createSQLite connStr : IData * JsonSerializer =
let log = sp.GetRequiredService<ILogger<SQLiteData>> () let log = sp.GetRequiredService<ILogger<SQLiteData>> ()
let conn = new SqliteConnection (connStr) let conn = new SqliteConnection (connStr)
log.LogInformation $"Using SQLite database {conn.DataSource}" log.LogInformation $"Using SQLite database {conn.DataSource}"
await (SQLiteData.setUpConnection conn) await (SQLiteData.setUpConnection conn)
SQLiteData (conn, log) SQLiteData (conn, log), Json.configure (JsonSerializer.CreateDefault ())
if hasConnStr "SQLite" then if hasConnStr "SQLite" then
upcast createSQLite (connStr "SQLite") createSQLite (connStr "SQLite")
elif hasConnStr "RethinkDB" then elif hasConnStr "RethinkDB" then
let log = sp.GetRequiredService<ILogger<RethinkDbData>> () let log = sp.GetRequiredService<ILogger<RethinkDbData>> ()
Json.all () |> Seq.iter Converter.Serializer.Converters.Add let _ = Json.configure Converter.Serializer
let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB") let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB")
let conn = await (rethinkCfg.CreateConnectionAsync log) let conn = await (rethinkCfg.CreateConnectionAsync log)
upcast RethinkDbData (conn, rethinkCfg, log) RethinkDbData (conn, rethinkCfg, log), Converter.Serializer
elif hasConnStr "PostgreSQL" then elif hasConnStr "PostgreSQL" then
let log = sp.GetRequiredService<ILogger<PostgresData>> () let log = sp.GetRequiredService<ILogger<PostgresData>> ()
let conn = new NpgsqlConnection (connStr "PostgreSQL") let conn = new NpgsqlConnection (connStr "PostgreSQL")
log.LogInformation $"Using PostgreSQL database {conn.Host}:{conn.Port}/{conn.Database}" log.LogInformation $"Using PostgreSQL database {conn.Host}:{conn.Port}/{conn.Database}"
PostgresData (conn, log) PostgresData (conn, log), Json.configure (JsonSerializer.CreateDefault ())
else else
upcast createSQLite "Data Source=./myweblog.db;Cache=Shared" createSQLite "Data Source=./myweblog.db;Cache=Shared"
open System.Threading.Tasks open System.Threading.Tasks
@ -94,6 +95,7 @@ open Giraffe.EndpointRouting
open Microsoft.AspNetCore.Authentication.Cookies open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Builder open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.HttpOverrides open Microsoft.AspNetCore.HttpOverrides
open Microsoft.Extensions.Caching.Distributed
open NeoSmart.Caching.Sqlite open NeoSmart.Caching.Sqlite
open RethinkDB.DistributedCache open RethinkDB.DistributedCache
@ -115,7 +117,8 @@ let rec main args =
let _ = builder.Services.AddAntiforgery () let _ = builder.Services.AddAntiforgery ()
let sp = builder.Services.BuildServiceProvider () let sp = builder.Services.BuildServiceProvider ()
let data = DataImplementation.get sp let data, serializer = DataImplementation.get sp
let _ = builder.Services.AddSingleton<JsonSerializer> serializer
task { task {
do! data.StartUp () do! data.StartUp ()
@ -127,33 +130,36 @@ let rec main args =
match data with match data with
| :? RethinkDbData as rethink -> | :? RethinkDbData as rethink ->
// A RethinkDB connection is designed to work as a singleton // A RethinkDB connection is designed to work as a singleton
builder.Services.AddSingleton<IData> data |> ignore let _ = builder.Services.AddSingleton<IData> data
let _ =
builder.Services.AddDistributedRethinkDBCache (fun opts -> builder.Services.AddDistributedRethinkDBCache (fun opts ->
opts.TableName <- "Session" opts.TableName <- "Session"
opts.Connection <- rethink.Conn) opts.Connection <- rethink.Conn)
|> ignore ()
| :? SQLiteData as sql -> | :? SQLiteData as sql ->
// ADO.NET connections are designed to work as per-request instantiation // ADO.NET connections are designed to work as per-request instantiation
let cfg = sp.GetRequiredService<IConfiguration> () let cfg = sp.GetRequiredService<IConfiguration> ()
let _ =
builder.Services.AddScoped<SqliteConnection> (fun sp -> builder.Services.AddScoped<SqliteConnection> (fun sp ->
let conn = new SqliteConnection (sql.Conn.ConnectionString) let conn = new SqliteConnection (sql.Conn.ConnectionString)
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
conn) conn)
|> ignore let _ = builder.Services.AddScoped<IData, SQLiteData> () |> ignore
builder.Services.AddScoped<IData, SQLiteData> () |> ignore
// Use SQLite for caching as well // Use SQLite for caching as well
let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./session.db" 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 -> | :? PostgresData ->
// ADO.NET connections are designed to work as per-request instantiation // ADO.NET connections are designed to work as per-request instantiation
let cfg = sp.GetRequiredService<IConfiguration> () let cfg = sp.GetRequiredService<IConfiguration> ()
let _ =
builder.Services.AddScoped<NpgsqlConnection> (fun sp -> builder.Services.AddScoped<NpgsqlConnection> (fun sp ->
new NpgsqlConnection (cfg.GetConnectionString "PostgreSQL")) new NpgsqlConnection (cfg.GetConnectionString "PostgreSQL"))
|> ignore let _ = builder.Services.AddScoped<IData, PostgresData> ()
builder.Services.AddScoped<IData, PostgresData> () |> ignore let _ =
// Use SQLite for caching (for now) builder.Services.AddSingleton<IDistributedCache> (fun sp ->
let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./session.db" Postgres.DistributedCache (cfg.GetConnectionString "PostgreSQL") :> IDistributedCache)
builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath) |> ignore ()
| _ -> () | _ -> ()
let _ = builder.Services.AddSession(fun opts -> let _ = builder.Services.AddSession(fun opts ->