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

WIP on PostgreSQL data impl

Browse Source
This commit is contained in:
Daniel J. Summers 2022-08-18 13:49:41 -04:00
parent b3c008629a
commit 73c7a686a4
12 changed files with 799 additions and 620 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -39,6 +39,7 @@
<Compile Include="PostgreSql\PostgreSqlThemeData.fs" /> <Compile Include="PostgreSql\PostgreSqlThemeData.fs" />
<Compile Include="PostgreSql\PostgreSqlUploadData.fs" /> <Compile Include="PostgreSql\PostgreSqlUploadData.fs" />
<Compile Include="PostgreSql\PostgreSqlWebLogData.fs" /> <Compile Include="PostgreSql\PostgreSqlWebLogData.fs" />
<Compile Include="PostgreSql\PostgreSqlWebLogUserData.fs" />
<Compile Include="PostgreSqlData.fs" /> <Compile Include="PostgreSqlData.fs" />
</ItemGroup> </ItemGroup>

56
src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs
View File

@ -10,14 +10,14 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) =
/// Count all categories for the given web log /// Count all categories for the given web log
let countAll webLogId = let countAll webLogId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT COUNT(id) AS the_count FROM category WHERE web_log_id = @webLogId" |> Sql.query $"SELECT COUNT(id) AS {countName} FROM category WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toCount |> Sql.executeRowAsync Map.toCount
/// Count all top-level categories for the given web log /// Count all top-level categories for the given web log
let countTopLevel webLogId = let countTopLevel webLogId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT COUNT(id) FROM category WHERE web_log_id = @webLogId AND parent_id IS NULL" |> Sql.query $"SELECT COUNT(id) AS {countName} FROM category WHERE web_log_id = @webLogId AND parent_id IS NULL"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toCount |> Sql.executeRowAsync Map.toCount
@ -41,13 +41,13 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) =
|> inClause "id" id |> inClause "id" id
let postCount = let postCount =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $""" |> Sql.query $"
SELECT COUNT(DISTINCT p.id) AS the_count SELECT COUNT(DISTINCT p.id) AS {countName}
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 ({catIdSql})""" AND pc.category_id IN ({catIdSql})"
|> Sql.parameters (webLogIdParam webLogId :: catIdParams) |> Sql.parameters (webLogIdParam webLogId :: catIdParams)
|> Sql.executeRowAsync Map.toCount |> Sql.executeRowAsync Map.toCount
|> Async.AwaitTask |> Async.AwaitTask
@ -66,14 +66,12 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) =
|> Array.ofSeq |> Array.ofSeq
} }
/// Find a category by its ID for the given web log /// Find a category by its ID for the given web log
let findById catId webLogId = backgroundTask { let findById catId webLogId =
let! cat = Sql.existingConnection conn
Sql.existingConnection conn |> Sql.query "SELECT * FROM category WHERE id = @id AND web_log_id = @webLogId"
|> Sql.query "SELECT * FROM category WHERE id = @id AND web_log_id = @webLogId" |> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ]
|> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ] |> Sql.executeAsync Map.toCategory
|> Sql.executeAsync Map.toCategory |> tryHead
return List.tryHead cat
}
/// Find all categories for the given web log /// Find all categories for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
@ -88,13 +86,13 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) =
match! findById catId webLogId with match! findById catId webLogId with
| Some cat -> | Some cat ->
// Reassign any children to the category's parent category // Reassign any children to the category's parent category
let parentParam = "@parentId", Sql.string (CategoryId.toString catId) let parentParam = "@parentId", Sql.string (CategoryId.toString catId)
let! children = let! hasChildren =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT COUNT(id) AS the_count FROM category WHERE parent_id = @parentId" |> Sql.query $"SELECT EXISTS (SELECT 1 FROM category WHERE parent_id = @parentId) AS {existsName}"
|> Sql.parameters [ parentParam ] |> Sql.parameters [ parentParam ]
|> Sql.executeRowAsync Map.toCount |> Sql.executeRowAsync Map.toExists
if children > 0 then if hasChildren then
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId" |> Sql.query "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId"
@ -106,24 +104,24 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) =
// Delete the category off all posts where it is assigned, and the category itself // Delete the category off all posts where it is assigned, and the category itself
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query """ |> Sql.query
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""" DELETE FROM category WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ] |> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
return if children = 0 then CategoryDeleted else ReassignedChildCategories return if hasChildren then ReassignedChildCategories else CategoryDeleted
| None -> return CategoryNotFound | None -> return CategoryNotFound
} }
/// The INSERT statement for a category /// The INSERT statement for a category
let catInsert = """ let catInsert =
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
)""" )"
/// Create parameters for a category insert / update /// Create parameters for a category insert / update
let catParameters (cat : Category) = [ let catParameters (cat : Category) = [
@ -139,12 +137,12 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) =
let save cat = backgroundTask { let save cat = backgroundTask {
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $""" |> Sql.query $"
{catInsert} ON CONFLICT (id) DO UPDATE {catInsert} ON CONFLICT (id) DO UPDATE
SET name = EXCLUDED.name, SET name = EXCLUDED.name,
slug = EXCLUDED.slug, slug = EXCLUDED.slug,
description = EXCLUDED.description, description = EXCLUDED.description,
parent_id = EXCLUDED.parent_id""" parent_id = EXCLUDED.parent_id"
|> Sql.parameters (catParameters cat) |> Sql.parameters (catParameters cat)
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
() ()

58
src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs
View File

@ -2,6 +2,7 @@
[<AutoOpen>] [<AutoOpen>]
module MyWebLog.Data.PostgreSql.PostgreSqlHelpers module MyWebLog.Data.PostgreSql.PostgreSqlHelpers
open System.Threading.Tasks
open MyWebLog open MyWebLog
open Newtonsoft.Json open Newtonsoft.Json
open Npgsql.FSharp open Npgsql.FSharp
@ -10,19 +11,11 @@ open Npgsql.FSharp
let webLogIdParam webLogId = let webLogIdParam webLogId =
"@webLogId", Sql.string (WebLogId.toString webLogId) "@webLogId", Sql.string (WebLogId.toString webLogId)
/// Create the SQL and parameters to find a page or post by one or more prior permalinks /// The name of the field to select to be able to use Map.toCount
let priorPermalinkSql permalinks = let countName = "the_count"
let mutable idx = 0
permalinks /// The name of the field to select to be able to use Map.toExists
|> List.skip 1 let existsName = "does_exist"
|> List.fold (fun (linkSql, linkParams) it ->
idx <- idx + 1
$"{linkSql} OR prior_permalinks && ARRAY[@link{idx}]",
($"@link{idx}", Sql.string (Permalink.toString it)) :: linkParams)
(Seq.ofList permalinks
|> Seq.map (fun it ->
"prior_permalinks && ARRAY[@link0]", [ "@link0", Sql.string (Permalink.toString it) ])
|> Seq.head)
/// Create the SQL and parameters for an IN clause /// Create the SQL and parameters for an IN clause
let inClause<'T> name (valueFunc: 'T -> string) (items : 'T list) = let inClause<'T> name (valueFunc: 'T -> string) (items : 'T list) =
@ -36,6 +29,26 @@ let inClause<'T> name (valueFunc: 'T -> string) (items : 'T list) =
|> Seq.map (fun it -> $"@%s{name}0", [ $"@%s{name}0", Sql.string (valueFunc it) ]) |> Seq.map (fun it -> $"@%s{name}0", [ $"@%s{name}0", Sql.string (valueFunc it) ])
|> Seq.head) |> Seq.head)
/// Create the SQL and parameters for the array equivalent of an IN clause
let arrayInClause<'T> name (valueFunc : 'T -> string) (items : 'T list) =
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS} OR %s{name} && ARRAY[@{name}{idx}]",
($"@{name}{idx}", Sql.string (valueFunc it)) :: itemP)
(Seq.ofList items
|> Seq.map (fun it ->
$"{name} && ARRAY[@{name}0]", [ $"@{name}0", Sql.string (valueFunc it) ])
|> Seq.head)
/// Get the first result of the given query
let tryHead<'T> (query : Task<'T list>) = backgroundTask {
let! results = query
return List.tryHead results
}
/// Mapping functions for SQL queries /// Mapping functions for SQL queries
module Map = module Map =
@ -55,7 +68,7 @@ module Map =
/// Get a count from a row /// Get a count from a row
let toCount (row : RowReader) = let toCount (row : RowReader) =
row.int "the_count" row.int countName
/// Create a custom feed from the current row /// Create a custom feed from the current row
let toCustomFeed (row : RowReader) : CustomFeed = let toCustomFeed (row : RowReader) : CustomFeed =
@ -88,7 +101,7 @@ module Map =
/// Get a true/false value as to whether an item exists /// Get a true/false value as to whether an item exists
let toExists (row : RowReader) = let toExists (row : RowReader) =
row.bool "does_exist" row.bool existsName
/// Create a meta item from the current row /// Create a meta item from the current row
let toMetaItem (row : RowReader) : MetaItem = let toMetaItem (row : RowReader) : MetaItem =
@ -213,3 +226,18 @@ module Map =
} }
} }
/// Create a web log user from the current row
let toWebLogUser (row : RowReader) : WebLogUser =
{ Id = row.string "id" |> WebLogUserId
WebLogId = row.string "web_log_id" |> WebLogId
Email = row.string "email"
FirstName = row.string "first_name"
LastName = row.string "last_name"
PreferredName = row.string "preferred_name"
PasswordHash = row.string "password_hash"
Salt = row.uuid "salt"
Url = row.stringOrNone "url"
AccessLevel = row.string "access_level" |> AccessLevel.parse
CreatedOn = row.dateTime "created_on"
LastSeenOn = row.dateTimeOrNone "last_seen_on"
}

