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

PostgreSQL data works

Browse Source 
- Add (de)serializer functions
- Add NodaTime support functions
This commit is contained in:
Daniel J. Summers 2022-08-20 16:26:59 -04:00
parent 80e7e26d51
commit 2131bd096b
27 changed files with 247 additions and 273 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -149,4 +149,30 @@ module Json =
let _ = ser.ConfigureForNodaTime DateTimeZoneProviders.Tzdb
// Handles DUs with no associated data, as well as option fields
ser.Converters.Add (CompactUnionJsonConverter ())
ser.NullValueHandling <- NullValueHandling.Ignore
ser.MissingMemberHandling <- MissingMemberHandling.Ignore
ser
/// Serializer settings extracted from a JsonSerializer (a property sure would be nice...)
let mutable private serializerSettings : JsonSerializerSettings option = None
/// Extract settings from the serializer to be used in JsonConvert calls
let settings (ser : JsonSerializer) =
if Option.isNone serializerSettings then
serializerSettings <- JsonSerializerSettings (
ConstructorHandling = ser.ConstructorHandling,
ContractResolver = ser.ContractResolver,
Converters = ser.Converters,
DefaultValueHandling = ser.DefaultValueHandling,
DateFormatHandling = ser.DateFormatHandling,
MetadataPropertyHandling = ser.MetadataPropertyHandling,
MissingMemberHandling = ser.MissingMemberHandling,
NullValueHandling = ser.NullValueHandling,
ObjectCreationHandling = ser.ObjectCreationHandling,
ReferenceLoopHandling = ser.ReferenceLoopHandling,
SerializationBinder = ser.SerializationBinder,
TraceWriter = ser.TraceWriter,
TypeNameAssemblyFormatHandling = ser.TypeNameAssemblyFormatHandling,
TypeNameHandling = ser.TypeNameHandling)
|> Some
serializerSettings.Value

4
src/MyWebLog.Data/Interfaces.fs
View File

@ -3,6 +3,7 @@ namespace MyWebLog.Data
open System.Threading.Tasks
open MyWebLog
open MyWebLog.ViewModels
open Newtonsoft.Json
open NodaTime
/// The result of a category deletion attempt
@ -326,6 +327,9 @@ type IData =
/// Web log user data functions
abstract member WebLogUser : IWebLogUserData
/// A JSON serializer for use in persistence
abstract member Serializer : JsonSerializer
/// Do any required start up data checks
abstract member StartUp : unit -> Task<unit>

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

@ -36,7 +36,7 @@ module private Helpers =
/// Create a parameter for the expire-at time
let expireParam =
typedParam "@expireAt"
typedParam "expireAt"
/// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog

5
src/MyWebLog.Data/Postgres/PostgresCategoryData.fs
View File

@ -38,8 +38,9 @@ type PostgresCategoryData (conn : NpgsqlConnection) =
ordered
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|> Seq.map (fun cat -> cat.Id)
|> Seq.append (Seq.singleton it.Id)
|> List.ofSeq
|> inClause "id" id
|> inClause "AND pc.category_id" "id" id
let postCount =
Sql.existingConnection conn
|> Sql.query $"
@ -48,7 +49,7 @@ type PostgresCategoryData (conn : NpgsqlConnection) =
INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = 'Published'
AND pc.category_id IN ({catIdSql})"
{catIdSql}"
|> Sql.parameters (webLogIdParam webLogId :: catIdParams)
|> Sql.executeRowAsync Map.toCount
|> Async.AwaitTask

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

@ -5,6 +5,7 @@ module MyWebLog.Data.Postgres.PostgresHelpers
open System
open System.Threading.Tasks
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
open NodaTime
open Npgsql
@ -21,30 +22,36 @@ let countName = "the_count"
let existsName = "does_exist"
/// Create the SQL and parameters for an IN clause
let inClause<'T> name (valueFunc: 'T -> string) (items : 'T list) =
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS}, @%s{name}{idx}", ($"@%s{name}{idx}", Sql.string (valueFunc it)) :: itemP)
(Seq.ofList items
|> Seq.map (fun it -> $"@%s{name}0", [ $"@%s{name}0", Sql.string (valueFunc it) ])
|> Seq.head)
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) =
if List.isEmpty items then "", []
else
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS}, @%s{paramName}{idx}", ($"@%s{paramName}{idx}", Sql.string (valueFunc it)) :: itemP)
(Seq.ofList items
|> Seq.map (fun it ->
$"%s{colNameAndPrefix} IN (@%s{paramName}0", [ $"@%s{paramName}0", Sql.string (valueFunc it) ])
|> Seq.head)
|> function sql, ps -> $"{sql})", ps
/// Create the SQL and parameters for the array equivalent of an IN clause
let arrayInClause<'T> name (valueFunc : 'T -> string) (items : 'T list) =
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS} OR %s{name} && ARRAY[@{name}{idx}]",
($"@{name}{idx}", Sql.string (valueFunc it)) :: itemP)
(Seq.ofList items
|> Seq.map (fun it ->
$"{name} && ARRAY[@{name}0]", [ $"@{name}0", Sql.string (valueFunc it) ])
|> Seq.head)
if List.isEmpty items then "TRUE = FALSE", []
else
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS} OR %s{name} && ARRAY[@{name}{idx}]",
($"@{name}{idx}", Sql.string (valueFunc it)) :: itemP)
(Seq.ofList items
|> Seq.map (fun it ->
$"{name} && ARRAY[@{name}0]", [ $"@{name}0", Sql.string (valueFunc it) ])
|> Seq.head)
/// Get the first result of the given query
let tryHead<'T> (query : Task<'T list>) = backgroundTask {
@ -83,32 +90,11 @@ module Map =
row.int countName
/// Create a custom feed from the current row
let toCustomFeed (row : RowReader) : CustomFeed =
{ Id = row.string "id" |> CustomFeedId
Source = row.string "source" |> CustomFeedSource.parse
Path = row.string "path" |> Permalink
Podcast =
match row.stringOrNone "title" with
| Some title ->
Some {
Title = title
Subtitle = row.stringOrNone "subtitle"
ItemsInFeed = row.int "items_in_feed"
Summary = row.string "summary"
DisplayedAuthor = row.string "displayed_author"
Email = row.string "email"
ImageUrl = row.string "image_url" |> Permalink
AppleCategory = row.string "apple_category"
AppleSubcategory = row.stringOrNone "apple_subcategory"
Explicit = row.string "explicit" |> ExplicitRating.parse
DefaultMediaType = row.stringOrNone "default_media_type"
MediaBaseUrl = row.stringOrNone "media_base_url"
PodcastGuid = row.uuidOrNone "podcast_guid"
FundingUrl = row.stringOrNone "funding_url"
FundingText = row.stringOrNone "funding_text"
Medium = row.stringOrNone "medium" |> Option.map PodcastMedium.parse
}
| None -> None
let toCustomFeed (ser : JsonSerializer) (row : RowReader) : CustomFeed =
{ Id = row.string "id" |> CustomFeedId
Source = row.string "source" |> CustomFeedSource.parse
Path = row.string "path" |> Permalink
Podcast = row.stringOrNone "podcast" |> Option.map (Utils.deserialize ser)
}
/// Get a true/false value as to whether an item exists
@ -126,7 +112,7 @@ module Map =
Permalink (row.string "permalink")
/// Create a page from the current row
let toPage (row : RowReader) : Page =
let toPage (ser : JsonSerializer) (row : RowReader) : Page =
{ Page.empty with
Id = row.string "id" |> PageId
WebLogId = row.string "web_log_id" |> WebLogId
@ -140,12 +126,12 @@ module Map =
Template = row.stringOrNone "template"
Text = row.string "page_text"
Metadata = row.stringOrNone "meta_items"
|> Option.map JsonConvert.DeserializeObject<MetaItem list>
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
}
/// Create a post from the current row
let toPost (row : RowReader) : Post =
let toPost (ser : JsonSerializer) (row : RowReader) : Post =
{ Post.empty with
Id = row.string "id" |> PostId
WebLogId = row.string "web_log_id" |> WebLogId
@ -158,6 +144,7 @@ module Map =
UpdatedOn = row.fieldValue<Instant> "updated_on"
Template = row.stringOrNone "template"
Text = row.string "post_text"
Episode = row.stringOrNone "episode" |> Option.map (Utils.deserialize ser)
CategoryIds = row.stringArrayOrNone "category_ids"
|> Option.map (Array.map CategoryId >> List.ofArray)
|> Option.defaultValue []
@ -165,10 +152,8 @@ module Map =
|> Option.map List.ofArray
|> Option.defaultValue []
Metadata = row.stringOrNone "meta_items"
|> Option.map JsonConvert.DeserializeObject<MetaItem list>
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
Episode = row.stringOrNone "episode"
|> Option.map JsonConvert.DeserializeObject<Episode>
}
/// Create a revision from the current row

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

@ -7,7 +7,7 @@ open Npgsql
open Npgsql.FSharp
/// PostgreSQL myWebLog page data implementation
type PostgresPageData (conn : NpgsqlConnection) =
type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS
@ -21,16 +21,19 @@ type PostgresPageData (conn : NpgsqlConnection) =
return { page with Revisions = revisions }
}
/// Shorthand to map to a page
let toPage = Map.toPage ser
/// Return a page with no text or revisions
let pageWithoutText row =
{ Map.toPage row with Text = "" }
{ toPage row with Text = "" }
/// The INSERT statement for a page revision
let revInsert = "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)"
/// Parameters for a revision INSERT statement
let revParams pageId rev = [
typedParam "@asOf" rev.AsOf
typedParam "asOf" rev.AsOf
"@pageId", Sql.string (PageId.toString pageId)
"@text", Sql.string (MarkupText.toString rev.Text)
]
@ -47,7 +50,7 @@ type PostgresPageData (conn : NpgsqlConnection) =
toDelete
|> List.map (fun it -> [
"@pageId", Sql.string (PageId.toString pageId)
typedParam "@asOf" it.AsOf
typedParam "asOf" it.AsOf
])
if not (List.isEmpty toAdd) then
revInsert, toAdd |> List.map (revParams pageId)
@ -94,7 +97,7 @@ type PostgresPageData (conn : NpgsqlConnection) =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM page WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters [ "@id", Sql.string (PageId.toString pageId); webLogIdParam webLogId ]
|> Sql.executeAsync Map.toPage
|> Sql.executeAsync toPage
|> tryHead
/// Find a complete page by its ID
@ -126,7 +129,7 @@ type PostgresPageData (conn : NpgsqlConnection) =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link"
|> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ]
|> Sql.executeAsync Map.toPage
|> Sql.executeAsync toPage
|> tryHead
/// Find the current permalink within a set of potential prior permalinks for the given web log
@ -148,7 +151,7 @@ type PostgresPageData (conn : NpgsqlConnection) =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toPage
|> Sql.executeAsync toPage
let! revisions =
Sql.existingConnection conn
|> Sql.query
@ -182,7 +185,7 @@ type PostgresPageData (conn : NpgsqlConnection) =
ORDER BY LOWER(title)
LIMIT @pageSize OFFSET @toSkip"
|> Sql.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
|> Sql.executeAsync Map.toPage
|> Sql.executeAsync toPage
/// The INSERT statement for a page
let pageInsert =
@ -204,10 +207,10 @@ type PostgresPageData (conn : NpgsqlConnection) =
"@isInPageList", Sql.bool page.IsInPageList
"@template", Sql.stringOrNone page.Template
"@text", Sql.string page.Text
"@metaItems", Sql.jsonb (JsonConvert.SerializeObject page.Metadata)
"@metaItems", Sql.jsonb (Utils.serialize ser page.Metadata)
"@priorPermalinks", Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
typedParam "@publishedOn" page.PublishedOn
typedParam "@updatedOn" page.UpdatedOn
typedParam "publishedOn" page.PublishedOn
typedParam "updatedOn" page.UpdatedOn
]
/// Restore pages from a backup
@ -237,7 +240,7 @@ type PostgresPageData (conn : NpgsqlConnection) =
updated_on = EXCLUDED.updated_on,
is_in_page_list = EXCLUDED.is_in_page_list,
template = EXCLUDED.template,
page_text = EXCLUDED.text,
page_text = EXCLUDED.page_text,
meta_items = EXCLUDED.meta_items"
|> Sql.parameters (pageParams page)
|> Sql.executeNonQueryAsync

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