143
src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs
View File

@ -55,6 +55,13 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
() ()
} }
/// Does the given page exist?
let pageExists pageId webLogId =
Sql.existingConnection conn
|> Sql.query $"SELECT EXISTS (SELECT 1 FROM page WHERE id = @id AND web_log_id = @webLogId) AS {existsName}"
|> Sql.parameters [ "@id", Sql.string (PageId.toString pageId); webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toExists
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Get all pages for a web log (without text, revisions, prior permalinks, or metadata) /// Get all pages for a web log (without text, revisions, prior permalinks, or metadata)
@ -67,26 +74,28 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
/// Count all pages for the given web log /// Count all pages for the given web log
let countAll webLogId = let countAll webLogId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT COUNT(id) AS the_count FROM page WHERE web_log_id = @webLogId" |> Sql.query $"SELECT COUNT(id) AS {countName} FROM page WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toCount |> Sql.executeRowAsync Map.toCount
/// 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 = let countListed webLogId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT COUNT(id) AS the_count FROM page WHERE web_log_id = @webLogId AND is_in_page_list = TRUE" |> Sql.query $"
SELECT COUNT(id) AS {countName}
FROM page
WHERE web_log_id = @webLogId
AND is_in_page_list = TRUE"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toCount |> Sql.executeRowAsync Map.toCount
/// Find a page by its ID (without revisions) /// Find a page by its ID (without revisions)
let findById pageId webLogId = backgroundTask { let findById pageId webLogId =
let! page = Sql.existingConnection conn
Sql.existingConnection conn |> Sql.query "SELECT * FROM page WHERE id = @id AND web_log_id = @webLogId"
|> Sql.query "SELECT * FROM page WHERE id = @id AND web_log_id = @webLogId" |> Sql.parameters [ "@id", Sql.string (PageId.toString pageId); webLogIdParam webLogId ]
|> Sql.parameters [ "@id", Sql.string (PageId.toString pageId); webLogIdParam webLogId ] |> Sql.executeAsync Map.toPage
|> Sql.executeAsync Map.toPage |> tryHead
return List.tryHead page
}
/// Find a complete page by its ID /// Find a complete page by its ID
let findFullById pageId webLogId = backgroundTask { let findFullById pageId webLogId = backgroundTask {
@ -99,40 +108,38 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
/// Delete a page by its ID /// Delete a page by its ID
let delete pageId webLogId = backgroundTask { let delete pageId webLogId = backgroundTask {
match! findById pageId webLogId with match! pageExists pageId webLogId with
| Some _ -> | true ->
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query """ |> Sql.query
DELETE FROM page_revision WHERE page_id = @id; "DELETE FROM page_revision WHERE page_id = @id;
DELETE FROM page WHERE id = @id""" DELETE FROM page WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string (PageId.toString pageId) ] |> Sql.parameters [ "@id", Sql.string (PageId.toString pageId) ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
return true return true
| None -> return false | false -> return false
} }
/// Find a page by its permalink for the given web log /// Find a page by its permalink for the given web log
let findByPermalink permalink webLogId = backgroundTask { let findByPermalink permalink webLogId =
let! page = Sql.existingConnection conn
Sql.existingConnection conn |> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link"
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link" |> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ]
|> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ] |> Sql.executeAsync Map.toPage
|> Sql.executeAsync Map.toPage |> tryHead
return List.tryHead page
}
/// 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 {
if List.isEmpty permalinks then return None if List.isEmpty permalinks then return None
else else
let linkSql, linkParams = priorPermalinkSql permalinks let linkSql, linkParams = arrayInClause "prior_permalinks" Permalink.toString permalinks
let! links = return!
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $"SELECT permalink FROM page WHERE web_log_id = @webLogId AND ({linkSql})" |> Sql.query $"SELECT permalink FROM page WHERE web_log_id = @webLogId AND ({linkSql})"
|> Sql.parameters (webLogIdParam webLogId :: linkParams) |> Sql.parameters (webLogIdParam webLogId :: linkParams)
|> Sql.executeAsync Map.toPermalink |> Sql.executeAsync Map.toPermalink
return List.tryHead links |> tryHead
} }
/// Get all complete pages for the given web log /// Get all complete pages for the given web log
@ -144,12 +151,12 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
|> Sql.executeAsync Map.toPage |> Sql.executeAsync Map.toPage
let! revisions = let! revisions =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query """ |> Sql.query
SELECT * "SELECT *
FROM page_revision pr FROM page_revision pr
INNER JOIN page p ON p.id = pr.page_id INNER JOIN page p ON p.id = pr.page_id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
ORDER BY pr.as_of DESC""" ORDER BY pr.as_of DESC"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (fun row -> PageId (row.string "page_id"), Map.toRevision row) |> Sql.executeAsync (fun row -> PageId (row.string "page_id"), Map.toRevision row)
return return
@ -168,24 +175,24 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
/// Get a page of pages for the given web log (without revisions) /// Get a page of pages for the given web log (without revisions)
let findPageOfPages webLogId pageNbr = let findPageOfPages webLogId pageNbr =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query""" |> Sql.query
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"
|> Sql.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ] |> Sql.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
|> Sql.executeAsync Map.toPage |> Sql.executeAsync Map.toPage
/// The INSERT statement for a page /// The INSERT statement for a page
let pageInsert = """ let pageInsert =
INSERT INTO page ( "INSERT INTO page (
id, web_log_id, author_id, title, permalink, prior_permalinks, published_on, updated_on, is_in_page_list, id, web_log_id, author_id, title, permalink, prior_permalinks, published_on, updated_on, is_in_page_list,
template, page_text, meta_items template, page_text, meta_items
) VALUES ( ) VALUES (
@id, @webLogId, @authorId, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn, @isInPageList, @id, @webLogId, @authorId, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn, @isInPageList,
@template, @text, @metaItems @template, @text, @metaItems
)""" )"
/// The parameters for saving a page /// The parameters for saving a page
let pageParams (page : Page) = [ let pageParams (page : Page) = [
@ -203,29 +210,6 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
"@priorPermalinks", Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) "@priorPermalinks", Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
] ]
/// Save a page
let save (page : Page) = backgroundTask {
let! oldPage = findFullById page.Id page.WebLogId
let! _ =
Sql.existingConnection conn
|> Sql.query $"""
{pageInsert} ON CONFLICT (id) DO UPDATE
SET author_id = EXCLUDED.author_id,
title = EXCLUDED.title,
permalink = EXCLUDED.permalink,
prior_permalinks = EXCLUDED.prior_permalinks,
published_on = EXCLUDED.published_on,
updated_on = EXCLUDED.updated_on,
is_in_page_list = EXCLUDED.is_in_page_list,
template = EXCLUDED.template,
page_text = EXCLUDED.text,
meta_items = EXCLUDED.meta_items"""
|> Sql.parameters (pageParams page)
|> Sql.executeNonQueryAsync
do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions
()
}
/// Restore pages from a backup /// Restore pages from a backup
let restore (pages : Page list) = backgroundTask { let restore (pages : Page list) = backgroundTask {
let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r)) let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
@ -238,10 +222,33 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
() ()
} }
/// Save a page
let save (page : Page) = backgroundTask {
let! oldPage = findFullById page.Id page.WebLogId
let! _ =
Sql.existingConnection conn
|> Sql.query $"
{pageInsert} ON CONFLICT (id) DO UPDATE
SET author_id = EXCLUDED.author_id,
title = EXCLUDED.title,
permalink = EXCLUDED.permalink,
prior_permalinks = EXCLUDED.prior_permalinks,
published_on = EXCLUDED.published_on,
updated_on = EXCLUDED.updated_on,
is_in_page_list = EXCLUDED.is_in_page_list,
template = EXCLUDED.template,
page_text = EXCLUDED.text,
meta_items = EXCLUDED.meta_items"
|> Sql.parameters (pageParams page)
|> Sql.executeNonQueryAsync
do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions
()
}
/// Update a page's prior permalinks /// Update a page's prior permalinks
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask { let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
match! findById pageId webLogId with match! pageExists pageId webLogId with
| Some _ -> | true ->
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "UPDATE page SET prior_permalinks = @prior WHERE id = @id" |> Sql.query "UPDATE page SET prior_permalinks = @prior WHERE id = @id"
@ -250,7 +257,7 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
"@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ] "@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
return true return true
| None -> return false | false -> return false
} }
interface IPageData with interface IPageData with

115
src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs
View File

@ -24,8 +24,8 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
/// The SELECT statement for a post that will include category IDs /// The SELECT statement for a post that will include category IDs
let selectPost = let selectPost =
"""SELECT *, ARRAY(SELECT cat.category_id FROM post_category cat WHERE cat.post_id = p.id) AS category_ids "SELECT *, ARRAY(SELECT cat.category_id FROM post_category cat WHERE cat.post_id = p.id) AS category_ids
FROM post""" FROM post"
/// Return a post with no revisions, prior permalinks, or text /// Return a post with no revisions, prior permalinks, or text
let postWithoutText row = let postWithoutText row =
@ -86,34 +86,37 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
() ()
} }
/// Does the given post exist?
let postExists postId webLogId =
Sql.existingConnection conn
|> Sql.query $"SELECT EXISTS (SELECT 1 FROM post WHERE id = @id AND web_log_id = @webLogId) AS {existsName}"
|> Sql.parameters [ "@id", Sql.string (PostId.toString postId); webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toExists
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Count posts in a status for the given web log /// Count posts in a status for the given web log
let countByStatus status webLogId = let countByStatus status webLogId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT COUNT(id) AS the_count FROM post WHERE web_log_id = @webLogId AND status = @status" |> Sql.query $"SELECT COUNT(id) AS {countName} FROM post WHERE web_log_id = @webLogId AND status = @status"
|> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString status) ] |> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString status) ]
|> Sql.executeRowAsync Map.toCount |> Sql.executeRowAsync Map.toCount
/// Find a post by its ID for the given web log (excluding revisions) /// Find a post by its ID for the given web log (excluding revisions)
let findById postId webLogId = backgroundTask { let findById postId webLogId =
let! post = Sql.existingConnection conn
Sql.existingConnection conn |> Sql.query $"{selectPost} WHERE id = @id AND web_log_id = @webLogId"
|> Sql.query $"{selectPost} WHERE id = @id AND web_log_id = @webLogId" |> Sql.parameters [ "@id", Sql.string (PostId.toString postId); webLogIdParam webLogId ]
|> Sql.parameters [ "@id", Sql.string (PostId.toString postId); webLogIdParam webLogId ] |> Sql.executeAsync Map.toPost
|> Sql.executeAsync Map.toPost |> tryHead
return List.tryHead post
}
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks) /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink permalink webLogId = backgroundTask { let findByPermalink permalink webLogId =
let! post = Sql.existingConnection conn
Sql.existingConnection conn |> Sql.query $"{selectPost} WHERE web_log_id = @webLogId AND permalink = @link"
|> Sql.query $"{selectPost} WHERE web_log_id = @webLogId AND permalink = @link" |> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ]
|> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ] |> Sql.executeAsync Map.toPost
|> Sql.executeAsync Map.toPost |> tryHead
return List.tryHead post
}
/// Find a complete post by its ID for the given web log /// Find a complete post by its ID for the given web log
let findFullById postId webLogId = backgroundTask { let findFullById postId webLogId = backgroundTask {
@ -126,31 +129,31 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
/// Delete a post by its ID for the given web log /// Delete a post by its ID for the given web log
let delete postId webLogId = backgroundTask { let delete postId webLogId = backgroundTask {
match! findById postId webLogId with match! postExists postId webLogId with
| Some _ -> | true ->
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query """ |> Sql.query
DELETE FROM post_revision WHERE post_id = @id; "DELETE FROM post_revision 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"
|> Sql.parameters [ "@id", Sql.string (PostId.toString postId) ] |> Sql.parameters [ "@id", Sql.string (PostId.toString postId) ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
return true return true
| None -> return false | false -> return false
} }
/// 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 {
if List.isEmpty permalinks then return None if List.isEmpty permalinks then return None
else else
let linkSql, linkParams = priorPermalinkSql permalinks let linkSql, linkParams = arrayInClause "prior_permalinks" Permalink.toString permalinks
let! links = return!
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $"SELECT permalink FROM post WHERE web_log_id = @webLogId AND ({linkSql}" |> Sql.query $"SELECT permalink FROM post WHERE web_log_id = @webLogId AND ({linkSql}"
|> Sql.parameters (webLogIdParam webLogId :: linkParams) |> Sql.parameters (webLogIdParam webLogId :: linkParams)
|> Sql.executeAsync Map.toPermalink |> Sql.executeAsync Map.toPermalink
return List.tryHead links |> tryHead
} }
/// Get all complete posts for the given web log /// Get all complete posts for the given web log
@ -162,12 +165,12 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
|> Sql.executeAsync Map.toPost |> Sql.executeAsync Map.toPost
let! revisions = let! revisions =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query """ |> Sql.query
SELECT * "SELECT *
FROM post_revision pr FROM post_revision pr
INNER JOIN post p ON p.id = pr.post_id INNER JOIN post p ON p.id = pr.post_id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
ORDER BY as_of DESC""" ORDER BY as_of DESC"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (fun row -> PostId (row.string "post_id"), Map.toRevision row) |> Sql.executeAsync (fun row -> PostId (row.string "post_id"), Map.toRevision row)
return return
@ -180,14 +183,14 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
let catSql, catParams = inClause "catId" CategoryId.toString categoryIds let catSql, catParams = inClause "catId" CategoryId.toString categoryIds
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $""" |> Sql.query $"
{selectPost} p {selectPost} 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 = @status AND p.status = @status
AND pc.category_id IN ({catSql}) AND pc.category_id IN ({catSql})
ORDER BY published_on DESC ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters |> Sql.parameters
[ webLogIdParam webLogId [ webLogIdParam webLogId
"@status", Sql.string (PostStatus.toString Published) "@status", Sql.string (PostStatus.toString Published)
@ -197,36 +200,36 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
/// Get a page of posts for the given web log (excludes text and revisions) /// Get a page of posts for the given web log (excludes text and revisions)
let findPageOfPosts webLogId pageNbr postsPerPage = let findPageOfPosts webLogId pageNbr postsPerPage =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $""" |> Sql.query $"
{selectPost} {selectPost}
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
ORDER BY published_on DESC NULLS FIRST, updated_on ORDER BY published_on DESC NULLS FIRST, updated_on
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync postWithoutText |> Sql.executeAsync postWithoutText
/// Get a page of published posts for the given web log (excludes revisions) /// Get a page of published posts for the given web log (excludes revisions)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $""" |> Sql.query $"
{selectPost} {selectPost}
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
AND status = @status AND status = @status
ORDER BY published_on DESC ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString Published) ] |> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString Published) ]
|> Sql.executeAsync Map.toPost |> Sql.executeAsync Map.toPost
/// 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 = let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $""" |> Sql.query $"
{selectPost} {selectPost}
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
AND status = @status AND status = @status
AND tag && ARRAY[@tag] AND tag && ARRAY[@tag]
ORDER BY published_on DESC ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters |> Sql.parameters
[ webLogIdParam webLogId [ webLogIdParam webLogId
"@status", Sql.string (PostStatus.toString Published) "@status", Sql.string (PostStatus.toString Published)
@ -238,43 +241,43 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask { let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask {
let queryParams = Sql.parameters [ let queryParams = Sql.parameters [
webLogIdParam webLogId webLogIdParam webLogId
"@status", Sql.string (PostStatus.toString Published) "@status", Sql.string (PostStatus.toString Published)
"@publishedOn", Sql.timestamptz publishedOn "@publishedOn", Sql.timestamptz publishedOn
] ]
let! older = let! older =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $""" |> Sql.query $"
{selectPost} {selectPost}
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
AND status = @status AND status = @status
AND published_on < @publishedOn AND published_on < @publishedOn
ORDER BY published_on DESC ORDER BY published_on DESC
LIMIT 1""" LIMIT 1"
|> queryParams |> queryParams
|> Sql.executeAsync Map.toPost |> Sql.executeAsync Map.toPost
let! newer = let! newer =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $""" |> Sql.query $"
{selectPost} {selectPost}
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
AND status = @status AND status = @status
AND published_on > @publishedOn AND published_on > @publishedOn
ORDER BY published_on ORDER BY published_on
LIMIT 1""" LIMIT 1"
|> queryParams |> queryParams
|> Sql.executeAsync Map.toPost |> Sql.executeAsync Map.toPost
return List.tryHead older, List.tryHead newer return List.tryHead older, List.tryHead newer
} }
/// The INSERT statement for a post /// The INSERT statement for a post
let postInsert = """ let postInsert =
INSERT INTO post ( "INSERT INTO post (
id, web_log_id, author_id, status, title, permalink, prior_permalinks, published_on, updated_on, id, web_log_id, author_id, status, title, permalink, prior_permalinks, published_on, updated_on,
template, post_text, tags, meta_items, episode template, post_text, tags, meta_items, episode
) VALUES ( ) VALUES (
@id, @webLogId, @authorId, @status, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn, @id, @webLogId, @authorId, @status, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn,
@template, @text, @tags, @metaItems, @episode @template, @text, @tags, @metaItems, @episode
)""" )"
/// The parameters for saving a post /// The parameters for saving a post
let postParams (post : Post) = [ let postParams (post : Post) = [
@ -301,7 +304,7 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
let! oldPost = findFullById post.Id post.WebLogId let! oldPost = findFullById post.Id post.WebLogId
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $""" |> Sql.query $"
{postInsert} ON CONFLICT (id) DO UPDATE {postInsert} ON CONFLICT (id) DO UPDATE
SET author_id = EXCLUDED.author_id, SET author_id = EXCLUDED.author_id,
status = EXCLUDED.status, status = EXCLUDED.status,
@ -314,7 +317,7 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
post_text = EXCLUDED.text, post_text = EXCLUDED.text,
tags = EXCLUDED.tags, tags = EXCLUDED.tags,
meta_items = EXCLUDED.meta_items, meta_items = EXCLUDED.meta_items,
episode = EXCLUDED.episode""" episode = EXCLUDED.episode"
|> Sql.parameters (postParams post) |> Sql.parameters (postParams post)
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
do! updatePostCategories post.Id (match oldPost with Some p -> p.CategoryIds | None -> []) post.CategoryIds do! updatePostCategories post.Id (match oldPost with Some p -> p.CategoryIds | None -> []) post.CategoryIds
@ -337,8 +340,8 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
/// Update prior permalinks for a post /// Update prior permalinks for a post
let updatePriorPermalinks postId webLogId permalinks = backgroundTask { let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
match! findById postId webLogId with match! postExists postId webLogId with
| Some _ -> | true ->
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "UPDATE post SET prior_permalinks = @prior WHERE id = @id" |> Sql.query "UPDATE post SET prior_permalinks = @prior WHERE id = @id"
@ -347,7 +350,7 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
"@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ] "@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
return true return true
| None -> return false | false -> return false
} }
interface IPostData with interface IPostData with

54
src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs
View File

@ -9,37 +9,41 @@ open Npgsql.FSharp
type PostgreSqlTagMapData (conn : NpgsqlConnection) = type PostgreSqlTagMapData (conn : NpgsqlConnection) =
/// Find a tag mapping by its ID for the given web log /// Find a tag mapping by its ID for the given web log
let findById tagMapId webLogId = backgroundTask { let findById tagMapId webLogId =
let! tagMap = Sql.existingConnection conn
Sql.existingConnection conn |> Sql.query "SELECT * FROM tag_map WHERE id = @id AND web_log_id = @webLogId"
|> Sql.query "SELECT * FROM tag_map WHERE id = @id AND web_log_id = @webLogId" |> Sql.parameters [ "@id", Sql.string (TagMapId.toString tagMapId); webLogIdParam webLogId ]
|> Sql.parameters [ "@id", Sql.string (TagMapId.toString tagMapId); webLogIdParam webLogId ] |> Sql.executeAsync Map.toTagMap
|> Sql.executeAsync Map.toTagMap |> tryHead
return List.tryHead tagMap
}
/// Delete a tag mapping for the given web log /// Delete a tag mapping for the given web log
let delete tagMapId webLogId = backgroundTask { let delete tagMapId webLogId = backgroundTask {
match! findById tagMapId webLogId with let idParams = [ "@id", Sql.string (TagMapId.toString tagMapId) ]
| Some _ -> let! exists =
Sql.existingConnection conn
|> Sql.query $"
SELECT EXISTS
(SELECT 1 FROM tag_map WHERE id = @id AND web_log_id = @webLogId)
AS {existsName}"
|> Sql.parameters (webLogIdParam webLogId :: idParams)
|> Sql.executeRowAsync Map.toExists
if exists then
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "DELETE FROM tag_map WHERE id = @id" |> Sql.query "DELETE FROM tag_map WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string (TagMapId.toString tagMapId) ] |> Sql.parameters idParams
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
return true return true
| None -> return false else return false
} }
/// Find a tag mapping by its URL value for the given web log /// Find a tag mapping by its URL value for the given web log
let findByUrlValue urlValue webLogId = backgroundTask { let findByUrlValue urlValue webLogId =
let! tagMap = Sql.existingConnection conn
Sql.existingConnection conn |> Sql.query "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue"
|> Sql.query "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue" |> Sql.parameters [ webLogIdParam webLogId; "@urlValue", Sql.string urlValue ]
|> Sql.parameters [ webLogIdParam webLogId; "@urlValue", Sql.string urlValue ] |> Sql.executeAsync Map.toTagMap
|> Sql.executeAsync Map.toTagMap |> tryHead
return List.tryHead tagMap
}
/// Get all tag mappings for the given web log /// Get all tag mappings for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
@ -57,12 +61,12 @@ type PostgreSqlTagMapData (conn : NpgsqlConnection) =
|> Sql.executeAsync Map.toTagMap |> Sql.executeAsync Map.toTagMap
/// The INSERT statement for a tag mapping /// The INSERT statement for a tag mapping
let tagMapInsert = """ let tagMapInsert =
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
)""" )"
/// The parameters for saving a tag mapping /// The parameters for saving a tag mapping
let tagMapParams (tagMap : TagMap) = [ let tagMapParams (tagMap : TagMap) = [
@ -76,10 +80,10 @@ type PostgreSqlTagMapData (conn : NpgsqlConnection) =
let save tagMap = backgroundTask { let save tagMap = backgroundTask {
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $""" |> Sql.query $"
{tagMapInsert} ON CONFLICT (id) DO UPDATE {tagMapInsert} ON CONFLICT (id) DO UPDATE
SET tag = EXCLUDED.tag, SET tag = EXCLUDED.tag,
url_value = EXCLUDED.url_value""" url_value = EXCLUDED.url_value"
|> Sql.parameters (tagMapParams tagMap) |> Sql.parameters (tagMapParams tagMap)
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
() ()

67
src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs
View File

@ -34,20 +34,20 @@ type PostgreSqlThemeData (conn : NpgsqlConnection) =
/// Find a theme by its ID /// Find a theme by its ID
let findById themeId = backgroundTask { let findById themeId = backgroundTask {
let themeIdParam = [ "@id", Sql.string (ThemeId.toString themeId) ] let themeIdParam = [ "@id", Sql.string (ThemeId.toString themeId) ]
let! tryTheme = let! theme =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme WHERE id = @id" |> Sql.query "SELECT * FROM theme WHERE id = @id"
|> Sql.parameters themeIdParam |> Sql.parameters themeIdParam
|> Sql.executeAsync Map.toTheme |> Sql.executeAsync Map.toTheme
match List.tryHead tryTheme with |> tryHead
| Some theme -> if Option.isSome theme then
let! templates = let! templates =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme_template WHERE theme_id = @id" |> Sql.query "SELECT * FROM theme_template WHERE theme_id = @id"
|> Sql.parameters themeIdParam |> Sql.parameters themeIdParam
|> Sql.executeAsync (Map.toThemeTemplate true) |> Sql.executeAsync (Map.toThemeTemplate true)
return Some { theme with Templates = templates } return Some { theme.Value with Templates = templates }
| None -> return None else return None
} }
/// Find a theme by its ID (excludes the text of templates) /// Find a theme by its ID (excludes the text of templates)
@ -62,18 +62,23 @@ type PostgreSqlThemeData (conn : NpgsqlConnection) =
/// Delete a theme by its ID /// Delete a theme by its ID
let delete themeId = backgroundTask { let delete themeId = backgroundTask {
match! findByIdWithoutText themeId with let idParams = [ "@id", Sql.string (ThemeId.toString themeId) ]
| Some _ -> let! exists =
Sql.existingConnection conn
|> Sql.query $"SELECT EXISTS (SELECT 1 FROM theme WHERE id = @id) AS {existsName}"
|> Sql.parameters idParams
|> Sql.executeRowAsync Map.toExists
if exists then
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query """ |> Sql.query
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"
|> Sql.parameters [ "@id", Sql.string (ThemeId.toString themeId) ] |> Sql.parameters idParams
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
return true return true
| None -> return false else return false
} }
/// Save a theme /// Save a theme
@ -82,11 +87,11 @@ type PostgreSqlThemeData (conn : NpgsqlConnection) =
let themeIdParam = Sql.string (ThemeId.toString theme.Id) let themeIdParam = Sql.string (ThemeId.toString theme.Id)
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query """ |> Sql.query
INSERT INTO theme VALUES (@id, @name, @version) "INSERT INTO theme VALUES (@id, @name, @version)
ON CONFLICT (id) DO UPDATE ON CONFLICT (id) DO UPDATE
SET name = EXCLUDED.name, SET name = EXCLUDED.name,
version = EXCLUDED.version""" version = EXCLUDED.version"
|> Sql.parameters |> Sql.parameters
[ "@id", themeIdParam [ "@id", themeIdParam
"@name", Sql.string theme.Name "@name", Sql.string theme.Name
@ -108,9 +113,9 @@ type PostgreSqlThemeData (conn : NpgsqlConnection) =
"DELETE FROM theme_template WHERE theme_id = @themeId AND name = @name", "DELETE FROM theme_template WHERE theme_id = @themeId AND name = @name",
toDelete |> List.map (fun tmpl -> [ "@themeId", themeIdParam; "@name", Sql.string tmpl.Name ]) toDelete |> List.map (fun tmpl -> [ "@themeId", themeIdParam; "@name", Sql.string tmpl.Name ])
if not (List.isEmpty toAddOrUpdate) then if not (List.isEmpty toAddOrUpdate) then
"""INSERT INTO theme_template VALUES (@themeId, @name, @template) "INSERT INTO theme_template VALUES (@themeId, @name, @template)
ON CONFLICT (theme_id, name) DO UPDATE ON CONFLICT (theme_id, name) DO UPDATE
SET template = EXCLUDED.template""", SET template = EXCLUDED.template",
toAddOrUpdate |> List.map (fun tmpl -> [ toAddOrUpdate |> List.map (fun tmpl -> [
"@themeId", themeIdParam "@themeId", themeIdParam
"@name", Sql.string tmpl.Name "@name", Sql.string tmpl.Name
@ -149,15 +154,13 @@ type PostgreSqlThemeAssetData (conn : NpgsqlConnection) =
} }
/// Find a theme asset by its ID /// Find a theme asset by its ID
let findById assetId = backgroundTask { let findById assetId =
let (ThemeAssetId (ThemeId themeId, path)) = assetId let (ThemeAssetId (ThemeId themeId, path)) = assetId
let! asset = Sql.existingConnection conn
Sql.existingConnection conn |> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId AND path = @path"
|> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId AND path = @path" |> Sql.parameters [ "@themeId", Sql.string themeId; "@path", Sql.string path ]
|> Sql.parameters [ "@themeId", Sql.string themeId; "@path", Sql.string path ] |> Sql.executeAsync (Map.toThemeAsset true)
|> Sql.executeAsync (Map.toThemeAsset true) |> tryHead
return List.tryHead asset
}
/// Get theme assets for the given theme (excludes data) /// Get theme assets for the given theme (excludes data)
let findByTheme themeId = let findByTheme themeId =
@ -178,14 +181,14 @@ type PostgreSqlThemeAssetData (conn : NpgsqlConnection) =
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query """ |> Sql.query
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, @data @themeId, @path, @updatedOn, @data
) ON CONFLICT (theme_id, path) DO UPDATE ) ON CONFLICT (theme_id, path) DO UPDATE
SET updated_on = EXCLUDED.updated_on, SET updated_on = EXCLUDED.updated_on,
data = EXCLUDED.data""" data = EXCLUDED.data"
|> Sql.parameters |> Sql.parameters
[ "@themeId", Sql.string themeId [ "@themeId", Sql.string themeId
"@path", Sql.string path "@path", Sql.string path

30
src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs
View File

@ -9,12 +9,12 @@ open Npgsql.FSharp
type PostgreSqlUploadData (conn : NpgsqlConnection) = type PostgreSqlUploadData (conn : NpgsqlConnection) =
/// The INSERT statement for an uploaded file /// The INSERT statement for an uploaded file
let upInsert = """ let upInsert =
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, @data @id, @webLogId, @path, @updatedOn, @data
)""" )"
/// Parameters for adding an uploaded file /// Parameters for adding an uploaded file
let upParams (upload : Upload) = [ let upParams (upload : Upload) = [
@ -38,31 +38,29 @@ type PostgreSqlUploadData (conn : NpgsqlConnection) =
/// Delete an uploaded file by its ID /// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask { let delete uploadId webLogId = backgroundTask {
let theParams = [ "@id", Sql.string (UploadId.toString uploadId); webLogIdParam webLogId ] let theParams = [ "@id", Sql.string (UploadId.toString uploadId); webLogIdParam webLogId ]
let! tryPath = let! path =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT path FROM upload WHERE id = @id AND web_log_id = @webLogId" |> Sql.query "SELECT path FROM upload WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters theParams |> Sql.parameters theParams
|> Sql.executeAsync (fun row -> row.string "path") |> Sql.executeAsync (fun row -> row.string "path")
match List.tryHead tryPath with |> tryHead
| Some path -> if Option.isSome path then
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId" |> Sql.query "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters theParams |> Sql.parameters theParams
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
return Ok path return Ok path.Value
| None -> return Error $"""Upload ID {UploadId.toString uploadId} not found""" else return Error $"""Upload ID {UploadId.toString uploadId} not found"""
} }
/// Find an uploaded file by its path for the given web log /// Find an uploaded file by its path for the given web log
let findByPath (path : string) webLogId = backgroundTask { let findByPath path webLogId =
let! upload = Sql.existingConnection conn
Sql.existingConnection conn |> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId AND path = @path"
|> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId AND path = @path" |> Sql.parameters [ webLogIdParam webLogId; "@path", Sql.string path ]
|> Sql.parameters [ webLogIdParam webLogId; "@path", Sql.string path ] |> Sql.executeAsync (Map.toUpload true)
|> Sql.executeAsync (Map.toUpload true) |> tryHead
return List.tryHead upload
}
/// Find all uploaded files for the given web log (excludes data) /// Find all uploaded files for the given web log (excludes data)
let findByWebLog webLogId = let findByWebLog webLogId =

390
src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs
View File

@ -5,56 +5,44 @@ open MyWebLog.Data
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
// The web log podcast insert loop is not statically compilable; this is OK
//#nowarn "3511"
/// PostgreSQL myWebLog web log data implementation /// PostgreSQL myWebLog web log data implementation
type PostgreSqlWebLogData (conn : NpgsqlConnection) = type PostgreSqlWebLogData (conn : NpgsqlConnection) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// Add parameters for web log INSERT or web log/RSS options UPDATE statements /// The parameters for web log INSERT or web log/RSS options UPDATE statements
let addWebLogRssParameters (webLog : WebLog) = let rssParams (webLog : WebLog) = [
[ cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled) "@isFeedEnabled", Sql.bool webLog.Rss.IsFeedEnabled
cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName) "@feedName", Sql.string webLog.Rss.FeedName
cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed) "@itemsInFeed", Sql.intOrNone webLog.Rss.ItemsInFeed
cmd.Parameters.AddWithValue ("@isCategoryEnabled", webLog.Rss.IsCategoryEnabled) "@isCategoryEnabled", Sql.bool webLog.Rss.IsCategoryEnabled
cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled) "@isTagEnabled", Sql.bool webLog.Rss.IsTagEnabled
cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright) "@copyright", Sql.stringOrNone webLog.Rss.Copyright
] |> ignore ]
/// Add parameters for web log INSERT or UPDATE statements /// The parameters for web log INSERT or UPDATE statements
let addWebLogParameters (webLog : WebLog) = let webLogParams (webLog : WebLog) = [
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) "@id", Sql.string (WebLogId.toString webLog.Id)
cmd.Parameters.AddWithValue ("@name", webLog.Name) "@name", Sql.string webLog.Name
cmd.Parameters.AddWithValue ("@slug", webLog.Slug) "@slug", Sql.string webLog.Slug
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle) "@subtitle", Sql.stringOrNone webLog.Subtitle
cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage) "@defaultPage", Sql.string webLog.DefaultPage
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage) "@postsPerPage", Sql.int webLog.PostsPerPage
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId) "@themeId", Sql.string (ThemeId.toString webLog.ThemeId)
cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase) "@urlBase", Sql.string webLog.UrlBase
cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone) "@timeZone", Sql.string webLog.TimeZone
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx) "@autoHtmx", Sql.bool webLog.AutoHtmx
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads) "@uploads", Sql.string (UploadDestination.toString webLog.Uploads)
] |> ignore yield! rssParams webLog
addWebLogRssParameters cmd webLog ]
/// Add parameters for custom feed INSERT or UPDATE statements /// The SELECT statement for custom feeds, which includes podcast feed settings if present
let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) = let feedSelect = "SELECT f.*, p.* FROM web_log_feed f LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id"
[ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId)
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source)
cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path)
] |> ignore
/// Get the current custom feeds for a web log /// Get the current custom feeds for a web log
let getCustomFeeds (webLog : WebLog) = let getCustomFeeds (webLog : WebLog) =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query """ |> Sql.query $"{feedSelect} WHERE f.web_log_id = @webLogId"
SELECT f.*, p.*
FROM web_log_feed f
LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id
WHERE f.web_log_id = @webLogId"""
|> Sql.parameters [ webLogIdParam webLog.Id ] |> Sql.parameters [ webLogIdParam webLog.Id ]
|> Sql.executeAsync Map.toCustomFeed |> Sql.executeAsync Map.toCustomFeed
@ -64,20 +52,8 @@ type PostgreSqlWebLogData (conn : NpgsqlConnection) =
return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } } return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
} }
/// The INSERT statement for a podcast feed
let feedInsert = """
INSERT INTO web_log_feed_podcast (
feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url, apple_category,
apple_subcategory, explicit, default_media_type, media_base_url, podcast_guid, funding_url, funding_text,
medium
) VALUES (
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl, @appleCategory,
@appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @podcastGuid, @fundingUrl, @fundingText,
@medium
)"""
/// The parameters to save a podcast feed /// The parameters to save a podcast feed
let feedParams feedId (podcast : PodcastOptions) = [ let podcastParams feedId (podcast : PodcastOptions) = [
"@feedId", Sql.string (CustomFeedId.toString feedId) "@feedId", Sql.string (CustomFeedId.toString feedId)
"@title", Sql.string podcast.Title "@title", Sql.string podcast.Title
"@subtitle", Sql.stringOrNone podcast.Subtitle "@subtitle", Sql.stringOrNone podcast.Subtitle
@ -97,127 +73,115 @@ type PostgreSqlWebLogData (conn : NpgsqlConnection) =
"@medium", Sql.stringOrNone (podcast.Medium |> Option.map PodcastMedium.toString) "@medium", Sql.stringOrNone (podcast.Medium |> Option.map PodcastMedium.toString)
] ]
/// Save a podcast for a custom feed /// The parameters to save a custom feed
let savePodcast feedId (podcast : PodcastOptions) = backgroundTask { let feedParams webLogId (feed : CustomFeed) = [
let! _ = webLogIdParam webLogId
Sql.existingConnection conn "@id", Sql.string (CustomFeedId.toString feed.Id)
|> Sql.query $""" "@source", Sql.string (CustomFeedSource.toString feed.Source)
{feedInsert} ON CONFLICT (feed_id) DO UPDATE "@path", Sql.string (Permalink.toString feed.Path)
SET title = EXCLUDED.title, ]
subtitle = EXCLUDED.subtitle,
items_in_feed = EXCLUDED.items_in_feed,
summary = EXCLUDED.summary,
displayed_author = EXCLUDED.displayed_author,
email = EXCLUDED.email,
image_url = EXCLUDED.image_url,
apple_category = EXCLUDED.apple_category,
apple_subcategory = EXCLUDED.apple_subcategory,
explicit = EXCLUDED.explicit,
default_media_type = EXCLUDED.default_media_type,
media_base_url = EXCLUDED.media_base_url,
podcast_guid = EXCLUDED.podcast_guid,
funding_url = EXCLUDED.funding_url,
funding_text = EXCLUDED.funding_text,
medium = EXCLUDED.medium"""
|> Sql.parameters (feedParams feedId podcast)
|> Sql.executeNonQueryAsync
()
}
/// Update the custom feeds for a web log /// Update the custom feeds for a web log
let updateCustomFeeds (webLog : WebLog) = backgroundTask { let updateCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog let! feeds = getCustomFeeds webLog
let toDelete, toAdd = Utils.diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}") let toDelete, _ = Utils.diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
let toId (feed : CustomFeed) = feed.Id let toId (feed : CustomFeed) = feed.Id
let toUpdate = let toAddOrUpdate =
webLog.Rss.CustomFeeds webLog.Rss.CustomFeeds |> List.filter (fun f -> not (toDelete |> List.map toId |> List.contains f.Id))
|> List.filter (fun f -> if not (List.isEmpty toDelete) || not (List.isEmpty toAddOrUpdate) then
not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.Id)) let! _ =
use cmd = conn.CreateCommand () Sql.existingConnection conn
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore |> Sql.executeTransactionAsync [
toDelete if not (List.isEmpty toDelete) then
|> List.map (fun it -> backgroundTask { "DELETE FROM web_log_feed_podcast WHERE feed_id = @id;
cmd.CommandText <- """ DELETE FROM web_log_feed WHERE id = @id",
DELETE FROM web_log_feed_podcast WHERE feed_id = @id; toDelete |> List.map (fun it -> [ "@id", Sql.string (CustomFeedId.toString it.Id) ])
DELETE FROM web_log_feed WHERE id = @id""" if not (List.isEmpty toAddOrUpdate) then
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id "INSERT INTO web_log_feed (
do! write cmd id, web_log_id, source, path
}) ) VALUES (
|> Task.WhenAll @id, @webLogId, @source, @path
|> ignore ) ON CONFLICT (id) DO UPDATE
cmd.Parameters.Clear () SET source = EXCLUDED.source,
toAdd path = EXCLUDED.path",
|> List.map (fun it -> backgroundTask { toAddOrUpdate |> List.map (feedParams webLog.Id)
cmd.CommandText <- """ let podcasts = toAddOrUpdate |> List.filter (fun it -> Option.isSome it.Podcast)
INSERT INTO web_log_feed ( if not (List.isEmpty podcasts) then
id, web_log_id, source, path "INSERT INTO web_log_feed_podcast (
) VALUES ( feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url,
@id, @webLogId, @source, @path apple_category, apple_subcategory, explicit, default_media_type, media_base_url,
)""" podcast_guid, funding_url, funding_text, medium
cmd.Parameters.Clear () ) VALUES (
addCustomFeedParameters cmd webLog.Id it @feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl,
do! write cmd @appleCategory, @appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl,
match it.Podcast with @podcastGuid, @fundingUrl, @fundingText, @medium
| Some podcast -> do! addPodcast it.Id podcast ) ON CONFLICT (feed_id) DO UPDATE
| None -> () SET title = EXCLUDED.title,
}) subtitle = EXCLUDED.subtitle,
|> Task.WhenAll items_in_feed = EXCLUDED.items_in_feed,
|> ignore summary = EXCLUDED.summary,
toUpdate displayed_author = EXCLUDED.displayed_author,
|> List.map (fun it -> backgroundTask { email = EXCLUDED.email,
cmd.CommandText <- """ image_url = EXCLUDED.image_url,
UPDATE web_log_feed apple_category = EXCLUDED.apple_category,
SET source = @source, apple_subcategory = EXCLUDED.apple_subcategory,
path = @path explicit = EXCLUDED.explicit,
WHERE id = @id default_media_type = EXCLUDED.default_media_type,
AND web_log_id = @webLogId""" media_base_url = EXCLUDED.media_base_url,
cmd.Parameters.Clear () podcast_guid = EXCLUDED.podcast_guid,
addCustomFeedParameters cmd webLog.Id it funding_url = EXCLUDED.funding_url,
do! write cmd funding_text = EXCLUDED.funding_text,
let hadPodcast = Option.isSome (feeds |> List.find (fun f -> f.Id = it.Id)).Podcast medium = EXCLUDED.medium",
match it.Podcast with podcasts |> List.map (fun it -> podcastParams it.Id it.Podcast.Value)
| Some podcast -> do! savePodcast it.Id podcast let hadPodcasts =
| None -> toAddOrUpdate
if hadPodcast then |> List.filter (fun it ->
cmd.CommandText <- "DELETE FROM web_log_feed_podcast WHERE feed_id = @id" match feeds |> List.tryFind (fun feed -> feed.Id = it.Id) with
cmd.Parameters.Clear () | Some feed -> Option.isSome feed.Podcast && Option.isNone it.Podcast
cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString it.Id) |> ignore | None -> false)
do! write cmd if not (List.isEmpty hadPodcasts) then
else "DELETE FROM web_log_feed_podcast WHERE feed_id = @id",
() hadPodcasts |> List.map (fun it -> [ "@id", Sql.string (CustomFeedId.toString it.Id) ])
}) ]
|> Task.WhenAll ()
|> ignore
} }
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Add a web log /// Add a web log
let add webLog = backgroundTask { let add webLog = backgroundTask {
use cmd = conn.CreateCommand () let! _ =
cmd.CommandText <- """ Sql.existingConnection conn
INSERT INTO web_log ( |> Sql.query
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx, "INSERT INTO web_log (
uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
) VALUES ( uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx, ) VALUES (
@uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright @id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
)""" @uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
addWebLogParameters cmd webLog )"
do! write cmd |> Sql.parameters (webLogParams webLog)
|> Sql.executeNonQueryAsync
do! updateCustomFeeds webLog do! updateCustomFeeds webLog
} }
/// Retrieve all web logs /// Retrieve all web logs
let all () = backgroundTask { let all () = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log"
use! rdr = cmd.ExecuteReaderAsync ()
let! webLogs = let! webLogs =
toList Map.toWebLog rdr Sql.existingConnection conn
|> List.map (fun webLog -> backgroundTask { return! appendCustomFeeds webLog }) |> Sql.query "SELECT * FROM web_log"
|> Task.WhenAll |> Sql.executeAsync Map.toWebLog
return List.ofArray webLogs let! feeds =
Sql.existingConnection conn
|> Sql.query feedSelect
|> Sql.executeAsync (fun row -> WebLogId (row.string "web_log_id"), Map.toCustomFeed row)
return
webLogs
|> List.map (fun it ->
{ it with
Rss =
{ it.Rss with
CustomFeeds = feeds |> List.filter (fun (wlId, _) -> wlId = it.Id) |> List.map snd } })
} }
/// Delete a web log by its ID /// Delete a web log by its ID
@ -247,72 +211,76 @@ type PostgreSqlWebLogData (conn : NpgsqlConnection) =
} }
/// Find a web log by its host (URL base) /// Find a web log by its host (URL base)
let findByHost (url : string) = backgroundTask { let findByHost url = backgroundTask {
use cmd = conn.CreateCommand () let! webLog =
cmd.CommandText <- "SELECT * FROM web_log WHERE url_base = @urlBase" Sql.existingConnection conn
cmd.Parameters.AddWithValue ("@urlBase", url) |> ignore |> Sql.query "SELECT * FROM web_log WHERE url_base = @urlBase"
use! rdr = cmd.ExecuteReaderAsync () |> Sql.parameters [ "@urlBase", Sql.string url ]
if rdr.Read () then |> Sql.executeAsync Map.toWebLog
let! webLog = appendCustomFeeds (Map.toWebLog rdr) |> tryHead
return Some webLog if Option.isSome webLog then
else let! withFeeds = appendCustomFeeds webLog.Value
return None return Some withFeeds
else return None
} }
/// Find a web log by its ID /// Find a web log by its ID
let findById webLogId = backgroundTask { let findById webLogId = backgroundTask {
use cmd = conn.CreateCommand () let! webLog =
cmd.CommandText <- "SELECT * FROM web_log WHERE id = @webLogId" Sql.existingConnection conn
addWebLogId cmd webLogId |> Sql.query "SELECT * FROM web_log WHERE id = @webLogId"
use! rdr = cmd.ExecuteReaderAsync () |> Sql.parameters [ webLogIdParam webLogId ]
if rdr.Read () then |> Sql.executeAsync Map.toWebLog
let! webLog = appendCustomFeeds (Map.toWebLog rdr) |> tryHead
return Some webLog if Option.isSome webLog then
else let! withFeeds = appendCustomFeeds webLog.Value
return None return Some withFeeds
else return None
} }
/// Update settings for a web log /// Update settings for a web log
let updateSettings webLog = backgroundTask { let updateSettings webLog = backgroundTask {
use cmd = conn.CreateCommand () let! _ =
cmd.CommandText <- """ Sql.existingConnection conn
UPDATE web_log |> Sql.query
SET name = @name, "UPDATE web_log
slug = @slug, SET name = @name,
subtitle = @subtitle, slug = @slug,
default_page = @defaultPage, subtitle = @subtitle,
posts_per_page = @postsPerPage, default_page = @defaultPage,
theme_id = @themeId, posts_per_page = @postsPerPage,
url_base = @urlBase, theme_id = @themeId,
time_zone = @timeZone, url_base = @urlBase,
auto_htmx = @autoHtmx, time_zone = @timeZone,
uploads = @uploads, auto_htmx = @autoHtmx,
is_feed_enabled = @isFeedEnabled, uploads = @uploads,
feed_name = @feedName, is_feed_enabled = @isFeedEnabled,
items_in_feed = @itemsInFeed, feed_name = @feedName,
is_category_enabled = @isCategoryEnabled, items_in_feed = @itemsInFeed,
is_tag_enabled = @isTagEnabled, is_category_enabled = @isCategoryEnabled,
copyright = @copyright is_tag_enabled = @isTagEnabled,
WHERE id = @id""" copyright = @copyright
addWebLogParameters cmd webLog WHERE id = @id"
do! write cmd |> Sql.parameters (webLogParams webLog)
|> Sql.executeNonQueryAsync
()
} }
/// Update RSS options for a web log /// Update RSS options for a web log
let updateRssOptions webLog = backgroundTask { let updateRssOptions (webLog : WebLog) = backgroundTask {
use cmd = conn.CreateCommand () let! _ =
cmd.CommandText <- """ Sql.existingConnection conn
UPDATE web_log |> Sql.query
SET is_feed_enabled = @isFeedEnabled, "UPDATE web_log
feed_name = @feedName, SET is_feed_enabled = @isFeedEnabled,
items_in_feed = @itemsInFeed, feed_name = @feedName,
is_category_enabled = @isCategoryEnabled, items_in_feed = @itemsInFeed,
is_tag_enabled = @isTagEnabled, is_category_enabled = @isCategoryEnabled,
copyright = @copyright is_tag_enabled = @isTagEnabled,
WHERE id = @id""" copyright = @copyright
addWebLogRssParameters cmd webLog WHERE id = @webLogId"
cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) |> ignore |> Sql.parameters (webLogIdParam webLog.Id :: rssParams webLog)
do! write cmd |> Sql.executeNonQueryAsync
do! updateCustomFeeds webLog do! updateCustomFeeds webLog
} }

151
src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogUserData.fs Normal file
View File

@ -0,0 +1,151 @@
namespace MyWebLog.Data.PostgreSql
open MyWebLog
open MyWebLog.Data
open Npgsql
open Npgsql.FSharp
/// PostgreSQL myWebLog user data implementation
type PostgreSqlWebLogUserData (conn : NpgsqlConnection) =
/// The INSERT statement for a user
let userInsert =
"INSERT INTO web_log_user (
id, web_log_id, email, first_name, last_name, preferred_name, password_hash, salt, url, access_level,
created_on, last_seen_on
) VALUES (
@id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel,
@createdOn, @lastSeenOn
)"
/// Parameters for saving web log users
let userParams (user : WebLogUser) = [
"@id", Sql.string (WebLogUserId.toString user.Id)
"@webLogId", Sql.string (WebLogId.toString user.WebLogId)
"@email", Sql.string user.Email
"@firstName", Sql.string user.FirstName
"@lastName", Sql.string user.LastName
"@preferredName", Sql.string user.PreferredName
"@passwordHash", Sql.string user.PasswordHash
"@salt", Sql.uuid user.Salt
"@url", Sql.stringOrNone user.Url
"@accessLevel", Sql.string (AccessLevel.toString user.AccessLevel)
"@createdOn", Sql.timestamptz user.CreatedOn
"@lastSeenOn", Sql.timestamptzOrNone user.LastSeenOn
]
/// Find a user by their ID for the given web log
let findById userId webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log_user WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters [ "@id", Sql.string (WebLogUserId.toString userId); webLogIdParam webLogId ]
|> Sql.executeAsync Map.toWebLogUser
|> tryHead
/// Delete a user if they have no posts or pages
let delete userId webLogId = backgroundTask {
match! findById userId webLogId with
| Some _ ->
let userParam = [ "@userId", Sql.string (WebLogUserId.toString userId) ]
let! isAuthor =
Sql.existingConnection conn
|> Sql.query
"SELECT ( EXISTS (SELECT 1 FROM page WHERE author_id = @userId
OR EXISTS (SELECT 1 FROM post WHERE author_id = @userId)) AS does_exist"
|> Sql.parameters userParam
|> Sql.executeRowAsync Map.toExists
if isAuthor then
return Error "User has pages or posts; cannot delete"
else
let! _ =
Sql.existingConnection conn
|> Sql.query "DELETE FROM web_log_user WHERE id = @userId"
|> Sql.parameters userParam
|> Sql.executeNonQueryAsync
return Ok true
| None -> return Error "User does not exist"
}
/// Find a user by their e-mail address for the given web log
let findByEmail email webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND email = @email"
|> Sql.parameters [ webLogIdParam webLogId; "@email", Sql.string email ]
|> Sql.executeAsync Map.toWebLogUser
|> tryHead
/// Get all users for the given web log
let findByWebLog webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log_user WHERE web_log_id = @webLogId ORDER BY LOWER(preferred_name)"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toWebLogUser
/// Find the names of users by their IDs for the given web log
let findNames webLogId userIds = backgroundTask {
let idSql, idParams = inClause "id" WebLogUserId.toString userIds
let! users =
Sql.existingConnection conn
|> Sql.query $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND id IN ({idSql})"
|> Sql.parameters (webLogIdParam webLogId :: idParams)
|> Sql.executeAsync Map.toWebLogUser
return
users
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
}
/// Restore users from a backup
let restore users = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
userInsert, users |> List.map userParams
]
()
}
/// Set a user's last seen date/time to now
let setLastSeen userId webLogId = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query "UPDATE web_log_user SET last_seen_on = @lastSeenOn WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters
[ webLogIdParam webLogId
"@id", Sql.string (WebLogUserId.toString userId)
"@lastSeenOn", Sql.timestamptz System.DateTime.UtcNow ]
|> Sql.executeNonQueryAsync
()
}
/// Save a user
let save user = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query $"
{userInsert} ON CONFLICT (id) DO UPDATE
SET email = @email,
first_name = @firstName,
last_name = @lastName,
preferred_name = @preferredName,
password_hash = @passwordHash,
salt = @salt,
url = @url,
access_level = @accessLevel,
created_on = @createdOn,
last_seen_on = @lastSeenOn"
|> Sql.parameters (userParams user)
|> Sql.executeNonQueryAsync
()
}
interface IWebLogUserData with
member _.Add user = save user
member _.Delete userId webLogId = delete userId webLogId
member _.FindByEmail email webLogId = findByEmail email webLogId
member _.FindById userId webLogId = findById userId webLogId
member _.FindByWebLog webLogId = findByWebLog webLogId
member _.FindNames webLogId userIds = findNames webLogId userIds
member _.Restore users = restore users
member _.SetLastSeen userId webLogId = setLastSeen userId webLogId
member _.Update user = save user

336
src/MyWebLog.Data/PostgreSqlData.fs
View File

@ -8,7 +8,6 @@ open Npgsql.FSharp
/// Data implementation for PostgreSQL /// Data implementation for PostgreSQL
type PostgreSqlData (conn : NpgsqlConnection, log : ILogger<PostgreSqlData>) = type PostgreSqlData (conn : NpgsqlConnection, log : ILogger<PostgreSqlData>) =
interface IData with interface IData with
member _.Category = PostgreSqlCategoryData conn member _.Category = PostgreSqlCategoryData conn
@ -19,6 +18,7 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger<PostgreSqlData>) =
member _.ThemeAsset = PostgreSqlThemeAssetData conn member _.ThemeAsset = PostgreSqlThemeAssetData conn
member _.Upload = PostgreSqlUploadData conn member _.Upload = PostgreSqlUploadData conn
member _.WebLog = PostgreSqlWebLogData conn member _.WebLog = PostgreSqlWebLogData conn
member _.WebLogUser = PostgreSqlWebLogUserData conn
member _.StartUp () = backgroundTask { member _.StartUp () = backgroundTask {
@ -28,202 +28,204 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger<PostgreSqlData>) =
|> Sql.executeAsync (fun row -> row.string "tablename") |> Sql.executeAsync (fun row -> row.string "tablename")
let needsTable table = not (List.contains table tables) let needsTable table = not (List.contains table tables)
seq { let sql = seq {
// Theme tables // Theme tables
if needsTable "theme" then if needsTable "theme" then
"""CREATE TABLE theme ( "CREATE TABLE theme (
id TEXT NOT NULL PRIMARY KEY, id TEXT NOT NULL PRIMARY KEY,
name TEXT NOT NULL, name TEXT NOT NULL,
version TEXT NOT NULL)""" version TEXT NOT NULL)"
if needsTable "theme_template" then if needsTable "theme_template" then
"""CREATE TABLE theme_template ( "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))"
if needsTable "theme_asset" then if needsTable "theme_asset" then
"""CREATE TABLE theme_asset ( "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 TIMESTAMPTZ NOT NULL, updated_on TIMESTAMPTZ NOT NULL,
data BYTEA NOT NULL, data BYTEA NOT NULL,
PRIMARY KEY (theme_id, path))""" PRIMARY KEY (theme_id, path))"
// Web log tables // Web log tables
if needsTable "web_log" then if needsTable "web_log" then
"""CREATE TABLE web_log ( "CREATE TABLE web_log (
id TEXT NOT NULL PRIMARY KEY, id TEXT NOT NULL PRIMARY KEY,
name TEXT NOT NULL, name TEXT NOT NULL,
slug TEXT NOT NULL, slug TEXT NOT NULL,
subtitle TEXT, subtitle TEXT,
default_page TEXT NOT NULL, default_page TEXT NOT NULL,
posts_per_page INTEGER NOT NULL, posts_per_page INTEGER NOT NULL,
theme_id TEXT NOT NULL REFERENCES theme (id), theme_id TEXT NOT NULL REFERENCES theme (id),
url_base TEXT NOT NULL, url_base TEXT NOT NULL,
time_zone TEXT NOT NULL, time_zone TEXT NOT NULL,
auto_htmx BOOLEAN NOT NULL DEFAULT FALSE, auto_htmx BOOLEAN NOT NULL DEFAULT FALSE,
uploads TEXT NOT NULL, uploads TEXT NOT NULL,
is_feed_enabled BOOLEAN NOT NULL DEFAULT FALSE, is_feed_enabled BOOLEAN NOT NULL DEFAULT FALSE,
feed_name TEXT NOT NULL, feed_name TEXT NOT NULL,
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),
title TEXT NOT NULL, title TEXT NOT NULL,
subtitle TEXT, subtitle TEXT,
items_in_feed INTEGER NOT NULL, items_in_feed INTEGER NOT NULL,
summary TEXT NOT NULL, summary TEXT NOT NULL,
displayed_author TEXT NOT NULL, displayed_author TEXT NOT NULL,
email TEXT NOT NULL, email TEXT NOT NULL,
image_url TEXT NOT NULL, image_url TEXT NOT NULL,
apple_category TEXT NOT NULL, apple_category TEXT NOT NULL,
apple_subcategory TEXT, apple_subcategory TEXT,
explicit TEXT NOT NULL, explicit TEXT NOT NULL,
default_media_type TEXT, default_media_type TEXT,
media_base_url TEXT, media_base_url TEXT,
podcast_guid TEXT, podcast_guid TEXT,
funding_url TEXT, funding_url TEXT,
funding_text TEXT, funding_text TEXT,
medium TEXT)""" medium TEXT)"
// Category table // Category table
if needsTable "category" then if needsTable "category" then
"""CREATE TABLE category ( "CREATE TABLE category (
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),
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
"""CREATE TABLE web_log_user ( "CREATE TABLE web_log_user (
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),
email TEXT NOT NULL, email TEXT NOT NULL,
first_name TEXT NOT NULL, first_name TEXT NOT NULL,
last_name TEXT NOT NULL, last_name TEXT NOT NULL,
preferred_name TEXT NOT NULL, preferred_name TEXT NOT NULL,
password_hash TEXT NOT NULL, password_hash TEXT NOT NULL,
salt TEXT NOT NULL, salt TEXT NOT NULL,
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
"""CREATE TABLE page ( "CREATE TABLE page (
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),
author_id TEXT NOT NULL REFERENCES web_log_user (id), author_id TEXT NOT NULL REFERENCES web_log_user (id),
title TEXT NOT NULL, title TEXT NOT NULL,
permalink TEXT NOT NULL, permalink TEXT NOT NULL,
prior_permalinks TEXT[] NOT NULL DEFAULT '{}', prior_permalinks TEXT[] NOT NULL DEFAULT '{}',
published_on TIMESTAMPTZ NOT NULL, published_on TIMESTAMPTZ NOT NULL,
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),
as_of TIMESTAMPTZ NOT NULL, as_of TIMESTAMPTZ NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (page_id, as_of))""" PRIMARY KEY (page_id, as_of))"
// Post tables // Post tables
if needsTable "post" then if needsTable "post" then
"""CREATE TABLE post ( "CREATE TABLE post (
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),
author_id TEXT NOT NULL REFERENCES web_log_user (id), author_id TEXT NOT NULL REFERENCES web_log_user (id),
status TEXT NOT NULL, status TEXT NOT NULL,
title TEXT NOT NULL, title TEXT NOT NULL,
permalink TEXT NOT NULL, permalink TEXT NOT NULL,
prior_permalinks TEXT[] NOT NULL DEFAULT '{}', prior_permalinks TEXT[] NOT NULL DEFAULT '{}',
published_on TIMESTAMPTZ, published_on TIMESTAMPTZ,
updated_on TIMESTAMPTZ NOT NULL, updated_on TIMESTAMPTZ NOT NULL,
template TEXT, template TEXT,
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),
as_of TIMESTAMPTZ NOT NULL, as_of TIMESTAMPTZ NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (post_id, as_of))""" PRIMARY KEY (post_id, as_of))"
if needsTable "post_comment" then if needsTable "post_comment" then
"""CREATE TABLE post_comment ( "CREATE TABLE post_comment (
id TEXT NOT NULL PRIMARY KEY, id TEXT NOT NULL 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,
name TEXT NOT NULL, name TEXT NOT NULL,
email TEXT NOT NULL, email TEXT NOT NULL,
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
"""CREATE TABLE tag_map ( "CREATE TABLE tag_map (
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
"""CREATE TABLE upload ( "CREATE TABLE upload (
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),
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)"
} }
|> Seq.iter (fun sql ->
let table = (sql.Split ' ')[2] Sql.existingConnection conn
log.LogInformation $"Creating {(sql.Split ' ')[2]} table..." |> Sql.executeTransactionAsync
Sql.existingConnection conn (sql
|> Sql.query sql |> Seq.map (fun s ->
|> Sql.executeNonQueryAsync log.LogInformation $"Creating {(s.Split ' ')[2]} table..."
|> Async.AwaitTask s, [ [] ])
|> Async.RunSynchronously |> List.ofSeq)
|> ignore) |> Async.AwaitTask
|> Async.RunSynchronously
|> ignore
} }

16
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 Npgsql
/// Middleware to derive the current web log /// Middleware to derive the current web log
type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>) = type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>) =
@ -58,6 +59,11 @@ module DataImplementation =
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) upcast RethinkDbData (conn, rethinkCfg, log)
elif hasConnStr "PostgreSQL" then
let log = sp.GetRequiredService<ILogger<PostgreSqlData>> ()
let conn = new NpgsqlConnection (connStr "PostgreSQL")
log.LogInformation $"Using PostgreSQL database {conn.Host}:{conn.Port}/{conn.Database}"
PostgreSqlData (conn, log)
else else
upcast createSQLite "Data Source=./myweblog.db;Cache=Shared" upcast createSQLite "Data Source=./myweblog.db;Cache=Shared"
@ -138,6 +144,16 @@ let rec main args =
// 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 builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath) |> ignore
| :? PostgreSqlData ->
// ADO.NET connections are designed to work as per-request instantiation
let cfg = sp.GetRequiredService<IConfiguration> ()
builder.Services.AddScoped<NpgsqlConnection> (fun sp ->
new NpgsqlConnection (cfg.GetConnectionString "PostgreSQL"))
|> ignore
builder.Services.AddScoped<IData, PostgreSqlData> () |> ignore
// Use SQLite for caching (for now)
let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./session.db"
builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath) |> ignore
| _ -> () | _ -> ()
let _ = builder.Services.AddSession(fun opts -> let _ = builder.Services.AddSession(fun opts ->