@ -8,7 +8,7 @@ open Npgsql
open Npgsql.FSharp
/// PostgreSQL myWebLog post data implementation
type PostgresPostData (conn : NpgsqlConnection) =
type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS
@ -25,11 +25,14 @@ type PostgresPostData (conn : NpgsqlConnection) =
/// The SELECT statement for a post that will include category IDs
let selectPost =
"SELECT *, ARRAY(SELECT cat.category_id FROM post_category cat WHERE cat.post_id = p.id) AS category_ids
FROM post"
FROM post p"
/// Shorthand for mapping to a post
let toPost = Map.toPost ser
/// Return a post with no revisions, prior permalinks, or text
let postWithoutText row =
{ Map.toPost row with Text = "" }
{ toPost row with Text = "" }
/// The INSERT statement for a post/category cross-reference
let catInsert = "INSERT INTO post_category VALUES (@postId, @categoryId)"
@ -61,7 +64,7 @@ type PostgresPostData (conn : NpgsqlConnection) =
/// The parameters for adding a post revision
let revParams postId rev = [
typedParam "@asOf" rev.AsOf
typedParam "asOf" rev.AsOf
"@postId", Sql.string (PostId.toString postId)
"@text", Sql.string (MarkupText.toString rev.Text)
]
@ -78,7 +81,7 @@ type PostgresPostData (conn : NpgsqlConnection) =
toDelete
|> List.map (fun it -> [
"@postId", Sql.string (PostId.toString postId)
typedParam "@asOf" it.AsOf
typedParam "asOf" it.AsOf
])
if not (List.isEmpty toAdd) then
revInsert, toAdd |> List.map (revParams postId)
@ -107,7 +110,7 @@ type PostgresPostData (conn : NpgsqlConnection) =
Sql.existingConnection conn
|> Sql.query $"{selectPost} WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters [ "@id", Sql.string (PostId.toString postId); webLogIdParam webLogId ]
|> Sql.executeAsync Map.toPost
|> Sql.executeAsync toPost
|> tryHead
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
@ -115,7 +118,7 @@ type PostgresPostData (conn : NpgsqlConnection) =
Sql.existingConnection conn
|> Sql.query $"{selectPost} WHERE web_log_id = @webLogId AND permalink = @link"
|> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ]
|> Sql.executeAsync Map.toPost
|> Sql.executeAsync toPost
|> tryHead
/// Find a complete post by its ID for the given web log
@ -150,7 +153,7 @@ type PostgresPostData (conn : NpgsqlConnection) =
let linkSql, linkParams = arrayInClause "prior_permalinks" Permalink.toString permalinks
return!
Sql.existingConnection conn
|> Sql.query $"SELECT permalink FROM post WHERE web_log_id = @webLogId AND ({linkSql}"
|> Sql.query $"SELECT permalink FROM post WHERE web_log_id = @webLogId AND ({linkSql})"
|> Sql.parameters (webLogIdParam webLogId :: linkParams)
|> Sql.executeAsync Map.toPermalink
|> tryHead
@ -162,7 +165,7 @@ type PostgresPostData (conn : NpgsqlConnection) =
Sql.existingConnection conn
|> Sql.query $"{selectPost} WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toPost
|> Sql.executeAsync toPost
let! revisions =
Sql.existingConnection conn
|> Sql.query
@ -181,21 +184,21 @@ type PostgresPostData (conn : NpgsqlConnection) =
/// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
let catSql, catParams = inClause "catId" CategoryId.toString categoryIds
let catSql, catParams = inClause "AND pc.category_id" "catId" CategoryId.toString categoryIds
Sql.existingConnection conn
|> Sql.query $"
{selectPost} p
{selectPost}
INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND pc.category_id IN ({catSql})
{catSql}
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters
[ webLogIdParam webLogId
"@status", Sql.string (PostStatus.toString Published)
yield! catParams ]
|> Sql.executeAsync Map.toPost
|> Sql.executeAsync toPost
/// Get a page of posts for the given web log (excludes text and revisions)
let findPageOfPosts webLogId pageNbr postsPerPage =
@ -218,7 +221,7 @@ type PostgresPostData (conn : NpgsqlConnection) =
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString Published) ]
|> Sql.executeAsync Map.toPost
|> Sql.executeAsync toPost
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage =
@ -227,7 +230,7 @@ type PostgresPostData (conn : NpgsqlConnection) =
{selectPost}
WHERE web_log_id = @webLogId
AND status = @status
AND tag && ARRAY[@tag]
AND tags && ARRAY[@tag]
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters
@ -235,13 +238,13 @@ type PostgresPostData (conn : NpgsqlConnection) =
"@status", Sql.string (PostStatus.toString Published)
"@tag", Sql.string tag
]
|> Sql.executeAsync Map.toPost
|> Sql.executeAsync toPost
/// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask {
let queryParams = Sql.parameters [
let queryParams () = Sql.parameters [
webLogIdParam webLogId
typedParam "@publishedOn" publishedOn
typedParam "publishedOn" publishedOn
"@status", Sql.string (PostStatus.toString Published)
]
let! older =
@ -253,8 +256,8 @@ type PostgresPostData (conn : NpgsqlConnection) =
AND published_on < @publishedOn
ORDER BY published_on DESC
LIMIT 1"
|> queryParams
|> Sql.executeAsync Map.toPost
|> queryParams ()
|> Sql.executeAsync toPost
let! newer =
Sql.existingConnection conn
|> Sql.query $"
@ -264,8 +267,8 @@ type PostgresPostData (conn : NpgsqlConnection) =
AND published_on > @publishedOn
ORDER BY published_on
LIMIT 1"
|> queryParams
|> Sql.executeAsync Map.toPost
|> queryParams ()
|> Sql.executeAsync toPost
return List.tryHead older, List.tryHead newer
}
@ -289,14 +292,14 @@ type PostgresPostData (conn : NpgsqlConnection) =
"@permalink", Sql.string (Permalink.toString post.Permalink)
"@template", Sql.stringOrNone post.Template
"@text", Sql.string post.Text
"@episode", Sql.jsonbOrNone (post.Episode |> Option.map JsonConvert.SerializeObject)
"@priorPermalinks", Sql.stringArray (post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
"@episode", Sql.jsonbOrNone (post.Episode |> Option.map (Utils.serialize ser))
"@tags", Sql.stringArrayOrNone (if List.isEmpty post.Tags then None else Some (Array.ofList post.Tags))
"@metaItems",
if List.isEmpty post.Metadata then None else Some (JsonConvert.SerializeObject post.Metadata)
if List.isEmpty post.Metadata then None else Some (Utils.serialize ser post.Metadata)
|> Sql.jsonbOrNone
optParam "@publishedOn" post.PublishedOn
typedParam "@updatedOn" post.UpdatedOn
optParam "publishedOn" post.PublishedOn
typedParam "updatedOn" post.UpdatedOn
]
/// Save a post
@ -314,7 +317,7 @@ type PostgresPostData (conn : NpgsqlConnection) =
published_on = EXCLUDED.published_on,
updated_on = EXCLUDED.updated_on,
template = EXCLUDED.template,
post_text = EXCLUDED.text,
post_text = EXCLUDED.post_text,
tags = EXCLUDED.tags,
meta_items = EXCLUDED.meta_items,
episode = EXCLUDED.episode"

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

@ -54,9 +54,9 @@ type PostgresTagMapData (conn : NpgsqlConnection) =
/// Find any tag mappings in a list of tags for the given web log
let findMappingForTags tags webLogId =
let tagSql, tagParams = inClause "tag" id tags
let tagSql, tagParams = inClause "AND tag" "tag" id tags
Sql.existingConnection conn
|> Sql.query $"SELECT * FROM tag_map WHERE web_log_id = @webLogId AND tag IN ({tagSql}"
|> Sql.query $"SELECT * FROM tag_map WHERE web_log_id = @webLogId {tagSql}"
|> Sql.parameters (webLogIdParam webLogId :: tagParams)
|> Sql.executeAsync Map.toTagMap

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

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

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

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

120
src/MyWebLog.Data/Postgres/PostgresWebLogData.fs
View File

@ -2,11 +2,12 @@
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
open Npgsql
open Npgsql.FSharp
/// PostgreSQL myWebLog web log data implementation
type PostgresWebLogData (conn : NpgsqlConnection) =
type PostgresWebLogData (conn : NpgsqlConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS
@ -36,15 +37,16 @@ type PostgresWebLogData (conn : NpgsqlConnection) =
yield! rssParams webLog
]
/// The SELECT statement for custom feeds, which includes podcast feed settings if present
let feedSelect = "SELECT f.*, p.* FROM web_log_feed f LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id"
/// Shorthand to map a result to a custom feed
let toCustomFeed =
Map.toCustomFeed ser
/// Get the current custom feeds for a web log
let getCustomFeeds (webLog : WebLog) =
Sql.existingConnection conn
|> Sql.query $"{feedSelect} WHERE f.web_log_id = @webLogId"
|> Sql.query "SELECT * FROM web_log_feed WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLog.Id ]
|> Sql.executeAsync Map.toCustomFeed
|> Sql.executeAsync toCustomFeed
/// Append custom feeds to a web log
let appendCustomFeeds (webLog : WebLog) = backgroundTask {
@ -52,33 +54,13 @@ type PostgresWebLogData (conn : NpgsqlConnection) =
return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
}
/// The parameters to save a podcast feed
let podcastParams feedId (podcast : PodcastOptions) = [
"@feedId", Sql.string (CustomFeedId.toString feedId)
"@title", Sql.string podcast.Title
"@subtitle", Sql.stringOrNone podcast.Subtitle
"@itemsInFeed", Sql.int podcast.ItemsInFeed
"@summary", Sql.string podcast.Summary
"@displayedAuthor", Sql.string podcast.DisplayedAuthor
"@email", Sql.string podcast.Email
"@imageUrl", Sql.string (Permalink.toString podcast.ImageUrl)
"@appleCategory", Sql.string podcast.AppleCategory
"@appleSubcategory", Sql.stringOrNone podcast.AppleSubcategory
"@explicit", Sql.string (ExplicitRating.toString podcast.Explicit)
"@defaultMediaType", Sql.stringOrNone podcast.DefaultMediaType
"@mediaBaseUrl", Sql.stringOrNone podcast.MediaBaseUrl
"@podcastGuid", Sql.uuidOrNone podcast.PodcastGuid
"@fundingUrl", Sql.stringOrNone podcast.FundingUrl
"@fundingText", Sql.stringOrNone podcast.FundingText
"@medium", Sql.stringOrNone (podcast.Medium |> Option.map PodcastMedium.toString)
]
/// The parameters to save a custom feed
let feedParams webLogId (feed : CustomFeed) = [
webLogIdParam webLogId
"@id", Sql.string (CustomFeedId.toString feed.Id)
"@source", Sql.string (CustomFeedSource.toString feed.Source)
"@path", Sql.string (Permalink.toString feed.Path)
"@id", Sql.string (CustomFeedId.toString feed.Id)
"@source", Sql.string (CustomFeedSource.toString feed.Source)
"@path", Sql.string (Permalink.toString feed.Path)
"@podcast", Sql.jsonbOrNone (feed.Podcast |> Option.map (Utils.serialize ser))
]
/// Update the custom feeds for a web log
@ -93,55 +75,18 @@ type PostgresWebLogData (conn : NpgsqlConnection) =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
"DELETE FROM web_log_feed_podcast WHERE feed_id = @id;
DELETE FROM web_log_feed WHERE id = @id",
"DELETE FROM web_log_feed WHERE id = @id",
toDelete |> List.map (fun it -> [ "@id", Sql.string (CustomFeedId.toString it.Id) ])
if not (List.isEmpty toAddOrUpdate) then
"INSERT INTO web_log_feed (
id, web_log_id, source, path
id, web_log_id, source, path, podcast
) VALUES (
@id, @webLogId, @source, @path
@id, @webLogId, @source, @path, @podcast
) ON CONFLICT (id) DO UPDATE
SET source = EXCLUDED.source,
path = EXCLUDED.path",
SET source = EXCLUDED.source,
path = EXCLUDED.path,
podcast = EXCLUDED.podcast",
toAddOrUpdate |> List.map (feedParams webLog.Id)
let podcasts = toAddOrUpdate |> List.filter (fun it -> Option.isSome it.Podcast)
if not (List.isEmpty podcasts) then
"INSERT INTO web_log_feed_podcast (
feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url,
apple_category, apple_subcategory, explicit, default_media_type, media_base_url,
podcast_guid, funding_url, funding_text, medium
) VALUES (
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl,
@appleCategory, @appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl,
@podcastGuid, @fundingUrl, @fundingText, @medium
) ON CONFLICT (feed_id) DO UPDATE
SET title = EXCLUDED.title,
subtitle = EXCLUDED.subtitle,
items_in_feed = EXCLUDED.items_in_feed,
summary = EXCLUDED.summary,
displayed_author = EXCLUDED.displayed_author,
email = EXCLUDED.email,
image_url = EXCLUDED.image_url,
apple_category = EXCLUDED.apple_category,
apple_subcategory = EXCLUDED.apple_subcategory,
explicit = EXCLUDED.explicit,
default_media_type = EXCLUDED.default_media_type,
media_base_url = EXCLUDED.media_base_url,
podcast_guid = EXCLUDED.podcast_guid,
funding_url = EXCLUDED.funding_url,
funding_text = EXCLUDED.funding_text,
medium = EXCLUDED.medium",
podcasts |> List.map (fun it -> podcastParams it.Id it.Podcast.Value)
let hadPodcasts =
toAddOrUpdate
|> List.filter (fun it ->
match feeds |> List.tryFind (fun feed -> feed.Id = it.Id) with
| Some feed -> Option.isSome feed.Podcast && Option.isNone it.Podcast
| None -> false)
if not (List.isEmpty hadPodcasts) then
"DELETE FROM web_log_feed_podcast WHERE feed_id = @id",
hadPodcasts |> List.map (fun it -> [ "@id", Sql.string (CustomFeedId.toString it.Id) ])
]
()
}
@ -173,8 +118,8 @@ type PostgresWebLogData (conn : NpgsqlConnection) =
|> Sql.executeAsync Map.toWebLog
let! feeds =
Sql.existingConnection conn
|> Sql.query feedSelect
|> Sql.executeAsync (fun row -> WebLogId (row.string "web_log_id"), Map.toCustomFeed row)
|> Sql.query "SELECT * FROM web_log_feed"
|> Sql.executeAsync (fun row -> WebLogId (row.string "web_log_id"), toCustomFeed row)
return
webLogs
|> List.map (fun it ->
@ -191,20 +136,19 @@ type PostgresWebLogData (conn : NpgsqlConnection) =
let pageSubQuery = subQuery "page"
let! _ =
Sql.existingConnection conn
|> Sql.query $"""
DELETE FROM post_comment WHERE post_id IN {postSubQuery};
DELETE FROM post_revision WHERE post_id IN {postSubQuery};
DELETE FROM post_category WHERE post_id IN {postSubQuery};
DELETE FROM post WHERE web_log_id = @webLogId;
DELETE FROM page_revision WHERE page_id IN {pageSubQuery};
DELETE FROM page WHERE web_log_id = @webLogId;
DELETE FROM category WHERE web_log_id = @webLogId;
DELETE FROM tag_map WHERE web_log_id = @webLogId;
DELETE FROM upload WHERE web_log_id = @webLogId;
DELETE FROM web_log_user WHERE web_log_id = @webLogId;
DELETE FROM web_log_feed_podcast WHERE feed_id IN {subQuery "web_log_feed"};
DELETE FROM web_log_feed WHERE web_log_id = @webLogId;
DELETE FROM web_log WHERE id = @webLogId"""
|> Sql.query $"
DELETE FROM post_comment WHERE post_id IN {postSubQuery};
DELETE FROM post_revision WHERE post_id IN {postSubQuery};
DELETE FROM post_category WHERE post_id IN {postSubQuery};
DELETE FROM post WHERE web_log_id = @webLogId;
DELETE FROM page_revision WHERE page_id IN {pageSubQuery};
DELETE FROM page WHERE web_log_id = @webLogId;
DELETE FROM category WHERE web_log_id = @webLogId;
DELETE FROM tag_map WHERE web_log_id = @webLogId;
DELETE FROM upload WHERE web_log_id = @webLogId;
DELETE FROM web_log_user WHERE web_log_id = @webLogId;
DELETE FROM web_log_feed WHERE web_log_id = @webLogId;
DELETE FROM web_log WHERE id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeNonQueryAsync
()

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

@ -30,8 +30,8 @@ type PostgresWebLogUserData (conn : NpgsqlConnection) =
"@salt", Sql.uuid user.Salt
"@url", Sql.stringOrNone user.Url
"@accessLevel", Sql.string (AccessLevel.toString user.AccessLevel)
typedParam "@createdOn" user.CreatedOn
optParam "@lastSeenOn" user.LastSeenOn
typedParam "createdOn" user.CreatedOn
optParam "lastSeenOn" user.LastSeenOn
]
/// Find a user by their ID for the given web log
@ -83,10 +83,10 @@ type PostgresWebLogUserData (conn : NpgsqlConnection) =
/// Find the names of users by their IDs for the given web log
let findNames webLogId userIds = backgroundTask {
let idSql, idParams = inClause "id" WebLogUserId.toString userIds
let idSql, idParams = inClause "AND id" "id" WebLogUserId.toString userIds
let! users =
Sql.existingConnection conn
|> Sql.query $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND id IN ({idSql})"
|> Sql.query $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {idSql}"
|> Sql.parameters (webLogIdParam webLogId :: idParams)
|> Sql.executeAsync Map.toWebLogUser
return
@ -111,7 +111,7 @@ type PostgresWebLogUserData (conn : NpgsqlConnection) =
|> Sql.query "UPDATE web_log_user SET last_seen_on = @lastSeenOn WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters
[ webLogIdParam webLogId
typedParam "@lastSeenOn" (Utils.now ())
typedParam "lastSeenOn" (Noda.now ())
"@id", Sql.string (WebLogUserId.toString userId) ]
|> Sql.executeNonQueryAsync
()

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

@ -2,24 +2,27 @@
open Microsoft.Extensions.Logging
open MyWebLog.Data.Postgres
open Newtonsoft.Json
open Npgsql
open Npgsql.FSharp
/// Data implementation for PostgreSQL
type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>) =
type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, ser : JsonSerializer) =
interface IData with
member _.Category = PostgresCategoryData conn
member _.Page = PostgresPageData conn
member _.Post = PostgresPostData conn
member _.Page = PostgresPageData (conn, ser)
member _.Post = PostgresPostData (conn, ser)
member _.TagMap = PostgresTagMapData conn
member _.Theme = PostgresThemeData conn
member _.ThemeAsset = PostgresThemeAssetData conn
member _.Upload = PostgresUploadData conn
member _.WebLog = PostgresWebLogData conn
member _.WebLog = PostgresWebLogData (conn, ser)
member _.WebLogUser = PostgresWebLogUserData conn
member _.Serializer = ser
member _.StartUp () = backgroundTask {
let _ = NpgsqlConnection.GlobalTypeMapper.UseNodaTime ()
@ -77,27 +80,9 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>) =
id TEXT NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
source TEXT NOT NULL,
path TEXT NOT NULL)"
path TEXT NOT NULL,
podcast JSONB)"
"CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"
if needsTable "web_log_feed_podcast" then
"CREATE TABLE web_log_feed_podcast (
feed_id TEXT NOT NULL PRIMARY KEY REFERENCES web_log_feed (id),
title TEXT NOT NULL,
subtitle TEXT,
items_in_feed INTEGER NOT NULL,
summary TEXT NOT NULL,
displayed_author TEXT NOT NULL,
email TEXT NOT NULL,
image_url TEXT NOT NULL,
apple_category TEXT NOT NULL,
apple_subcategory TEXT,
explicit TEXT NOT NULL,
default_media_type TEXT,
media_base_url TEXT,
podcast_guid TEXT,
funding_url TEXT,
funding_text TEXT,
medium TEXT)"
// Category table
if needsTable "category" then
@ -120,7 +105,7 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>) =
last_name TEXT NOT NULL,
preferred_name TEXT NOT NULL,
password_hash TEXT NOT NULL,
salt TEXT NOT NULL,
salt UUID NOT NULL,
url TEXT,
access_level TEXT NOT NULL,
created_on TIMESTAMPTZ NOT NULL,

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

@ -1079,7 +1079,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! rethink {
withTable Table.WebLogUser
get userId
update [ nameof WebLogUser.empty.LastSeenOn, Utils.now () :> obj ]
update [ nameof WebLogUser.empty.LastSeenOn, Noda.now () :> obj ]
write; withRetryOnce; ignoreResult conn
}
| None -> ()
@ -1102,6 +1102,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
}
}
member _.Serializer =
Net.Converter.Serializer
member _.StartUp () = backgroundTask {
let! dbs = rethink<string list> { dbList; result; withRetryOnce conn }
if not (dbs |> List.contains config.Database) then

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

@ -122,7 +122,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
AND web_log_id = @webLogId"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId)
cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Utils.now ()))
cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Noda.now ()))
] |> ignore
let! _ = cmd.ExecuteNonQueryAsync ()
()

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

@ -3,9 +3,10 @@ namespace MyWebLog.Data
open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging
open MyWebLog.Data.SQLite
open Newtonsoft.Json
/// SQLite myWebLog data implementation
type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonSerializer) =
/// The connection for this instance
member _.Conn = conn
@ -31,6 +32,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
member _.WebLog = SQLiteWebLogData conn
member _.WebLogUser = SQLiteWebLogUserData conn
member _.Serializer = ser
member _.StartUp () = backgroundTask {
use cmd = conn.CreateCommand ()

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

@ -37,6 +37,13 @@ let diffPermalinks oldLinks newLinks =
let diffRevisions oldRevs newRevs =
diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.ToUnixTimeTicks ()}|{MarkupText.toString rev.Text}")
/// Get the current instant
let now () =
NodaTime.SystemClock.Instance.GetCurrentInstant ()
open MyWebLog.Converters
open Newtonsoft.Json
/// Serialize an object to JSON
let serialize<'T> ser (item : 'T) =
JsonConvert.SerializeObject (item, Json.settings ser)
/// Deserialize a JSON string
let deserialize<'T> (ser : JsonSerializer) value =
JsonConvert.DeserializeObject<'T> (value, Json.settings ser)

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

@ -83,7 +83,7 @@ module Comment =
Email = ""
Url = None
Status = Pending
PostedOn = Instant.MinValue
PostedOn = Noda.epoch
Text = ""
}
@ -141,8 +141,8 @@ module Page =
AuthorId = WebLogUserId.empty
Title = ""
Permalink = Permalink.empty
PublishedOn = Instant.MinValue
UpdatedOn = Instant.MinValue
PublishedOn = Noda.epoch
UpdatedOn = Noda.epoch
IsInPageList = false
Template = None
Text = ""
@ -216,7 +216,7 @@ module Post =
Title = ""
Permalink = Permalink.empty
PublishedOn = None
UpdatedOn = Instant.MinValue
UpdatedOn = Noda.epoch
Text = ""
Template = None
CategoryIds = []
@ -301,7 +301,7 @@ module ThemeAsset =
/// An empty theme asset
let empty =
{ Id = ThemeAssetId (ThemeId "", "")
UpdatedOn = Instant.MinValue
UpdatedOn = Noda.epoch
Data = [||]
}
@ -332,7 +332,7 @@ module Upload =
{ Id = UploadId.empty
WebLogId = WebLogId.empty
Path = Permalink.empty
UpdatedOn = Instant.MinValue
UpdatedOn = Noda.epoch
Data = [||]
}
@ -473,7 +473,7 @@ module WebLogUser =
Salt = Guid.Empty
Url = None
AccessLevel = Author
CreatedOn = Instant.FromUnixTimeSeconds 0L
CreatedOn = Noda.epoch
LastSeenOn = None
}

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

@ -13,6 +13,19 @@ module private Helpers =
Convert.ToBase64String(Guid.NewGuid().ToByteArray ()).Replace('/', '_').Replace('+', '-').Substring (0, 22)
/// Functions to support NodaTime manipulation
module Noda =
/// The clock to use when getting "now" (will make mutable for testing)
let clock : IClock = SystemClock.Instance
/// The Unix epoch
let epoch = Instant.FromUnixTimeSeconds 0L
/// The current Instant, with fractional seconds truncated
let now () = Instant.FromUnixTimeSeconds (clock.GetCurrentInstant().ToUnixTimeSeconds ())
/// A user's access level
type AccessLevel =
/// The user may create and publish posts and edit the ones they have created
@ -291,7 +304,7 @@ module Revision =
/// An empty revision
let empty =
{ AsOf = Instant.MinValue
{ AsOf = Noda.epoch
Text = Html ""
}

5
src/MyWebLog/Caches.fs
View File

@ -11,7 +11,6 @@ module Extensions =
open Microsoft.AspNetCore.Antiforgery
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection
open NodaTime
/// Hold variable for the configured generator string
let mutable private generatorString : string option = None
@ -21,9 +20,6 @@ module Extensions =
/// The anti-CSRF service
member this.AntiForgery = this.RequestServices.GetRequiredService<IAntiforgery> ()
/// The system clock
member this.Clock = this.RequestServices.GetRequiredService<IClock> ()
/// The cross-site request forgery token set for this request
member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this
@ -60,7 +56,6 @@ module Extensions =
defaultArg (this.UserAccessLevel |> Option.map (AccessLevel.hasAccess level)) false
open System.Collections.Concurrent
/// <summary>

27
src/MyWebLog/Handlers/Admin.fs
View File

@ -13,23 +13,22 @@ module Dashboard =
// GET /admin/dashboard
let user : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let getCount (f : WebLogId -> Task<int>) = f ctx.WebLog.Id
let data = ctx.Data
let posts = getCount (data.Post.CountByStatus Published)
let drafts = getCount (data.Post.CountByStatus Draft)
let pages = getCount data.Page.CountAll
let listed = getCount data.Page.CountListed
let cats = getCount data.Category.CountAll
let topCats = getCount data.Category.CountTopLevel
let! _ = Task.WhenAll (posts, drafts, pages, listed, cats, topCats)
let data = ctx.Data
let! posts = getCount (data.Post.CountByStatus Published)
let! drafts = getCount (data.Post.CountByStatus Draft)
let! pages = getCount data.Page.CountAll
let! listed = getCount data.Page.CountListed
let! cats = getCount data.Category.CountAll
let! topCats = getCount data.Category.CountTopLevel
return!
hashForPage "Dashboard"
|> addToHash ViewContext.Model {
Posts = posts.Result
Drafts = drafts.Result
Pages = pages.Result
ListedPages = listed.Result
Categories = cats.Result
TopLevelCategories = topCats.Result
Posts = posts
Drafts = drafts
Pages = pages
ListedPages = listed
Categories = cats
TopLevelCategories = topCats
}
|> adminView "dashboard" next ctx
}

4
src/MyWebLog/Handlers/Page.fs
View File

@ -145,7 +145,7 @@ let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update
{ pg with
Revisions = { rev with AsOf = ctx.Clock.GetCurrentInstant () }
Revisions = { rev with AsOf = Noda.now () }
:: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
}
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
@ -171,7 +171,7 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> ()
let data = ctx.Data
let now = ctx.Clock.GetCurrentInstant ()
let now = Noda.now ()
let tryPage =
if model.IsNew then
{ Page.empty with

4
src/MyWebLog/Handlers/Post.fs
View File

@ -350,7 +350,7 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update
{ post with
Revisions = { rev with AsOf = ctx.Clock.GetCurrentInstant () }
Revisions = { rev with AsOf = Noda.now () }
:: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
}
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
@ -388,7 +388,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
| Some post when canEdit post.AuthorId ctx ->
let priorCats = post.CategoryIds
let updatedPost =
model.UpdatePost post (ctx.Clock.GetCurrentInstant ())
model.UpdatePost post (Noda.now ())
|> function
| post ->
if model.SetPublished then

2
src/MyWebLog/Handlers/Upload.fs
View File

@ -145,7 +145,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let upload = Seq.head ctx.Request.Form.Files
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
Path.GetExtension(upload.FileName).ToLowerInvariant ())
let now = ctx.Clock.GetCurrentInstant ()
let now = Noda.now ()
let localNow = WebLog.localTime ctx.WebLog now
let year = localNow.ToString "yyyy"
let month = localNow.ToString "MM"

2
src/MyWebLog/Handlers/User.fs
View File

@ -203,7 +203,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
{ WebLogUser.empty with
Id = WebLogUserId.create ()
WebLogId = ctx.WebLog.Id
CreatedOn = ctx.Clock.GetCurrentInstant ()
CreatedOn = Noda.now ()
} |> someTask
else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
match! tryUser with

19
src/MyWebLog/Maintenance.fs
View File

@ -156,7 +156,6 @@ let loadTheme (args : string[]) (sp : IServiceProvider) = task {
/// Back up a web log's data
module Backup =
open System.Threading.Tasks
open MyWebLog.Converters
open Newtonsoft.Json
@ -252,7 +251,7 @@ module Backup =
Uploads : EncodedUpload list
}
/// Create a JSON serializer (uses RethinkDB data implementation's JSON converters)
/// Create a JSON serializer
let private getSerializer prettyOutput =
let serializer = Json.configure (JsonSerializer.CreateDefault ())
if prettyOutput then serializer.Formatting <- Formatting.Indented
@ -382,7 +381,8 @@ module Backup =
printfn ""
printfn "- Importing theme..."
do! data.Theme.Save restore.Theme
let! _ = restore.Assets |> List.map (EncodedAsset.toAsset >> data.ThemeAsset.Save) |> Task.WhenAll
restore.Assets
|> List.iter (EncodedAsset.toAsset >> data.ThemeAsset.Save >> Async.AwaitTask >> Async.RunSynchronously)
// Restore web log data
@ -393,19 +393,22 @@ module Backup =
do! data.WebLogUser.Restore restore.Users
printfn "- Restoring categories and tag mappings..."
do! data.TagMap.Restore restore.TagMappings
do! data.Category.Restore restore.Categories
if not (List.isEmpty restore.TagMappings) then do! data.TagMap.Restore restore.TagMappings
if not (List.isEmpty restore.Categories) then do! data.Category.Restore restore.Categories
printfn "- Restoring pages..."
do! data.Page.Restore restore.Pages
if not (List.isEmpty restore.Pages) then
printfn "here"
do! data.Page.Restore restore.Pages
printfn "- Restoring posts..."
do! data.Post.Restore restore.Posts
if not (List.isEmpty restore.Posts) then do! data.Post.Restore restore.Posts
// TODO: comments not yet implemented
printfn "- Restoring uploads..."
do! data.Upload.Restore (restore.Uploads |> List.map EncodedUpload.toUpload)
if not (List.isEmpty restore.Uploads) then
do! data.Upload.Restore (restore.Uploads |> List.map EncodedUpload.toUpload)
displayStats "Restored for <>NAME<>:" restore.WebLog restore
}

18
src/MyWebLog/Program.fs
View File

@ -30,28 +30,28 @@ open System
open Microsoft.Extensions.DependencyInjection
open MyWebLog.Data
open Newtonsoft.Json
open NodaTime
open Npgsql
/// Logic to obtain a data connection and implementation based on configured values
module DataImplementation =
open MyWebLog.Converters
// open Npgsql.Logging
open RethinkDb.Driver.FSharp
open RethinkDb.Driver.Net
/// Get the configured data implementation
let get (sp : IServiceProvider) : IData * JsonSerializer =
let get (sp : IServiceProvider) : IData =
let config = sp.GetRequiredService<IConfiguration> ()
let await it = (Async.AwaitTask >> Async.RunSynchronously) it
let connStr name = config.GetConnectionString name
let hasConnStr name = (connStr >> isNull >> not) name
let createSQLite connStr : IData * JsonSerializer =
let createSQLite connStr : IData =
let log = sp.GetRequiredService<ILogger<SQLiteData>> ()
let conn = new SqliteConnection (connStr)
log.LogInformation $"Using SQLite database {conn.DataSource}"
await (SQLiteData.setUpConnection conn)
SQLiteData (conn, log), Json.configure (JsonSerializer.CreateDefault ())
SQLiteData (conn, log, Json.configure (JsonSerializer.CreateDefault ()))
if hasConnStr "SQLite" then
createSQLite (connStr "SQLite")
@ -60,12 +60,13 @@ module DataImplementation =
let _ = Json.configure Converter.Serializer
let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB")
let conn = await (rethinkCfg.CreateConnectionAsync log)
RethinkDbData (conn, rethinkCfg, log), Converter.Serializer
RethinkDbData (conn, rethinkCfg, log)
elif hasConnStr "PostgreSQL" then
let log = sp.GetRequiredService<ILogger<PostgresData>> ()
// NpgsqlLogManager.Provider <- ConsoleLoggingProvider NpgsqlLogLevel.Debug
let conn = new NpgsqlConnection (connStr "PostgreSQL")
log.LogInformation $"Using PostgreSQL database {conn.Host}:{conn.Port}/{conn.Database}"
PostgresData (conn, log), Json.configure (JsonSerializer.CreateDefault ())
PostgresData (conn, log, Json.configure (JsonSerializer.CreateDefault ()))
else
createSQLite "Data Source=./myweblog.db;Cache=Shared"
@ -118,9 +119,8 @@ let rec main args =
let _ = builder.Services.AddAntiforgery ()
let sp = builder.Services.BuildServiceProvider ()
let data, serializer = DataImplementation.get sp
let _ = builder.Services.AddSingleton<JsonSerializer> serializer
let _ = builder.Services.AddSingleton<IClock> SystemClock.Instance
let data = DataImplementation.get sp
let _ = builder.Services.AddSingleton<JsonSerializer> data.Serializer
task {
do! data.StartUp ()