v2 RC2 (#33)
* Add PostgreSQL back end (#30) * Upgrade password storage (#32) * Change podcast/episode storage for SQLite (#29) * Move date/time handling to NodaTime (#31)
This commit is contained in:
parent
1ec664ad24
commit
5f3daa1de9
|
@ -5,6 +5,6 @@
|
||||||
<AssemblyVersion>2.0.0.0</AssemblyVersion>
|
<AssemblyVersion>2.0.0.0</AssemblyVersion>
|
||||||
<FileVersion>2.0.0.0</FileVersion>
|
<FileVersion>2.0.0.0</FileVersion>
|
||||||
<Version>2.0.0</Version>
|
<Version>2.0.0</Version>
|
||||||
<VersionSuffix>rc1</VersionSuffix>
|
<VersionSuffix>rc2</VersionSuffix>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
</Project>
|
</Project>
|
||||||
|
|
|
@ -122,12 +122,13 @@ module Json =
|
||||||
(string >> WebLogUserId) reader.Value
|
(string >> WebLogUserId) reader.Value
|
||||||
|
|
||||||
open Microsoft.FSharpLu.Json
|
open Microsoft.FSharpLu.Json
|
||||||
|
open NodaTime
|
||||||
/// All converters to use for data conversion
|
open NodaTime.Serialization.JsonNet
|
||||||
let all () : JsonConverter seq =
|
|
||||||
seq {
|
/// Configure a serializer to use these converters
|
||||||
// Our converters
|
let configure (ser : JsonSerializer) =
|
||||||
CategoryIdConverter ()
|
// Our converters
|
||||||
|
[ CategoryIdConverter () :> JsonConverter
|
||||||
CommentIdConverter ()
|
CommentIdConverter ()
|
||||||
CustomFeedIdConverter ()
|
CustomFeedIdConverter ()
|
||||||
CustomFeedSourceConverter ()
|
CustomFeedSourceConverter ()
|
||||||
|
@ -143,6 +144,35 @@ module Json =
|
||||||
UploadIdConverter ()
|
UploadIdConverter ()
|
||||||
WebLogIdConverter ()
|
WebLogIdConverter ()
|
||||||
WebLogUserIdConverter ()
|
WebLogUserIdConverter ()
|
||||||
// Handles DUs with no associated data, as well as option fields
|
] |> List.iter ser.Converters.Add
|
||||||
CompactUnionJsonConverter ()
|
// NodaTime
|
||||||
}
|
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
|
||||||
|
|
|
@ -1,9 +1,10 @@
|
||||||
namespace MyWebLog.Data
|
namespace MyWebLog.Data
|
||||||
|
|
||||||
open System
|
|
||||||
open System.Threading.Tasks
|
open System.Threading.Tasks
|
||||||
open MyWebLog
|
open MyWebLog
|
||||||
open MyWebLog.ViewModels
|
open MyWebLog.ViewModels
|
||||||
|
open Newtonsoft.Json
|
||||||
|
open NodaTime
|
||||||
|
|
||||||
/// The result of a category deletion attempt
|
/// The result of a category deletion attempt
|
||||||
type CategoryDeleteResult =
|
type CategoryDeleteResult =
|
||||||
|
@ -137,7 +138,7 @@ type IPostData =
|
||||||
WebLogId -> tag : string -> pageNbr : int -> postsPerPage : int -> Task<Post list>
|
WebLogId -> tag : string -> pageNbr : int -> postsPerPage : int -> Task<Post list>
|
||||||
|
|
||||||
/// Find the next older and newer post for the given published date/time (excluding revisions and prior permalinks)
|
/// Find the next older and newer post for the given published date/time (excluding revisions and prior permalinks)
|
||||||
abstract member FindSurroundingPosts : WebLogId -> publishedOn : DateTime -> Task<Post option * Post option>
|
abstract member FindSurroundingPosts : WebLogId -> publishedOn : Instant -> Task<Post option * Post option>
|
||||||
|
|
||||||
/// Restore posts from a backup
|
/// Restore posts from a backup
|
||||||
abstract member Restore : Post list -> Task<unit>
|
abstract member Restore : Post list -> Task<unit>
|
||||||
|
@ -326,6 +327,9 @@ type IData =
|
||||||
/// Web log user data functions
|
/// Web log user data functions
|
||||||
abstract member WebLogUser : IWebLogUserData
|
abstract member WebLogUser : IWebLogUserData
|
||||||
|
|
||||||
|
/// A JSON serializer for use in persistence
|
||||||
|
abstract member Serializer : JsonSerializer
|
||||||
|
|
||||||
/// Do any required start up data checks
|
/// Do any required start up data checks
|
||||||
abstract member StartUp : unit -> Task<unit>
|
abstract member StartUp : unit -> Task<unit>
|
||||||
|
|
|
@ -5,10 +5,16 @@
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.7" />
|
<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.8" />
|
||||||
|
<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="6.0.0" />
|
||||||
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" />
|
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" />
|
||||||
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
|
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
|
||||||
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
|
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
|
||||||
|
<PackageReference Include="NodaTime" Version="3.1.2" />
|
||||||
|
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" />
|
||||||
|
<PackageReference Include="Npgsql" Version="6.0.6" />
|
||||||
|
<PackageReference Include="Npgsql.FSharp" Version="5.3.0" />
|
||||||
|
<PackageReference Include="Npgsql.NodaTime" Version="6.0.6" />
|
||||||
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
|
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
|
||||||
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
|
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
|
||||||
<PackageReference Update="FSharp.Core" Version="6.0.5" />
|
<PackageReference Update="FSharp.Core" Version="6.0.5" />
|
||||||
|
@ -29,6 +35,17 @@
|
||||||
<Compile Include="SQLite\SQLiteWebLogData.fs" />
|
<Compile Include="SQLite\SQLiteWebLogData.fs" />
|
||||||
<Compile Include="SQLite\SQLiteWebLogUserData.fs" />
|
<Compile Include="SQLite\SQLiteWebLogUserData.fs" />
|
||||||
<Compile Include="SQLiteData.fs" />
|
<Compile Include="SQLiteData.fs" />
|
||||||
|
<Compile Include="Postgres\PostgresHelpers.fs" />
|
||||||
|
<Compile Include="Postgres\PostgresCache.fs" />
|
||||||
|
<Compile Include="Postgres\PostgresCategoryData.fs" />
|
||||||
|
<Compile Include="Postgres\PostgresPageData.fs" />
|
||||||
|
<Compile Include="Postgres\PostgresPostData.fs" />
|
||||||
|
<Compile Include="Postgres\PostgresTagMapData.fs" />
|
||||||
|
<Compile Include="Postgres\PostgresThemeData.fs" />
|
||||||
|
<Compile Include="Postgres\PostgresUploadData.fs" />
|
||||||
|
<Compile Include="Postgres\PostgresWebLogData.fs" />
|
||||||
|
<Compile Include="Postgres\PostgresWebLogUserData.fs" />
|
||||||
|
<Compile Include="PostgresData.fs" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
</Project>
|
</Project>
|
||||||
|
|
210
src/MyWebLog.Data/Postgres/PostgresCache.fs
Normal file
210
src/MyWebLog.Data/Postgres/PostgresCache.fs
Normal file
|
@ -0,0 +1,210 @@
|
||||||
|
namespace MyWebLog.Data.Postgres
|
||||||
|
|
||||||
|
open System.Threading
|
||||||
|
open System.Threading.Tasks
|
||||||
|
open Microsoft.Extensions.Caching.Distributed
|
||||||
|
open NodaTime
|
||||||
|
open Npgsql.FSharp
|
||||||
|
|
||||||
|
/// Helper types and functions for the cache
|
||||||
|
[<AutoOpen>]
|
||||||
|
module private Helpers =
|
||||||
|
|
||||||
|
/// The cache entry
|
||||||
|
type Entry =
|
||||||
|
{ /// The ID of the cache entry
|
||||||
|
Id : string
|
||||||
|
|
||||||
|
/// The value to be cached
|
||||||
|
Payload : byte[]
|
||||||
|
|
||||||
|
/// When this entry will expire
|
||||||
|
ExpireAt : Instant
|
||||||
|
|
||||||
|
/// The duration by which the expiration should be pushed out when being refreshed
|
||||||
|
SlidingExpiration : Duration option
|
||||||
|
|
||||||
|
/// The must-expire-by date/time for the cache entry
|
||||||
|
AbsoluteExpiration : Instant option
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Run a task synchronously
|
||||||
|
let sync<'T> (it : Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously)
|
||||||
|
|
||||||
|
/// Get the current instant
|
||||||
|
let getNow () = SystemClock.Instance.GetCurrentInstant ()
|
||||||
|
|
||||||
|
/// Create a parameter for the expire-at time
|
||||||
|
let expireParam =
|
||||||
|
typedParam "expireAt"
|
||||||
|
|
||||||
|
|
||||||
|
/// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog
|
||||||
|
type DistributedCache (connStr : string) =
|
||||||
|
|
||||||
|
// ~~~ INITIALIZATION ~~~
|
||||||
|
|
||||||
|
do
|
||||||
|
task {
|
||||||
|
let! exists =
|
||||||
|
Sql.connect connStr
|
||||||
|
|> Sql.query $"
|
||||||
|
SELECT EXISTS
|
||||||
|
(SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session')
|
||||||
|
AS {existsName}"
|
||||||
|
|> Sql.executeRowAsync Map.toExists
|
||||||
|
if not exists then
|
||||||
|
let! _ =
|
||||||
|
Sql.connect connStr
|
||||||
|
|> Sql.query
|
||||||
|
"CREATE TABLE session (
|
||||||
|
id TEXT NOT NULL PRIMARY KEY,
|
||||||
|
payload BYTEA NOT NULL,
|
||||||
|
expire_at TIMESTAMPTZ NOT NULL,
|
||||||
|
sliding_expiration INTERVAL,
|
||||||
|
absolute_expiration TIMESTAMPTZ);
|
||||||
|
CREATE INDEX idx_session_expiration ON session (expire_at)"
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
()
|
||||||
|
} |> sync
|
||||||
|
|
||||||
|
// ~~~ SUPPORT FUNCTIONS ~~~
|
||||||
|
|
||||||
|
/// Get an entry, updating it for sliding expiration
|
||||||
|
let getEntry key = backgroundTask {
|
||||||
|
let idParam = "@id", Sql.string key
|
||||||
|
let! tryEntry =
|
||||||
|
Sql.connect connStr
|
||||||
|
|> Sql.query "SELECT * FROM session WHERE id = @id"
|
||||||
|
|> Sql.parameters [ idParam ]
|
||||||
|
|> Sql.executeAsync (fun row ->
|
||||||
|
{ Id = row.string "id"
|
||||||
|
Payload = row.bytea "payload"
|
||||||
|
ExpireAt = row.fieldValue<Instant> "expire_at"
|
||||||
|
SlidingExpiration = row.fieldValueOrNone<Duration> "sliding_expiration"
|
||||||
|
AbsoluteExpiration = row.fieldValueOrNone<Instant> "absolute_expiration" })
|
||||||
|
|> tryHead
|
||||||
|
match tryEntry with
|
||||||
|
| Some entry ->
|
||||||
|
let now = getNow ()
|
||||||
|
let slideExp = defaultArg entry.SlidingExpiration Duration.MinValue
|
||||||
|
let absExp = defaultArg entry.AbsoluteExpiration Instant.MinValue
|
||||||
|
let needsRefresh, item =
|
||||||
|
if entry.ExpireAt = absExp then false, entry
|
||||||
|
elif slideExp = Duration.MinValue && absExp = Instant.MinValue then false, entry
|
||||||
|
elif absExp > Instant.MinValue && entry.ExpireAt.Plus slideExp > absExp then
|
||||||
|
true, { entry with ExpireAt = absExp }
|
||||||
|
else true, { entry with ExpireAt = now.Plus slideExp }
|
||||||
|
if needsRefresh then
|
||||||
|
let! _ =
|
||||||
|
Sql.connect connStr
|
||||||
|
|> Sql.query "UPDATE session SET expire_at = @expireAt WHERE id = @id"
|
||||||
|
|> Sql.parameters [ expireParam item.ExpireAt; idParam ]
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
()
|
||||||
|
return if item.ExpireAt > now then Some entry else None
|
||||||
|
| None -> return None
|
||||||
|
}
|
||||||
|
|
||||||
|
/// The last time expired entries were purged (runs every 30 minutes)
|
||||||
|
let mutable lastPurge = Instant.MinValue
|
||||||
|
|
||||||
|
/// Purge expired entries every 30 minutes
|
||||||
|
let purge () = backgroundTask {
|
||||||
|
let now = getNow ()
|
||||||
|
if lastPurge.Plus (Duration.FromMinutes 30L) < now then
|
||||||
|
let! _ =
|
||||||
|
Sql.connect connStr
|
||||||
|
|> Sql.query "DELETE FROM session WHERE expire_at < @expireAt"
|
||||||
|
|> Sql.parameters [ expireParam now ]
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
lastPurge <- now
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Remove a cache entry
|
||||||
|
let removeEntry key = backgroundTask {
|
||||||
|
let! _ =
|
||||||
|
Sql.connect connStr
|
||||||
|
|> Sql.query "DELETE FROM session WHERE id = @id"
|
||||||
|
|> Sql.parameters [ "@id", Sql.string key ]
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Save an entry
|
||||||
|
let saveEntry (opts : DistributedCacheEntryOptions) key payload = backgroundTask {
|
||||||
|
let now = getNow ()
|
||||||
|
let expireAt, slideExp, absExp =
|
||||||
|
if opts.SlidingExpiration.HasValue then
|
||||||
|
let slide = Duration.FromTimeSpan opts.SlidingExpiration.Value
|
||||||
|
now.Plus slide, Some slide, None
|
||||||
|
elif opts.AbsoluteExpiration.HasValue then
|
||||||
|
let exp = Instant.FromDateTimeOffset opts.AbsoluteExpiration.Value
|
||||||
|
exp, None, Some exp
|
||||||
|
elif opts.AbsoluteExpirationRelativeToNow.HasValue then
|
||||||
|
let exp = now.Plus (Duration.FromTimeSpan opts.AbsoluteExpirationRelativeToNow.Value)
|
||||||
|
exp, None, Some exp
|
||||||
|
else
|
||||||
|
// Default to 1 hour sliding expiration
|
||||||
|
let slide = Duration.FromHours 1
|
||||||
|
now.Plus slide, Some slide, None
|
||||||
|
let! _ =
|
||||||
|
Sql.connect connStr
|
||||||
|
|> Sql.query
|
||||||
|
"INSERT INTO session (
|
||||||
|
id, payload, expire_at, sliding_expiration, absolute_expiration
|
||||||
|
) VALUES (
|
||||||
|
@id, @payload, @expireAt, @slideExp, @absExp
|
||||||
|
) ON CONFLICT (id) DO UPDATE
|
||||||
|
SET payload = EXCLUDED.payload,
|
||||||
|
expire_at = EXCLUDED.expire_at,
|
||||||
|
sliding_expiration = EXCLUDED.sliding_expiration,
|
||||||
|
absolute_expiration = EXCLUDED.absolute_expiration"
|
||||||
|
|> Sql.parameters
|
||||||
|
[ "@id", Sql.string key
|
||||||
|
"@payload", Sql.bytea payload
|
||||||
|
expireParam expireAt
|
||||||
|
optParam "slideExp" slideExp
|
||||||
|
optParam "absExp" absExp ]
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
// ~~~ IMPLEMENTATION FUNCTIONS ~~~
|
||||||
|
|
||||||
|
/// Retrieve the data for a cache entry
|
||||||
|
let get key (_ : CancellationToken) = backgroundTask {
|
||||||
|
match! getEntry key with
|
||||||
|
| Some entry ->
|
||||||
|
do! purge ()
|
||||||
|
return entry.Payload
|
||||||
|
| None -> return null
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Refresh an entry
|
||||||
|
let refresh key (cancelToken : CancellationToken) = backgroundTask {
|
||||||
|
let! _ = get key cancelToken
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Remove an entry
|
||||||
|
let remove key (_ : CancellationToken) = backgroundTask {
|
||||||
|
do! removeEntry key
|
||||||
|
do! purge ()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Set an entry
|
||||||
|
let set key value options (_ : CancellationToken) = backgroundTask {
|
||||||
|
do! saveEntry options key value
|
||||||
|
do! purge ()
|
||||||
|
}
|
||||||
|
|
||||||
|
interface IDistributedCache with
|
||||||
|
member this.Get key = get key CancellationToken.None |> sync
|
||||||
|
member this.GetAsync (key, token) = get key token
|
||||||
|
member this.Refresh key = refresh key CancellationToken.None |> sync
|
||||||
|
member this.RefreshAsync (key, token) = refresh key token
|
||||||
|
member this.Remove key = remove key CancellationToken.None |> sync
|
||||||
|
member this.RemoveAsync (key, token) = remove key token
|
||||||
|
member this.Set (key, value, options) = set key value options CancellationToken.None |> sync
|
||||||
|
member this.SetAsync (key, value, options, token) = set key value options token
|
172
src/MyWebLog.Data/Postgres/PostgresCategoryData.fs
Normal file
172
src/MyWebLog.Data/Postgres/PostgresCategoryData.fs
Normal file
|
@ -0,0 +1,172 @@
|
||||||
|
namespace MyWebLog.Data.Postgres
|
||||||
|
|
||||||
|
open MyWebLog
|
||||||
|
open MyWebLog.Data
|
||||||
|
open Npgsql
|
||||||
|
open Npgsql.FSharp
|
||||||
|
|
||||||
|
/// PostgreSQL myWebLog category data implementation
|
||||||
|
type PostgresCategoryData (conn : NpgsqlConnection) =
|
||||||
|
|
||||||
|
/// Count all categories for the given web log
|
||||||
|
let countAll webLogId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"SELECT COUNT(id) AS {countName} FROM category WHERE web_log_id = @webLogId"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeRowAsync Map.toCount
|
||||||
|
|
||||||
|
/// Count all top-level categories for the given web log
|
||||||
|
let countTopLevel webLogId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"SELECT COUNT(id) AS {countName} FROM category WHERE web_log_id = @webLogId AND parent_id IS NULL"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeRowAsync Map.toCount
|
||||||
|
|
||||||
|
/// Retrieve all categories for the given web log in a DotLiquid-friendly format
|
||||||
|
let findAllForView webLogId = backgroundTask {
|
||||||
|
let! cats =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM category WHERE web_log_id = @webLogId ORDER BY LOWER(name)"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeAsync Map.toCategory
|
||||||
|
let ordered = Utils.orderByHierarchy cats None None []
|
||||||
|
let counts =
|
||||||
|
ordered
|
||||||
|
|> Seq.map (fun it ->
|
||||||
|
// Parent category post counts include posts in subcategories
|
||||||
|
let catIdSql, catIdParams =
|
||||||
|
ordered
|
||||||
|
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|
||||||
|
|> Seq.map (fun cat -> cat.Id)
|
||||||
|
|> Seq.append (Seq.singleton it.Id)
|
||||||
|
|> List.ofSeq
|
||||||
|
|> inClause "AND pc.category_id" "id" id
|
||||||
|
let postCount =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"
|
||||||
|
SELECT COUNT(DISTINCT p.id) AS {countName}
|
||||||
|
FROM post p
|
||||||
|
INNER JOIN post_category pc ON pc.post_id = p.id
|
||||||
|
WHERE p.web_log_id = @webLogId
|
||||||
|
AND p.status = 'Published'
|
||||||
|
{catIdSql}"
|
||||||
|
|> Sql.parameters (webLogIdParam webLogId :: catIdParams)
|
||||||
|
|> Sql.executeRowAsync Map.toCount
|
||||||
|
|> Async.AwaitTask
|
||||||
|
|> Async.RunSynchronously
|
||||||
|
it.Id, postCount)
|
||||||
|
|> List.ofSeq
|
||||||
|
return
|
||||||
|
ordered
|
||||||
|
|> Seq.map (fun cat ->
|
||||||
|
{ cat with
|
||||||
|
PostCount = counts
|
||||||
|
|> List.tryFind (fun c -> fst c = cat.Id)
|
||||||
|
|> Option.map snd
|
||||||
|
|> Option.defaultValue 0
|
||||||
|
})
|
||||||
|
|> Array.ofSeq
|
||||||
|
}
|
||||||
|
/// Find a category by its ID for the given web log
|
||||||
|
let findById catId webLogId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM category WHERE id = @id AND web_log_id = @webLogId"
|
||||||
|
|> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeAsync Map.toCategory
|
||||||
|
|> tryHead
|
||||||
|
|
||||||
|
/// Find all categories for the given web log
|
||||||
|
let findByWebLog webLogId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM category WHERE web_log_id = @webLogId"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeAsync Map.toCategory
|
||||||
|
|
||||||
|
|
||||||
|
/// Delete a category
|
||||||
|
let delete catId webLogId = backgroundTask {
|
||||||
|
match! findById catId webLogId with
|
||||||
|
| Some cat ->
|
||||||
|
// Reassign any children to the category's parent category
|
||||||
|
let parentParam = "@parentId", Sql.string (CategoryId.toString catId)
|
||||||
|
let! hasChildren =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"SELECT EXISTS (SELECT 1 FROM category WHERE parent_id = @parentId) AS {existsName}"
|
||||||
|
|> Sql.parameters [ parentParam ]
|
||||||
|
|> Sql.executeRowAsync Map.toExists
|
||||||
|
if hasChildren then
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId"
|
||||||
|
|> Sql.parameters
|
||||||
|
[ parentParam
|
||||||
|
"@newParentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) ]
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
()
|
||||||
|
// Delete the category off all posts where it is assigned, and the category itself
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query
|
||||||
|
"DELETE FROM post_category
|
||||||
|
WHERE category_id = @id
|
||||||
|
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId);
|
||||||
|
DELETE FROM category WHERE id = @id"
|
||||||
|
|> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
return if hasChildren then ReassignedChildCategories else CategoryDeleted
|
||||||
|
| None -> return CategoryNotFound
|
||||||
|
}
|
||||||
|
|
||||||
|
/// The INSERT statement for a category
|
||||||
|
let catInsert =
|
||||||
|
"INSERT INTO category (
|
||||||
|
id, web_log_id, name, slug, description, parent_id
|
||||||
|
) VALUES (
|
||||||
|
@id, @webLogId, @name, @slug, @description, @parentId
|
||||||
|
)"
|
||||||
|
|
||||||
|
/// Create parameters for a category insert / update
|
||||||
|
let catParameters (cat : Category) = [
|
||||||
|
webLogIdParam cat.WebLogId
|
||||||
|
"@id", Sql.string (CategoryId.toString cat.Id)
|
||||||
|
"@name", Sql.string cat.Name
|
||||||
|
"@slug", Sql.string cat.Slug
|
||||||
|
"@description", Sql.stringOrNone cat.Description
|
||||||
|
"@parentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString)
|
||||||
|
]
|
||||||
|
|
||||||
|
/// Save a category
|
||||||
|
let save cat = backgroundTask {
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"
|
||||||
|
{catInsert} ON CONFLICT (id) DO UPDATE
|
||||||
|
SET name = EXCLUDED.name,
|
||||||
|
slug = EXCLUDED.slug,
|
||||||
|
description = EXCLUDED.description,
|
||||||
|
parent_id = EXCLUDED.parent_id"
|
||||||
|
|> Sql.parameters (catParameters cat)
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Restore categories from a backup
|
||||||
|
let restore cats = backgroundTask {
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.executeTransactionAsync [
|
||||||
|
catInsert, cats |> List.map catParameters
|
||||||
|
]
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
interface ICategoryData with
|
||||||
|
member _.Add cat = save cat
|
||||||
|
member _.CountAll webLogId = countAll webLogId
|
||||||
|
member _.CountTopLevel webLogId = countTopLevel webLogId
|
||||||
|
member _.FindAllForView webLogId = findAllForView webLogId
|
||||||
|
member _.FindById catId webLogId = findById catId webLogId
|
||||||
|
member _.FindByWebLog webLogId = findByWebLog webLogId
|
||||||
|
member _.Delete catId webLogId = delete catId webLogId
|
||||||
|
member _.Restore cats = restore cats
|
||||||
|
member _.Update cat = save cat
|
240
src/MyWebLog.Data/Postgres/PostgresHelpers.fs
Normal file
240
src/MyWebLog.Data/Postgres/PostgresHelpers.fs
Normal file
|
@ -0,0 +1,240 @@
|
||||||
|
/// Helper functions for the PostgreSQL data implementation
|
||||||
|
[<AutoOpen>]
|
||||||
|
module MyWebLog.Data.Postgres.PostgresHelpers
|
||||||
|
|
||||||
|
open System
|
||||||
|
open System.Threading.Tasks
|
||||||
|
open MyWebLog
|
||||||
|
open MyWebLog.Data
|
||||||
|
open Newtonsoft.Json
|
||||||
|
open NodaTime
|
||||||
|
open Npgsql
|
||||||
|
open Npgsql.FSharp
|
||||||
|
|
||||||
|
/// Create a SQL parameter for the web log ID
|
||||||
|
let webLogIdParam webLogId =
|
||||||
|
"@webLogId", Sql.string (WebLogId.toString webLogId)
|
||||||
|
|
||||||
|
/// The name of the field to select to be able to use Map.toCount
|
||||||
|
let countName = "the_count"
|
||||||
|
|
||||||
|
/// The name of the field to select to be able to use Map.toExists
|
||||||
|
let existsName = "does_exist"
|
||||||
|
|
||||||
|
/// Create the SQL and parameters for an IN clause
|
||||||
|
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) =
|
||||||
|
if List.isEmpty items then "", []
|
||||||
|
else
|
||||||
|
let mutable idx = 0
|
||||||
|
items
|
||||||
|
|> List.skip 1
|
||||||
|
|> List.fold (fun (itemS, itemP) it ->
|
||||||
|
idx <- idx + 1
|
||||||
|
$"{itemS}, @%s{paramName}{idx}", ($"@%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) =
|
||||||
|
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 {
|
||||||
|
let! results = query
|
||||||
|
return List.tryHead results
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Create a parameter for a non-standard type
|
||||||
|
let typedParam<'T> name (it : 'T) =
|
||||||
|
$"@%s{name}", Sql.parameter (NpgsqlParameter ($"@{name}", it))
|
||||||
|
|
||||||
|
/// Create a parameter for a possibly-missing non-standard type
|
||||||
|
let optParam<'T> name (it : 'T option) =
|
||||||
|
let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value)
|
||||||
|
p.ParameterName, Sql.parameter p
|
||||||
|
|
||||||
|
/// Mapping functions for SQL queries
|
||||||
|
module Map =
|
||||||
|
|
||||||
|
/// Map an id field to a category ID
|
||||||
|
let toCategoryId (row : RowReader) =
|
||||||
|
CategoryId (row.string "id")
|
||||||
|
|
||||||
|
/// Create a category from the current row
|
||||||
|
let toCategory (row : RowReader) : Category =
|
||||||
|
{ Id = toCategoryId row
|
||||||
|
WebLogId = row.string "web_log_id" |> WebLogId
|
||||||
|
Name = row.string "name"
|
||||||
|
Slug = row.string "slug"
|
||||||
|
Description = row.stringOrNone "description"
|
||||||
|
ParentId = row.stringOrNone "parent_id" |> Option.map CategoryId
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Get a count from a row
|
||||||
|
let toCount (row : RowReader) =
|
||||||
|
row.int countName
|
||||||
|
|
||||||
|
/// Create a custom feed from the current row
|
||||||
|
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
|
||||||
|
let toExists (row : RowReader) =
|
||||||
|
row.bool existsName
|
||||||
|
|
||||||
|
/// Create a meta item from the current row
|
||||||
|
let toMetaItem (row : RowReader) : MetaItem =
|
||||||
|
{ Name = row.string "name"
|
||||||
|
Value = row.string "value"
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Create a permalink from the current row
|
||||||
|
let toPermalink (row : RowReader) =
|
||||||
|
Permalink (row.string "permalink")
|
||||||
|
|
||||||
|
/// Create a page from the current row
|
||||||
|
let toPage (ser : JsonSerializer) (row : RowReader) : Page =
|
||||||
|
{ Page.empty with
|
||||||
|
Id = row.string "id" |> PageId
|
||||||
|
WebLogId = row.string "web_log_id" |> WebLogId
|
||||||
|
AuthorId = row.string "author_id" |> WebLogUserId
|
||||||
|
Title = row.string "title"
|
||||||
|
Permalink = toPermalink row
|
||||||
|
PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray
|
||||||
|
PublishedOn = row.fieldValue<Instant> "published_on"
|
||||||
|
UpdatedOn = row.fieldValue<Instant> "updated_on"
|
||||||
|
IsInPageList = row.bool "is_in_page_list"
|
||||||
|
Template = row.stringOrNone "template"
|
||||||
|
Text = row.string "page_text"
|
||||||
|
Metadata = row.stringOrNone "meta_items"
|
||||||
|
|> Option.map (Utils.deserialize ser)
|
||||||
|
|> Option.defaultValue []
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Create a post from the current row
|
||||||
|
let toPost (ser : JsonSerializer) (row : RowReader) : Post =
|
||||||
|
{ Post.empty with
|
||||||
|
Id = row.string "id" |> PostId
|
||||||
|
WebLogId = row.string "web_log_id" |> WebLogId
|
||||||
|
AuthorId = row.string "author_id" |> WebLogUserId
|
||||||
|
Status = row.string "status" |> PostStatus.parse
|
||||||
|
Title = row.string "title"
|
||||||
|
Permalink = toPermalink row
|
||||||
|
PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray
|
||||||
|
PublishedOn = row.fieldValueOrNone<Instant> "published_on"
|
||||||
|
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 []
|
||||||
|
Tags = row.stringArrayOrNone "tags"
|
||||||
|
|> Option.map List.ofArray
|
||||||
|
|> Option.defaultValue []
|
||||||
|
Metadata = row.stringOrNone "meta_items"
|
||||||
|
|> Option.map (Utils.deserialize ser)
|
||||||
|
|> Option.defaultValue []
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Create a revision from the current row
|
||||||
|
let toRevision (row : RowReader) : Revision =
|
||||||
|
{ AsOf = row.fieldValue<Instant> "as_of"
|
||||||
|
Text = row.string "revision_text" |> MarkupText.parse
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Create a tag mapping from the current row
|
||||||
|
let toTagMap (row : RowReader) : TagMap =
|
||||||
|
{ Id = row.string "id" |> TagMapId
|
||||||
|
WebLogId = row.string "web_log_id" |> WebLogId
|
||||||
|
Tag = row.string "tag"
|
||||||
|
UrlValue = row.string "url_value"
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Create a theme from the current row (excludes templates)
|
||||||
|
let toTheme (row : RowReader) : Theme =
|
||||||
|
{ Theme.empty with
|
||||||
|
Id = row.string "id" |> ThemeId
|
||||||
|
Name = row.string "name"
|
||||||
|
Version = row.string "version"
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Create a theme asset from the current row
|
||||||
|
let toThemeAsset includeData (row : RowReader) : ThemeAsset =
|
||||||
|
{ Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
|
||||||
|
UpdatedOn = row.fieldValue<Instant> "updated_on"
|
||||||
|
Data = if includeData then row.bytea "data" else [||]
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Create a theme template from the current row
|
||||||
|
let toThemeTemplate includeText (row : RowReader) : ThemeTemplate =
|
||||||
|
{ Name = row.string "name"
|
||||||
|
Text = if includeText then row.string "template" else ""
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Create an uploaded file from the current row
|
||||||
|
let toUpload includeData (row : RowReader) : Upload =
|
||||||
|
{ Id = row.string "id" |> UploadId
|
||||||
|
WebLogId = row.string "web_log_id" |> WebLogId
|
||||||
|
Path = row.string "path" |> Permalink
|
||||||
|
UpdatedOn = row.fieldValue<Instant> "updated_on"
|
||||||
|
Data = if includeData then row.bytea "data" else [||]
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Create a web log from the current row
|
||||||
|
let toWebLog (row : RowReader) : WebLog =
|
||||||
|
{ Id = row.string "id" |> WebLogId
|
||||||
|
Name = row.string "name"
|
||||||
|
Slug = row.string "slug"
|
||||||
|
Subtitle = row.stringOrNone "subtitle"
|
||||||
|
DefaultPage = row.string "default_page"
|
||||||
|
PostsPerPage = row.int "posts_per_page"
|
||||||
|
ThemeId = row.string "theme_id" |> ThemeId
|
||||||
|
UrlBase = row.string "url_base"
|
||||||
|
TimeZone = row.string "time_zone"
|
||||||
|
AutoHtmx = row.bool "auto_htmx"
|
||||||
|
Uploads = row.string "uploads" |> UploadDestination.parse
|
||||||
|
Rss = {
|
||||||
|
IsFeedEnabled = row.bool "is_feed_enabled"
|
||||||
|
FeedName = row.string "feed_name"
|
||||||
|
ItemsInFeed = row.intOrNone "items_in_feed"
|
||||||
|
IsCategoryEnabled = row.bool "is_category_enabled"
|
||||||
|
IsTagEnabled = row.bool "is_tag_enabled"
|
||||||
|
Copyright = row.stringOrNone "copyright"
|
||||||
|
CustomFeeds = []
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/// 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"
|
||||||
|
Url = row.stringOrNone "url"
|
||||||
|
AccessLevel = row.string "access_level" |> AccessLevel.parse
|
||||||
|
CreatedOn = row.fieldValue<Instant> "created_on"
|
||||||
|
LastSeenOn = row.fieldValueOrNone<Instant> "last_seen_on"
|
||||||
|
}
|
281
src/MyWebLog.Data/Postgres/PostgresPageData.fs
Normal file
281
src/MyWebLog.Data/Postgres/PostgresPageData.fs
Normal file
|
@ -0,0 +1,281 @@
|
||||||
|
namespace MyWebLog.Data.Postgres
|
||||||
|
|
||||||
|
open MyWebLog
|
||||||
|
open MyWebLog.Data
|
||||||
|
open Newtonsoft.Json
|
||||||
|
open Npgsql
|
||||||
|
open Npgsql.FSharp
|
||||||
|
|
||||||
|
/// PostgreSQL myWebLog page data implementation
|
||||||
|
type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
|
||||||
|
|
||||||
|
// SUPPORT FUNCTIONS
|
||||||
|
|
||||||
|
/// Append revisions and permalinks to a page
|
||||||
|
let appendPageRevisions (page : Page) = backgroundTask {
|
||||||
|
let! revisions =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC"
|
||||||
|
|> Sql.parameters [ "@pageId", Sql.string (PageId.toString page.Id) ]
|
||||||
|
|> Sql.executeAsync Map.toRevision
|
||||||
|
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 =
|
||||||
|
{ 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
|
||||||
|
"@pageId", Sql.string (PageId.toString pageId)
|
||||||
|
"@text", Sql.string (MarkupText.toString rev.Text)
|
||||||
|
]
|
||||||
|
|
||||||
|
/// Update a page's revisions
|
||||||
|
let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
|
||||||
|
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
|
||||||
|
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.executeTransactionAsync [
|
||||||
|
if not (List.isEmpty toDelete) then
|
||||||
|
"DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf",
|
||||||
|
toDelete
|
||||||
|
|> List.map (fun it -> [
|
||||||
|
"@pageId", Sql.string (PageId.toString pageId)
|
||||||
|
typedParam "asOf" it.AsOf
|
||||||
|
])
|
||||||
|
if not (List.isEmpty toAdd) then
|
||||||
|
revInsert, toAdd |> List.map (revParams pageId)
|
||||||
|
]
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// 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
|
||||||
|
|
||||||
|
/// Get all pages for a web log (without text, revisions, prior permalinks, or metadata)
|
||||||
|
let all webLogId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeAsync pageWithoutText
|
||||||
|
|
||||||
|
/// Count all pages for the given web log
|
||||||
|
let countAll webLogId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"SELECT COUNT(id) AS {countName} FROM page WHERE web_log_id = @webLogId"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeRowAsync Map.toCount
|
||||||
|
|
||||||
|
/// Count all pages shown in the page list for the given web log
|
||||||
|
let countListed webLogId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> 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.executeRowAsync Map.toCount
|
||||||
|
|
||||||
|
/// Find a page by its ID (without revisions)
|
||||||
|
let findById pageId webLogId =
|
||||||
|
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 toPage
|
||||||
|
|> tryHead
|
||||||
|
|
||||||
|
/// Find a complete page by its ID
|
||||||
|
let findFullById pageId webLogId = backgroundTask {
|
||||||
|
match! findById pageId webLogId with
|
||||||
|
| Some page ->
|
||||||
|
let! withMore = appendPageRevisions page
|
||||||
|
return Some withMore
|
||||||
|
| None -> return None
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Delete a page by its ID
|
||||||
|
let delete pageId webLogId = backgroundTask {
|
||||||
|
match! pageExists pageId webLogId with
|
||||||
|
| true ->
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query
|
||||||
|
"DELETE FROM page_revision WHERE page_id = @id;
|
||||||
|
DELETE FROM page WHERE id = @id"
|
||||||
|
|> Sql.parameters [ "@id", Sql.string (PageId.toString pageId) ]
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
return true
|
||||||
|
| false -> return false
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Find a page by its permalink for the given web log
|
||||||
|
let findByPermalink permalink webLogId =
|
||||||
|
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 toPage
|
||||||
|
|> tryHead
|
||||||
|
|
||||||
|
/// Find the current permalink within a set of potential prior permalinks for the given web log
|
||||||
|
let findCurrentPermalink permalinks webLogId = backgroundTask {
|
||||||
|
if List.isEmpty permalinks then return None
|
||||||
|
else
|
||||||
|
let linkSql, linkParams = arrayInClause "prior_permalinks" Permalink.toString permalinks
|
||||||
|
return!
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"SELECT permalink FROM page WHERE web_log_id = @webLogId AND ({linkSql})"
|
||||||
|
|> Sql.parameters (webLogIdParam webLogId :: linkParams)
|
||||||
|
|> Sql.executeAsync Map.toPermalink
|
||||||
|
|> tryHead
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Get all complete pages for the given web log
|
||||||
|
let findFullByWebLog webLogId = backgroundTask {
|
||||||
|
let! pages =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeAsync toPage
|
||||||
|
let! revisions =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query
|
||||||
|
"SELECT *
|
||||||
|
FROM page_revision pr
|
||||||
|
INNER JOIN page p ON p.id = pr.page_id
|
||||||
|
WHERE p.web_log_id = @webLogId
|
||||||
|
ORDER BY pr.as_of DESC"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeAsync (fun row -> PageId (row.string "page_id"), Map.toRevision row)
|
||||||
|
return
|
||||||
|
pages
|
||||||
|
|> List.map (fun it ->
|
||||||
|
{ it with Revisions = revisions |> List.filter (fun r -> fst r = it.Id) |> List.map snd })
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Get all listed pages for the given web log (without revisions or text)
|
||||||
|
let findListed webLogId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND is_in_page_list = TRUE ORDER BY LOWER(title)"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeAsync pageWithoutText
|
||||||
|
|
||||||
|
/// Get a page of pages for the given web log (without revisions)
|
||||||
|
let findPageOfPages webLogId pageNbr =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query
|
||||||
|
"SELECT *
|
||||||
|
FROM page
|
||||||
|
WHERE web_log_id = @webLogId
|
||||||
|
ORDER BY LOWER(title)
|
||||||
|
LIMIT @pageSize OFFSET @toSkip"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
|
||||||
|
|> Sql.executeAsync toPage
|
||||||
|
|
||||||
|
/// The INSERT statement for a page
|
||||||
|
let pageInsert =
|
||||||
|
"INSERT INTO page (
|
||||||
|
id, web_log_id, author_id, title, permalink, prior_permalinks, published_on, updated_on, is_in_page_list,
|
||||||
|
template, page_text, meta_items
|
||||||
|
) VALUES (
|
||||||
|
@id, @webLogId, @authorId, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn, @isInPageList,
|
||||||
|
@template, @text, @metaItems
|
||||||
|
)"
|
||||||
|
|
||||||
|
/// The parameters for saving a page
|
||||||
|
let pageParams (page : Page) = [
|
||||||
|
webLogIdParam page.WebLogId
|
||||||
|
"@id", Sql.string (PageId.toString page.Id)
|
||||||
|
"@authorId", Sql.string (WebLogUserId.toString page.AuthorId)
|
||||||
|
"@title", Sql.string page.Title
|
||||||
|
"@permalink", Sql.string (Permalink.toString page.Permalink)
|
||||||
|
"@isInPageList", Sql.bool page.IsInPageList
|
||||||
|
"@template", Sql.stringOrNone page.Template
|
||||||
|
"@text", Sql.string page.Text
|
||||||
|
"@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
|
||||||
|
]
|
||||||
|
|
||||||
|
/// Restore pages from a backup
|
||||||
|
let restore (pages : Page list) = backgroundTask {
|
||||||
|
let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.executeTransactionAsync [
|
||||||
|
pageInsert, pages |> List.map pageParams
|
||||||
|
revInsert, revisions |> List.map (fun (pageId, rev) -> revParams pageId rev)
|
||||||
|
]
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// 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.page_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
|
||||||
|
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
|
||||||
|
match! pageExists pageId webLogId with
|
||||||
|
| true ->
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "UPDATE page SET prior_permalinks = @prior WHERE id = @id"
|
||||||
|
|> Sql.parameters
|
||||||
|
[ "@id", Sql.string (PageId.toString pageId)
|
||||||
|
"@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ]
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
return true
|
||||||
|
| false -> return false
|
||||||
|
}
|
||||||
|
|
||||||
|
interface IPageData with
|
||||||
|
member _.Add page = save page
|
||||||
|
member _.All webLogId = all webLogId
|
||||||
|
member _.CountAll webLogId = countAll webLogId
|
||||||
|
member _.CountListed webLogId = countListed webLogId
|
||||||
|
member _.Delete pageId webLogId = delete pageId webLogId
|
||||||
|
member _.FindById pageId webLogId = findById pageId webLogId
|
||||||
|
member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId
|
||||||
|
member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
|
||||||
|
member _.FindFullById pageId webLogId = findFullById pageId webLogId
|
||||||
|
member _.FindFullByWebLog webLogId = findFullByWebLog webLogId
|
||||||
|
member _.FindListed webLogId = findListed webLogId
|
||||||
|
member _.FindPageOfPages webLogId pageNbr = findPageOfPages webLogId pageNbr
|
||||||
|
member _.Restore pages = restore pages
|
||||||
|
member _.Update page = save page
|
||||||
|
member _.UpdatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks
|
378
src/MyWebLog.Data/Postgres/PostgresPostData.fs
Normal file
378
src/MyWebLog.Data/Postgres/PostgresPostData.fs
Normal file
|
@ -0,0 +1,378 @@
|
||||||
|
namespace MyWebLog.Data.Postgres
|
||||||
|
|
||||||
|
open MyWebLog
|
||||||
|
open MyWebLog.Data
|
||||||
|
open Newtonsoft.Json
|
||||||
|
open NodaTime
|
||||||
|
open Npgsql
|
||||||
|
open Npgsql.FSharp
|
||||||
|
|
||||||
|
/// PostgreSQL myWebLog post data implementation
|
||||||
|
type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
|
||||||
|
|
||||||
|
// SUPPORT FUNCTIONS
|
||||||
|
|
||||||
|
/// Append revisions to a post
|
||||||
|
let appendPostRevisions (post : Post) = backgroundTask {
|
||||||
|
let! revisions =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT as_of, revision_text FROM post_revision WHERE post_id = @id ORDER BY as_of DESC"
|
||||||
|
|> Sql.parameters [ "@id", Sql.string (PostId.toString post.Id) ]
|
||||||
|
|> Sql.executeAsync Map.toRevision
|
||||||
|
return { post with Revisions = revisions }
|
||||||
|
}
|
||||||
|
|
||||||
|
/// 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 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 =
|
||||||
|
{ toPost row with Text = "" }
|
||||||
|
|
||||||
|
/// The INSERT statement for a post/category cross-reference
|
||||||
|
let catInsert = "INSERT INTO post_category VALUES (@postId, @categoryId)"
|
||||||
|
|
||||||
|
/// Parameters for adding or updating a post/category cross-reference
|
||||||
|
let catParams postId cat = [
|
||||||
|
"@postId", Sql.string (PostId.toString postId)
|
||||||
|
"categoryId", Sql.string (CategoryId.toString cat)
|
||||||
|
]
|
||||||
|
|
||||||
|
/// Update a post's assigned categories
|
||||||
|
let updatePostCategories postId oldCats newCats = backgroundTask {
|
||||||
|
let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString
|
||||||
|
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.executeTransactionAsync [
|
||||||
|
if not (List.isEmpty toDelete) then
|
||||||
|
"DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId",
|
||||||
|
toDelete |> List.map (catParams postId)
|
||||||
|
if not (List.isEmpty toAdd) then
|
||||||
|
catInsert, toAdd |> List.map (catParams postId)
|
||||||
|
]
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// The INSERT statement for a post revision
|
||||||
|
let revInsert = "INSERT INTO post_revision VALUES (@postId, @asOf, @text)"
|
||||||
|
|
||||||
|
/// The parameters for adding a post revision
|
||||||
|
let revParams postId rev = [
|
||||||
|
typedParam "asOf" rev.AsOf
|
||||||
|
"@postId", Sql.string (PostId.toString postId)
|
||||||
|
"@text", Sql.string (MarkupText.toString rev.Text)
|
||||||
|
]
|
||||||
|
|
||||||
|
/// Update a post's revisions
|
||||||
|
let updatePostRevisions postId oldRevs newRevs = backgroundTask {
|
||||||
|
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
|
||||||
|
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.executeTransactionAsync [
|
||||||
|
if not (List.isEmpty toDelete) then
|
||||||
|
"DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf",
|
||||||
|
toDelete
|
||||||
|
|> List.map (fun it -> [
|
||||||
|
"@postId", Sql.string (PostId.toString postId)
|
||||||
|
typedParam "asOf" it.AsOf
|
||||||
|
])
|
||||||
|
if not (List.isEmpty toAdd) then
|
||||||
|
revInsert, toAdd |> List.map (revParams postId)
|
||||||
|
]
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// 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
|
||||||
|
|
||||||
|
/// Count posts in a status for the given web log
|
||||||
|
let countByStatus status webLogId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> 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.executeRowAsync Map.toCount
|
||||||
|
|
||||||
|
/// Find a post by its ID for the given web log (excluding revisions)
|
||||||
|
let findById postId webLogId =
|
||||||
|
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 toPost
|
||||||
|
|> tryHead
|
||||||
|
|
||||||
|
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
|
||||||
|
let findByPermalink permalink webLogId =
|
||||||
|
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 toPost
|
||||||
|
|> tryHead
|
||||||
|
|
||||||
|
/// Find a complete post by its ID for the given web log
|
||||||
|
let findFullById postId webLogId = backgroundTask {
|
||||||
|
match! findById postId webLogId with
|
||||||
|
| Some post ->
|
||||||
|
let! withRevisions = appendPostRevisions post
|
||||||
|
return Some withRevisions
|
||||||
|
| None -> return None
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Delete a post by its ID for the given web log
|
||||||
|
let delete postId webLogId = backgroundTask {
|
||||||
|
match! postExists postId webLogId with
|
||||||
|
| true ->
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query
|
||||||
|
"DELETE FROM post_revision WHERE post_id = @id;
|
||||||
|
DELETE FROM post_category WHERE post_id = @id;
|
||||||
|
DELETE FROM post WHERE id = @id"
|
||||||
|
|> Sql.parameters [ "@id", Sql.string (PostId.toString postId) ]
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
return true
|
||||||
|
| false -> return false
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Find the current permalink from a list of potential prior permalinks for the given web log
|
||||||
|
let findCurrentPermalink permalinks webLogId = backgroundTask {
|
||||||
|
if List.isEmpty permalinks then return None
|
||||||
|
else
|
||||||
|
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.parameters (webLogIdParam webLogId :: linkParams)
|
||||||
|
|> Sql.executeAsync Map.toPermalink
|
||||||
|
|> tryHead
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Get all complete posts for the given web log
|
||||||
|
let findFullByWebLog webLogId = backgroundTask {
|
||||||
|
let! posts =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"{selectPost} WHERE web_log_id = @webLogId"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeAsync toPost
|
||||||
|
let! revisions =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query
|
||||||
|
"SELECT *
|
||||||
|
FROM post_revision pr
|
||||||
|
INNER JOIN post p ON p.id = pr.post_id
|
||||||
|
WHERE p.web_log_id = @webLogId
|
||||||
|
ORDER BY as_of DESC"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeAsync (fun row -> PostId (row.string "post_id"), Map.toRevision row)
|
||||||
|
return
|
||||||
|
posts
|
||||||
|
|> List.map (fun it ->
|
||||||
|
{ it with Revisions = revisions |> List.filter (fun r -> fst r = it.Id) |> List.map snd })
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Get a page of categorized posts for the given web log (excludes revisions)
|
||||||
|
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
|
||||||
|
let catSql, catParams = inClause "AND pc.category_id" "catId" CategoryId.toString categoryIds
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"
|
||||||
|
{selectPost}
|
||||||
|
INNER JOIN post_category pc ON pc.post_id = p.id
|
||||||
|
WHERE p.web_log_id = @webLogId
|
||||||
|
AND p.status = @status
|
||||||
|
{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 toPost
|
||||||
|
|
||||||
|
/// Get a page of posts for the given web log (excludes text and revisions)
|
||||||
|
let findPageOfPosts webLogId pageNbr postsPerPage =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"
|
||||||
|
{selectPost}
|
||||||
|
WHERE web_log_id = @webLogId
|
||||||
|
ORDER BY published_on DESC NULLS FIRST, updated_on
|
||||||
|
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeAsync postWithoutText
|
||||||
|
|
||||||
|
/// Get a page of published posts for the given web log (excludes revisions)
|
||||||
|
let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"
|
||||||
|
{selectPost}
|
||||||
|
WHERE web_log_id = @webLogId
|
||||||
|
AND status = @status
|
||||||
|
ORDER BY published_on DESC
|
||||||
|
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString Published) ]
|
||||||
|
|> 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 =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"
|
||||||
|
{selectPost}
|
||||||
|
WHERE web_log_id = @webLogId
|
||||||
|
AND status = @status
|
||||||
|
AND tags && ARRAY[@tag]
|
||||||
|
ORDER BY published_on DESC
|
||||||
|
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||||
|
|> Sql.parameters
|
||||||
|
[ webLogIdParam webLogId
|
||||||
|
"@status", Sql.string (PostStatus.toString Published)
|
||||||
|
"@tag", Sql.string tag
|
||||||
|
]
|
||||||
|
|> 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 [
|
||||||
|
webLogIdParam webLogId
|
||||||
|
typedParam "publishedOn" publishedOn
|
||||||
|
"@status", Sql.string (PostStatus.toString Published)
|
||||||
|
]
|
||||||
|
let! older =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"
|
||||||
|
{selectPost}
|
||||||
|
WHERE web_log_id = @webLogId
|
||||||
|
AND status = @status
|
||||||
|
AND published_on < @publishedOn
|
||||||
|
ORDER BY published_on DESC
|
||||||
|
LIMIT 1"
|
||||||
|
|> queryParams ()
|
||||||
|
|> Sql.executeAsync toPost
|
||||||
|
let! newer =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"
|
||||||
|
{selectPost}
|
||||||
|
WHERE web_log_id = @webLogId
|
||||||
|
AND status = @status
|
||||||
|
AND published_on > @publishedOn
|
||||||
|
ORDER BY published_on
|
||||||
|
LIMIT 1"
|
||||||
|
|> queryParams ()
|
||||||
|
|> Sql.executeAsync toPost
|
||||||
|
return List.tryHead older, List.tryHead newer
|
||||||
|
}
|
||||||
|
|
||||||
|
/// The INSERT statement for a post
|
||||||
|
let postInsert =
|
||||||
|
"INSERT INTO post (
|
||||||
|
id, web_log_id, author_id, status, title, permalink, prior_permalinks, published_on, updated_on,
|
||||||
|
template, post_text, tags, meta_items, episode
|
||||||
|
) VALUES (
|
||||||
|
@id, @webLogId, @authorId, @status, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn,
|
||||||
|
@template, @text, @tags, @metaItems, @episode
|
||||||
|
)"
|
||||||
|
|
||||||
|
/// The parameters for saving a post
|
||||||
|
let postParams (post : Post) = [
|
||||||
|
webLogIdParam post.WebLogId
|
||||||
|
"@id", Sql.string (PostId.toString post.Id)
|
||||||
|
"@authorId", Sql.string (WebLogUserId.toString post.AuthorId)
|
||||||
|
"@status", Sql.string (PostStatus.toString post.Status)
|
||||||
|
"@title", Sql.string post.Title
|
||||||
|
"@permalink", Sql.string (Permalink.toString post.Permalink)
|
||||||
|
"@template", Sql.stringOrNone post.Template
|
||||||
|
"@text", Sql.string post.Text
|
||||||
|
"@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 (Utils.serialize ser post.Metadata)
|
||||||
|
|> Sql.jsonbOrNone
|
||||||
|
optParam "publishedOn" post.PublishedOn
|
||||||
|
typedParam "updatedOn" post.UpdatedOn
|
||||||
|
]
|
||||||
|
|
||||||
|
/// Save a post
|
||||||
|
let save (post : Post) = backgroundTask {
|
||||||
|
let! oldPost = findFullById post.Id post.WebLogId
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"
|
||||||
|
{postInsert} ON CONFLICT (id) DO UPDATE
|
||||||
|
SET author_id = EXCLUDED.author_id,
|
||||||
|
status = EXCLUDED.status,
|
||||||
|
title = EXCLUDED.title,
|
||||||
|
permalink = EXCLUDED.permalink,
|
||||||
|
prior_permalinks = EXCLUDED.prior_permalinks,
|
||||||
|
published_on = EXCLUDED.published_on,
|
||||||
|
updated_on = EXCLUDED.updated_on,
|
||||||
|
template = EXCLUDED.template,
|
||||||
|
post_text = EXCLUDED.post_text,
|
||||||
|
tags = EXCLUDED.tags,
|
||||||
|
meta_items = EXCLUDED.meta_items,
|
||||||
|
episode = EXCLUDED.episode"
|
||||||
|
|> Sql.parameters (postParams post)
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
do! updatePostCategories post.Id (match oldPost with Some p -> p.CategoryIds | None -> []) post.CategoryIds
|
||||||
|
do! updatePostRevisions post.Id (match oldPost with Some p -> p.Revisions | None -> []) post.Revisions
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Restore posts from a backup
|
||||||
|
let restore posts = backgroundTask {
|
||||||
|
let cats = posts |> List.collect (fun p -> p.CategoryIds |> List.map (fun c -> p.Id, c))
|
||||||
|
let revisions = posts |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.executeTransactionAsync [
|
||||||
|
postInsert, posts |> List.map postParams
|
||||||
|
catInsert, cats |> List.map (fun (postId, catId) -> catParams postId catId)
|
||||||
|
revInsert, revisions |> List.map (fun (postId, rev) -> revParams postId rev)
|
||||||
|
]
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Update prior permalinks for a post
|
||||||
|
let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
|
||||||
|
match! postExists postId webLogId with
|
||||||
|
| true ->
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "UPDATE post SET prior_permalinks = @prior WHERE id = @id"
|
||||||
|
|> Sql.parameters
|
||||||
|
[ "@id", Sql.string (PostId.toString postId)
|
||||||
|
"@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ]
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
return true
|
||||||
|
| false -> return false
|
||||||
|
}
|
||||||
|
|
||||||
|
interface IPostData with
|
||||||
|
member _.Add post = save post
|
||||||
|
member _.CountByStatus status webLogId = countByStatus status webLogId
|
||||||
|
member _.Delete postId webLogId = delete postId webLogId
|
||||||
|
member _.FindById postId webLogId = findById postId webLogId
|
||||||
|
member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId
|
||||||
|
member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
|
||||||
|
member _.FindFullById postId webLogId = findFullById postId webLogId
|
||||||
|
member _.FindFullByWebLog webLogId = findFullByWebLog webLogId
|
||||||
|
member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
|
||||||
|
findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage
|
||||||
|
member _.FindPageOfPosts webLogId pageNbr postsPerPage = findPageOfPosts webLogId pageNbr postsPerPage
|
||||||
|
member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage =
|
||||||
|
findPageOfPublishedPosts webLogId pageNbr postsPerPage
|
||||||
|
member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage =
|
||||||
|
findPageOfTaggedPosts webLogId tag pageNbr postsPerPage
|
||||||
|
member _.FindSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn
|
||||||
|
member _.Restore posts = restore posts
|
||||||
|
member _.Update post = save post
|
||||||
|
member _.UpdatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks
|
109
src/MyWebLog.Data/Postgres/PostgresTagMapData.fs
Normal file
109
src/MyWebLog.Data/Postgres/PostgresTagMapData.fs
Normal file
|
@ -0,0 +1,109 @@
|
||||||
|
namespace MyWebLog.Data.Postgres
|
||||||
|
|
||||||
|
open MyWebLog
|
||||||
|
open MyWebLog.Data
|
||||||
|
open Npgsql
|
||||||
|
open Npgsql.FSharp
|
||||||
|
|
||||||
|
/// PostgreSQL myWebLog tag mapping data implementation
|
||||||
|
type PostgresTagMapData (conn : NpgsqlConnection) =
|
||||||
|
|
||||||
|
/// Find a tag mapping by its ID for the given web log
|
||||||
|
let findById tagMapId webLogId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> 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.executeAsync Map.toTagMap
|
||||||
|
|> tryHead
|
||||||
|
|
||||||
|
/// Delete a tag mapping for the given web log
|
||||||
|
let delete tagMapId webLogId = backgroundTask {
|
||||||
|
let idParams = [ "@id", Sql.string (TagMapId.toString tagMapId) ]
|
||||||
|
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! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "DELETE FROM tag_map WHERE id = @id"
|
||||||
|
|> Sql.parameters idParams
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
return true
|
||||||
|
else return false
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Find a tag mapping by its URL value for the given web log
|
||||||
|
let findByUrlValue urlValue webLogId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId; "@urlValue", Sql.string urlValue ]
|
||||||
|
|> Sql.executeAsync Map.toTagMap
|
||||||
|
|> tryHead
|
||||||
|
|
||||||
|
/// Get all tag mappings for the given web log
|
||||||
|
let findByWebLog webLogId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM tag_map WHERE web_log_id = @webLogId ORDER BY tag"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeAsync Map.toTagMap
|
||||||
|
|
||||||
|
/// Find any tag mappings in a list of tags for the given web log
|
||||||
|
let findMappingForTags tags webLogId =
|
||||||
|
let tagSql, tagParams = inClause "AND tag" "tag" id tags
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"SELECT * FROM tag_map WHERE web_log_id = @webLogId {tagSql}"
|
||||||
|
|> Sql.parameters (webLogIdParam webLogId :: tagParams)
|
||||||
|
|> Sql.executeAsync Map.toTagMap
|
||||||
|
|
||||||
|
/// The INSERT statement for a tag mapping
|
||||||
|
let tagMapInsert =
|
||||||
|
"INSERT INTO tag_map (
|
||||||
|
id, web_log_id, tag, url_value
|
||||||
|
) VALUES (
|
||||||
|
@id, @webLogId, @tag, @urlValue
|
||||||
|
)"
|
||||||
|
|
||||||
|
/// The parameters for saving a tag mapping
|
||||||
|
let tagMapParams (tagMap : TagMap) = [
|
||||||
|
webLogIdParam tagMap.WebLogId
|
||||||
|
"@id", Sql.string (TagMapId.toString tagMap.Id)
|
||||||
|
"@tag", Sql.string tagMap.Tag
|
||||||
|
"@urlValue", Sql.string tagMap.UrlValue
|
||||||
|
]
|
||||||
|
|
||||||
|
/// Save a tag mapping
|
||||||
|
let save tagMap = backgroundTask {
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"
|
||||||
|
{tagMapInsert} ON CONFLICT (id) DO UPDATE
|
||||||
|
SET tag = EXCLUDED.tag,
|
||||||
|
url_value = EXCLUDED.url_value"
|
||||||
|
|> Sql.parameters (tagMapParams tagMap)
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Restore tag mappings from a backup
|
||||||
|
let restore tagMaps = backgroundTask {
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.executeTransactionAsync [
|
||||||
|
tagMapInsert, tagMaps |> List.map tagMapParams
|
||||||
|
]
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
interface ITagMapData with
|
||||||
|
member _.Delete tagMapId webLogId = delete tagMapId webLogId
|
||||||
|
member _.FindById tagMapId webLogId = findById tagMapId webLogId
|
||||||
|
member _.FindByUrlValue urlValue webLogId = findByUrlValue urlValue webLogId
|
||||||
|
member _.FindByWebLog webLogId = findByWebLog webLogId
|
||||||
|
member _.FindMappingForTags tags webLogId = findMappingForTags tags webLogId
|
||||||
|
member _.Save tagMap = save tagMap
|
||||||
|
member _.Restore tagMaps = restore tagMaps
|
207
src/MyWebLog.Data/Postgres/PostgresThemeData.fs
Normal file
207
src/MyWebLog.Data/Postgres/PostgresThemeData.fs
Normal file
|
@ -0,0 +1,207 @@
|
||||||
|
namespace MyWebLog.Data.Postgres
|
||||||
|
|
||||||
|
open MyWebLog
|
||||||
|
open MyWebLog.Data
|
||||||
|
open Npgsql
|
||||||
|
open Npgsql.FSharp
|
||||||
|
|
||||||
|
/// PostreSQL myWebLog theme data implementation
|
||||||
|
type PostgresThemeData (conn : NpgsqlConnection) =
|
||||||
|
|
||||||
|
/// Retrieve all themes (except 'admin'; excludes template text)
|
||||||
|
let all () = backgroundTask {
|
||||||
|
let! themes =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id"
|
||||||
|
|> Sql.executeAsync Map.toTheme
|
||||||
|
let! templates =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name"
|
||||||
|
|> Sql.executeAsync (fun row -> ThemeId (row.string "theme_id"), Map.toThemeTemplate false row)
|
||||||
|
return
|
||||||
|
themes
|
||||||
|
|> List.map (fun t ->
|
||||||
|
{ t with Templates = templates |> List.filter (fun tt -> fst tt = t.Id) |> List.map snd })
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Does a given theme exist?
|
||||||
|
let exists themeId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT EXISTS (SELECT 1 FROM theme WHERE id = @id) AS does_exist"
|
||||||
|
|> Sql.parameters [ "@id", Sql.string (ThemeId.toString themeId) ]
|
||||||
|
|> Sql.executeRowAsync Map.toExists
|
||||||
|
|
||||||
|
/// Find a theme by its ID
|
||||||
|
let findById themeId = backgroundTask {
|
||||||
|
let themeIdParam = [ "@id", Sql.string (ThemeId.toString themeId) ]
|
||||||
|
let! theme =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM theme WHERE id = @id"
|
||||||
|
|> Sql.parameters themeIdParam
|
||||||
|
|> Sql.executeAsync Map.toTheme
|
||||||
|
|> tryHead
|
||||||
|
if Option.isSome theme then
|
||||||
|
let! templates =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM theme_template WHERE theme_id = @id"
|
||||||
|
|> Sql.parameters themeIdParam
|
||||||
|
|> Sql.executeAsync (Map.toThemeTemplate true)
|
||||||
|
return Some { theme.Value with Templates = templates }
|
||||||
|
else return None
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Find a theme by its ID (excludes the text of templates)
|
||||||
|
let findByIdWithoutText themeId = backgroundTask {
|
||||||
|
match! findById themeId with
|
||||||
|
| Some theme ->
|
||||||
|
return Some {
|
||||||
|
theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" })
|
||||||
|
}
|
||||||
|
| None -> return None
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Delete a theme by its ID
|
||||||
|
let delete themeId = backgroundTask {
|
||||||
|
let idParams = [ "@id", Sql.string (ThemeId.toString themeId) ]
|
||||||
|
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! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query
|
||||||
|
"DELETE FROM theme_asset WHERE theme_id = @id;
|
||||||
|
DELETE FROM theme_template WHERE theme_id = @id;
|
||||||
|
DELETE FROM theme WHERE id = @id"
|
||||||
|
|> Sql.parameters idParams
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
return true
|
||||||
|
else return false
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Save a theme
|
||||||
|
let save (theme : Theme) = backgroundTask {
|
||||||
|
let! oldTheme = findById theme.Id
|
||||||
|
let themeIdParam = Sql.string (ThemeId.toString theme.Id)
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query
|
||||||
|
"INSERT INTO theme VALUES (@id, @name, @version)
|
||||||
|
ON CONFLICT (id) DO UPDATE
|
||||||
|
SET name = EXCLUDED.name,
|
||||||
|
version = EXCLUDED.version"
|
||||||
|
|> Sql.parameters
|
||||||
|
[ "@id", themeIdParam
|
||||||
|
"@name", Sql.string theme.Name
|
||||||
|
"@version", Sql.string theme.Version ]
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
|
||||||
|
let toDelete, _ =
|
||||||
|
Utils.diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue [])
|
||||||
|
theme.Templates (fun t -> t.Name)
|
||||||
|
let toAddOrUpdate =
|
||||||
|
theme.Templates
|
||||||
|
|> List.filter (fun t -> not (toDelete |> List.exists (fun d -> d.Name = t.Name)))
|
||||||
|
|
||||||
|
if not (List.isEmpty toDelete) || not (List.isEmpty toAddOrUpdate) then
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.executeTransactionAsync [
|
||||||
|
if not (List.isEmpty toDelete) then
|
||||||
|
"DELETE FROM theme_template WHERE theme_id = @themeId AND name = @name",
|
||||||
|
toDelete |> List.map (fun tmpl -> [ "@themeId", themeIdParam; "@name", Sql.string tmpl.Name ])
|
||||||
|
if not (List.isEmpty toAddOrUpdate) then
|
||||||
|
"INSERT INTO theme_template VALUES (@themeId, @name, @template)
|
||||||
|
ON CONFLICT (theme_id, name) DO UPDATE
|
||||||
|
SET template = EXCLUDED.template",
|
||||||
|
toAddOrUpdate |> List.map (fun tmpl -> [
|
||||||
|
"@themeId", themeIdParam
|
||||||
|
"@name", Sql.string tmpl.Name
|
||||||
|
"@template", Sql.string tmpl.Text
|
||||||
|
])
|
||||||
|
]
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
interface IThemeData with
|
||||||
|
member _.All () = all ()
|
||||||
|
member _.Delete themeId = delete themeId
|
||||||
|
member _.Exists themeId = exists themeId
|
||||||
|
member _.FindById themeId = findById themeId
|
||||||
|
member _.FindByIdWithoutText themeId = findByIdWithoutText themeId
|
||||||
|
member _.Save theme = save theme
|
||||||
|
|
||||||
|
|
||||||
|
/// PostreSQL myWebLog theme data implementation
|
||||||
|
type PostgresThemeAssetData (conn : NpgsqlConnection) =
|
||||||
|
|
||||||
|
/// Get all theme assets (excludes data)
|
||||||
|
let all () =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT theme_id, path, updated_on FROM theme_asset"
|
||||||
|
|> Sql.executeAsync (Map.toThemeAsset false)
|
||||||
|
|
||||||
|
/// Delete all assets for the given theme
|
||||||
|
let deleteByTheme themeId = backgroundTask {
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "DELETE FROM theme_asset WHERE theme_id = @themeId"
|
||||||
|
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Find a theme asset by its ID
|
||||||
|
let findById assetId =
|
||||||
|
let (ThemeAssetId (ThemeId themeId, path)) = assetId
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId AND path = @path"
|
||||||
|
|> Sql.parameters [ "@themeId", Sql.string themeId; "@path", Sql.string path ]
|
||||||
|
|> Sql.executeAsync (Map.toThemeAsset true)
|
||||||
|
|> tryHead
|
||||||
|
|
||||||
|
/// Get theme assets for the given theme (excludes data)
|
||||||
|
let findByTheme themeId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId"
|
||||||
|
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|
||||||
|
|> Sql.executeAsync (Map.toThemeAsset false)
|
||||||
|
|
||||||
|
/// Get theme assets for the given theme
|
||||||
|
let findByThemeWithData themeId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId"
|
||||||
|
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|
||||||
|
|> Sql.executeAsync (Map.toThemeAsset true)
|
||||||
|
|
||||||
|
/// Save a theme asset
|
||||||
|
let save (asset : ThemeAsset) = backgroundTask {
|
||||||
|
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query
|
||||||
|
"INSERT INTO theme_asset (
|
||||||
|
theme_id, path, updated_on, data
|
||||||
|
) VALUES (
|
||||||
|
@themeId, @path, @updatedOn, @data
|
||||||
|
) ON CONFLICT (theme_id, path) DO UPDATE
|
||||||
|
SET updated_on = EXCLUDED.updated_on,
|
||||||
|
data = EXCLUDED.data"
|
||||||
|
|> Sql.parameters
|
||||||
|
[ "@themeId", Sql.string themeId
|
||||||
|
"@path", Sql.string path
|
||||||
|
"@data", Sql.bytea asset.Data
|
||||||
|
typedParam "updatedOn" asset.UpdatedOn ]
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
interface IThemeAssetData with
|
||||||
|
member _.All () = all ()
|
||||||
|
member _.DeleteByTheme themeId = deleteByTheme themeId
|
||||||
|
member _.FindById assetId = findById assetId
|
||||||
|
member _.FindByTheme themeId = findByTheme themeId
|
||||||
|
member _.FindByThemeWithData themeId = findByThemeWithData themeId
|
||||||
|
member _.Save asset = save asset
|
97
src/MyWebLog.Data/Postgres/PostgresUploadData.fs
Normal file
97
src/MyWebLog.Data/Postgres/PostgresUploadData.fs
Normal file
|
@ -0,0 +1,97 @@
|
||||||
|
namespace MyWebLog.Data.Postgres
|
||||||
|
|
||||||
|
open MyWebLog
|
||||||
|
open MyWebLog.Data
|
||||||
|
open Npgsql
|
||||||
|
open Npgsql.FSharp
|
||||||
|
|
||||||
|
/// PostgreSQL myWebLog uploaded file data implementation
|
||||||
|
type PostgresUploadData (conn : NpgsqlConnection) =
|
||||||
|
|
||||||
|
/// The INSERT statement for an uploaded file
|
||||||
|
let upInsert =
|
||||||
|
"INSERT INTO upload (
|
||||||
|
id, web_log_id, path, updated_on, data
|
||||||
|
) VALUES (
|
||||||
|
@id, @webLogId, @path, @updatedOn, @data
|
||||||
|
)"
|
||||||
|
|
||||||
|
/// Parameters for adding an uploaded file
|
||||||
|
let upParams (upload : Upload) = [
|
||||||
|
webLogIdParam upload.WebLogId
|
||||||
|
typedParam "updatedOn" upload.UpdatedOn
|
||||||
|
"@id", Sql.string (UploadId.toString upload.Id)
|
||||||
|
"@path", Sql.string (Permalink.toString upload.Path)
|
||||||
|
"@data", Sql.bytea upload.Data
|
||||||
|
]
|
||||||
|
|
||||||
|
/// Save an uploaded file
|
||||||
|
let add upload = backgroundTask {
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query upInsert
|
||||||
|
|> Sql.parameters (upParams upload)
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Delete an uploaded file by its ID
|
||||||
|
let delete uploadId webLogId = backgroundTask {
|
||||||
|
let theParams = [ "@id", Sql.string (UploadId.toString uploadId); webLogIdParam webLogId ]
|
||||||
|
let! path =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT path FROM upload WHERE id = @id AND web_log_id = @webLogId"
|
||||||
|
|> Sql.parameters theParams
|
||||||
|
|> Sql.executeAsync (fun row -> row.string "path")
|
||||||
|
|> tryHead
|
||||||
|
if Option.isSome path then
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
|
||||||
|
|> Sql.parameters theParams
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
return Ok path.Value
|
||||||
|
else return Error $"""Upload ID {UploadId.toString uploadId} not found"""
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Find an uploaded file by its path for the given web log
|
||||||
|
let findByPath path webLogId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId AND path = @path"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId; "@path", Sql.string path ]
|
||||||
|
|> Sql.executeAsync (Map.toUpload true)
|
||||||
|
|> tryHead
|
||||||
|
|
||||||
|
/// Find all uploaded files for the given web log (excludes data)
|
||||||
|
let findByWebLog webLogId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT id, web_log_id, path, updated_on FROM upload WHERE web_log_id = @webLogId"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeAsync (Map.toUpload false)
|
||||||
|
|
||||||
|
/// Find all uploaded files for the given web log
|
||||||
|
let findByWebLogWithData webLogId =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeAsync (Map.toUpload true)
|
||||||
|
|
||||||
|
/// Restore uploads from a backup
|
||||||
|
let restore uploads = backgroundTask {
|
||||||
|
for batch in uploads |> List.chunkBySize 5 do
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.executeTransactionAsync [
|
||||||
|
upInsert, batch |> List.map upParams
|
||||||
|
]
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
interface IUploadData with
|
||||||
|
member _.Add upload = add upload
|
||||||
|
member _.Delete uploadId webLogId = delete uploadId webLogId
|
||||||
|
member _.FindByPath path webLogId = findByPath path webLogId
|
||||||
|
member _.FindByWebLog webLogId = findByWebLog webLogId
|
||||||
|
member _.FindByWebLogWithData webLogId = findByWebLogWithData webLogId
|
||||||
|
member _.Restore uploads = restore uploads
|
||||||
|
|
238
src/MyWebLog.Data/Postgres/PostgresWebLogData.fs
Normal file
238
src/MyWebLog.Data/Postgres/PostgresWebLogData.fs
Normal file
|
@ -0,0 +1,238 @@
|
||||||
|
namespace MyWebLog.Data.Postgres
|
||||||
|
|
||||||
|
open MyWebLog
|
||||||
|
open MyWebLog.Data
|
||||||
|
open Newtonsoft.Json
|
||||||
|
open Npgsql
|
||||||
|
open Npgsql.FSharp
|
||||||
|
|
||||||
|
/// PostgreSQL myWebLog web log data implementation
|
||||||
|
type PostgresWebLogData (conn : NpgsqlConnection, ser : JsonSerializer) =
|
||||||
|
|
||||||
|
// SUPPORT FUNCTIONS
|
||||||
|
|
||||||
|
/// The parameters for web log INSERT or web log/RSS options UPDATE statements
|
||||||
|
let rssParams (webLog : WebLog) = [
|
||||||
|
"@isFeedEnabled", Sql.bool webLog.Rss.IsFeedEnabled
|
||||||
|
"@feedName", Sql.string webLog.Rss.FeedName
|
||||||
|
"@itemsInFeed", Sql.intOrNone webLog.Rss.ItemsInFeed
|
||||||
|
"@isCategoryEnabled", Sql.bool webLog.Rss.IsCategoryEnabled
|
||||||
|
"@isTagEnabled", Sql.bool webLog.Rss.IsTagEnabled
|
||||||
|
"@copyright", Sql.stringOrNone webLog.Rss.Copyright
|
||||||
|
]
|
||||||
|
|
||||||
|
/// The parameters for web log INSERT or UPDATE statements
|
||||||
|
let webLogParams (webLog : WebLog) = [
|
||||||
|
"@id", Sql.string (WebLogId.toString webLog.Id)
|
||||||
|
"@name", Sql.string webLog.Name
|
||||||
|
"@slug", Sql.string webLog.Slug
|
||||||
|
"@subtitle", Sql.stringOrNone webLog.Subtitle
|
||||||
|
"@defaultPage", Sql.string webLog.DefaultPage
|
||||||
|
"@postsPerPage", Sql.int webLog.PostsPerPage
|
||||||
|
"@themeId", Sql.string (ThemeId.toString webLog.ThemeId)
|
||||||
|
"@urlBase", Sql.string webLog.UrlBase
|
||||||
|
"@timeZone", Sql.string webLog.TimeZone
|
||||||
|
"@autoHtmx", Sql.bool webLog.AutoHtmx
|
||||||
|
"@uploads", Sql.string (UploadDestination.toString webLog.Uploads)
|
||||||
|
yield! rssParams webLog
|
||||||
|
]
|
||||||
|
|
||||||
|
/// 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 "SELECT * FROM web_log_feed WHERE web_log_id = @webLogId"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLog.Id ]
|
||||||
|
|> Sql.executeAsync toCustomFeed
|
||||||
|
|
||||||
|
/// Append custom feeds to a web log
|
||||||
|
let appendCustomFeeds (webLog : WebLog) = backgroundTask {
|
||||||
|
let! feeds = getCustomFeeds webLog
|
||||||
|
return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
|
||||||
|
}
|
||||||
|
|
||||||
|
/// 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)
|
||||||
|
"@podcast", Sql.jsonbOrNone (feed.Podcast |> Option.map (Utils.serialize ser))
|
||||||
|
]
|
||||||
|
|
||||||
|
/// Update the custom feeds for a web log
|
||||||
|
let updateCustomFeeds (webLog : WebLog) = backgroundTask {
|
||||||
|
let! feeds = getCustomFeeds webLog
|
||||||
|
let toDelete, _ = Utils.diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
|
||||||
|
let toId (feed : CustomFeed) = feed.Id
|
||||||
|
let toAddOrUpdate =
|
||||||
|
webLog.Rss.CustomFeeds |> List.filter (fun f -> not (toDelete |> List.map toId |> List.contains f.Id))
|
||||||
|
if not (List.isEmpty toDelete) || not (List.isEmpty toAddOrUpdate) then
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.executeTransactionAsync [
|
||||||
|
if not (List.isEmpty toDelete) then
|
||||||
|
"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, podcast
|
||||||
|
) VALUES (
|
||||||
|
@id, @webLogId, @source, @path, @podcast
|
||||||
|
) ON CONFLICT (id) DO UPDATE
|
||||||
|
SET source = EXCLUDED.source,
|
||||||
|
path = EXCLUDED.path,
|
||||||
|
podcast = EXCLUDED.podcast",
|
||||||
|
toAddOrUpdate |> List.map (feedParams webLog.Id)
|
||||||
|
]
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
// IMPLEMENTATION FUNCTIONS
|
||||||
|
|
||||||
|
/// Add a web log
|
||||||
|
let add webLog = backgroundTask {
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query
|
||||||
|
"INSERT INTO web_log (
|
||||||
|
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
|
||||||
|
uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright
|
||||||
|
) VALUES (
|
||||||
|
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
|
||||||
|
@uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
|
||||||
|
)"
|
||||||
|
|> Sql.parameters (webLogParams webLog)
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
do! updateCustomFeeds webLog
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Retrieve all web logs
|
||||||
|
let all () = backgroundTask {
|
||||||
|
let! webLogs =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM web_log"
|
||||||
|
|> Sql.executeAsync Map.toWebLog
|
||||||
|
let! feeds =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> 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 ->
|
||||||
|
{ 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
|
||||||
|
let delete webLogId = backgroundTask {
|
||||||
|
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
|
||||||
|
let postSubQuery = subQuery "post"
|
||||||
|
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 WHERE web_log_id = @webLogId;
|
||||||
|
DELETE FROM web_log WHERE id = @webLogId"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Find a web log by its host (URL base)
|
||||||
|
let findByHost url = backgroundTask {
|
||||||
|
let! webLog =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM web_log WHERE url_base = @urlBase"
|
||||||
|
|> Sql.parameters [ "@urlBase", Sql.string url ]
|
||||||
|
|> Sql.executeAsync Map.toWebLog
|
||||||
|
|> tryHead
|
||||||
|
if Option.isSome webLog then
|
||||||
|
let! withFeeds = appendCustomFeeds webLog.Value
|
||||||
|
return Some withFeeds
|
||||||
|
else return None
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Find a web log by its ID
|
||||||
|
let findById webLogId = backgroundTask {
|
||||||
|
let! webLog =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT * FROM web_log WHERE id = @webLogId"
|
||||||
|
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||||
|
|> Sql.executeAsync Map.toWebLog
|
||||||
|
|> tryHead
|
||||||
|
if Option.isSome webLog then
|
||||||
|
let! withFeeds = appendCustomFeeds webLog.Value
|
||||||
|
return Some withFeeds
|
||||||
|
else return None
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Update settings for a web log
|
||||||
|
let updateSettings webLog = backgroundTask {
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query
|
||||||
|
"UPDATE web_log
|
||||||
|
SET name = @name,
|
||||||
|
slug = @slug,
|
||||||
|
subtitle = @subtitle,
|
||||||
|
default_page = @defaultPage,
|
||||||
|
posts_per_page = @postsPerPage,
|
||||||
|
theme_id = @themeId,
|
||||||
|
url_base = @urlBase,
|
||||||
|
time_zone = @timeZone,
|
||||||
|
auto_htmx = @autoHtmx,
|
||||||
|
uploads = @uploads,
|
||||||
|
is_feed_enabled = @isFeedEnabled,
|
||||||
|
feed_name = @feedName,
|
||||||
|
items_in_feed = @itemsInFeed,
|
||||||
|
is_category_enabled = @isCategoryEnabled,
|
||||||
|
is_tag_enabled = @isTagEnabled,
|
||||||
|
copyright = @copyright
|
||||||
|
WHERE id = @id"
|
||||||
|
|> Sql.parameters (webLogParams webLog)
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Update RSS options for a web log
|
||||||
|
let updateRssOptions (webLog : WebLog) = backgroundTask {
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query
|
||||||
|
"UPDATE web_log
|
||||||
|
SET is_feed_enabled = @isFeedEnabled,
|
||||||
|
feed_name = @feedName,
|
||||||
|
items_in_feed = @itemsInFeed,
|
||||||
|
is_category_enabled = @isCategoryEnabled,
|
||||||
|
is_tag_enabled = @isTagEnabled,
|
||||||
|
copyright = @copyright
|
||||||
|
WHERE id = @webLogId"
|
||||||
|
|> Sql.parameters (webLogIdParam webLog.Id :: rssParams webLog)
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
do! updateCustomFeeds webLog
|
||||||
|
}
|
||||||
|
|
||||||
|
interface IWebLogData with
|
||||||
|
member _.Add webLog = add webLog
|
||||||
|
member _.All () = all ()
|
||||||
|
member _.Delete webLogId = delete webLogId
|
||||||
|
member _.FindByHost url = findByHost url
|
||||||
|
member _.FindById webLogId = findById webLogId
|
||||||
|
member _.UpdateSettings webLog = updateSettings webLog
|
||||||
|
member _.UpdateRssOptions webLog = updateRssOptions webLog
|
149
src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs
Normal file
149
src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs
Normal file
|
@ -0,0 +1,149 @@
|
||||||
|
namespace MyWebLog.Data.Postgres
|
||||||
|
|
||||||
|
open MyWebLog
|
||||||
|
open MyWebLog.Data
|
||||||
|
open Npgsql
|
||||||
|
open Npgsql.FSharp
|
||||||
|
|
||||||
|
/// PostgreSQL myWebLog user data implementation
|
||||||
|
type PostgresWebLogUserData (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, url, access_level,
|
||||||
|
created_on, last_seen_on
|
||||||
|
) VALUES (
|
||||||
|
@id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @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
|
||||||
|
"@url", Sql.stringOrNone user.Url
|
||||||
|
"@accessLevel", Sql.string (AccessLevel.toString user.AccessLevel)
|
||||||
|
typedParam "createdOn" user.CreatedOn
|
||||||
|
optParam "lastSeenOn" 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 "AND id" "id" WebLogUserId.toString userIds
|
||||||
|
let! users =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {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
|
||||||
|
typedParam "lastSeenOn" (Noda.now ())
|
||||||
|
"@id", Sql.string (WebLogUserId.toString userId) ]
|
||||||
|
|> 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,
|
||||||
|
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
|
||||||
|
|
260
src/MyWebLog.Data/PostgresData.fs
Normal file
260
src/MyWebLog.Data/PostgresData.fs
Normal file
|
@ -0,0 +1,260 @@
|
||||||
|
namespace MyWebLog.Data
|
||||||
|
|
||||||
|
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>, ser : JsonSerializer) =
|
||||||
|
|
||||||
|
/// Create any needed tables
|
||||||
|
let ensureTables () = backgroundTask {
|
||||||
|
let _ = NpgsqlConnection.GlobalTypeMapper.UseNodaTime ()
|
||||||
|
|
||||||
|
let! tables =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'"
|
||||||
|
|> Sql.executeAsync (fun row -> row.string "tablename")
|
||||||
|
let needsTable table = not (List.contains table tables)
|
||||||
|
let mutable isNew = false
|
||||||
|
|
||||||
|
let sql = seq {
|
||||||
|
// Theme tables
|
||||||
|
if needsTable "theme" then
|
||||||
|
isNew <- true
|
||||||
|
"CREATE TABLE theme (
|
||||||
|
id TEXT NOT NULL PRIMARY KEY,
|
||||||
|
name TEXT NOT NULL,
|
||||||
|
version TEXT NOT NULL)"
|
||||||
|
if needsTable "theme_template" then
|
||||||
|
"CREATE TABLE theme_template (
|
||||||
|
theme_id TEXT NOT NULL REFERENCES theme (id),
|
||||||
|
name TEXT NOT NULL,
|
||||||
|
template TEXT NOT NULL,
|
||||||
|
PRIMARY KEY (theme_id, name))"
|
||||||
|
if needsTable "theme_asset" then
|
||||||
|
"CREATE TABLE theme_asset (
|
||||||
|
theme_id TEXT NOT NULL REFERENCES theme (id),
|
||||||
|
path TEXT NOT NULL,
|
||||||
|
updated_on TIMESTAMPTZ NOT NULL,
|
||||||
|
data BYTEA NOT NULL,
|
||||||
|
PRIMARY KEY (theme_id, path))"
|
||||||
|
|
||||||
|
// Web log tables
|
||||||
|
if needsTable "web_log" then
|
||||||
|
"CREATE TABLE web_log (
|
||||||
|
id TEXT NOT NULL PRIMARY KEY,
|
||||||
|
name TEXT NOT NULL,
|
||||||
|
slug TEXT NOT NULL,
|
||||||
|
subtitle TEXT,
|
||||||
|
default_page TEXT NOT NULL,
|
||||||
|
posts_per_page INTEGER NOT NULL,
|
||||||
|
theme_id TEXT NOT NULL REFERENCES theme (id),
|
||||||
|
url_base TEXT NOT NULL,
|
||||||
|
time_zone TEXT NOT NULL,
|
||||||
|
auto_htmx BOOLEAN NOT NULL DEFAULT FALSE,
|
||||||
|
uploads TEXT NOT NULL,
|
||||||
|
is_feed_enabled BOOLEAN NOT NULL DEFAULT FALSE,
|
||||||
|
feed_name TEXT NOT NULL,
|
||||||
|
items_in_feed INTEGER,
|
||||||
|
is_category_enabled BOOLEAN NOT NULL DEFAULT FALSE,
|
||||||
|
is_tag_enabled BOOLEAN NOT NULL DEFAULT FALSE,
|
||||||
|
copyright TEXT)"
|
||||||
|
"CREATE INDEX web_log_theme_idx ON web_log (theme_id)"
|
||||||
|
if needsTable "web_log_feed" then
|
||||||
|
"CREATE TABLE web_log_feed (
|
||||||
|
id TEXT NOT NULL PRIMARY KEY,
|
||||||
|
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||||
|
source TEXT NOT NULL,
|
||||||
|
path TEXT NOT NULL,
|
||||||
|
podcast JSONB)"
|
||||||
|
"CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"
|
||||||
|
|
||||||
|
// Category table
|
||||||
|
if needsTable "category" then
|
||||||
|
"CREATE TABLE category (
|
||||||
|
id TEXT NOT NULL PRIMARY KEY,
|
||||||
|
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||||
|
name TEXT NOT NULL,
|
||||||
|
slug TEXT NOT NULL,
|
||||||
|
description TEXT,
|
||||||
|
parent_id TEXT)"
|
||||||
|
"CREATE INDEX category_web_log_idx ON category (web_log_id)"
|
||||||
|
|
||||||
|
// Web log user table
|
||||||
|
if needsTable "web_log_user" then
|
||||||
|
"CREATE TABLE web_log_user (
|
||||||
|
id TEXT NOT NULL PRIMARY KEY,
|
||||||
|
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||||
|
email TEXT NOT NULL,
|
||||||
|
first_name TEXT NOT NULL,
|
||||||
|
last_name TEXT NOT NULL,
|
||||||
|
preferred_name TEXT NOT NULL,
|
||||||
|
password_hash TEXT NOT NULL,
|
||||||
|
url TEXT,
|
||||||
|
access_level TEXT NOT NULL,
|
||||||
|
created_on TIMESTAMPTZ NOT NULL,
|
||||||
|
last_seen_on TIMESTAMPTZ)"
|
||||||
|
"CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id)"
|
||||||
|
"CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)"
|
||||||
|
|
||||||
|
// Page tables
|
||||||
|
if needsTable "page" then
|
||||||
|
"CREATE TABLE page (
|
||||||
|
id TEXT NOT NULL PRIMARY KEY,
|
||||||
|
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||||
|
author_id TEXT NOT NULL REFERENCES web_log_user (id),
|
||||||
|
title TEXT NOT NULL,
|
||||||
|
permalink TEXT NOT NULL,
|
||||||
|
prior_permalinks TEXT[] NOT NULL DEFAULT '{}',
|
||||||
|
published_on TIMESTAMPTZ NOT NULL,
|
||||||
|
updated_on TIMESTAMPTZ NOT NULL,
|
||||||
|
is_in_page_list BOOLEAN NOT NULL DEFAULT FALSE,
|
||||||
|
template TEXT,
|
||||||
|
page_text TEXT NOT NULL,
|
||||||
|
meta_items JSONB)"
|
||||||
|
"CREATE INDEX page_web_log_idx ON page (web_log_id)"
|
||||||
|
"CREATE INDEX page_author_idx ON page (author_id)"
|
||||||
|
"CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)"
|
||||||
|
if needsTable "page_revision" then
|
||||||
|
"CREATE TABLE page_revision (
|
||||||
|
page_id TEXT NOT NULL REFERENCES page (id),
|
||||||
|
as_of TIMESTAMPTZ NOT NULL,
|
||||||
|
revision_text TEXT NOT NULL,
|
||||||
|
PRIMARY KEY (page_id, as_of))"
|
||||||
|
|
||||||
|
// Post tables
|
||||||
|
if needsTable "post" then
|
||||||
|
"CREATE TABLE post (
|
||||||
|
id TEXT NOT NULL PRIMARY KEY,
|
||||||
|
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||||
|
author_id TEXT NOT NULL REFERENCES web_log_user (id),
|
||||||
|
status TEXT NOT NULL,
|
||||||
|
title TEXT NOT NULL,
|
||||||
|
permalink TEXT NOT NULL,
|
||||||
|
prior_permalinks TEXT[] NOT NULL DEFAULT '{}',
|
||||||
|
published_on TIMESTAMPTZ,
|
||||||
|
updated_on TIMESTAMPTZ NOT NULL,
|
||||||
|
template TEXT,
|
||||||
|
post_text TEXT NOT NULL,
|
||||||
|
tags TEXT[],
|
||||||
|
meta_items JSONB,
|
||||||
|
episode JSONB)"
|
||||||
|
"CREATE INDEX post_web_log_idx ON post (web_log_id)"
|
||||||
|
"CREATE INDEX post_author_idx ON post (author_id)"
|
||||||
|
"CREATE INDEX post_status_idx ON post (web_log_id, status, updated_on)"
|
||||||
|
"CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)"
|
||||||
|
if needsTable "post_category" then
|
||||||
|
"CREATE TABLE post_category (
|
||||||
|
post_id TEXT NOT NULL REFERENCES post (id),
|
||||||
|
category_id TEXT NOT NULL REFERENCES category (id),
|
||||||
|
PRIMARY KEY (post_id, category_id))"
|
||||||
|
"CREATE INDEX post_category_category_idx ON post_category (category_id)"
|
||||||
|
if needsTable "post_revision" then
|
||||||
|
"CREATE TABLE post_revision (
|
||||||
|
post_id TEXT NOT NULL REFERENCES post (id),
|
||||||
|
as_of TIMESTAMPTZ NOT NULL,
|
||||||
|
revision_text TEXT NOT NULL,
|
||||||
|
PRIMARY KEY (post_id, as_of))"
|
||||||
|
if needsTable "post_comment" then
|
||||||
|
"CREATE TABLE post_comment (
|
||||||
|
id TEXT NOT NULL PRIMARY KEY,
|
||||||
|
post_id TEXT NOT NULL REFERENCES post(id),
|
||||||
|
in_reply_to_id TEXT,
|
||||||
|
name TEXT NOT NULL,
|
||||||
|
email TEXT NOT NULL,
|
||||||
|
url TEXT,
|
||||||
|
status TEXT NOT NULL,
|
||||||
|
posted_on TIMESTAMPTZ NOT NULL,
|
||||||
|
comment_text TEXT NOT NULL)"
|
||||||
|
"CREATE INDEX post_comment_post_idx ON post_comment (post_id)"
|
||||||
|
|
||||||
|
// Tag map table
|
||||||
|
if needsTable "tag_map" then
|
||||||
|
"CREATE TABLE tag_map (
|
||||||
|
id TEXT NOT NULL PRIMARY KEY,
|
||||||
|
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||||
|
tag TEXT NOT NULL,
|
||||||
|
url_value TEXT NOT NULL)"
|
||||||
|
"CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)"
|
||||||
|
|
||||||
|
// Uploaded file table
|
||||||
|
if needsTable "upload" then
|
||||||
|
"CREATE TABLE upload (
|
||||||
|
id TEXT NOT NULL PRIMARY KEY,
|
||||||
|
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||||
|
path TEXT NOT NULL,
|
||||||
|
updated_on TIMESTAMPTZ NOT NULL,
|
||||||
|
data BYTEA NOT NULL)"
|
||||||
|
"CREATE INDEX upload_web_log_idx ON upload (web_log_id)"
|
||||||
|
"CREATE INDEX upload_path_idx ON upload (web_log_id, path)"
|
||||||
|
|
||||||
|
// Database version table
|
||||||
|
if needsTable "db_version" then
|
||||||
|
"CREATE TABLE db_version (id TEXT NOT NULL PRIMARY KEY)"
|
||||||
|
$"INSERT INTO db_version VALUES ('{Utils.currentDbVersion}')"
|
||||||
|
}
|
||||||
|
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.executeTransactionAsync
|
||||||
|
(sql
|
||||||
|
|> Seq.map (fun s ->
|
||||||
|
let parts = s.Split ' '
|
||||||
|
if parts[1].ToLowerInvariant () = "table" then
|
||||||
|
log.LogInformation $"Creating {parts[2]} table..."
|
||||||
|
s, [ [] ])
|
||||||
|
|> List.ofSeq)
|
||||||
|
|> Async.AwaitTask
|
||||||
|
|> Async.RunSynchronously
|
||||||
|
|> ignore
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Set a specific database version
|
||||||
|
let setDbVersion version = backgroundTask {
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')"
|
||||||
|
|> Sql.executeNonQueryAsync
|
||||||
|
()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Do required data migration between versions
|
||||||
|
let migrate version = backgroundTask {
|
||||||
|
match version with
|
||||||
|
| Some "v2-rc2" -> ()
|
||||||
|
// Future versions will be inserted here
|
||||||
|
| Some _
|
||||||
|
| None ->
|
||||||
|
log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
|
||||||
|
do! setDbVersion Utils.currentDbVersion
|
||||||
|
}
|
||||||
|
|
||||||
|
interface IData with
|
||||||
|
|
||||||
|
member _.Category = PostgresCategoryData conn
|
||||||
|
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, ser)
|
||||||
|
member _.WebLogUser = PostgresWebLogUserData conn
|
||||||
|
|
||||||
|
member _.Serializer = ser
|
||||||
|
|
||||||
|
member _.StartUp () = backgroundTask {
|
||||||
|
do! ensureTables ()
|
||||||
|
|
||||||
|
let! version =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query "SELECT id FROM db_version"
|
||||||
|
|> Sql.executeAsync (fun row -> row.string "id")
|
||||||
|
|> tryHead
|
||||||
|
match version with
|
||||||
|
| Some v when v = Utils.currentDbVersion -> ()
|
||||||
|
| Some _
|
||||||
|
| None -> do! migrate version
|
||||||
|
}
|
|
@ -17,7 +17,10 @@ module private RethinkHelpers =
|
||||||
|
|
||||||
/// The comment table
|
/// The comment table
|
||||||
let Comment = "Comment"
|
let Comment = "Comment"
|
||||||
|
|
||||||
|
/// The database version table
|
||||||
|
let DbVersion = "DbVersion"
|
||||||
|
|
||||||
/// The page table
|
/// The page table
|
||||||
let Page = "Page"
|
let Page = "Page"
|
||||||
|
|
||||||
|
@ -43,7 +46,7 @@ module private RethinkHelpers =
|
||||||
let WebLogUser = "WebLogUser"
|
let WebLogUser = "WebLogUser"
|
||||||
|
|
||||||
/// A list of all tables
|
/// A list of all tables
|
||||||
let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ]
|
let all = [ Category; Comment; DbVersion; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ]
|
||||||
|
|
||||||
|
|
||||||
/// Index names for indexes not on a data item's name
|
/// Index names for indexes not on a data item's name
|
||||||
|
@ -187,7 +190,42 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|
||||||
delete
|
delete
|
||||||
write; withRetryDefault; ignoreResult conn
|
write; withRetryDefault; ignoreResult conn
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/// Set a specific database version
|
||||||
|
let setDbVersion (version : string) = backgroundTask {
|
||||||
|
do! rethink {
|
||||||
|
withTable Table.DbVersion
|
||||||
|
delete
|
||||||
|
write; withRetryOnce; ignoreResult conn
|
||||||
|
}
|
||||||
|
do! rethink {
|
||||||
|
withTable Table.DbVersion
|
||||||
|
insert {| Id = version |}
|
||||||
|
write; withRetryOnce; ignoreResult conn
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Migrate from v2-rc1 to v2-rc2
|
||||||
|
let migrateV2Rc1ToV2Rc2 () = backgroundTask {
|
||||||
|
let logStep = Utils.logMigrationStep log "v2-rc1 to v2-rc2"
|
||||||
|
logStep "**IMPORTANT**"
|
||||||
|
logStep "See release notes about required backup/restoration for RethinkDB."
|
||||||
|
logStep "If there is an error immediately below this message, this is why."
|
||||||
|
logStep "Setting database version to v2-rc2"
|
||||||
|
do! setDbVersion "v2-rc2"
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Migrate data between versions
|
||||||
|
let migrate version = backgroundTask {
|
||||||
|
match version with
|
||||||
|
| Some v when v = "v2-rc2" -> ()
|
||||||
|
| Some v when v = "v2-rc1" -> do! migrateV2Rc1ToV2Rc2 ()
|
||||||
|
| Some _
|
||||||
|
| None ->
|
||||||
|
log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
|
||||||
|
do! setDbVersion Utils.currentDbVersion
|
||||||
|
}
|
||||||
|
|
||||||
/// The connection for this instance
|
/// The connection for this instance
|
||||||
member _.Conn = conn
|
member _.Conn = conn
|
||||||
|
|
||||||
|
@ -1079,7 +1117,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|
||||||
do! rethink {
|
do! rethink {
|
||||||
withTable Table.WebLogUser
|
withTable Table.WebLogUser
|
||||||
get userId
|
get userId
|
||||||
update [ nameof WebLogUser.empty.LastSeenOn, DateTime.UtcNow :> obj ]
|
update [ nameof WebLogUser.empty.LastSeenOn, Noda.now () :> obj ]
|
||||||
write; withRetryOnce; ignoreResult conn
|
write; withRetryOnce; ignoreResult conn
|
||||||
}
|
}
|
||||||
| None -> ()
|
| None -> ()
|
||||||
|
@ -1094,7 +1132,6 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|
||||||
nameof user.LastName, user.LastName
|
nameof user.LastName, user.LastName
|
||||||
nameof user.PreferredName, user.PreferredName
|
nameof user.PreferredName, user.PreferredName
|
||||||
nameof user.PasswordHash, user.PasswordHash
|
nameof user.PasswordHash, user.PasswordHash
|
||||||
nameof user.Salt, user.Salt
|
|
||||||
nameof user.Url, user.Url
|
nameof user.Url, user.Url
|
||||||
nameof user.AccessLevel, user.AccessLevel
|
nameof user.AccessLevel, user.AccessLevel
|
||||||
]
|
]
|
||||||
|
@ -1102,6 +1139,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
member _.Serializer =
|
||||||
|
Net.Converter.Serializer
|
||||||
|
|
||||||
member _.StartUp () = backgroundTask {
|
member _.StartUp () = backgroundTask {
|
||||||
let! dbs = rethink<string list> { dbList; result; withRetryOnce conn }
|
let! dbs = rethink<string list> { dbList; result; withRetryOnce conn }
|
||||||
if not (dbs |> List.contains config.Database) then
|
if not (dbs |> List.contains config.Database) then
|
||||||
|
@ -1114,6 +1154,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|
||||||
log.LogInformation $"Creating table {tbl}..."
|
log.LogInformation $"Creating table {tbl}..."
|
||||||
do! rethink { tableCreate tbl [ PrimaryKey "Id" ]; write; withRetryOnce; ignoreResult conn }
|
do! rethink { tableCreate tbl [ PrimaryKey "Id" ]; write; withRetryOnce; ignoreResult conn }
|
||||||
|
|
||||||
|
if not (List.contains Table.DbVersion tables) then
|
||||||
|
// Version table added in v2-rc2; this will flag that migration to be run
|
||||||
|
do! rethink {
|
||||||
|
withTable Table.DbVersion
|
||||||
|
insert {| Id = "v2-rc1" |}
|
||||||
|
write; withRetryOnce; ignoreResult conn
|
||||||
|
}
|
||||||
|
|
||||||
do! ensureIndexes Table.Category [ nameof Category.empty.WebLogId ]
|
do! ensureIndexes Table.Category [ nameof Category.empty.WebLogId ]
|
||||||
do! ensureIndexes Table.Comment [ nameof Comment.empty.PostId ]
|
do! ensureIndexes Table.Comment [ nameof Comment.empty.PostId ]
|
||||||
do! ensureIndexes Table.Page [ nameof Page.empty.WebLogId; nameof Page.empty.AuthorId ]
|
do! ensureIndexes Table.Page [ nameof Page.empty.WebLogId; nameof Page.empty.AuthorId ]
|
||||||
|
@ -1122,4 +1170,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|
||||||
do! ensureIndexes Table.Upload []
|
do! ensureIndexes Table.Upload []
|
||||||
do! ensureIndexes Table.WebLog [ nameof WebLog.empty.UrlBase ]
|
do! ensureIndexes Table.WebLog [ nameof WebLog.empty.UrlBase ]
|
||||||
do! ensureIndexes Table.WebLogUser [ nameof WebLogUser.empty.WebLogId ]
|
do! ensureIndexes Table.WebLogUser [ nameof WebLogUser.empty.WebLogId ]
|
||||||
|
|
||||||
|
let! version = rethink<{| Id : string |} list> {
|
||||||
|
withTable Table.DbVersion
|
||||||
|
limit 1
|
||||||
|
result; withRetryOnce conn
|
||||||
|
}
|
||||||
|
match List.tryHead version with
|
||||||
|
| Some v when v.Id = "v2-rc2" -> ()
|
||||||
|
| it -> do! migrate (it |> Option.map (fun x -> x.Id))
|
||||||
}
|
}
|
||||||
|
|
|
@ -5,6 +5,8 @@ module MyWebLog.Data.SQLite.Helpers
|
||||||
open System
|
open System
|
||||||
open Microsoft.Data.Sqlite
|
open Microsoft.Data.Sqlite
|
||||||
open MyWebLog
|
open MyWebLog
|
||||||
|
open MyWebLog.Data
|
||||||
|
open NodaTime.Text
|
||||||
|
|
||||||
/// Run a command that returns a count
|
/// Run a command that returns a count
|
||||||
let count (cmd : SqliteCommand) = backgroundTask {
|
let count (cmd : SqliteCommand) = backgroundTask {
|
||||||
|
@ -12,23 +14,6 @@ let count (cmd : SqliteCommand) = backgroundTask {
|
||||||
return int (it :?> int64)
|
return int (it :?> int64)
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Get lists of items removed from and added to the given lists
|
|
||||||
let diffLists<'T, 'U when 'U : equality> oldItems newItems (f : 'T -> 'U) =
|
|
||||||
let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other))
|
|
||||||
List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems
|
|
||||||
|
|
||||||
/// Find meta items added and removed
|
|
||||||
let diffMetaItems (oldItems : MetaItem list) newItems =
|
|
||||||
diffLists oldItems newItems (fun item -> $"{item.Name}|{item.Value}")
|
|
||||||
|
|
||||||
/// Find the permalinks added and removed
|
|
||||||
let diffPermalinks oldLinks newLinks =
|
|
||||||
diffLists oldLinks newLinks Permalink.toString
|
|
||||||
|
|
||||||
/// Find the revisions added and removed
|
|
||||||
let diffRevisions oldRevs newRevs =
|
|
||||||
diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.Ticks}|{MarkupText.toString rev.Text}")
|
|
||||||
|
|
||||||
/// Create a list of items from the given data reader
|
/// Create a list of items from the given data reader
|
||||||
let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) =
|
let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) =
|
||||||
seq { while rdr.Read () do it rdr }
|
seq { while rdr.Read () do it rdr }
|
||||||
|
@ -47,6 +32,42 @@ let write (cmd : SqliteCommand) = backgroundTask {
|
||||||
()
|
()
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/// Add a possibly-missing parameter, substituting null for None
|
||||||
|
let maybe<'T> (it : 'T option) : obj = match it with Some x -> x :> obj | None -> DBNull.Value
|
||||||
|
|
||||||
|
/// Create a value for a Duration
|
||||||
|
let durationParam =
|
||||||
|
DurationPattern.Roundtrip.Format
|
||||||
|
|
||||||
|
/// Create a value for an Instant
|
||||||
|
let instantParam =
|
||||||
|
InstantPattern.General.Format
|
||||||
|
|
||||||
|
/// Create an optional value for a Duration
|
||||||
|
let maybeDuration =
|
||||||
|
Option.map durationParam >> maybe
|
||||||
|
|
||||||
|
/// Create an optional value for an Instant
|
||||||
|
let maybeInstant =
|
||||||
|
Option.map instantParam >> maybe
|
||||||
|
|
||||||
|
/// Create the SQL and parameters for an IN clause
|
||||||
|
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) =
|
||||||
|
if List.isEmpty items then "", []
|
||||||
|
else
|
||||||
|
let mutable idx = 0
|
||||||
|
items
|
||||||
|
|> List.skip 1
|
||||||
|
|> List.fold (fun (itemS, itemP) it ->
|
||||||
|
idx <- idx + 1
|
||||||
|
$"{itemS}, @%s{paramName}{idx}", (SqliteParameter ($"@%s{paramName}{idx}", valueFunc it) :: itemP))
|
||||||
|
(Seq.ofList items
|
||||||
|
|> Seq.map (fun it ->
|
||||||
|
$"%s{colNameAndPrefix} IN (@%s{paramName}0", [ SqliteParameter ($"@%s{paramName}0", valueFunc it) ])
|
||||||
|
|> Seq.head)
|
||||||
|
|> function sql, ps -> $"{sql})", ps
|
||||||
|
|
||||||
|
|
||||||
/// Functions to map domain items from a data reader
|
/// Functions to map domain items from a data reader
|
||||||
module Map =
|
module Map =
|
||||||
|
|
||||||
|
@ -73,6 +94,26 @@ module Map =
|
||||||
/// Get a string value from a data reader
|
/// Get a string value from a data reader
|
||||||
let getString col (rdr : SqliteDataReader) = rdr.GetString (rdr.GetOrdinal col)
|
let getString col (rdr : SqliteDataReader) = rdr.GetString (rdr.GetOrdinal col)
|
||||||
|
|
||||||
|
/// Parse a Duration from the given value
|
||||||
|
let parseDuration value =
|
||||||
|
match DurationPattern.Roundtrip.Parse value with
|
||||||
|
| it when it.Success -> it.Value
|
||||||
|
| it -> raise it.Exception
|
||||||
|
|
||||||
|
/// Get a Duration value from a data reader
|
||||||
|
let getDuration col rdr =
|
||||||
|
getString col rdr |> parseDuration
|
||||||
|
|
||||||
|
/// Parse an Instant from the given value
|
||||||
|
let parseInstant value =
|
||||||
|
match InstantPattern.General.Parse value with
|
||||||
|
| it when it.Success -> it.Value
|
||||||
|
| it -> raise it.Exception
|
||||||
|
|
||||||
|
/// Get an Instant value from a data reader
|
||||||
|
let getInstant col rdr =
|
||||||
|
getString col rdr |> parseInstant
|
||||||
|
|
||||||
/// Get a timespan value from a data reader
|
/// Get a timespan value from a data reader
|
||||||
let getTimeSpan col (rdr : SqliteDataReader) = rdr.GetTimeSpan (rdr.GetOrdinal col)
|
let getTimeSpan col (rdr : SqliteDataReader) = rdr.GetTimeSpan (rdr.GetOrdinal col)
|
||||||
|
|
||||||
|
@ -96,6 +137,14 @@ module Map =
|
||||||
let tryString col (rdr : SqliteDataReader) =
|
let tryString col (rdr : SqliteDataReader) =
|
||||||
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr)
|
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr)
|
||||||
|
|
||||||
|
/// Get a possibly null Duration value from a data reader
|
||||||
|
let tryDuration col rdr =
|
||||||
|
tryString col rdr |> Option.map parseDuration
|
||||||
|
|
||||||
|
/// Get a possibly null Instant value from a data reader
|
||||||
|
let tryInstant col rdr =
|
||||||
|
tryString col rdr |> Option.map parseInstant
|
||||||
|
|
||||||
/// Get a possibly null timespan value from a data reader
|
/// Get a possibly null timespan value from a data reader
|
||||||
let tryTimeSpan col (rdr : SqliteDataReader) =
|
let tryTimeSpan col (rdr : SqliteDataReader) =
|
||||||
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
|
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
|
||||||
|
@ -114,100 +163,57 @@ module Map =
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Create a custom feed from the current row in the given data reader
|
/// Create a custom feed from the current row in the given data reader
|
||||||
let toCustomFeed rdr : CustomFeed =
|
let toCustomFeed ser rdr : CustomFeed =
|
||||||
{ Id = getString "id" rdr |> CustomFeedId
|
{ Id = getString "id" rdr |> CustomFeedId
|
||||||
Source = getString "source" rdr |> CustomFeedSource.parse
|
Source = getString "source" rdr |> CustomFeedSource.parse
|
||||||
Path = getString "path" rdr |> Permalink
|
Path = getString "path" rdr |> Permalink
|
||||||
Podcast =
|
Podcast = tryString "podcast" rdr |> Option.map (Utils.deserialize ser)
|
||||||
if rdr.IsDBNull (rdr.GetOrdinal "title") then
|
|
||||||
None
|
|
||||||
else
|
|
||||||
Some {
|
|
||||||
Title = getString "title" rdr
|
|
||||||
Subtitle = tryString "subtitle" rdr
|
|
||||||
ItemsInFeed = getInt "items_in_feed" rdr
|
|
||||||
Summary = getString "summary" rdr
|
|
||||||
DisplayedAuthor = getString "displayed_author" rdr
|
|
||||||
Email = getString "email" rdr
|
|
||||||
ImageUrl = getString "image_url" rdr |> Permalink
|
|
||||||
AppleCategory = getString "apple_category" rdr
|
|
||||||
AppleSubcategory = tryString "apple_subcategory" rdr
|
|
||||||
Explicit = getString "explicit" rdr |> ExplicitRating.parse
|
|
||||||
DefaultMediaType = tryString "default_media_type" rdr
|
|
||||||
MediaBaseUrl = tryString "media_base_url" rdr
|
|
||||||
PodcastGuid = tryGuid "podcast_guid" rdr
|
|
||||||
FundingUrl = tryString "funding_url" rdr
|
|
||||||
FundingText = tryString "funding_text" rdr
|
|
||||||
Medium = tryString "medium" rdr |> Option.map PodcastMedium.parse
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Create a meta item from the current row in the given data reader
|
|
||||||
let toMetaItem rdr : MetaItem =
|
|
||||||
{ Name = getString "name" rdr
|
|
||||||
Value = getString "value" rdr
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Create a permalink from the current row in the given data reader
|
/// Create a permalink from the current row in the given data reader
|
||||||
let toPermalink rdr = getString "permalink" rdr |> Permalink
|
let toPermalink rdr = getString "permalink" rdr |> Permalink
|
||||||
|
|
||||||
/// Create a page from the current row in the given data reader
|
/// Create a page from the current row in the given data reader
|
||||||
let toPage rdr : Page =
|
let toPage ser rdr : Page =
|
||||||
{ Page.empty with
|
{ Page.empty with
|
||||||
Id = getString "id" rdr |> PageId
|
Id = getString "id" rdr |> PageId
|
||||||
WebLogId = getString "web_log_id" rdr |> WebLogId
|
WebLogId = getString "web_log_id" rdr |> WebLogId
|
||||||
AuthorId = getString "author_id" rdr |> WebLogUserId
|
AuthorId = getString "author_id" rdr |> WebLogUserId
|
||||||
Title = getString "title" rdr
|
Title = getString "title" rdr
|
||||||
Permalink = toPermalink rdr
|
Permalink = toPermalink rdr
|
||||||
PublishedOn = getDateTime "published_on" rdr
|
PublishedOn = getInstant "published_on" rdr
|
||||||
UpdatedOn = getDateTime "updated_on" rdr
|
UpdatedOn = getInstant "updated_on" rdr
|
||||||
IsInPageList = getBoolean "is_in_page_list" rdr
|
IsInPageList = getBoolean "is_in_page_list" rdr
|
||||||
Template = tryString "template" rdr
|
Template = tryString "template" rdr
|
||||||
Text = getString "page_text" rdr
|
Text = getString "page_text" rdr
|
||||||
|
Metadata = tryString "meta_items" rdr
|
||||||
|
|> Option.map (Utils.deserialize ser)
|
||||||
|
|> Option.defaultValue []
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Create a post from the current row in the given data reader
|
/// Create a post from the current row in the given data reader
|
||||||
let toPost rdr : Post =
|
let toPost ser rdr : Post =
|
||||||
{ Post.empty with
|
{ Post.empty with
|
||||||
Id = getString "id" rdr |> PostId
|
Id = getString "id" rdr |> PostId
|
||||||
WebLogId = getString "web_log_id" rdr |> WebLogId
|
WebLogId = getString "web_log_id" rdr |> WebLogId
|
||||||
AuthorId = getString "author_id" rdr |> WebLogUserId
|
AuthorId = getString "author_id" rdr |> WebLogUserId
|
||||||
Status = getString "status" rdr |> PostStatus.parse
|
Status = getString "status" rdr |> PostStatus.parse
|
||||||
Title = getString "title" rdr
|
Title = getString "title" rdr
|
||||||
Permalink = toPermalink rdr
|
Permalink = toPermalink rdr
|
||||||
PublishedOn = tryDateTime "published_on" rdr
|
PublishedOn = tryInstant "published_on" rdr
|
||||||
UpdatedOn = getDateTime "updated_on" rdr
|
UpdatedOn = getInstant "updated_on" rdr
|
||||||
Template = tryString "template" rdr
|
Template = tryString "template" rdr
|
||||||
Text = getString "post_text" rdr
|
Text = getString "post_text" rdr
|
||||||
Episode =
|
Episode = tryString "episode" rdr |> Option.map (Utils.deserialize ser)
|
||||||
match tryString "media" rdr with
|
Metadata = tryString "meta_items" rdr
|
||||||
| Some media ->
|
|> Option.map (Utils.deserialize ser)
|
||||||
Some {
|
|> Option.defaultValue []
|
||||||
Media = media
|
|
||||||
Length = getLong "length" rdr
|
|
||||||
Duration = tryTimeSpan "duration" rdr
|
|
||||||
MediaType = tryString "media_type" rdr
|
|
||||||
ImageUrl = tryString "image_url" rdr
|
|
||||||
Subtitle = tryString "subtitle" rdr
|
|
||||||
Explicit = tryString "explicit" rdr |> Option.map ExplicitRating.parse
|
|
||||||
ChapterFile = tryString "chapter_file" rdr
|
|
||||||
ChapterType = tryString "chapter_type" rdr
|
|
||||||
TranscriptUrl = tryString "transcript_url" rdr
|
|
||||||
TranscriptType = tryString "transcript_type" rdr
|
|
||||||
TranscriptLang = tryString "transcript_lang" rdr
|
|
||||||
TranscriptCaptions = tryBoolean "transcript_captions" rdr
|
|
||||||
SeasonNumber = tryInt "season_number" rdr
|
|
||||||
SeasonDescription = tryString "season_description" rdr
|
|
||||||
EpisodeNumber = tryString "episode_number" rdr |> Option.map Double.Parse
|
|
||||||
EpisodeDescription = tryString "episode_description" rdr
|
|
||||||
}
|
|
||||||
| None -> None
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Create a revision from the current row in the given data reader
|
/// Create a revision from the current row in the given data reader
|
||||||
let toRevision rdr : Revision =
|
let toRevision rdr : Revision =
|
||||||
{ AsOf = getDateTime "as_of" rdr
|
{ AsOf = getInstant "as_of" rdr
|
||||||
Text = getString "revision_text" rdr |> MarkupText.parse
|
Text = getString "revision_text" rdr |> MarkupText.parse
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Create a tag mapping from the current row in the given data reader
|
/// Create a tag mapping from the current row in the given data reader
|
||||||
|
@ -237,7 +243,7 @@ module Map =
|
||||||
else
|
else
|
||||||
[||]
|
[||]
|
||||||
{ Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
|
{ Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
|
||||||
UpdatedOn = getDateTime "updated_on" rdr
|
UpdatedOn = getInstant "updated_on" rdr
|
||||||
Data = assetData
|
Data = assetData
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -257,10 +263,10 @@ module Map =
|
||||||
dataStream.ToArray ()
|
dataStream.ToArray ()
|
||||||
else
|
else
|
||||||
[||]
|
[||]
|
||||||
{ Id = getString "id" rdr |> UploadId
|
{ Id = getString "id" rdr |> UploadId
|
||||||
WebLogId = getString "web_log_id" rdr |> WebLogId
|
WebLogId = getString "web_log_id" rdr |> WebLogId
|
||||||
Path = getString "path" rdr |> Permalink
|
Path = getString "path" rdr |> Permalink
|
||||||
UpdatedOn = getDateTime "updated_on" rdr
|
UpdatedOn = getInstant "updated_on" rdr
|
||||||
Data = data
|
Data = data
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -290,23 +296,19 @@ module Map =
|
||||||
|
|
||||||
/// Create a web log user from the current row in the given data reader
|
/// Create a web log user from the current row in the given data reader
|
||||||
let toWebLogUser rdr : WebLogUser =
|
let toWebLogUser rdr : WebLogUser =
|
||||||
{ Id = getString "id" rdr |> WebLogUserId
|
{ Id = getString "id" rdr |> WebLogUserId
|
||||||
WebLogId = getString "web_log_id" rdr |> WebLogId
|
WebLogId = getString "web_log_id" rdr |> WebLogId
|
||||||
Email = getString "email" rdr
|
Email = getString "email" rdr
|
||||||
FirstName = getString "first_name" rdr
|
FirstName = getString "first_name" rdr
|
||||||
LastName = getString "last_name" rdr
|
LastName = getString "last_name" rdr
|
||||||
PreferredName = getString "preferred_name" rdr
|
PreferredName = getString "preferred_name" rdr
|
||||||
PasswordHash = getString "password_hash" rdr
|
PasswordHash = getString "password_hash" rdr
|
||||||
Salt = getGuid "salt" rdr
|
Url = tryString "url" rdr
|
||||||
Url = tryString "url" rdr
|
AccessLevel = getString "access_level" rdr |> AccessLevel.parse
|
||||||
AccessLevel = getString "access_level" rdr |> AccessLevel.parse
|
CreatedOn = getInstant "created_on" rdr
|
||||||
CreatedOn = getDateTime "created_on" rdr
|
LastSeenOn = tryInstant "last_seen_on" rdr
|
||||||
LastSeenOn = tryDateTime "last_seen_on" rdr
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Add a possibly-missing parameter, substituting null for None
|
|
||||||
let maybe<'T> (it : 'T option) : obj = match it with Some x -> x :> obj | None -> DBNull.Value
|
|
||||||
|
|
||||||
/// Add a web log ID parameter
|
/// Add a web log ID parameter
|
||||||
let addWebLogId (cmd : SqliteCommand) webLogId =
|
let addWebLogId (cmd : SqliteCommand) webLogId =
|
||||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
|
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
|
||||||
|
|
|
@ -10,23 +10,23 @@ type SQLiteCategoryData (conn : SqliteConnection) =
|
||||||
|
|
||||||
/// Add parameters for category INSERT or UPDATE statements
|
/// Add parameters for category INSERT or UPDATE statements
|
||||||
let addCategoryParameters (cmd : SqliteCommand) (cat : Category) =
|
let addCategoryParameters (cmd : SqliteCommand) (cat : Category) =
|
||||||
[ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.Id)
|
[ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.Id)
|
||||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId)
|
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId)
|
||||||
cmd.Parameters.AddWithValue ("@name", cat.Name)
|
cmd.Parameters.AddWithValue ("@name", cat.Name)
|
||||||
cmd.Parameters.AddWithValue ("@slug", cat.Slug)
|
cmd.Parameters.AddWithValue ("@slug", cat.Slug)
|
||||||
cmd.Parameters.AddWithValue ("@description", maybe cat.Description)
|
cmd.Parameters.AddWithValue ("@description", maybe cat.Description)
|
||||||
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
|
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
|
||||||
] |> ignore
|
] |> ignore
|
||||||
|
|
||||||
/// Add a category
|
/// Add a category
|
||||||
let add cat = backgroundTask {
|
let add cat = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
INSERT INTO category (
|
"INSERT INTO category (
|
||||||
id, web_log_id, name, slug, description, parent_id
|
id, web_log_id, name, slug, description, parent_id
|
||||||
) VALUES (
|
) VALUES (
|
||||||
@id, @webLogId, @name, @slug, @description, @parentId
|
@id, @webLogId, @name, @slug, @description, @parentId
|
||||||
)"""
|
)"
|
||||||
addCategoryParameters cmd cat
|
addCategoryParameters cmd cat
|
||||||
let! _ = cmd.ExecuteNonQueryAsync ()
|
let! _ = cmd.ExecuteNonQueryAsync ()
|
||||||
()
|
()
|
||||||
|
@ -68,24 +68,23 @@ type SQLiteCategoryData (conn : SqliteConnection) =
|
||||||
ordered
|
ordered
|
||||||
|> Seq.map (fun it -> backgroundTask {
|
|> Seq.map (fun it -> backgroundTask {
|
||||||
// Parent category post counts include posts in subcategories
|
// Parent category post counts include posts in subcategories
|
||||||
|
let catSql, catParams =
|
||||||
|
ordered
|
||||||
|
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|
||||||
|
|> Seq.map (fun cat -> cat.Id)
|
||||||
|
|> Seq.append (Seq.singleton it.Id)
|
||||||
|
|> List.ofSeq
|
||||||
|
|> inClause "AND pc.category_id" "catId" id
|
||||||
cmd.Parameters.Clear ()
|
cmd.Parameters.Clear ()
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
cmd.CommandText <- """
|
cmd.Parameters.AddRange catParams
|
||||||
|
cmd.CommandText <- $"
|
||||||
SELECT COUNT(DISTINCT p.id)
|
SELECT COUNT(DISTINCT p.id)
|
||||||
FROM post p
|
FROM post p
|
||||||
INNER JOIN post_category pc ON pc.post_id = p.id
|
INNER JOIN post_category pc ON pc.post_id = p.id
|
||||||
WHERE p.web_log_id = @webLogId
|
WHERE p.web_log_id = @webLogId
|
||||||
AND p.status = 'Published'
|
AND p.status = 'Published'
|
||||||
AND pc.category_id IN ("""
|
{catSql}"
|
||||||
ordered
|
|
||||||
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|
|
||||||
|> Seq.map (fun cat -> cat.Id)
|
|
||||||
|> Seq.append (Seq.singleton it.Id)
|
|
||||||
|> Seq.iteri (fun idx item ->
|
|
||||||
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
|
|
||||||
cmd.CommandText <- $"{cmd.CommandText}@catId{idx}"
|
|
||||||
cmd.Parameters.AddWithValue ($"@catId{idx}", item) |> ignore)
|
|
||||||
cmd.CommandText <- $"{cmd.CommandText})"
|
|
||||||
let! postCount = count cmd
|
let! postCount = count cmd
|
||||||
return it.Id, postCount
|
return it.Id, postCount
|
||||||
})
|
})
|
||||||
|
@ -133,19 +132,15 @@ type SQLiteCategoryData (conn : SqliteConnection) =
|
||||||
cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
|
cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
|
||||||
|> ignore
|
|> ignore
|
||||||
do! write cmd
|
do! write cmd
|
||||||
// Delete the category off all posts where it is assigned
|
// Delete the category off all posts where it is assigned, and the category itself
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
DELETE FROM post_category
|
"DELETE FROM post_category
|
||||||
WHERE category_id = @id
|
WHERE category_id = @id
|
||||||
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)"""
|
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId);
|
||||||
|
DELETE FROM category WHERE id = @id"
|
||||||
cmd.Parameters.Clear ()
|
cmd.Parameters.Clear ()
|
||||||
let catIdParameter = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
|
let _ = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
|
||||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
|
addWebLogId cmd webLogId
|
||||||
do! write cmd
|
|
||||||
// Delete the category itself
|
|
||||||
cmd.CommandText <- "DELETE FROM category WHERE id = @id"
|
|
||||||
cmd.Parameters.Clear ()
|
|
||||||
cmd.Parameters.Add catIdParameter |> ignore
|
|
||||||
do! write cmd
|
do! write cmd
|
||||||
return if children = 0 then CategoryDeleted else ReassignedChildCategories
|
return if children = 0 then CategoryDeleted else ReassignedChildCategories
|
||||||
| None -> return CategoryNotFound
|
| None -> return CategoryNotFound
|
||||||
|
@ -160,14 +155,14 @@ type SQLiteCategoryData (conn : SqliteConnection) =
|
||||||
/// Update a category
|
/// Update a category
|
||||||
let update cat = backgroundTask {
|
let update cat = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
UPDATE category
|
"UPDATE category
|
||||||
SET name = @name,
|
SET name = @name,
|
||||||
slug = @slug,
|
slug = @slug,
|
||||||
description = @description,
|
description = @description,
|
||||||
parent_id = @parentId
|
parent_id = @parentId
|
||||||
WHERE id = @id
|
WHERE id = @id
|
||||||
AND web_log_id = @webLogId"""
|
AND web_log_id = @webLogId"
|
||||||
addCategoryParameters cmd cat
|
addCategoryParameters cmd cat
|
||||||
do! write cmd
|
do! write cmd
|
||||||
}
|
}
|
||||||
|
|
|
@ -4,35 +4,29 @@ open System.Threading.Tasks
|
||||||
open Microsoft.Data.Sqlite
|
open Microsoft.Data.Sqlite
|
||||||
open MyWebLog
|
open MyWebLog
|
||||||
open MyWebLog.Data
|
open MyWebLog.Data
|
||||||
|
open Newtonsoft.Json
|
||||||
|
|
||||||
/// SQLite myWebLog page data implementation
|
/// SQLite myWebLog page data implementation
|
||||||
type SQLitePageData (conn : SqliteConnection) =
|
type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
|
||||||
|
|
||||||
// SUPPORT FUNCTIONS
|
// SUPPORT FUNCTIONS
|
||||||
|
|
||||||
/// Add parameters for page INSERT or UPDATE statements
|
/// Add parameters for page INSERT or UPDATE statements
|
||||||
let addPageParameters (cmd : SqliteCommand) (page : Page) =
|
let addPageParameters (cmd : SqliteCommand) (page : Page) =
|
||||||
[ cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id)
|
[ cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id)
|
||||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId)
|
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId)
|
||||||
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId)
|
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId)
|
||||||
cmd.Parameters.AddWithValue ("@title", page.Title)
|
cmd.Parameters.AddWithValue ("@title", page.Title)
|
||||||
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink)
|
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink)
|
||||||
cmd.Parameters.AddWithValue ("@publishedOn", page.PublishedOn)
|
cmd.Parameters.AddWithValue ("@publishedOn", instantParam page.PublishedOn)
|
||||||
cmd.Parameters.AddWithValue ("@updatedOn", page.UpdatedOn)
|
cmd.Parameters.AddWithValue ("@updatedOn", instantParam page.UpdatedOn)
|
||||||
cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
|
cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
|
||||||
cmd.Parameters.AddWithValue ("@template", maybe page.Template)
|
cmd.Parameters.AddWithValue ("@template", maybe page.Template)
|
||||||
cmd.Parameters.AddWithValue ("@text", page.Text)
|
cmd.Parameters.AddWithValue ("@text", page.Text)
|
||||||
|
cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty page.Metadata then None
|
||||||
|
else Some (Utils.serialize ser page.Metadata)))
|
||||||
] |> ignore
|
] |> ignore
|
||||||
|
|
||||||
/// Append meta items to a page
|
|
||||||
let appendPageMeta (page : Page) = backgroundTask {
|
|
||||||
use cmd = conn.CreateCommand ()
|
|
||||||
cmd.CommandText <- "SELECT name, value FROM page_meta WHERE page_id = @id"
|
|
||||||
cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id) |> ignore
|
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
|
||||||
return { page with Metadata = toList Map.toMetaItem rdr }
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Append revisions and permalinks to a page
|
/// Append revisions and permalinks to a page
|
||||||
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
|
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
|
@ -48,47 +42,23 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||||
return { page with Revisions = toList Map.toRevision rdr }
|
return { page with Revisions = toList Map.toRevision rdr }
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Return a page with no text (or meta items, prior permalinks, or revisions)
|
/// Shorthand for mapping a data reader to a page
|
||||||
let pageWithoutTextOrMeta rdr =
|
let toPage =
|
||||||
{ Map.toPage rdr with Text = "" }
|
Map.toPage ser
|
||||||
|
|
||||||
/// Update a page's metadata items
|
/// Return a page with no text (or prior permalinks or revisions)
|
||||||
let updatePageMeta pageId oldItems newItems = backgroundTask {
|
let pageWithoutText rdr =
|
||||||
let toDelete, toAdd = diffMetaItems oldItems newItems
|
{ toPage rdr with Text = "" }
|
||||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
|
||||||
return ()
|
|
||||||
else
|
|
||||||
use cmd = conn.CreateCommand ()
|
|
||||||
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
|
|
||||||
cmd.Parameters.Add ("@name", SqliteType.Text)
|
|
||||||
cmd.Parameters.Add ("@value", SqliteType.Text)
|
|
||||||
] |> ignore
|
|
||||||
let runCmd (item : MetaItem) = backgroundTask {
|
|
||||||
cmd.Parameters["@name" ].Value <- item.Name
|
|
||||||
cmd.Parameters["@value"].Value <- item.Value
|
|
||||||
do! write cmd
|
|
||||||
}
|
|
||||||
cmd.CommandText <- "DELETE FROM page_meta WHERE page_id = @pageId AND name = @name AND value = @value"
|
|
||||||
toDelete
|
|
||||||
|> List.map runCmd
|
|
||||||
|> Task.WhenAll
|
|
||||||
|> ignore
|
|
||||||
cmd.CommandText <- "INSERT INTO page_meta VALUES (@pageId, @name, @value)"
|
|
||||||
toAdd
|
|
||||||
|> List.map runCmd
|
|
||||||
|> Task.WhenAll
|
|
||||||
|> ignore
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Update a page's prior permalinks
|
/// Update a page's prior permalinks
|
||||||
let updatePagePermalinks pageId oldLinks newLinks = backgroundTask {
|
let updatePagePermalinks pageId oldLinks newLinks = backgroundTask {
|
||||||
let toDelete, toAdd = diffPermalinks oldLinks newLinks
|
let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
|
||||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
if List.isEmpty toDelete && List.isEmpty toAdd then
|
||||||
return ()
|
return ()
|
||||||
else
|
else
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
|
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
|
||||||
cmd.Parameters.Add ("@link", SqliteType.Text)
|
cmd.Parameters.Add ("@link", SqliteType.Text)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
let runCmd link = backgroundTask {
|
let runCmd link = backgroundTask {
|
||||||
cmd.Parameters["@link"].Value <- Permalink.toString link
|
cmd.Parameters["@link"].Value <- Permalink.toString link
|
||||||
|
@ -108,15 +78,15 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||||
|
|
||||||
/// Update a page's revisions
|
/// Update a page's revisions
|
||||||
let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
|
let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
|
||||||
let toDelete, toAdd = diffRevisions oldRevs newRevs
|
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
|
||||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
if List.isEmpty toDelete && List.isEmpty toAdd then
|
||||||
return ()
|
return ()
|
||||||
else
|
else
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
let runCmd withText rev = backgroundTask {
|
let runCmd withText rev = backgroundTask {
|
||||||
cmd.Parameters.Clear ()
|
cmd.Parameters.Clear ()
|
||||||
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
|
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
|
||||||
cmd.Parameters.AddWithValue ("@asOf", rev.AsOf)
|
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
|
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
|
||||||
do! write cmd
|
do! write cmd
|
||||||
|
@ -139,17 +109,16 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||||
let add page = backgroundTask {
|
let add page = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
// The page itself
|
// The page itself
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
INSERT INTO page (
|
"INSERT INTO page (
|
||||||
id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template,
|
id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template,
|
||||||
page_text
|
page_text, meta_items
|
||||||
) VALUES (
|
) VALUES (
|
||||||
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template,
|
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template,
|
||||||
@text
|
@text, @metaItems
|
||||||
)"""
|
)"
|
||||||
addPageParameters cmd page
|
addPageParameters cmd page
|
||||||
do! write cmd
|
do! write cmd
|
||||||
do! updatePageMeta page.Id [] page.Metadata
|
|
||||||
do! updatePagePermalinks page.Id [] page.PriorPermalinks
|
do! updatePagePermalinks page.Id [] page.PriorPermalinks
|
||||||
do! updatePageRevisions page.Id [] page.Revisions
|
do! updatePageRevisions page.Id [] page.Revisions
|
||||||
}
|
}
|
||||||
|
@ -160,7 +129,7 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||||
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)"
|
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)"
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
return toList pageWithoutTextOrMeta rdr
|
return toList pageWithoutText rdr
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Count all pages for the given web log
|
/// Count all pages for the given web log
|
||||||
|
@ -174,11 +143,11 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||||
/// Count all pages shown in the page list for the given web log
|
/// Count all pages shown in the page list for the given web log
|
||||||
let countListed webLogId = backgroundTask {
|
let countListed webLogId = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
SELECT COUNT(id)
|
"SELECT COUNT(id)
|
||||||
FROM page
|
FROM page
|
||||||
WHERE web_log_id = @webLogId
|
WHERE web_log_id = @webLogId
|
||||||
AND is_in_page_list = @isInPageList"""
|
AND is_in_page_list = @isInPageList"
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
|
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
|
||||||
return! count cmd
|
return! count cmd
|
||||||
|
@ -190,11 +159,7 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||||
cmd.CommandText <- "SELECT * FROM page WHERE id = @id"
|
cmd.CommandText <- "SELECT * FROM page WHERE id = @id"
|
||||||
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
|
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
match Helpers.verifyWebLog<Page> webLogId (fun it -> it.WebLogId) Map.toPage rdr with
|
return Helpers.verifyWebLog<Page> webLogId (fun it -> it.WebLogId) (Map.toPage ser) rdr
|
||||||
| Some page ->
|
|
||||||
let! page = appendPageMeta page
|
|
||||||
return Some page
|
|
||||||
| None -> return None
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Find a complete page by its ID
|
/// Find a complete page by its ID
|
||||||
|
@ -211,11 +176,10 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||||
| Some _ ->
|
| Some _ ->
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
|
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
DELETE FROM page_revision WHERE page_id = @id;
|
"DELETE FROM page_revision WHERE page_id = @id;
|
||||||
DELETE FROM page_permalink WHERE page_id = @id;
|
DELETE FROM page_permalink WHERE page_id = @id;
|
||||||
DELETE FROM page_meta WHERE page_id = @id;
|
DELETE FROM page WHERE id = @id"
|
||||||
DELETE FROM page WHERE id = @id"""
|
|
||||||
do! write cmd
|
do! write cmd
|
||||||
return true
|
return true
|
||||||
| None -> return false
|
| None -> return false
|
||||||
|
@ -228,29 +192,21 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
|
cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
if rdr.Read () then
|
return if rdr.Read () then Some (toPage rdr) else None
|
||||||
let! page = appendPageMeta (Map.toPage rdr)
|
|
||||||
return Some page
|
|
||||||
else
|
|
||||||
return None
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Find the current permalink within a set of potential prior permalinks for the given web log
|
/// Find the current permalink within a set of potential prior permalinks for the given web log
|
||||||
let findCurrentPermalink permalinks webLogId = backgroundTask {
|
let findCurrentPermalink permalinks webLogId = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
let linkSql, linkParams = inClause "AND pp.permalink" "link" Permalink.toString permalinks
|
||||||
|
cmd.CommandText <- $"
|
||||||
SELECT p.permalink
|
SELECT p.permalink
|
||||||
FROM page p
|
FROM page p
|
||||||
INNER JOIN page_permalink pp ON pp.page_id = p.id
|
INNER JOIN page_permalink pp ON pp.page_id = p.id
|
||||||
WHERE p.web_log_id = @webLogId
|
WHERE p.web_log_id = @webLogId
|
||||||
AND pp.permalink IN ("""
|
{linkSql}"
|
||||||
permalinks
|
|
||||||
|> List.iteri (fun idx link ->
|
|
||||||
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
|
|
||||||
cmd.CommandText <- $"{cmd.CommandText}@link{idx}"
|
|
||||||
cmd.Parameters.AddWithValue ($"@link{idx}", Permalink.toString link) |> ignore)
|
|
||||||
cmd.CommandText <- $"{cmd.CommandText})"
|
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
|
cmd.Parameters.AddRange linkParams
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
return if rdr.Read () then Some (Map.toPermalink rdr) else None
|
return if rdr.Read () then Some (Map.toPermalink rdr) else None
|
||||||
}
|
}
|
||||||
|
@ -262,11 +218,8 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
let! pages =
|
let! pages =
|
||||||
toList Map.toPage rdr
|
toList toPage rdr
|
||||||
|> List.map (fun page -> backgroundTask {
|
|> List.map (fun page -> backgroundTask { return! appendPageRevisionsAndPermalinks page })
|
||||||
let! page = appendPageMeta page
|
|
||||||
return! appendPageRevisionsAndPermalinks page
|
|
||||||
})
|
|
||||||
|> Task.WhenAll
|
|> Task.WhenAll
|
||||||
return List.ofArray pages
|
return List.ofArray pages
|
||||||
}
|
}
|
||||||
|
@ -274,37 +227,33 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||||
/// Get all listed pages for the given web log (without revisions, prior permalinks, or text)
|
/// Get all listed pages for the given web log (without revisions, prior permalinks, or text)
|
||||||
let findListed webLogId = backgroundTask {
|
let findListed webLogId = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
SELECT *
|
"SELECT *
|
||||||
FROM page
|
FROM page
|
||||||
WHERE web_log_id = @webLogId
|
WHERE web_log_id = @webLogId
|
||||||
AND is_in_page_list = @isInPageList
|
AND is_in_page_list = @isInPageList
|
||||||
ORDER BY LOWER(title)"""
|
ORDER BY LOWER(title)"
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
|
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
let! pages =
|
return toList pageWithoutText rdr
|
||||||
toList pageWithoutTextOrMeta rdr
|
|
||||||
|> List.map (fun page -> backgroundTask { return! appendPageMeta page })
|
|
||||||
|> Task.WhenAll
|
|
||||||
return List.ofArray pages
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata)
|
/// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata)
|
||||||
let findPageOfPages webLogId pageNbr = backgroundTask {
|
let findPageOfPages webLogId pageNbr = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
SELECT *
|
"SELECT *
|
||||||
FROM page
|
FROM page
|
||||||
WHERE web_log_id = @webLogId
|
WHERE web_log_id = @webLogId
|
||||||
ORDER BY LOWER(title)
|
ORDER BY LOWER(title)
|
||||||
LIMIT @pageSize OFFSET @toSkip"""
|
LIMIT @pageSize OFFSET @toSkip"
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
[ cmd.Parameters.AddWithValue ("@pageSize", 26)
|
[ cmd.Parameters.AddWithValue ("@pageSize", 26)
|
||||||
cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25)
|
cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
return toList Map.toPage rdr
|
return toList toPage rdr
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Restore pages from a backup
|
/// Restore pages from a backup
|
||||||
|
@ -318,21 +267,21 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||||
match! findFullById page.Id page.WebLogId with
|
match! findFullById page.Id page.WebLogId with
|
||||||
| Some oldPage ->
|
| Some oldPage ->
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
UPDATE page
|
"UPDATE page
|
||||||
SET author_id = @authorId,
|
SET author_id = @authorId,
|
||||||
title = @title,
|
title = @title,
|
||||||
permalink = @permalink,
|
permalink = @permalink,
|
||||||
published_on = @publishedOn,
|
published_on = @publishedOn,
|
||||||
updated_on = @updatedOn,
|
updated_on = @updatedOn,
|
||||||
is_in_page_list = @isInPageList,
|
is_in_page_list = @isInPageList,
|
||||||
template = @template,
|
template = @template,
|
||||||
page_text = @text
|
page_text = @text,
|
||||||
WHERE id = @id
|
meta_items = @metaItems
|
||||||
AND web_log_id = @webLogId"""
|
WHERE id = @id
|
||||||
|
AND web_log_id = @webLogId"
|
||||||
addPageParameters cmd page
|
addPageParameters cmd page
|
||||||
do! write cmd
|
do! write cmd
|
||||||
do! updatePageMeta page.Id oldPage.Metadata page.Metadata
|
|
||||||
do! updatePagePermalinks page.Id oldPage.PriorPermalinks page.PriorPermalinks
|
do! updatePagePermalinks page.Id oldPage.PriorPermalinks page.PriorPermalinks
|
||||||
do! updatePageRevisions page.Id oldPage.Revisions page.Revisions
|
do! updatePageRevisions page.Id oldPage.Revisions page.Revisions
|
||||||
return ()
|
return ()
|
||||||
|
|
|
@ -1,53 +1,38 @@
|
||||||
namespace MyWebLog.Data.SQLite
|
namespace MyWebLog.Data.SQLite
|
||||||
|
|
||||||
open System
|
|
||||||
open System.Threading.Tasks
|
open System.Threading.Tasks
|
||||||
open Microsoft.Data.Sqlite
|
open Microsoft.Data.Sqlite
|
||||||
open MyWebLog
|
open MyWebLog
|
||||||
open MyWebLog.Data
|
open MyWebLog.Data
|
||||||
|
open Newtonsoft.Json
|
||||||
|
open NodaTime
|
||||||
|
|
||||||
/// SQLite myWebLog post data implementation
|
/// SQLite myWebLog post data implementation
|
||||||
type SQLitePostData (conn : SqliteConnection) =
|
type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
|
||||||
|
|
||||||
// SUPPORT FUNCTIONS
|
// SUPPORT FUNCTIONS
|
||||||
|
|
||||||
/// Add parameters for post INSERT or UPDATE statements
|
/// Add parameters for post INSERT or UPDATE statements
|
||||||
let addPostParameters (cmd : SqliteCommand) (post : Post) =
|
let addPostParameters (cmd : SqliteCommand) (post : Post) =
|
||||||
[ cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id)
|
[ cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id)
|
||||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId)
|
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId)
|
||||||
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId)
|
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId)
|
||||||
cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status)
|
cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status)
|
||||||
cmd.Parameters.AddWithValue ("@title", post.Title)
|
cmd.Parameters.AddWithValue ("@title", post.Title)
|
||||||
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink)
|
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink)
|
||||||
cmd.Parameters.AddWithValue ("@publishedOn", maybe post.PublishedOn)
|
cmd.Parameters.AddWithValue ("@publishedOn", maybeInstant post.PublishedOn)
|
||||||
cmd.Parameters.AddWithValue ("@updatedOn", post.UpdatedOn)
|
cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn)
|
||||||
cmd.Parameters.AddWithValue ("@template", maybe post.Template)
|
cmd.Parameters.AddWithValue ("@template", maybe post.Template)
|
||||||
cmd.Parameters.AddWithValue ("@text", post.Text)
|
cmd.Parameters.AddWithValue ("@text", post.Text)
|
||||||
|
cmd.Parameters.AddWithValue ("@episode", maybe (if Option.isSome post.Episode then
|
||||||
|
Some (Utils.serialize ser post.Episode)
|
||||||
|
else None))
|
||||||
|
cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty post.Metadata then None
|
||||||
|
else Some (Utils.serialize ser post.Metadata)))
|
||||||
] |> ignore
|
] |> ignore
|
||||||
|
|
||||||
/// Add parameters for episode INSERT or UPDATE statements
|
/// Append category IDs and tags to a post
|
||||||
let addEpisodeParameters (cmd : SqliteCommand) (ep : Episode) =
|
let appendPostCategoryAndTag (post : Post) = backgroundTask {
|
||||||
[ cmd.Parameters.AddWithValue ("@media", ep.Media)
|
|
||||||
cmd.Parameters.AddWithValue ("@length", ep.Length)
|
|
||||||
cmd.Parameters.AddWithValue ("@duration", maybe ep.Duration)
|
|
||||||
cmd.Parameters.AddWithValue ("@mediaType", maybe ep.MediaType)
|
|
||||||
cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.ImageUrl)
|
|
||||||
cmd.Parameters.AddWithValue ("@subtitle", maybe ep.Subtitle)
|
|
||||||
cmd.Parameters.AddWithValue ("@explicit", maybe (ep.Explicit |> Option.map ExplicitRating.toString))
|
|
||||||
cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.ChapterFile)
|
|
||||||
cmd.Parameters.AddWithValue ("@chapterType", maybe ep.ChapterType)
|
|
||||||
cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.TranscriptUrl)
|
|
||||||
cmd.Parameters.AddWithValue ("@transcriptType", maybe ep.TranscriptType)
|
|
||||||
cmd.Parameters.AddWithValue ("@transcriptLang", maybe ep.TranscriptLang)
|
|
||||||
cmd.Parameters.AddWithValue ("@transcriptCaptions", maybe ep.TranscriptCaptions)
|
|
||||||
cmd.Parameters.AddWithValue ("@seasonNumber", maybe ep.SeasonNumber)
|
|
||||||
cmd.Parameters.AddWithValue ("@seasonDescription", maybe ep.SeasonDescription)
|
|
||||||
cmd.Parameters.AddWithValue ("@episodeNumber", maybe (ep.EpisodeNumber |> Option.map string))
|
|
||||||
cmd.Parameters.AddWithValue ("@episodeDescription", maybe ep.EpisodeDescription)
|
|
||||||
] |> ignore
|
|
||||||
|
|
||||||
/// Append category IDs, tags, and meta items to a post
|
|
||||||
let appendPostCategoryTagAndMeta (post : Post) = backgroundTask {
|
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id) |> ignore
|
cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id) |> ignore
|
||||||
|
|
||||||
|
@ -58,12 +43,7 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
|
|
||||||
cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id"
|
cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id"
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
let post = { post with Tags = toList (Map.getString "tag") rdr }
|
return { post with Tags = toList (Map.getString "tag") rdr }
|
||||||
do! rdr.CloseAsync ()
|
|
||||||
|
|
||||||
cmd.CommandText <- "SELECT name, value FROM post_meta WHERE post_id = @id"
|
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
|
||||||
return { post with Metadata = toList Map.toMetaItem rdr }
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Append revisions and permalinks to a post
|
/// Append revisions and permalinks to a post
|
||||||
|
@ -82,7 +62,11 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
}
|
}
|
||||||
|
|
||||||
/// The SELECT statement for a post that will include episode data, if it exists
|
/// The SELECT statement for a post that will include episode data, if it exists
|
||||||
let selectPost = "SELECT p.*, e.* FROM post p LEFT JOIN post_episode e ON e.post_id = p.id"
|
let selectPost = "SELECT p.* FROM post p"
|
||||||
|
|
||||||
|
/// Shorthand for mapping a data reader to a post
|
||||||
|
let toPost =
|
||||||
|
Map.toPost ser
|
||||||
|
|
||||||
/// Find just-the-post by its ID for the given web log (excludes category, tag, meta, revisions, and permalinks)
|
/// Find just-the-post by its ID for the given web log (excludes category, tag, meta, revisions, and permalinks)
|
||||||
let findPostById postId webLogId = backgroundTask {
|
let findPostById postId webLogId = backgroundTask {
|
||||||
|
@ -90,22 +74,22 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
|
cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
|
||||||
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
|
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
return Helpers.verifyWebLog<Post> webLogId (fun p -> p.WebLogId) Map.toPost rdr
|
return Helpers.verifyWebLog<Post> webLogId (fun p -> p.WebLogId) toPost rdr
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Return a post with no revisions, prior permalinks, or text
|
/// Return a post with no revisions, prior permalinks, or text
|
||||||
let postWithoutText rdr =
|
let postWithoutText rdr =
|
||||||
{ Map.toPost rdr with Text = "" }
|
{ toPost rdr with Text = "" }
|
||||||
|
|
||||||
/// Update a post's assigned categories
|
/// Update a post's assigned categories
|
||||||
let updatePostCategories postId oldCats newCats = backgroundTask {
|
let updatePostCategories postId oldCats newCats = backgroundTask {
|
||||||
let toDelete, toAdd = diffLists oldCats newCats CategoryId.toString
|
let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString
|
||||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
if List.isEmpty toDelete && List.isEmpty toAdd then
|
||||||
return ()
|
return ()
|
||||||
else
|
else
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
|
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
|
||||||
cmd.Parameters.Add ("@categoryId", SqliteType.Text)
|
cmd.Parameters.Add ("@categoryId", SqliteType.Text)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
let runCmd catId = backgroundTask {
|
let runCmd catId = backgroundTask {
|
||||||
cmd.Parameters["@categoryId"].Value <- CategoryId.toString catId
|
cmd.Parameters["@categoryId"].Value <- CategoryId.toString catId
|
||||||
|
@ -125,13 +109,13 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
|
|
||||||
/// Update a post's assigned categories
|
/// Update a post's assigned categories
|
||||||
let updatePostTags postId (oldTags : string list) newTags = backgroundTask {
|
let updatePostTags postId (oldTags : string list) newTags = backgroundTask {
|
||||||
let toDelete, toAdd = diffLists oldTags newTags id
|
let toDelete, toAdd = Utils.diffLists oldTags newTags id
|
||||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
if List.isEmpty toDelete && List.isEmpty toAdd then
|
||||||
return ()
|
return ()
|
||||||
else
|
else
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
|
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
|
||||||
cmd.Parameters.Add ("@tag", SqliteType.Text)
|
cmd.Parameters.Add ("@tag", SqliteType.Text)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
let runCmd (tag : string) = backgroundTask {
|
let runCmd (tag : string) = backgroundTask {
|
||||||
cmd.Parameters["@tag"].Value <- tag
|
cmd.Parameters["@tag"].Value <- tag
|
||||||
|
@ -149,95 +133,15 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
|> ignore
|
|> ignore
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Update an episode
|
|
||||||
let updatePostEpisode (post : Post) = backgroundTask {
|
|
||||||
use cmd = conn.CreateCommand ()
|
|
||||||
cmd.CommandText <- "SELECT COUNT(post_id) FROM post_episode WHERE post_id = @postId"
|
|
||||||
cmd.Parameters.AddWithValue ("@postId", PostId.toString post.Id) |> ignore
|
|
||||||
let! count = count cmd
|
|
||||||
if count = 1 then
|
|
||||||
match post.Episode with
|
|
||||||
| Some ep ->
|
|
||||||
cmd.CommandText <- """
|
|
||||||
UPDATE post_episode
|
|
||||||
SET media = @media,
|
|
||||||
length = @length,
|
|
||||||
duration = @duration,
|
|
||||||
media_type = @mediaType,
|
|
||||||
image_url = @imageUrl,
|
|
||||||
subtitle = @subtitle,
|
|
||||||
explicit = @explicit,
|
|
||||||
chapter_file = @chapterFile,
|
|
||||||
chapter_type = @chapterType,
|
|
||||||
transcript_url = @transcriptUrl,
|
|
||||||
transcript_type = @transcriptType,
|
|
||||||
transcript_lang = @transcriptLang,
|
|
||||||
transcript_captions = @transcriptCaptions,
|
|
||||||
season_number = @seasonNumber,
|
|
||||||
season_description = @seasonDescription,
|
|
||||||
episode_number = @episodeNumber,
|
|
||||||
episode_description = @episodeDescription
|
|
||||||
WHERE post_id = @postId"""
|
|
||||||
addEpisodeParameters cmd ep
|
|
||||||
do! write cmd
|
|
||||||
| None ->
|
|
||||||
cmd.CommandText <- "DELETE FROM post_episode WHERE post_id = @postId"
|
|
||||||
do! write cmd
|
|
||||||
else
|
|
||||||
match post.Episode with
|
|
||||||
| Some ep ->
|
|
||||||
cmd.CommandText <- """
|
|
||||||
INSERT INTO post_episode (
|
|
||||||
post_id, media, length, duration, media_type, image_url, subtitle, explicit, chapter_file,
|
|
||||||
chapter_type, transcript_url, transcript_type, transcript_lang, transcript_captions,
|
|
||||||
season_number, season_description, episode_number, episode_description
|
|
||||||
) VALUES (
|
|
||||||
@postId, @media, @length, @duration, @mediaType, @imageUrl, @subtitle, @explicit, @chapterFile,
|
|
||||||
@chapterType, @transcriptUrl, @transcriptType, @transcriptLang, @transcriptCaptions,
|
|
||||||
@seasonNumber, @seasonDescription, @episodeNumber, @episodeDescription
|
|
||||||
)"""
|
|
||||||
addEpisodeParameters cmd ep
|
|
||||||
do! write cmd
|
|
||||||
| None -> ()
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Update a post's metadata items
|
|
||||||
let updatePostMeta postId oldItems newItems = backgroundTask {
|
|
||||||
let toDelete, toAdd = diffMetaItems oldItems newItems
|
|
||||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
|
||||||
return ()
|
|
||||||
else
|
|
||||||
use cmd = conn.CreateCommand ()
|
|
||||||
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
|
|
||||||
cmd.Parameters.Add ("@name", SqliteType.Text)
|
|
||||||
cmd.Parameters.Add ("@value", SqliteType.Text)
|
|
||||||
] |> ignore
|
|
||||||
let runCmd (item : MetaItem) = backgroundTask {
|
|
||||||
cmd.Parameters["@name" ].Value <- item.Name
|
|
||||||
cmd.Parameters["@value"].Value <- item.Value
|
|
||||||
do! write cmd
|
|
||||||
}
|
|
||||||
cmd.CommandText <- "DELETE FROM post_meta WHERE post_id = @postId AND name = @name AND value = @value"
|
|
||||||
toDelete
|
|
||||||
|> List.map runCmd
|
|
||||||
|> Task.WhenAll
|
|
||||||
|> ignore
|
|
||||||
cmd.CommandText <- "INSERT INTO post_meta VALUES (@postId, @name, @value)"
|
|
||||||
toAdd
|
|
||||||
|> List.map runCmd
|
|
||||||
|> Task.WhenAll
|
|
||||||
|> ignore
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Update a post's prior permalinks
|
/// Update a post's prior permalinks
|
||||||
let updatePostPermalinks postId oldLinks newLinks = backgroundTask {
|
let updatePostPermalinks postId oldLinks newLinks = backgroundTask {
|
||||||
let toDelete, toAdd = diffPermalinks oldLinks newLinks
|
let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
|
||||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
if List.isEmpty toDelete && List.isEmpty toAdd then
|
||||||
return ()
|
return ()
|
||||||
else
|
else
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
|
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
|
||||||
cmd.Parameters.Add ("@link", SqliteType.Text)
|
cmd.Parameters.Add ("@link", SqliteType.Text)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
let runCmd link = backgroundTask {
|
let runCmd link = backgroundTask {
|
||||||
cmd.Parameters["@link"].Value <- Permalink.toString link
|
cmd.Parameters["@link"].Value <- Permalink.toString link
|
||||||
|
@ -257,15 +161,15 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
|
|
||||||
/// Update a post's revisions
|
/// Update a post's revisions
|
||||||
let updatePostRevisions postId oldRevs newRevs = backgroundTask {
|
let updatePostRevisions postId oldRevs newRevs = backgroundTask {
|
||||||
let toDelete, toAdd = diffRevisions oldRevs newRevs
|
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
|
||||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
if List.isEmpty toDelete && List.isEmpty toAdd then
|
||||||
return ()
|
return ()
|
||||||
else
|
else
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
let runCmd withText rev = backgroundTask {
|
let runCmd withText rev = backgroundTask {
|
||||||
cmd.Parameters.Clear ()
|
cmd.Parameters.Clear ()
|
||||||
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
|
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
|
||||||
cmd.Parameters.AddWithValue ("@asOf", rev.AsOf)
|
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
|
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
|
||||||
do! write cmd
|
do! write cmd
|
||||||
|
@ -287,18 +191,18 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
/// Add a post
|
/// Add a post
|
||||||
let add post = backgroundTask {
|
let add post = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
INSERT INTO post (
|
"INSERT INTO post (
|
||||||
id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text
|
id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text,
|
||||||
|
episode, meta_items
|
||||||
) VALUES (
|
) VALUES (
|
||||||
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text
|
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text,
|
||||||
)"""
|
@episode, @metaItems
|
||||||
|
)"
|
||||||
addPostParameters cmd post
|
addPostParameters cmd post
|
||||||
do! write cmd
|
do! write cmd
|
||||||
do! updatePostCategories post.Id [] post.CategoryIds
|
do! updatePostCategories post.Id [] post.CategoryIds
|
||||||
do! updatePostTags post.Id [] post.Tags
|
do! updatePostTags post.Id [] post.Tags
|
||||||
do! updatePostEpisode post
|
|
||||||
do! updatePostMeta post.Id [] post.Metadata
|
|
||||||
do! updatePostPermalinks post.Id [] post.PriorPermalinks
|
do! updatePostPermalinks post.Id [] post.PriorPermalinks
|
||||||
do! updatePostRevisions post.Id [] post.Revisions
|
do! updatePostRevisions post.Id [] post.Revisions
|
||||||
}
|
}
|
||||||
|
@ -316,7 +220,7 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
let findById postId webLogId = backgroundTask {
|
let findById postId webLogId = backgroundTask {
|
||||||
match! findPostById postId webLogId with
|
match! findPostById postId webLogId with
|
||||||
| Some post ->
|
| Some post ->
|
||||||
let! post = appendPostCategoryTagAndMeta post
|
let! post = appendPostCategoryAndTag post
|
||||||
return Some post
|
return Some post
|
||||||
| None -> return None
|
| None -> return None
|
||||||
}
|
}
|
||||||
|
@ -329,7 +233,7 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
|
cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
if rdr.Read () then
|
if rdr.Read () then
|
||||||
let! post = appendPostCategoryTagAndMeta (Map.toPost rdr)
|
let! post = appendPostCategoryAndTag (toPost rdr)
|
||||||
return Some post
|
return Some post
|
||||||
else
|
else
|
||||||
return None
|
return None
|
||||||
|
@ -350,14 +254,13 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
| Some _ ->
|
| Some _ ->
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
|
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
DELETE FROM post_revision WHERE post_id = @id;
|
"DELETE FROM post_revision WHERE post_id = @id;
|
||||||
DELETE FROM post_permalink WHERE post_id = @id;
|
DELETE FROM post_permalink WHERE post_id = @id;
|
||||||
DELETE FROM post_meta WHERE post_id = @id;
|
DELETE FROM post_tag WHERE post_id = @id;
|
||||||
DELETE FROM post_episode WHERE post_id = @id;
|
DELETE FROM post_category WHERE post_id = @id;
|
||||||
DELETE FROM post_tag WHERE post_id = @id;
|
DELETE FROM post_comment WHERE post_id = @id;
|
||||||
DELETE FROM post_category WHERE post_id = @id;
|
DELETE FROM post WHERE id = @id"
|
||||||
DELETE FROM post WHERE id = @id"""
|
|
||||||
do! write cmd
|
do! write cmd
|
||||||
return true
|
return true
|
||||||
| None -> return false
|
| None -> return false
|
||||||
|
@ -366,19 +269,15 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
/// Find the current permalink from a list of potential prior permalinks for the given web log
|
/// Find the current permalink from a list of potential prior permalinks for the given web log
|
||||||
let findCurrentPermalink permalinks webLogId = backgroundTask {
|
let findCurrentPermalink permalinks webLogId = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
let linkSql, linkParams = inClause "AND pp.permalink" "link" Permalink.toString permalinks
|
||||||
|
cmd.CommandText <- $"
|
||||||
SELECT p.permalink
|
SELECT p.permalink
|
||||||
FROM post p
|
FROM post p
|
||||||
INNER JOIN post_permalink pp ON pp.post_id = p.id
|
INNER JOIN post_permalink pp ON pp.post_id = p.id
|
||||||
WHERE p.web_log_id = @webLogId
|
WHERE p.web_log_id = @webLogId
|
||||||
AND pp.permalink IN ("""
|
{linkSql}"
|
||||||
permalinks
|
|
||||||
|> List.iteri (fun idx link ->
|
|
||||||
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
|
|
||||||
cmd.CommandText <- $"{cmd.CommandText}@link{idx}"
|
|
||||||
cmd.Parameters.AddWithValue ($"@link{idx}", Permalink.toString link) |> ignore)
|
|
||||||
cmd.CommandText <- $"{cmd.CommandText})"
|
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
|
cmd.Parameters.AddRange linkParams
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
return if rdr.Read () then Some (Map.toPermalink rdr) else None
|
return if rdr.Read () then Some (Map.toPermalink rdr) else None
|
||||||
}
|
}
|
||||||
|
@ -390,9 +289,9 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
let! posts =
|
let! posts =
|
||||||
toList Map.toPost rdr
|
toList toPost rdr
|
||||||
|> List.map (fun post -> backgroundTask {
|
|> List.map (fun post -> backgroundTask {
|
||||||
let! post = appendPostCategoryTagAndMeta post
|
let! post = appendPostCategoryAndTag post
|
||||||
return! appendPostRevisionsAndPermalinks post
|
return! appendPostRevisionsAndPermalinks post
|
||||||
})
|
})
|
||||||
|> Task.WhenAll
|
|> Task.WhenAll
|
||||||
|
@ -402,27 +301,22 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
/// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
|
/// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
|
||||||
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
|
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- $"""
|
let catSql, catParams = inClause "AND pc.category_id" "catId" CategoryId.toString categoryIds
|
||||||
|
cmd.CommandText <- $"
|
||||||
{selectPost}
|
{selectPost}
|
||||||
INNER JOIN post_category pc ON pc.post_id = p.id
|
INNER JOIN post_category pc ON pc.post_id = p.id
|
||||||
WHERE p.web_log_id = @webLogId
|
WHERE p.web_log_id = @webLogId
|
||||||
AND p.status = @status
|
AND p.status = @status
|
||||||
AND pc.category_id IN ("""
|
{catSql}
|
||||||
categoryIds
|
ORDER BY published_on DESC
|
||||||
|> List.iteri (fun idx catId ->
|
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||||
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
|
|
||||||
cmd.CommandText <- $"{cmd.CommandText}@catId{idx}"
|
|
||||||
cmd.Parameters.AddWithValue ($"@catId{idx}", CategoryId.toString catId) |> ignore)
|
|
||||||
cmd.CommandText <-
|
|
||||||
$"""{cmd.CommandText})
|
|
||||||
ORDER BY published_on DESC
|
|
||||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
|
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
|
||||||
|
cmd.Parameters.AddRange catParams
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
let! posts =
|
let! posts =
|
||||||
toList Map.toPost rdr
|
toList toPost rdr
|
||||||
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
|
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|
||||||
|> Task.WhenAll
|
|> Task.WhenAll
|
||||||
return List.ofArray posts
|
return List.ofArray posts
|
||||||
}
|
}
|
||||||
|
@ -430,16 +324,16 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
/// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks)
|
/// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks)
|
||||||
let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask {
|
let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- $"""
|
cmd.CommandText <- $"
|
||||||
{selectPost}
|
{selectPost}
|
||||||
WHERE p.web_log_id = @webLogId
|
WHERE p.web_log_id = @webLogId
|
||||||
ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
|
ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
|
||||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
let! posts =
|
let! posts =
|
||||||
toList postWithoutText rdr
|
toList postWithoutText rdr
|
||||||
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
|
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|
||||||
|> Task.WhenAll
|
|> Task.WhenAll
|
||||||
return List.ofArray posts
|
return List.ofArray posts
|
||||||
}
|
}
|
||||||
|
@ -447,18 +341,18 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
/// Get a page of published posts for the given web log (excludes revisions and prior permalinks)
|
/// Get a page of published posts for the given web log (excludes revisions and prior permalinks)
|
||||||
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask {
|
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- $"""
|
cmd.CommandText <- $"
|
||||||
{selectPost}
|
{selectPost}
|
||||||
WHERE p.web_log_id = @webLogId
|
WHERE p.web_log_id = @webLogId
|
||||||
AND p.status = @status
|
AND p.status = @status
|
||||||
ORDER BY p.published_on DESC
|
ORDER BY p.published_on DESC
|
||||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
|
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
let! posts =
|
let! posts =
|
||||||
toList Map.toPost rdr
|
toList toPost rdr
|
||||||
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
|
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|
||||||
|> Task.WhenAll
|
|> Task.WhenAll
|
||||||
return List.ofArray posts
|
return List.ofArray posts
|
||||||
}
|
}
|
||||||
|
@ -466,60 +360,60 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
|
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
|
||||||
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask {
|
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- $"""
|
cmd.CommandText <- $"
|
||||||
{selectPost}
|
{selectPost}
|
||||||
INNER JOIN post_tag pt ON pt.post_id = p.id
|
INNER JOIN post_tag pt ON pt.post_id = p.id
|
||||||
WHERE p.web_log_id = @webLogId
|
WHERE p.web_log_id = @webLogId
|
||||||
AND p.status = @status
|
AND p.status = @status
|
||||||
AND pt.tag = @tag
|
AND pt.tag = @tag
|
||||||
ORDER BY p.published_on DESC
|
ORDER BY p.published_on DESC
|
||||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
|
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
|
||||||
cmd.Parameters.AddWithValue ("@tag", tag)
|
cmd.Parameters.AddWithValue ("@tag", tag)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
let! posts =
|
let! posts =
|
||||||
toList Map.toPost rdr
|
toList toPost rdr
|
||||||
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
|
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|
||||||
|> Task.WhenAll
|
|> Task.WhenAll
|
||||||
return List.ofArray posts
|
return List.ofArray posts
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Find the next newest and oldest post from a publish date for the given web log
|
/// Find the next newest and oldest post from a publish date for the given web log
|
||||||
let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask {
|
let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- $"""
|
cmd.CommandText <- $"
|
||||||
{selectPost}
|
{selectPost}
|
||||||
WHERE p.web_log_id = @webLogId
|
WHERE p.web_log_id = @webLogId
|
||||||
AND p.status = @status
|
AND p.status = @status
|
||||||
AND p.published_on < @publishedOn
|
AND p.published_on < @publishedOn
|
||||||
ORDER BY p.published_on DESC
|
ORDER BY p.published_on DESC
|
||||||
LIMIT 1"""
|
LIMIT 1"
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
|
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
|
||||||
cmd.Parameters.AddWithValue ("@publishedOn", publishedOn)
|
cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
let! older = backgroundTask {
|
let! older = backgroundTask {
|
||||||
if rdr.Read () then
|
if rdr.Read () then
|
||||||
let! post = appendPostCategoryTagAndMeta (postWithoutText rdr)
|
let! post = appendPostCategoryAndTag (postWithoutText rdr)
|
||||||
return Some post
|
return Some post
|
||||||
else
|
else
|
||||||
return None
|
return None
|
||||||
}
|
}
|
||||||
do! rdr.CloseAsync ()
|
do! rdr.CloseAsync ()
|
||||||
cmd.CommandText <- $"""
|
cmd.CommandText <- $"
|
||||||
{selectPost}
|
{selectPost}
|
||||||
WHERE p.web_log_id = @webLogId
|
WHERE p.web_log_id = @webLogId
|
||||||
AND p.status = @status
|
AND p.status = @status
|
||||||
AND p.published_on > @publishedOn
|
AND p.published_on > @publishedOn
|
||||||
ORDER BY p.published_on
|
ORDER BY p.published_on
|
||||||
LIMIT 1"""
|
LIMIT 1"
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
let! newer = backgroundTask {
|
let! newer = backgroundTask {
|
||||||
if rdr.Read () then
|
if rdr.Read () then
|
||||||
let! post = appendPostCategoryTagAndMeta (postWithoutText rdr)
|
let! post = appendPostCategoryAndTag (postWithoutText rdr)
|
||||||
return Some post
|
return Some post
|
||||||
else
|
else
|
||||||
return None
|
return None
|
||||||
|
@ -538,24 +432,24 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||||
match! findFullById post.Id post.WebLogId with
|
match! findFullById post.Id post.WebLogId with
|
||||||
| Some oldPost ->
|
| Some oldPost ->
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
UPDATE post
|
"UPDATE post
|
||||||
SET author_id = @authorId,
|
SET author_id = @authorId,
|
||||||
status = @status,
|
status = @status,
|
||||||
title = @title,
|
title = @title,
|
||||||
permalink = @permalink,
|
permalink = @permalink,
|
||||||
published_on = @publishedOn,
|
published_on = @publishedOn,
|
||||||
updated_on = @updatedOn,
|
updated_on = @updatedOn,
|
||||||
template = @template,
|
template = @template,
|
||||||
post_text = @text
|
post_text = @text,
|
||||||
WHERE id = @id
|
episode = @episode,
|
||||||
AND web_log_id = @webLogId"""
|
meta_items = @metaItems
|
||||||
|
WHERE id = @id
|
||||||
|
AND web_log_id = @webLogId"
|
||||||
addPostParameters cmd post
|
addPostParameters cmd post
|
||||||
do! write cmd
|
do! write cmd
|
||||||
do! updatePostCategories post.Id oldPost.CategoryIds post.CategoryIds
|
do! updatePostCategories post.Id oldPost.CategoryIds post.CategoryIds
|
||||||
do! updatePostTags post.Id oldPost.Tags post.Tags
|
do! updatePostTags post.Id oldPost.Tags post.Tags
|
||||||
do! updatePostEpisode post
|
|
||||||
do! updatePostMeta post.Id oldPost.Metadata post.Metadata
|
|
||||||
do! updatePostPermalinks post.Id oldPost.PriorPermalinks post.PriorPermalinks
|
do! updatePostPermalinks post.Id oldPost.PriorPermalinks post.PriorPermalinks
|
||||||
do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
|
do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
|
||||||
| None -> return ()
|
| None -> return ()
|
||||||
|
|
|
@ -50,18 +50,14 @@ type SQLiteTagMapData (conn : SqliteConnection) =
|
||||||
/// Find any tag mappings in a list of tags for the given web log
|
/// Find any tag mappings in a list of tags for the given web log
|
||||||
let findMappingForTags (tags : string list) webLogId = backgroundTask {
|
let findMappingForTags (tags : string list) webLogId = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
let mapSql, mapParams = inClause "AND tag" "tag" id tags
|
||||||
|
cmd.CommandText <- $"
|
||||||
SELECT *
|
SELECT *
|
||||||
FROM tag_map
|
FROM tag_map
|
||||||
WHERE web_log_id = @webLogId
|
WHERE web_log_id = @webLogId
|
||||||
AND tag IN ("""
|
{mapSql}"
|
||||||
tags
|
|
||||||
|> List.iteri (fun idx tag ->
|
|
||||||
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
|
|
||||||
cmd.CommandText <- $"{cmd.CommandText}@tag{idx}"
|
|
||||||
cmd.Parameters.AddWithValue ($"@tag{idx}", tag) |> ignore)
|
|
||||||
cmd.CommandText <- $"{cmd.CommandText})"
|
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
|
cmd.Parameters.AddRange mapParams
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
return toList Map.toTagMap rdr
|
return toList Map.toTagMap rdr
|
||||||
}
|
}
|
||||||
|
@ -71,23 +67,23 @@ type SQLiteTagMapData (conn : SqliteConnection) =
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
match! findById tagMap.Id tagMap.WebLogId with
|
match! findById tagMap.Id tagMap.WebLogId with
|
||||||
| Some _ ->
|
| Some _ ->
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
UPDATE tag_map
|
"UPDATE tag_map
|
||||||
SET tag = @tag,
|
SET tag = @tag,
|
||||||
url_value = @urlValue
|
url_value = @urlValue
|
||||||
WHERE id = @id
|
WHERE id = @id
|
||||||
AND web_log_id = @webLogId"""
|
AND web_log_id = @webLogId"
|
||||||
| None ->
|
| None ->
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
INSERT INTO tag_map (
|
"INSERT INTO tag_map (
|
||||||
id, web_log_id, tag, url_value
|
id, web_log_id, tag, url_value
|
||||||
) VALUES (
|
) VALUES (
|
||||||
@id, @webLogId, @tag, @urlValue
|
@id, @webLogId, @tag, @urlValue
|
||||||
)"""
|
)"
|
||||||
addWebLogId cmd tagMap.WebLogId
|
addWebLogId cmd tagMap.WebLogId
|
||||||
[ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id)
|
[ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id)
|
||||||
cmd.Parameters.AddWithValue ("@tag", tagMap.Tag)
|
cmd.Parameters.AddWithValue ("@tag", tagMap.Tag)
|
||||||
cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue)
|
cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
do! write cmd
|
do! write cmd
|
||||||
}
|
}
|
||||||
|
|
|
@ -17,13 +17,13 @@ type SQLiteThemeData (conn : SqliteConnection) =
|
||||||
do! rdr.CloseAsync ()
|
do! rdr.CloseAsync ()
|
||||||
cmd.CommandText <- "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name"
|
cmd.CommandText <- "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name"
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
let mutable templates = []
|
let templates =
|
||||||
while rdr.Read () do
|
seq { while rdr.Read () do ThemeId (Map.getString "theme_id" rdr), Map.toThemeTemplate false rdr }
|
||||||
templates <- (ThemeId (Map.getString "theme_id" rdr), Map.toThemeTemplate false rdr) :: templates
|
|> List.ofSeq
|
||||||
return
|
return
|
||||||
themes
|
themes
|
||||||
|> List.map (fun t ->
|
|> List.map (fun t ->
|
||||||
{ t with Templates = templates |> List.filter (fun tt -> fst tt = t.Id) |> List.map snd })
|
{ t with Templates = templates |> List.filter (fun (themeId, _) -> themeId = t.Id) |> List.map snd })
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Does a given theme exist?
|
/// Does a given theme exist?
|
||||||
|
@ -67,10 +67,10 @@ type SQLiteThemeData (conn : SqliteConnection) =
|
||||||
match! findByIdWithoutText themeId with
|
match! findByIdWithoutText themeId with
|
||||||
| Some _ ->
|
| Some _ ->
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
DELETE FROM theme_asset WHERE theme_id = @id;
|
"DELETE FROM theme_asset WHERE theme_id = @id;
|
||||||
DELETE FROM theme_template WHERE theme_id = @id;
|
DELETE FROM theme_template WHERE theme_id = @id;
|
||||||
DELETE FROM theme WHERE id = @id"""
|
DELETE FROM theme WHERE id = @id"
|
||||||
cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
|
cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
|
||||||
do! write cmd
|
do! write cmd
|
||||||
return true
|
return true
|
||||||
|
@ -85,15 +85,15 @@ type SQLiteThemeData (conn : SqliteConnection) =
|
||||||
match oldTheme with
|
match oldTheme with
|
||||||
| Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id"
|
| Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id"
|
||||||
| None -> "INSERT INTO theme VALUES (@id, @name, @version)"
|
| None -> "INSERT INTO theme VALUES (@id, @name, @version)"
|
||||||
[ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.Id)
|
[ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.Id)
|
||||||
cmd.Parameters.AddWithValue ("@name", theme.Name)
|
cmd.Parameters.AddWithValue ("@name", theme.Name)
|
||||||
cmd.Parameters.AddWithValue ("@version", theme.Version)
|
cmd.Parameters.AddWithValue ("@version", theme.Version)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
do! write cmd
|
do! write cmd
|
||||||
|
|
||||||
let toDelete, toAdd =
|
let toDelete, toAdd =
|
||||||
diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue [])
|
Utils.diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue [])
|
||||||
theme.Templates (fun t -> t.Name)
|
theme.Templates (fun t -> t.Name)
|
||||||
let toUpdate =
|
let toUpdate =
|
||||||
theme.Templates
|
theme.Templates
|
||||||
|> List.filter (fun t ->
|
|> List.filter (fun t ->
|
||||||
|
@ -102,9 +102,9 @@ type SQLiteThemeData (conn : SqliteConnection) =
|
||||||
cmd.CommandText <-
|
cmd.CommandText <-
|
||||||
"UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name"
|
"UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name"
|
||||||
cmd.Parameters.Clear ()
|
cmd.Parameters.Clear ()
|
||||||
[ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.Id)
|
[ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.Id)
|
||||||
cmd.Parameters.Add ("@name", SqliteType.Text)
|
cmd.Parameters.Add ("@name", SqliteType.Text)
|
||||||
cmd.Parameters.Add ("@template", SqliteType.Text)
|
cmd.Parameters.Add ("@template", SqliteType.Text)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
toUpdate
|
toUpdate
|
||||||
|> List.map (fun template -> backgroundTask {
|
|> List.map (fun template -> backgroundTask {
|
||||||
|
@ -169,8 +169,8 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
|
cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
|
||||||
let (ThemeAssetId (ThemeId themeId, path)) = assetId
|
let (ThemeAssetId (ThemeId themeId, path)) = assetId
|
||||||
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
|
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
|
||||||
cmd.Parameters.AddWithValue ("@path", path)
|
cmd.Parameters.AddWithValue ("@path", path)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
return if rdr.Read () then Some (Map.toThemeAsset true rdr) else None
|
return if rdr.Read () then Some (Map.toThemeAsset true rdr) else None
|
||||||
|
@ -200,29 +200,29 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
|
||||||
sideCmd.CommandText <-
|
sideCmd.CommandText <-
|
||||||
"SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path"
|
"SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path"
|
||||||
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
|
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
|
||||||
[ sideCmd.Parameters.AddWithValue ("@themeId", themeId)
|
[ sideCmd.Parameters.AddWithValue ("@themeId", themeId)
|
||||||
sideCmd.Parameters.AddWithValue ("@path", path)
|
sideCmd.Parameters.AddWithValue ("@path", path)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
let! exists = count sideCmd
|
let! exists = count sideCmd
|
||||||
|
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <-
|
cmd.CommandText <-
|
||||||
if exists = 1 then
|
if exists = 1 then
|
||||||
"""UPDATE theme_asset
|
"UPDATE theme_asset
|
||||||
SET updated_on = @updatedOn,
|
SET updated_on = @updatedOn,
|
||||||
data = ZEROBLOB(@dataLength)
|
data = ZEROBLOB(@dataLength)
|
||||||
WHERE theme_id = @themeId
|
WHERE theme_id = @themeId
|
||||||
AND path = @path"""
|
AND path = @path"
|
||||||
else
|
else
|
||||||
"""INSERT INTO theme_asset (
|
"INSERT INTO theme_asset (
|
||||||
theme_id, path, updated_on, data
|
theme_id, path, updated_on, data
|
||||||
) VALUES (
|
) VALUES (
|
||||||
@themeId, @path, @updatedOn, ZEROBLOB(@dataLength)
|
@themeId, @path, @updatedOn, ZEROBLOB(@dataLength)
|
||||||
)"""
|
)"
|
||||||
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
|
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
|
||||||
cmd.Parameters.AddWithValue ("@path", path)
|
cmd.Parameters.AddWithValue ("@path", path)
|
||||||
cmd.Parameters.AddWithValue ("@updatedOn", asset.UpdatedOn)
|
cmd.Parameters.AddWithValue ("@updatedOn", instantParam asset.UpdatedOn)
|
||||||
cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length)
|
cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
do! write cmd
|
do! write cmd
|
||||||
|
|
||||||
|
|
|
@ -10,22 +10,22 @@ type SQLiteUploadData (conn : SqliteConnection) =
|
||||||
|
|
||||||
/// Add parameters for uploaded file INSERT and UPDATE statements
|
/// Add parameters for uploaded file INSERT and UPDATE statements
|
||||||
let addUploadParameters (cmd : SqliteCommand) (upload : Upload) =
|
let addUploadParameters (cmd : SqliteCommand) (upload : Upload) =
|
||||||
[ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id)
|
[ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id)
|
||||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId)
|
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId)
|
||||||
cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.Path)
|
cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.Path)
|
||||||
cmd.Parameters.AddWithValue ("@updatedOn", upload.UpdatedOn)
|
cmd.Parameters.AddWithValue ("@updatedOn", instantParam upload.UpdatedOn)
|
||||||
cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length)
|
cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
|
|
||||||
/// Save an uploaded file
|
/// Save an uploaded file
|
||||||
let add upload = backgroundTask {
|
let add upload = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
INSERT INTO upload (
|
"INSERT INTO upload (
|
||||||
id, web_log_id, path, updated_on, data
|
id, web_log_id, path, updated_on, data
|
||||||
) VALUES (
|
) VALUES (
|
||||||
@id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength)
|
@id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength)
|
||||||
)"""
|
)"
|
||||||
addUploadParameters cmd upload
|
addUploadParameters cmd upload
|
||||||
do! write cmd
|
do! write cmd
|
||||||
|
|
||||||
|
@ -40,11 +40,11 @@ type SQLiteUploadData (conn : SqliteConnection) =
|
||||||
/// Delete an uploaded file by its ID
|
/// Delete an uploaded file by its ID
|
||||||
let delete uploadId webLogId = backgroundTask {
|
let delete uploadId webLogId = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
SELECT id, web_log_id, path, updated_on
|
"SELECT id, web_log_id, path, updated_on
|
||||||
FROM upload
|
FROM upload
|
||||||
WHERE id = @id
|
WHERE id = @id
|
||||||
AND web_log_id = @webLogId"""
|
AND web_log_id = @webLogId"
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
cmd.Parameters.AddWithValue ("@id", UploadId.toString uploadId) |> ignore
|
cmd.Parameters.AddWithValue ("@id", UploadId.toString uploadId) |> ignore
|
||||||
let! rdr = cmd.ExecuteReaderAsync ()
|
let! rdr = cmd.ExecuteReaderAsync ()
|
||||||
|
|
|
@ -4,81 +4,64 @@ open System.Threading.Tasks
|
||||||
open Microsoft.Data.Sqlite
|
open Microsoft.Data.Sqlite
|
||||||
open MyWebLog
|
open MyWebLog
|
||||||
open MyWebLog.Data
|
open MyWebLog.Data
|
||||||
|
open Newtonsoft.Json
|
||||||
|
|
||||||
// The web log podcast insert loop is not statically compilable; this is OK
|
// The web log podcast insert loop is not statically compilable; this is OK
|
||||||
#nowarn "3511"
|
#nowarn "3511"
|
||||||
|
|
||||||
/// SQLite myWebLog web log data implementation
|
/// SQLite myWebLog web log data implementation
|
||||||
type SQLiteWebLogData (conn : SqliteConnection) =
|
type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
|
||||||
|
|
||||||
// SUPPORT FUNCTIONS
|
// SUPPORT FUNCTIONS
|
||||||
|
|
||||||
/// Add parameters for web log INSERT or web log/RSS options UPDATE statements
|
/// Add parameters for web log INSERT or web log/RSS options UPDATE statements
|
||||||
let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) =
|
let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) =
|
||||||
[ cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled)
|
[ cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled)
|
||||||
cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName)
|
cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName)
|
||||||
cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed)
|
cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed)
|
||||||
cmd.Parameters.AddWithValue ("@isCategoryEnabled", webLog.Rss.IsCategoryEnabled)
|
cmd.Parameters.AddWithValue ("@isCategoryEnabled", webLog.Rss.IsCategoryEnabled)
|
||||||
cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled)
|
cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled)
|
||||||
cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright)
|
cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
|
|
||||||
/// Add parameters for web log INSERT or UPDATE statements
|
/// Add parameters for web log INSERT or UPDATE statements
|
||||||
let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) =
|
let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) =
|
||||||
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id)
|
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id)
|
||||||
cmd.Parameters.AddWithValue ("@name", webLog.Name)
|
cmd.Parameters.AddWithValue ("@name", webLog.Name)
|
||||||
cmd.Parameters.AddWithValue ("@slug", webLog.Slug)
|
cmd.Parameters.AddWithValue ("@slug", webLog.Slug)
|
||||||
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle)
|
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle)
|
||||||
cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage)
|
cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage)
|
||||||
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage)
|
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage)
|
||||||
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId)
|
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId)
|
||||||
cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase)
|
cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase)
|
||||||
cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone)
|
cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone)
|
||||||
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx)
|
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx)
|
||||||
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads)
|
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads)
|
||||||
] |> ignore
|
] |> ignore
|
||||||
addWebLogRssParameters cmd webLog
|
addWebLogRssParameters cmd webLog
|
||||||
|
|
||||||
/// Add parameters for custom feed INSERT or UPDATE statements
|
/// Add parameters for custom feed INSERT or UPDATE statements
|
||||||
let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) =
|
let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) =
|
||||||
[ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.Id)
|
[ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.Id)
|
||||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId)
|
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId)
|
||||||
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source)
|
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source)
|
||||||
cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path)
|
cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path)
|
||||||
|
cmd.Parameters.AddWithValue ("@podcast", maybe (if Option.isSome feed.Podcast then
|
||||||
|
Some (Utils.serialize ser feed.Podcast)
|
||||||
|
else None))
|
||||||
] |> ignore
|
] |> ignore
|
||||||
|
|
||||||
/// Add parameters for podcast INSERT or UPDATE statements
|
/// Shorthand to map a data reader to a custom feed
|
||||||
let addPodcastParameters (cmd : SqliteCommand) feedId (podcast : PodcastOptions) =
|
let toCustomFeed =
|
||||||
[ cmd.Parameters.AddWithValue ("@feedId", CustomFeedId.toString feedId)
|
Map.toCustomFeed ser
|
||||||
cmd.Parameters.AddWithValue ("@title", podcast.Title)
|
|
||||||
cmd.Parameters.AddWithValue ("@subtitle", maybe podcast.Subtitle)
|
|
||||||
cmd.Parameters.AddWithValue ("@itemsInFeed", podcast.ItemsInFeed)
|
|
||||||
cmd.Parameters.AddWithValue ("@summary", podcast.Summary)
|
|
||||||
cmd.Parameters.AddWithValue ("@displayedAuthor", podcast.DisplayedAuthor)
|
|
||||||
cmd.Parameters.AddWithValue ("@email", podcast.Email)
|
|
||||||
cmd.Parameters.AddWithValue ("@imageUrl", Permalink.toString podcast.ImageUrl)
|
|
||||||
cmd.Parameters.AddWithValue ("@appleCategory", podcast.AppleCategory)
|
|
||||||
cmd.Parameters.AddWithValue ("@appleSubcategory", maybe podcast.AppleSubcategory)
|
|
||||||
cmd.Parameters.AddWithValue ("@explicit", ExplicitRating.toString podcast.Explicit)
|
|
||||||
cmd.Parameters.AddWithValue ("@defaultMediaType", maybe podcast.DefaultMediaType)
|
|
||||||
cmd.Parameters.AddWithValue ("@mediaBaseUrl", maybe podcast.MediaBaseUrl)
|
|
||||||
cmd.Parameters.AddWithValue ("@podcastGuid", maybe podcast.PodcastGuid)
|
|
||||||
cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.FundingUrl)
|
|
||||||
cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.FundingText)
|
|
||||||
cmd.Parameters.AddWithValue ("@medium", maybe (podcast.Medium |> Option.map PodcastMedium.toString))
|
|
||||||
] |> ignore
|
|
||||||
|
|
||||||
/// Get the current custom feeds for a web log
|
/// Get the current custom feeds for a web log
|
||||||
let getCustomFeeds (webLog : WebLog) = backgroundTask {
|
let getCustomFeeds (webLog : WebLog) = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <- "SELECT * FROM web_log_feed WHERE 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"""
|
|
||||||
addWebLogId cmd webLog.Id
|
addWebLogId cmd webLog.Id
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
return toList Map.toCustomFeed rdr
|
return toList toCustomFeed rdr
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Append custom feeds to a web log
|
/// Append custom feeds to a web log
|
||||||
|
@ -87,27 +70,10 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||||
return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
|
return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Add a podcast to a custom feed
|
|
||||||
let addPodcast feedId (podcast : PodcastOptions) = backgroundTask {
|
|
||||||
use cmd = conn.CreateCommand ()
|
|
||||||
cmd.CommandText <- """
|
|
||||||
INSERT INTO web_log_feed_podcast (
|
|
||||||
feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url,
|
|
||||||
apple_category, apple_subcategory, explicit, default_media_type, media_base_url, podcast_guid,
|
|
||||||
funding_url, funding_text, medium
|
|
||||||
) VALUES (
|
|
||||||
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl,
|
|
||||||
@appleCategory, @appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @podcastGuid,
|
|
||||||
@fundingUrl, @fundingText, @medium
|
|
||||||
)"""
|
|
||||||
addPodcastParameters cmd feedId podcast
|
|
||||||
do! write cmd
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Update the custom feeds for a web log
|
/// 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 = diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
|
let toDelete, toAdd = 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 toUpdate =
|
||||||
webLog.Rss.CustomFeeds
|
webLog.Rss.CustomFeeds
|
||||||
|
@ -117,9 +83,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||||
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
|
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
|
||||||
toDelete
|
toDelete
|
||||||
|> List.map (fun it -> backgroundTask {
|
|> List.map (fun it -> backgroundTask {
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <- "DELETE FROM web_log_feed WHERE id = @id"
|
||||||
DELETE FROM web_log_feed_podcast WHERE feed_id = @id;
|
|
||||||
DELETE FROM web_log_feed WHERE id = @id"""
|
|
||||||
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id
|
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id
|
||||||
do! write cmd
|
do! write cmd
|
||||||
})
|
})
|
||||||
|
@ -128,68 +92,30 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||||
cmd.Parameters.Clear ()
|
cmd.Parameters.Clear ()
|
||||||
toAdd
|
toAdd
|
||||||
|> List.map (fun it -> backgroundTask {
|
|> List.map (fun it -> backgroundTask {
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
INSERT INTO web_log_feed (
|
"INSERT INTO web_log_feed (
|
||||||
id, web_log_id, source, path
|
id, web_log_id, source, path, podcast
|
||||||
) VALUES (
|
) VALUES (
|
||||||
@id, @webLogId, @source, @path
|
@id, @webLogId, @source, @path, @podcast
|
||||||
)"""
|
)"
|
||||||
cmd.Parameters.Clear ()
|
cmd.Parameters.Clear ()
|
||||||
addCustomFeedParameters cmd webLog.Id it
|
addCustomFeedParameters cmd webLog.Id it
|
||||||
do! write cmd
|
do! write cmd
|
||||||
match it.Podcast with
|
|
||||||
| Some podcast -> do! addPodcast it.Id podcast
|
|
||||||
| None -> ()
|
|
||||||
})
|
})
|
||||||
|> Task.WhenAll
|
|> Task.WhenAll
|
||||||
|> ignore
|
|> ignore
|
||||||
toUpdate
|
toUpdate
|
||||||
|> List.map (fun it -> backgroundTask {
|
|> List.map (fun it -> backgroundTask {
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
UPDATE web_log_feed
|
"UPDATE web_log_feed
|
||||||
SET source = @source,
|
SET source = @source,
|
||||||
path = @path
|
path = @path,
|
||||||
WHERE id = @id
|
podcast = @podcast
|
||||||
AND web_log_id = @webLogId"""
|
WHERE id = @id
|
||||||
|
AND web_log_id = @webLogId"
|
||||||
cmd.Parameters.Clear ()
|
cmd.Parameters.Clear ()
|
||||||
addCustomFeedParameters cmd webLog.Id it
|
addCustomFeedParameters cmd webLog.Id it
|
||||||
do! write cmd
|
do! write cmd
|
||||||
let hadPodcast = Option.isSome (feeds |> List.find (fun f -> f.Id = it.Id)).Podcast
|
|
||||||
match it.Podcast with
|
|
||||||
| Some podcast ->
|
|
||||||
if hadPodcast then
|
|
||||||
cmd.CommandText <- """
|
|
||||||
UPDATE web_log_feed_podcast
|
|
||||||
SET title = @title,
|
|
||||||
subtitle = @subtitle,
|
|
||||||
items_in_feed = @itemsInFeed,
|
|
||||||
summary = @summary,
|
|
||||||
displayed_author = @displayedAuthor,
|
|
||||||
email = @email,
|
|
||||||
image_url = @imageUrl,
|
|
||||||
apple_category = @appleCategory,
|
|
||||||
apple_subcategory = @appleSubcategory,
|
|
||||||
explicit = @explicit,
|
|
||||||
default_media_type = @defaultMediaType,
|
|
||||||
media_base_url = @mediaBaseUrl,
|
|
||||||
podcast_guid = @podcastGuid,
|
|
||||||
funding_url = @fundingUrl,
|
|
||||||
funding_text = @fundingText,
|
|
||||||
medium = @medium
|
|
||||||
WHERE feed_id = @feedId"""
|
|
||||||
cmd.Parameters.Clear ()
|
|
||||||
addPodcastParameters cmd it.Id podcast
|
|
||||||
do! write cmd
|
|
||||||
else
|
|
||||||
do! addPodcast it.Id podcast
|
|
||||||
| None ->
|
|
||||||
if hadPodcast then
|
|
||||||
cmd.CommandText <- "DELETE FROM web_log_feed_podcast WHERE feed_id = @id"
|
|
||||||
cmd.Parameters.Clear ()
|
|
||||||
cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString it.Id) |> ignore
|
|
||||||
do! write cmd
|
|
||||||
else
|
|
||||||
()
|
|
||||||
})
|
})
|
||||||
|> Task.WhenAll
|
|> Task.WhenAll
|
||||||
|> ignore
|
|> ignore
|
||||||
|
@ -200,14 +126,14 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||||
/// Add a web log
|
/// Add a web log
|
||||||
let add webLog = backgroundTask {
|
let add webLog = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
INSERT INTO web_log (
|
"INSERT INTO web_log (
|
||||||
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
|
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
|
||||||
uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright
|
uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright
|
||||||
) VALUES (
|
) VALUES (
|
||||||
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
|
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
|
||||||
@uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
|
@uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
|
||||||
)"""
|
)"
|
||||||
addWebLogParameters cmd webLog
|
addWebLogParameters cmd webLog
|
||||||
do! write cmd
|
do! write cmd
|
||||||
do! updateCustomFeeds webLog
|
do! updateCustomFeeds webLog
|
||||||
|
@ -232,26 +158,22 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||||
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
|
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
|
||||||
let postSubQuery = subQuery "post"
|
let postSubQuery = subQuery "post"
|
||||||
let pageSubQuery = subQuery "page"
|
let pageSubQuery = subQuery "page"
|
||||||
cmd.CommandText <- $"""
|
cmd.CommandText <- $"
|
||||||
DELETE FROM post_comment WHERE post_id IN {postSubQuery};
|
DELETE FROM post_comment WHERE post_id IN {postSubQuery};
|
||||||
DELETE FROM post_revision WHERE post_id IN {postSubQuery};
|
DELETE FROM post_revision WHERE post_id IN {postSubQuery};
|
||||||
DELETE FROM post_permalink WHERE post_id IN {postSubQuery};
|
DELETE FROM post_permalink WHERE post_id IN {postSubQuery};
|
||||||
DELETE FROM post_episode WHERE post_id IN {postSubQuery};
|
DELETE FROM post_tag WHERE post_id IN {postSubQuery};
|
||||||
DELETE FROM post_tag WHERE post_id IN {postSubQuery};
|
DELETE FROM post_category WHERE post_id IN {postSubQuery};
|
||||||
DELETE FROM post_category WHERE post_id IN {postSubQuery};
|
DELETE FROM post WHERE web_log_id = @webLogId;
|
||||||
DELETE FROM post_meta WHERE post_id IN {postSubQuery};
|
DELETE FROM page_revision WHERE page_id IN {pageSubQuery};
|
||||||
DELETE FROM post WHERE web_log_id = @webLogId;
|
DELETE FROM page_permalink WHERE page_id IN {pageSubQuery};
|
||||||
DELETE FROM page_revision WHERE page_id IN {pageSubQuery};
|
DELETE FROM page WHERE web_log_id = @webLogId;
|
||||||
DELETE FROM page_permalink WHERE page_id IN {pageSubQuery};
|
DELETE FROM category WHERE web_log_id = @webLogId;
|
||||||
DELETE FROM page_meta WHERE page_id IN {pageSubQuery};
|
DELETE FROM tag_map WHERE web_log_id = @webLogId;
|
||||||
DELETE FROM page WHERE web_log_id = @webLogId;
|
DELETE FROM upload WHERE web_log_id = @webLogId;
|
||||||
DELETE FROM category WHERE web_log_id = @webLogId;
|
DELETE FROM web_log_user WHERE web_log_id = @webLogId;
|
||||||
DELETE FROM tag_map WHERE web_log_id = @webLogId;
|
DELETE FROM web_log_feed WHERE web_log_id = @webLogId;
|
||||||
DELETE FROM upload WHERE web_log_id = @webLogId;
|
DELETE FROM web_log WHERE 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"""
|
|
||||||
do! write cmd
|
do! write cmd
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -284,25 +206,25 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||||
/// Update settings for a web log
|
/// Update settings for a web log
|
||||||
let updateSettings webLog = backgroundTask {
|
let updateSettings webLog = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
UPDATE web_log
|
"UPDATE web_log
|
||||||
SET name = @name,
|
SET name = @name,
|
||||||
slug = @slug,
|
slug = @slug,
|
||||||
subtitle = @subtitle,
|
subtitle = @subtitle,
|
||||||
default_page = @defaultPage,
|
default_page = @defaultPage,
|
||||||
posts_per_page = @postsPerPage,
|
posts_per_page = @postsPerPage,
|
||||||
theme_id = @themeId,
|
theme_id = @themeId,
|
||||||
url_base = @urlBase,
|
url_base = @urlBase,
|
||||||
time_zone = @timeZone,
|
time_zone = @timeZone,
|
||||||
auto_htmx = @autoHtmx,
|
auto_htmx = @autoHtmx,
|
||||||
uploads = @uploads,
|
uploads = @uploads,
|
||||||
is_feed_enabled = @isFeedEnabled,
|
is_feed_enabled = @isFeedEnabled,
|
||||||
feed_name = @feedName,
|
feed_name = @feedName,
|
||||||
items_in_feed = @itemsInFeed,
|
items_in_feed = @itemsInFeed,
|
||||||
is_category_enabled = @isCategoryEnabled,
|
is_category_enabled = @isCategoryEnabled,
|
||||||
is_tag_enabled = @isTagEnabled,
|
is_tag_enabled = @isTagEnabled,
|
||||||
copyright = @copyright
|
copyright = @copyright
|
||||||
WHERE id = @id"""
|
WHERE id = @id"
|
||||||
addWebLogParameters cmd webLog
|
addWebLogParameters cmd webLog
|
||||||
do! write cmd
|
do! write cmd
|
||||||
}
|
}
|
||||||
|
@ -310,15 +232,15 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||||
/// Update RSS options for a web log
|
/// Update RSS options for a web log
|
||||||
let updateRssOptions webLog = backgroundTask {
|
let updateRssOptions webLog = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
UPDATE web_log
|
"UPDATE web_log
|
||||||
SET is_feed_enabled = @isFeedEnabled,
|
SET is_feed_enabled = @isFeedEnabled,
|
||||||
feed_name = @feedName,
|
feed_name = @feedName,
|
||||||
items_in_feed = @itemsInFeed,
|
items_in_feed = @itemsInFeed,
|
||||||
is_category_enabled = @isCategoryEnabled,
|
is_category_enabled = @isCategoryEnabled,
|
||||||
is_tag_enabled = @isTagEnabled,
|
is_tag_enabled = @isTagEnabled,
|
||||||
copyright = @copyright
|
copyright = @copyright
|
||||||
WHERE id = @id"""
|
WHERE id = @id"
|
||||||
addWebLogRssParameters cmd webLog
|
addWebLogRssParameters cmd webLog
|
||||||
cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) |> ignore
|
cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) |> ignore
|
||||||
do! write cmd
|
do! write cmd
|
||||||
|
|
|
@ -1,6 +1,5 @@
|
||||||
namespace MyWebLog.Data.SQLite
|
namespace MyWebLog.Data.SQLite
|
||||||
|
|
||||||
open System
|
|
||||||
open Microsoft.Data.Sqlite
|
open Microsoft.Data.Sqlite
|
||||||
open MyWebLog
|
open MyWebLog
|
||||||
open MyWebLog.Data
|
open MyWebLog.Data
|
||||||
|
@ -12,18 +11,17 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
|
||||||
|
|
||||||
/// Add parameters for web log user INSERT or UPDATE statements
|
/// Add parameters for web log user INSERT or UPDATE statements
|
||||||
let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) =
|
let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) =
|
||||||
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.Id)
|
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.Id)
|
||||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.WebLogId)
|
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.WebLogId)
|
||||||
cmd.Parameters.AddWithValue ("@email", user.Email)
|
cmd.Parameters.AddWithValue ("@email", user.Email)
|
||||||
cmd.Parameters.AddWithValue ("@firstName", user.FirstName)
|
cmd.Parameters.AddWithValue ("@firstName", user.FirstName)
|
||||||
cmd.Parameters.AddWithValue ("@lastName", user.LastName)
|
cmd.Parameters.AddWithValue ("@lastName", user.LastName)
|
||||||
cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName)
|
cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName)
|
||||||
cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash)
|
cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash)
|
||||||
cmd.Parameters.AddWithValue ("@salt", user.Salt)
|
cmd.Parameters.AddWithValue ("@url", maybe user.Url)
|
||||||
cmd.Parameters.AddWithValue ("@url", maybe user.Url)
|
cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel)
|
||||||
cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel)
|
cmd.Parameters.AddWithValue ("@createdOn", instantParam user.CreatedOn)
|
||||||
cmd.Parameters.AddWithValue ("@createdOn", user.CreatedOn)
|
cmd.Parameters.AddWithValue ("@lastSeenOn", maybeInstant user.LastSeenOn)
|
||||||
cmd.Parameters.AddWithValue ("@lastSeenOn", maybe user.LastSeenOn)
|
|
||||||
] |> ignore
|
] |> ignore
|
||||||
|
|
||||||
// IMPLEMENTATION FUNCTIONS
|
// IMPLEMENTATION FUNCTIONS
|
||||||
|
@ -31,14 +29,14 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
|
||||||
/// Add a user
|
/// Add a user
|
||||||
let add user = backgroundTask {
|
let add user = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
INSERT INTO web_log_user (
|
"INSERT INTO web_log_user (
|
||||||
id, web_log_id, email, first_name, last_name, preferred_name, password_hash, salt, url, access_level,
|
id, web_log_id, email, first_name, last_name, preferred_name, password_hash, url, access_level,
|
||||||
created_on, last_seen_on
|
created_on, last_seen_on
|
||||||
) VALUES (
|
) VALUES (
|
||||||
@id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel,
|
@id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @url, @accessLevel,
|
||||||
@createdOn, @lastSeenOn
|
@createdOn, @lastSeenOn
|
||||||
)"""
|
)"
|
||||||
addWebLogUserParameters cmd user
|
addWebLogUserParameters cmd user
|
||||||
do! write cmd
|
do! write cmd
|
||||||
}
|
}
|
||||||
|
@ -93,14 +91,10 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
|
||||||
/// Find the names of users by their IDs for the given web log
|
/// Find the names of users by their IDs for the given web log
|
||||||
let findNames webLogId userIds = backgroundTask {
|
let findNames webLogId userIds = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND id IN ("
|
let nameSql, nameParams = inClause "AND id" "id" WebLogUserId.toString userIds
|
||||||
userIds
|
cmd.CommandText <- $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {nameSql}"
|
||||||
|> List.iteri (fun idx userId ->
|
|
||||||
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
|
|
||||||
cmd.CommandText <- $"{cmd.CommandText}@id{idx}"
|
|
||||||
cmd.Parameters.AddWithValue ($"@id{idx}", WebLogUserId.toString userId) |> ignore)
|
|
||||||
cmd.CommandText <- $"{cmd.CommandText})"
|
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
|
cmd.Parameters.AddRange nameParams
|
||||||
use! rdr = cmd.ExecuteReaderAsync ()
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
return
|
return
|
||||||
toList Map.toWebLogUser rdr
|
toList Map.toWebLogUser rdr
|
||||||
|
@ -116,14 +110,14 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
|
||||||
/// Set a user's last seen date/time to now
|
/// Set a user's last seen date/time to now
|
||||||
let setLastSeen userId webLogId = backgroundTask {
|
let setLastSeen userId webLogId = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
UPDATE web_log_user
|
"UPDATE web_log_user
|
||||||
SET last_seen_on = @lastSeenOn
|
SET last_seen_on = @lastSeenOn
|
||||||
WHERE id = @id
|
WHERE id = @id
|
||||||
AND web_log_id = @webLogId"""
|
AND web_log_id = @webLogId"
|
||||||
addWebLogId cmd webLogId
|
addWebLogId cmd webLogId
|
||||||
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId)
|
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId)
|
||||||
cmd.Parameters.AddWithValue ("@lastSeenOn", DateTime.UtcNow)
|
cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Noda.now ()))
|
||||||
] |> ignore
|
] |> ignore
|
||||||
let! _ = cmd.ExecuteNonQueryAsync ()
|
let! _ = cmd.ExecuteNonQueryAsync ()
|
||||||
()
|
()
|
||||||
|
@ -132,20 +126,19 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
|
||||||
/// Update a user
|
/// Update a user
|
||||||
let update user = backgroundTask {
|
let update user = backgroundTask {
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- """
|
cmd.CommandText <-
|
||||||
UPDATE web_log_user
|
"UPDATE web_log_user
|
||||||
SET email = @email,
|
SET email = @email,
|
||||||
first_name = @firstName,
|
first_name = @firstName,
|
||||||
last_name = @lastName,
|
last_name = @lastName,
|
||||||
preferred_name = @preferredName,
|
preferred_name = @preferredName,
|
||||||
password_hash = @passwordHash,
|
password_hash = @passwordHash,
|
||||||
salt = @salt,
|
url = @url,
|
||||||
url = @url,
|
access_level = @accessLevel,
|
||||||
access_level = @accessLevel,
|
created_on = @createdOn,
|
||||||
created_on = @createdOn,
|
last_seen_on = @lastSeenOn
|
||||||
last_seen_on = @lastSeenOn
|
WHERE id = @id
|
||||||
WHERE id = @id
|
AND web_log_id = @webLogId"
|
||||||
AND web_log_id = @webLogId"""
|
|
||||||
addWebLogUserParameters cmd user
|
addWebLogUserParameters cmd user
|
||||||
do! write cmd
|
do! write cmd
|
||||||
}
|
}
|
||||||
|
|
|
@ -2,20 +2,545 @@ namespace MyWebLog.Data
|
||||||
|
|
||||||
open Microsoft.Data.Sqlite
|
open Microsoft.Data.Sqlite
|
||||||
open Microsoft.Extensions.Logging
|
open Microsoft.Extensions.Logging
|
||||||
|
open MyWebLog
|
||||||
open MyWebLog.Data.SQLite
|
open MyWebLog.Data.SQLite
|
||||||
|
open Newtonsoft.Json
|
||||||
|
open NodaTime
|
||||||
|
|
||||||
/// SQLite myWebLog data implementation
|
/// SQLite myWebLog data implementation
|
||||||
type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonSerializer) =
|
||||||
|
|
||||||
/// Determine if the given table exists
|
let ensureTables () = backgroundTask {
|
||||||
let tableExists (table : string) = backgroundTask {
|
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
cmd.CommandText <- "SELECT COUNT(*) FROM sqlite_master WHERE type = 'table' AND name = @table"
|
|
||||||
cmd.Parameters.AddWithValue ("@table", table) |> ignore
|
let! tables = backgroundTask {
|
||||||
let! count = count cmd
|
cmd.CommandText <- "SELECT name FROM sqlite_master WHERE type = 'table'"
|
||||||
return count = 1
|
let! rdr = cmd.ExecuteReaderAsync ()
|
||||||
|
let mutable tableList = []
|
||||||
|
while rdr.Read() do
|
||||||
|
tableList <- Map.getString "name" rdr :: tableList
|
||||||
|
do! rdr.CloseAsync ()
|
||||||
|
return tableList
|
||||||
|
}
|
||||||
|
let needsTable table =
|
||||||
|
not (List.contains table tables)
|
||||||
|
seq {
|
||||||
|
// Theme tables
|
||||||
|
if needsTable "theme" then
|
||||||
|
"CREATE TABLE theme (
|
||||||
|
id TEXT PRIMARY KEY,
|
||||||
|
name TEXT NOT NULL,
|
||||||
|
version TEXT NOT NULL)"
|
||||||
|
if needsTable "theme_template" then
|
||||||
|
"CREATE TABLE theme_template (
|
||||||
|
theme_id TEXT NOT NULL REFERENCES theme (id),
|
||||||
|
name TEXT NOT NULL,
|
||||||
|
template TEXT NOT NULL,
|
||||||
|
PRIMARY KEY (theme_id, name))"
|
||||||
|
if needsTable "theme_asset" then
|
||||||
|
"CREATE TABLE theme_asset (
|
||||||
|
theme_id TEXT NOT NULL REFERENCES theme (id),
|
||||||
|
path TEXT NOT NULL,
|
||||||
|
updated_on TEXT NOT NULL,
|
||||||
|
data BLOB NOT NULL,
|
||||||
|
PRIMARY KEY (theme_id, path))"
|
||||||
|
|
||||||
|
// Web log tables
|
||||||
|
if needsTable "web_log" then
|
||||||
|
"CREATE TABLE web_log (
|
||||||
|
id TEXT PRIMARY KEY,
|
||||||
|
name TEXT NOT NULL,
|
||||||
|
slug TEXT NOT NULL,
|
||||||
|
subtitle TEXT,
|
||||||
|
default_page TEXT NOT NULL,
|
||||||
|
posts_per_page INTEGER NOT NULL,
|
||||||
|
theme_id TEXT NOT NULL REFERENCES theme (id),
|
||||||
|
url_base TEXT NOT NULL,
|
||||||
|
time_zone TEXT NOT NULL,
|
||||||
|
auto_htmx INTEGER NOT NULL DEFAULT 0,
|
||||||
|
uploads TEXT NOT NULL,
|
||||||
|
is_feed_enabled INTEGER NOT NULL DEFAULT 0,
|
||||||
|
feed_name TEXT NOT NULL,
|
||||||
|
items_in_feed INTEGER,
|
||||||
|
is_category_enabled INTEGER NOT NULL DEFAULT 0,
|
||||||
|
is_tag_enabled INTEGER NOT NULL DEFAULT 0,
|
||||||
|
copyright TEXT);
|
||||||
|
CREATE INDEX web_log_theme_idx ON web_log (theme_id)"
|
||||||
|
if needsTable "web_log_feed" then
|
||||||
|
"CREATE TABLE web_log_feed (
|
||||||
|
id TEXT PRIMARY KEY,
|
||||||
|
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||||
|
source TEXT NOT NULL,
|
||||||
|
path TEXT NOT NULL,
|
||||||
|
podcast TEXT);
|
||||||
|
CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"
|
||||||
|
|
||||||
|
// Category table
|
||||||
|
if needsTable "category" then
|
||||||
|
"CREATE TABLE category (
|
||||||
|
id TEXT PRIMARY KEY,
|
||||||
|
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||||
|
name TEXT NOT NULL,
|
||||||
|
slug TEXT NOT NULL,
|
||||||
|
description TEXT,
|
||||||
|
parent_id TEXT);
|
||||||
|
CREATE INDEX category_web_log_idx ON category (web_log_id)"
|
||||||
|
|
||||||
|
// Web log user table
|
||||||
|
if needsTable "web_log_user" then
|
||||||
|
"CREATE TABLE web_log_user (
|
||||||
|
id TEXT PRIMARY KEY,
|
||||||
|
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||||
|
email TEXT NOT NULL,
|
||||||
|
first_name TEXT NOT NULL,
|
||||||
|
last_name TEXT NOT NULL,
|
||||||
|
preferred_name TEXT NOT NULL,
|
||||||
|
password_hash TEXT NOT NULL,
|
||||||
|
url TEXT,
|
||||||
|
access_level TEXT NOT NULL,
|
||||||
|
created_on TEXT NOT NULL,
|
||||||
|
last_seen_on TEXT);
|
||||||
|
CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id);
|
||||||
|
CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)"
|
||||||
|
|
||||||
|
// Page tables
|
||||||
|
if needsTable "page" then
|
||||||
|
"CREATE TABLE page (
|
||||||
|
id TEXT PRIMARY KEY,
|
||||||
|
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||||
|
author_id TEXT NOT NULL REFERENCES web_log_user (id),
|
||||||
|
title TEXT NOT NULL,
|
||||||
|
permalink TEXT NOT NULL,
|
||||||
|
published_on TEXT NOT NULL,
|
||||||
|
updated_on TEXT NOT NULL,
|
||||||
|
is_in_page_list INTEGER NOT NULL DEFAULT 0,
|
||||||
|
template TEXT,
|
||||||
|
page_text TEXT NOT NULL,
|
||||||
|
meta_items TEXT);
|
||||||
|
CREATE INDEX page_web_log_idx ON page (web_log_id);
|
||||||
|
CREATE INDEX page_author_idx ON page (author_id);
|
||||||
|
CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)"
|
||||||
|
if needsTable "page_permalink" then
|
||||||
|
"CREATE TABLE page_permalink (
|
||||||
|
page_id TEXT NOT NULL REFERENCES page (id),
|
||||||
|
permalink TEXT NOT NULL,
|
||||||
|
PRIMARY KEY (page_id, permalink))"
|
||||||
|
if needsTable "page_revision" then
|
||||||
|
"CREATE TABLE page_revision (
|
||||||
|
page_id TEXT NOT NULL REFERENCES page (id),
|
||||||
|
as_of TEXT NOT NULL,
|
||||||
|
revision_text TEXT NOT NULL,
|
||||||
|
PRIMARY KEY (page_id, as_of))"
|
||||||
|
|
||||||
|
// Post tables
|
||||||
|
if needsTable "post" then
|
||||||
|
"CREATE TABLE post (
|
||||||
|
id TEXT PRIMARY KEY,
|
||||||
|
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||||
|
author_id TEXT NOT NULL REFERENCES web_log_user (id),
|
||||||
|
status TEXT NOT NULL,
|
||||||
|
title TEXT NOT NULL,
|
||||||
|
permalink TEXT NOT NULL,
|
||||||
|
published_on TEXT,
|
||||||
|
updated_on TEXT NOT NULL,
|
||||||
|
template TEXT,
|
||||||
|
post_text TEXT NOT NULL,
|
||||||
|
meta_items TEXT,
|
||||||
|
episode TEXT);
|
||||||
|
CREATE INDEX post_web_log_idx ON post (web_log_id);
|
||||||
|
CREATE INDEX post_author_idx ON post (author_id);
|
||||||
|
CREATE INDEX post_status_idx ON post (web_log_id, status, updated_on);
|
||||||
|
CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)"
|
||||||
|
if needsTable "post_category" then
|
||||||
|
"CREATE TABLE post_category (
|
||||||
|
post_id TEXT NOT NULL REFERENCES post (id),
|
||||||
|
category_id TEXT NOT NULL REFERENCES category (id),
|
||||||
|
PRIMARY KEY (post_id, category_id));
|
||||||
|
CREATE INDEX post_category_category_idx ON post_category (category_id)"
|
||||||
|
if needsTable "post_tag" then
|
||||||
|
"CREATE TABLE post_tag (
|
||||||
|
post_id TEXT NOT NULL REFERENCES post (id),
|
||||||
|
tag TEXT NOT NULL,
|
||||||
|
PRIMARY KEY (post_id, tag))"
|
||||||
|
if needsTable "post_permalink" then
|
||||||
|
"CREATE TABLE post_permalink (
|
||||||
|
post_id TEXT NOT NULL REFERENCES post (id),
|
||||||
|
permalink TEXT NOT NULL,
|
||||||
|
PRIMARY KEY (post_id, permalink))"
|
||||||
|
if needsTable "post_revision" then
|
||||||
|
"CREATE TABLE post_revision (
|
||||||
|
post_id TEXT NOT NULL REFERENCES post (id),
|
||||||
|
as_of TEXT NOT NULL,
|
||||||
|
revision_text TEXT NOT NULL,
|
||||||
|
PRIMARY KEY (post_id, as_of))"
|
||||||
|
if needsTable "post_comment" then
|
||||||
|
"CREATE TABLE post_comment (
|
||||||
|
id TEXT PRIMARY KEY,
|
||||||
|
post_id TEXT NOT NULL REFERENCES post(id),
|
||||||
|
in_reply_to_id TEXT,
|
||||||
|
name TEXT NOT NULL,
|
||||||
|
email TEXT NOT NULL,
|
||||||
|
url TEXT,
|
||||||
|
status TEXT NOT NULL,
|
||||||
|
posted_on TEXT NOT NULL,
|
||||||
|
comment_text TEXT NOT NULL);
|
||||||
|
CREATE INDEX post_comment_post_idx ON post_comment (post_id)"
|
||||||
|
|
||||||
|
// Tag map table
|
||||||
|
if needsTable "tag_map" then
|
||||||
|
"CREATE TABLE tag_map (
|
||||||
|
id TEXT PRIMARY KEY,
|
||||||
|
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||||
|
tag TEXT NOT NULL,
|
||||||
|
url_value TEXT NOT NULL);
|
||||||
|
CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)"
|
||||||
|
|
||||||
|
// Uploaded file table
|
||||||
|
if needsTable "upload" then
|
||||||
|
"CREATE TABLE upload (
|
||||||
|
id TEXT PRIMARY KEY,
|
||||||
|
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||||
|
path TEXT NOT NULL,
|
||||||
|
updated_on TEXT NOT NULL,
|
||||||
|
data BLOB NOT NULL);
|
||||||
|
CREATE INDEX upload_web_log_idx ON upload (web_log_id);
|
||||||
|
CREATE INDEX upload_path_idx ON upload (web_log_id, path)"
|
||||||
|
|
||||||
|
// Database version table
|
||||||
|
if needsTable "db_version" then
|
||||||
|
"CREATE TABLE db_version (id TEXT PRIMARY KEY);
|
||||||
|
INSERT INTO db_version VALUES ('v2-rc1')"
|
||||||
|
}
|
||||||
|
|> Seq.map (fun sql ->
|
||||||
|
log.LogInformation $"Creating {(sql.Split ' ')[2]} table..."
|
||||||
|
cmd.CommandText <- sql
|
||||||
|
write cmd |> Async.AwaitTask |> Async.RunSynchronously)
|
||||||
|
|> List.ofSeq
|
||||||
|
|> ignore
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/// Set the database version to the specified version
|
||||||
|
let setDbVersion version = backgroundTask {
|
||||||
|
use cmd = conn.CreateCommand ()
|
||||||
|
cmd.CommandText <- $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')"
|
||||||
|
do! write cmd
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Implement the changes between v2-rc1 and v2-rc2
|
||||||
|
let migrateV2Rc1ToV2Rc2 () = backgroundTask {
|
||||||
|
let logStep = Utils.logMigrationStep log "v2-rc1 to v2-rc2"
|
||||||
|
// Move meta items, podcast settings, and episode details to JSON-encoded text fields
|
||||||
|
use cmd = conn.CreateCommand ()
|
||||||
|
logStep "Adding new columns"
|
||||||
|
cmd.CommandText <-
|
||||||
|
"ALTER TABLE web_log_feed ADD COLUMN podcast TEXT;
|
||||||
|
ALTER TABLE page ADD COLUMN meta_items TEXT;
|
||||||
|
ALTER TABLE post ADD COLUMN meta_items TEXT;
|
||||||
|
ALTER TABLE post ADD COLUMN episode TEXT"
|
||||||
|
do! write cmd
|
||||||
|
logStep "Migrating meta items"
|
||||||
|
let migrateMeta entity = backgroundTask {
|
||||||
|
cmd.CommandText <- $"SELECT * FROM %s{entity}_meta"
|
||||||
|
use! metaRdr = cmd.ExecuteReaderAsync ()
|
||||||
|
let allMetas =
|
||||||
|
seq {
|
||||||
|
while metaRdr.Read () do
|
||||||
|
Map.getString $"{entity}_id" metaRdr,
|
||||||
|
{ Name = Map.getString "name" metaRdr; Value = Map.getString "value" metaRdr }
|
||||||
|
} |> List.ofSeq
|
||||||
|
metaRdr.Close ()
|
||||||
|
let metas =
|
||||||
|
allMetas
|
||||||
|
|> List.map fst
|
||||||
|
|> List.distinct
|
||||||
|
|> List.map (fun it -> it, allMetas |> List.filter (fun meta -> fst meta = it))
|
||||||
|
metas
|
||||||
|
|> List.iter (fun (entityId, items) ->
|
||||||
|
cmd.CommandText <-
|
||||||
|
"UPDATE post
|
||||||
|
SET meta_items = @metaItems
|
||||||
|
WHERE id = @postId"
|
||||||
|
[ cmd.Parameters.AddWithValue ("@metaItems", Utils.serialize ser items)
|
||||||
|
cmd.Parameters.AddWithValue ("@id", entityId) ] |> ignore
|
||||||
|
let _ = cmd.ExecuteNonQuery ()
|
||||||
|
cmd.Parameters.Clear ())
|
||||||
|
}
|
||||||
|
do! migrateMeta "page"
|
||||||
|
do! migrateMeta "post"
|
||||||
|
logStep "Migrating podcasts and episodes"
|
||||||
|
cmd.CommandText <- "SELECT * FROM web_log_feed_podcast"
|
||||||
|
use! podcastRdr = cmd.ExecuteReaderAsync ()
|
||||||
|
let podcasts =
|
||||||
|
seq {
|
||||||
|
while podcastRdr.Read () do
|
||||||
|
CustomFeedId (Map.getString "feed_id" podcastRdr),
|
||||||
|
{ Title = Map.getString "title" podcastRdr
|
||||||
|
Subtitle = Map.tryString "subtitle" podcastRdr
|
||||||
|
ItemsInFeed = Map.getInt "items_in_feed" podcastRdr
|
||||||
|
Summary = Map.getString "summary" podcastRdr
|
||||||
|
DisplayedAuthor = Map.getString "displayed_author" podcastRdr
|
||||||
|
Email = Map.getString "email" podcastRdr
|
||||||
|
ImageUrl = Map.getString "image_url" podcastRdr |> Permalink
|
||||||
|
AppleCategory = Map.getString "apple_category" podcastRdr
|
||||||
|
AppleSubcategory = Map.tryString "apple_subcategory" podcastRdr
|
||||||
|
Explicit = Map.getString "explicit" podcastRdr |> ExplicitRating.parse
|
||||||
|
DefaultMediaType = Map.tryString "default_media_type" podcastRdr
|
||||||
|
MediaBaseUrl = Map.tryString "media_base_url" podcastRdr
|
||||||
|
PodcastGuid = Map.tryGuid "podcast_guid" podcastRdr
|
||||||
|
FundingUrl = Map.tryString "funding_url" podcastRdr
|
||||||
|
FundingText = Map.tryString "funding_text" podcastRdr
|
||||||
|
Medium = Map.tryString "medium" podcastRdr
|
||||||
|
|> Option.map PodcastMedium.parse
|
||||||
|
}
|
||||||
|
} |> List.ofSeq
|
||||||
|
podcastRdr.Close ()
|
||||||
|
podcasts
|
||||||
|
|> List.iter (fun (feedId, podcast) ->
|
||||||
|
cmd.CommandText <- "UPDATE web_log_feed SET podcast = @podcast WHERE id = @id"
|
||||||
|
[ cmd.Parameters.AddWithValue ("@podcast", Utils.serialize ser podcast)
|
||||||
|
cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feedId) ] |> ignore
|
||||||
|
let _ = cmd.ExecuteNonQuery ()
|
||||||
|
cmd.Parameters.Clear ())
|
||||||
|
cmd.CommandText <- "SELECT * FROM post_episode"
|
||||||
|
use! epRdr = cmd.ExecuteReaderAsync ()
|
||||||
|
let episodes =
|
||||||
|
seq {
|
||||||
|
while epRdr.Read () do
|
||||||
|
PostId (Map.getString "post_id" epRdr),
|
||||||
|
{ Media = Map.getString "media" epRdr
|
||||||
|
Length = Map.getLong "length" epRdr
|
||||||
|
Duration = Map.tryTimeSpan "duration" epRdr
|
||||||
|
|> Option.map Duration.FromTimeSpan
|
||||||
|
MediaType = Map.tryString "media_type" epRdr
|
||||||
|
ImageUrl = Map.tryString "image_url" epRdr
|
||||||
|
Subtitle = Map.tryString "subtitle" epRdr
|
||||||
|
Explicit = Map.tryString "explicit" epRdr
|
||||||
|
|> Option.map ExplicitRating.parse
|
||||||
|
ChapterFile = Map.tryString "chapter_file" epRdr
|
||||||
|
ChapterType = Map.tryString "chapter_type" epRdr
|
||||||
|
TranscriptUrl = Map.tryString "transcript_url" epRdr
|
||||||
|
TranscriptType = Map.tryString "transcript_type" epRdr
|
||||||
|
TranscriptLang = Map.tryString "transcript_lang" epRdr
|
||||||
|
TranscriptCaptions = Map.tryBoolean "transcript_captions" epRdr
|
||||||
|
SeasonNumber = Map.tryInt "season_number" epRdr
|
||||||
|
SeasonDescription = Map.tryString "season_description" epRdr
|
||||||
|
EpisodeNumber = Map.tryString "episode_number" epRdr
|
||||||
|
|> Option.map System.Double.Parse
|
||||||
|
EpisodeDescription = Map.tryString "episode_description" epRdr
|
||||||
|
}
|
||||||
|
} |> List.ofSeq
|
||||||
|
epRdr.Close ()
|
||||||
|
episodes
|
||||||
|
|> List.iter (fun (postId, episode) ->
|
||||||
|
cmd.CommandText <- "UPDATE post SET episode = @episode WHERE id = @id"
|
||||||
|
[ cmd.Parameters.AddWithValue ("@episode", Utils.serialize ser episode)
|
||||||
|
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) ] |> ignore
|
||||||
|
let _ = cmd.ExecuteNonQuery ()
|
||||||
|
cmd.Parameters.Clear ())
|
||||||
|
|
||||||
|
logStep "Migrating dates/times"
|
||||||
|
let inst (dt : System.DateTime) =
|
||||||
|
System.DateTime (dt.Ticks, System.DateTimeKind.Utc)
|
||||||
|
|> (Instant.FromDateTimeUtc >> Noda.toSecondsPrecision)
|
||||||
|
// page.updated_on, page.published_on
|
||||||
|
cmd.CommandText <- "SELECT id, updated_on, published_on FROM page"
|
||||||
|
use! pageRdr = cmd.ExecuteReaderAsync ()
|
||||||
|
let toUpdate =
|
||||||
|
seq {
|
||||||
|
while pageRdr.Read () do
|
||||||
|
Map.getString "id" pageRdr,
|
||||||
|
inst (Map.getDateTime "updated_on" pageRdr),
|
||||||
|
inst (Map.getDateTime "published_on" pageRdr)
|
||||||
|
} |> List.ofSeq
|
||||||
|
pageRdr.Close ()
|
||||||
|
cmd.CommandText <- "UPDATE page SET updated_on = @updatedOn, published_on = @publishedOn WHERE id = @id"
|
||||||
|
[ cmd.Parameters.Add ("@id", SqliteType.Text)
|
||||||
|
cmd.Parameters.Add ("@updatedOn", SqliteType.Text)
|
||||||
|
cmd.Parameters.Add ("@publishedOn", SqliteType.Text)
|
||||||
|
] |> ignore
|
||||||
|
toUpdate
|
||||||
|
|> List.iter (fun (pageId, updatedOn, publishedOn) ->
|
||||||
|
cmd.Parameters["@id" ].Value <- pageId
|
||||||
|
cmd.Parameters["@updatedOn" ].Value <- instantParam updatedOn
|
||||||
|
cmd.Parameters["@publishedOn"].Value <- instantParam publishedOn
|
||||||
|
let _ = cmd.ExecuteNonQuery ()
|
||||||
|
())
|
||||||
|
cmd.Parameters.Clear ()
|
||||||
|
// page_revision.as_of
|
||||||
|
cmd.CommandText <- "SELECT * FROM page_revision"
|
||||||
|
use! pageRevRdr = cmd.ExecuteReaderAsync ()
|
||||||
|
let toUpdate =
|
||||||
|
seq {
|
||||||
|
while pageRevRdr.Read () do
|
||||||
|
let asOf = Map.getDateTime "as_of" pageRevRdr
|
||||||
|
Map.getString "page_id" pageRevRdr, asOf, inst asOf, Map.getString "revision_text" pageRevRdr
|
||||||
|
} |> List.ofSeq
|
||||||
|
pageRevRdr.Close ()
|
||||||
|
cmd.CommandText <-
|
||||||
|
"DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @oldAsOf;
|
||||||
|
INSERT INTO page_revision (page_id, as_of, revision_text) VALUES (@pageId, @asOf, @text)"
|
||||||
|
[ cmd.Parameters.Add ("@pageId", SqliteType.Text)
|
||||||
|
cmd.Parameters.Add ("@oldAsOf", SqliteType.Text)
|
||||||
|
cmd.Parameters.Add ("@asOf", SqliteType.Text)
|
||||||
|
cmd.Parameters.Add ("@text", SqliteType.Text)
|
||||||
|
] |> ignore
|
||||||
|
toUpdate
|
||||||
|
|> List.iter (fun (pageId, oldAsOf, asOf, text) ->
|
||||||
|
cmd.Parameters["@pageId" ].Value <- pageId
|
||||||
|
cmd.Parameters["@oldAsOf"].Value <- oldAsOf
|
||||||
|
cmd.Parameters["@asOf" ].Value <- instantParam asOf
|
||||||
|
cmd.Parameters["@text" ].Value <- text
|
||||||
|
let _ = cmd.ExecuteNonQuery ()
|
||||||
|
())
|
||||||
|
cmd.Parameters.Clear ()
|
||||||
|
// post.updated_on, post.published_on (opt)
|
||||||
|
cmd.CommandText <- "SELECT id, updated_on, published_on FROM post"
|
||||||
|
use! postRdr = cmd.ExecuteReaderAsync ()
|
||||||
|
let toUpdate =
|
||||||
|
seq {
|
||||||
|
while postRdr.Read () do
|
||||||
|
Map.getString "id" postRdr,
|
||||||
|
inst (Map.getDateTime "updated_on" postRdr),
|
||||||
|
(Map.tryDateTime "published_on" postRdr |> Option.map inst)
|
||||||
|
} |> List.ofSeq
|
||||||
|
postRdr.Close ()
|
||||||
|
cmd.CommandText <- "UPDATE post SET updated_on = @updatedOn, published_on = @publishedOn WHERE id = @id"
|
||||||
|
[ cmd.Parameters.Add ("@id", SqliteType.Text)
|
||||||
|
cmd.Parameters.Add ("@updatedOn", SqliteType.Text)
|
||||||
|
cmd.Parameters.Add ("@publishedOn", SqliteType.Text)
|
||||||
|
] |> ignore
|
||||||
|
toUpdate
|
||||||
|
|> List.iter (fun (postId, updatedOn, publishedOn) ->
|
||||||
|
cmd.Parameters["@id" ].Value <- postId
|
||||||
|
cmd.Parameters["@updatedOn" ].Value <- instantParam updatedOn
|
||||||
|
cmd.Parameters["@publishedOn"].Value <- maybeInstant publishedOn
|
||||||
|
let _ = cmd.ExecuteNonQuery ()
|
||||||
|
())
|
||||||
|
cmd.Parameters.Clear ()
|
||||||
|
// post_revision.as_of
|
||||||
|
cmd.CommandText <- "SELECT * FROM post_revision"
|
||||||
|
use! postRevRdr = cmd.ExecuteReaderAsync ()
|
||||||
|
let toUpdate =
|
||||||
|
seq {
|
||||||
|
while postRevRdr.Read () do
|
||||||
|
let asOf = Map.getDateTime "as_of" postRevRdr
|
||||||
|
Map.getString "post_id" postRevRdr, asOf, inst asOf, Map.getString "revision_text" postRevRdr
|
||||||
|
} |> List.ofSeq
|
||||||
|
postRevRdr.Close ()
|
||||||
|
cmd.CommandText <-
|
||||||
|
"DELETE FROM post_revision WHERE post_id = @postId AND as_of = @oldAsOf;
|
||||||
|
INSERT INTO post_revision (post_id, as_of, revision_text) VALUES (@postId, @asOf, @text)"
|
||||||
|
[ cmd.Parameters.Add ("@postId", SqliteType.Text)
|
||||||
|
cmd.Parameters.Add ("@oldAsOf", SqliteType.Text)
|
||||||
|
cmd.Parameters.Add ("@asOf", SqliteType.Text)
|
||||||
|
cmd.Parameters.Add ("@text", SqliteType.Text)
|
||||||
|
] |> ignore
|
||||||
|
toUpdate
|
||||||
|
|> List.iter (fun (postId, oldAsOf, asOf, text) ->
|
||||||
|
cmd.Parameters["@postId" ].Value <- postId
|
||||||
|
cmd.Parameters["@oldAsOf"].Value <- oldAsOf
|
||||||
|
cmd.Parameters["@asOf" ].Value <- instantParam asOf
|
||||||
|
cmd.Parameters["@text" ].Value <- text
|
||||||
|
let _ = cmd.ExecuteNonQuery ()
|
||||||
|
())
|
||||||
|
cmd.Parameters.Clear ()
|
||||||
|
// theme_asset.updated_on
|
||||||
|
cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset"
|
||||||
|
use! assetRdr = cmd.ExecuteReaderAsync ()
|
||||||
|
let toUpdate =
|
||||||
|
seq {
|
||||||
|
while assetRdr.Read () do
|
||||||
|
Map.getString "theme_id" assetRdr, Map.getString "path" assetRdr,
|
||||||
|
inst (Map.getDateTime "updated_on" assetRdr)
|
||||||
|
} |> List.ofSeq
|
||||||
|
assetRdr.Close ()
|
||||||
|
cmd.CommandText <- "UPDATE theme_asset SET updated_on = @updatedOn WHERE theme_id = @themeId AND path = @path"
|
||||||
|
[ cmd.Parameters.Add ("@updatedOn", SqliteType.Text)
|
||||||
|
cmd.Parameters.Add ("@themeId", SqliteType.Text)
|
||||||
|
cmd.Parameters.Add ("@path", SqliteType.Text)
|
||||||
|
] |> ignore
|
||||||
|
toUpdate
|
||||||
|
|> List.iter (fun (themeId, path, updatedOn) ->
|
||||||
|
cmd.Parameters["@themeId" ].Value <- themeId
|
||||||
|
cmd.Parameters["@path" ].Value <- path
|
||||||
|
cmd.Parameters["@updatedOn"].Value <- instantParam updatedOn
|
||||||
|
let _ = cmd.ExecuteNonQuery ()
|
||||||
|
())
|
||||||
|
cmd.Parameters.Clear ()
|
||||||
|
// upload.updated_on
|
||||||
|
cmd.CommandText <- "SELECT id, updated_on FROM upload"
|
||||||
|
use! upRdr = cmd.ExecuteReaderAsync ()
|
||||||
|
let toUpdate =
|
||||||
|
seq {
|
||||||
|
while upRdr.Read () do
|
||||||
|
Map.getString "id" upRdr, inst (Map.getDateTime "updated_on" upRdr)
|
||||||
|
} |> List.ofSeq
|
||||||
|
upRdr.Close ()
|
||||||
|
cmd.CommandText <- "UPDATE upload SET updated_on = @updatedOn WHERE id = @id"
|
||||||
|
[ cmd.Parameters.Add ("@updatedOn", SqliteType.Text)
|
||||||
|
cmd.Parameters.Add ("@id", SqliteType.Text)
|
||||||
|
] |> ignore
|
||||||
|
toUpdate
|
||||||
|
|> List.iter (fun (upId, updatedOn) ->
|
||||||
|
cmd.Parameters["@id" ].Value <- upId
|
||||||
|
cmd.Parameters["@updatedOn"].Value <- instantParam updatedOn
|
||||||
|
let _ = cmd.ExecuteNonQuery ()
|
||||||
|
())
|
||||||
|
cmd.Parameters.Clear ()
|
||||||
|
// web_log_user.created_on, web_log_user.last_seen_on (opt)
|
||||||
|
cmd.CommandText <- "SELECT id, created_on, last_seen_on FROM web_log_user"
|
||||||
|
use! userRdr = cmd.ExecuteReaderAsync ()
|
||||||
|
let toUpdate =
|
||||||
|
seq {
|
||||||
|
while userRdr.Read () do
|
||||||
|
Map.getString "id" userRdr,
|
||||||
|
inst (Map.getDateTime "created_on" userRdr),
|
||||||
|
(Map.tryDateTime "last_seen_on" userRdr |> Option.map inst)
|
||||||
|
} |> List.ofSeq
|
||||||
|
userRdr.Close ()
|
||||||
|
cmd.CommandText <- "UPDATE web_log_user SET created_on = @createdOn, last_seen_on = @lastSeenOn WHERE id = @id"
|
||||||
|
[ cmd.Parameters.Add ("@id", SqliteType.Text)
|
||||||
|
cmd.Parameters.Add ("@createdOn", SqliteType.Text)
|
||||||
|
cmd.Parameters.Add ("@lastSeenOn", SqliteType.Text)
|
||||||
|
] |> ignore
|
||||||
|
toUpdate
|
||||||
|
|> List.iter (fun (userId, createdOn, lastSeenOn) ->
|
||||||
|
cmd.Parameters["@id" ].Value <- userId
|
||||||
|
cmd.Parameters["@createdOn" ].Value <- instantParam createdOn
|
||||||
|
cmd.Parameters["@lastSeenOn"].Value <- maybeInstant lastSeenOn
|
||||||
|
let _ = cmd.ExecuteNonQuery ()
|
||||||
|
())
|
||||||
|
cmd.Parameters.Clear ()
|
||||||
|
|
||||||
|
conn.Close ()
|
||||||
|
conn.Open ()
|
||||||
|
|
||||||
|
logStep "Dropping old tables and columns"
|
||||||
|
cmd.CommandText <-
|
||||||
|
"ALTER TABLE web_log_user DROP COLUMN salt;
|
||||||
|
DROP TABLE post_episode;
|
||||||
|
DROP TABLE post_meta;
|
||||||
|
DROP TABLE page_meta;
|
||||||
|
DROP TABLE web_log_feed_podcast"
|
||||||
|
do! write cmd
|
||||||
|
|
||||||
|
logStep "Setting database version to v2-rc2"
|
||||||
|
do! setDbVersion "v2-rc2"
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Migrate data among versions (up only)
|
||||||
|
let migrate version = backgroundTask {
|
||||||
|
|
||||||
|
match version with
|
||||||
|
| Some v when v = "v2-rc2" -> ()
|
||||||
|
| Some v when v = "v2-rc1" -> do! migrateV2Rc1ToV2Rc2 ()
|
||||||
|
| Some _
|
||||||
|
| None ->
|
||||||
|
log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
|
||||||
|
do! setDbVersion Utils.currentDbVersion
|
||||||
|
}
|
||||||
|
|
||||||
/// The connection for this instance
|
/// The connection for this instance
|
||||||
member _.Conn = conn
|
member _.Conn = conn
|
||||||
|
|
||||||
|
@ -31,355 +556,26 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||||
interface IData with
|
interface IData with
|
||||||
|
|
||||||
member _.Category = SQLiteCategoryData conn
|
member _.Category = SQLiteCategoryData conn
|
||||||
member _.Page = SQLitePageData conn
|
member _.Page = SQLitePageData (conn, ser)
|
||||||
member _.Post = SQLitePostData conn
|
member _.Post = SQLitePostData (conn, ser)
|
||||||
member _.TagMap = SQLiteTagMapData conn
|
member _.TagMap = SQLiteTagMapData conn
|
||||||
member _.Theme = SQLiteThemeData conn
|
member _.Theme = SQLiteThemeData conn
|
||||||
member _.ThemeAsset = SQLiteThemeAssetData conn
|
member _.ThemeAsset = SQLiteThemeAssetData conn
|
||||||
member _.Upload = SQLiteUploadData conn
|
member _.Upload = SQLiteUploadData conn
|
||||||
member _.WebLog = SQLiteWebLogData conn
|
member _.WebLog = SQLiteWebLogData (conn, ser)
|
||||||
member _.WebLogUser = SQLiteWebLogUserData conn
|
member _.WebLogUser = SQLiteWebLogUserData conn
|
||||||
|
|
||||||
|
member _.Serializer = ser
|
||||||
|
|
||||||
member _.StartUp () = backgroundTask {
|
member _.StartUp () = backgroundTask {
|
||||||
|
do! ensureTables ()
|
||||||
|
|
||||||
use cmd = conn.CreateCommand ()
|
use cmd = conn.CreateCommand ()
|
||||||
|
cmd.CommandText <- "SELECT id FROM db_version"
|
||||||
// Theme tables
|
use! rdr = cmd.ExecuteReaderAsync ()
|
||||||
match! tableExists "theme" with
|
let version = if rdr.Read () then Some (Map.getString "id" rdr) else None
|
||||||
| true -> ()
|
match version with
|
||||||
| false ->
|
| Some v when v = "v2-rc2" -> ()
|
||||||
log.LogInformation "Creating theme table..."
|
| Some _
|
||||||
cmd.CommandText <- """
|
| None -> do! migrate version
|
||||||
CREATE TABLE theme (
|
|
||||||
id TEXT PRIMARY KEY,
|
|
||||||
name TEXT NOT NULL,
|
|
||||||
version TEXT NOT NULL)"""
|
|
||||||
do! write cmd
|
|
||||||
match! tableExists "theme_template" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating theme_template table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE theme_template (
|
|
||||||
theme_id TEXT NOT NULL REFERENCES theme (id),
|
|
||||||
name TEXT NOT NULL,
|
|
||||||
template TEXT NOT NULL,
|
|
||||||
PRIMARY KEY (theme_id, name))"""
|
|
||||||
do! write cmd
|
|
||||||
match! tableExists "theme_asset" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating theme_asset table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE theme_asset (
|
|
||||||
theme_id TEXT NOT NULL REFERENCES theme (id),
|
|
||||||
path TEXT NOT NULL,
|
|
||||||
updated_on TEXT NOT NULL,
|
|
||||||
data BLOB NOT NULL,
|
|
||||||
PRIMARY KEY (theme_id, path))"""
|
|
||||||
do! write cmd
|
|
||||||
|
|
||||||
// Web log tables
|
|
||||||
match! tableExists "web_log" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating web_log table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE web_log (
|
|
||||||
id TEXT PRIMARY KEY,
|
|
||||||
name TEXT NOT NULL,
|
|
||||||
slug TEXT NOT NULL,
|
|
||||||
subtitle TEXT,
|
|
||||||
default_page TEXT NOT NULL,
|
|
||||||
posts_per_page INTEGER NOT NULL,
|
|
||||||
theme_id TEXT NOT NULL REFERENCES theme (id),
|
|
||||||
url_base TEXT NOT NULL,
|
|
||||||
time_zone TEXT NOT NULL,
|
|
||||||
auto_htmx INTEGER NOT NULL DEFAULT 0,
|
|
||||||
uploads TEXT NOT NULL,
|
|
||||||
is_feed_enabled INTEGER NOT NULL DEFAULT 0,
|
|
||||||
feed_name TEXT NOT NULL,
|
|
||||||
items_in_feed INTEGER,
|
|
||||||
is_category_enabled INTEGER NOT NULL DEFAULT 0,
|
|
||||||
is_tag_enabled INTEGER NOT NULL DEFAULT 0,
|
|
||||||
copyright TEXT);
|
|
||||||
CREATE INDEX web_log_theme_idx ON web_log (theme_id)"""
|
|
||||||
do! write cmd
|
|
||||||
match! tableExists "web_log_feed" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating web_log_feed table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE web_log_feed (
|
|
||||||
id TEXT PRIMARY KEY,
|
|
||||||
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
|
||||||
source TEXT NOT NULL,
|
|
||||||
path TEXT NOT NULL);
|
|
||||||
CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"""
|
|
||||||
do! write cmd
|
|
||||||
match! tableExists "web_log_feed_podcast" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating web_log_feed_podcast table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE web_log_feed_podcast (
|
|
||||||
feed_id TEXT PRIMARY KEY REFERENCES web_log_feed (id),
|
|
||||||
title TEXT NOT NULL,
|
|
||||||
subtitle TEXT,
|
|
||||||
items_in_feed INTEGER NOT NULL,
|
|
||||||
summary TEXT NOT NULL,
|
|
||||||
displayed_author TEXT NOT NULL,
|
|
||||||
email TEXT NOT NULL,
|
|
||||||
image_url TEXT NOT NULL,
|
|
||||||
apple_category TEXT NOT NULL,
|
|
||||||
apple_subcategory TEXT,
|
|
||||||
explicit TEXT NOT NULL,
|
|
||||||
default_media_type TEXT,
|
|
||||||
media_base_url TEXT,
|
|
||||||
podcast_guid TEXT,
|
|
||||||
funding_url TEXT,
|
|
||||||
funding_text TEXT,
|
|
||||||
medium TEXT)"""
|
|
||||||
do! write cmd
|
|
||||||
|
|
||||||
// Category table
|
|
||||||
match! tableExists "category" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating category table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE category (
|
|
||||||
id TEXT PRIMARY KEY,
|
|
||||||
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
|
||||||
name TEXT NOT NULL,
|
|
||||||
slug TEXT NOT NULL,
|
|
||||||
description TEXT,
|
|
||||||
parent_id TEXT);
|
|
||||||
CREATE INDEX category_web_log_idx ON category (web_log_id)"""
|
|
||||||
do! write cmd
|
|
||||||
|
|
||||||
// Web log user table
|
|
||||||
match! tableExists "web_log_user" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating web_log_user table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE web_log_user (
|
|
||||||
id TEXT PRIMARY KEY,
|
|
||||||
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
|
||||||
email TEXT NOT NULL,
|
|
||||||
first_name TEXT NOT NULL,
|
|
||||||
last_name TEXT NOT NULL,
|
|
||||||
preferred_name TEXT NOT NULL,
|
|
||||||
password_hash TEXT NOT NULL,
|
|
||||||
salt TEXT NOT NULL,
|
|
||||||
url TEXT,
|
|
||||||
access_level TEXT NOT NULL,
|
|
||||||
created_on TEXT NOT NULL,
|
|
||||||
last_seen_on TEXT);
|
|
||||||
CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id);
|
|
||||||
CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)"""
|
|
||||||
do! write cmd
|
|
||||||
|
|
||||||
// Page tables
|
|
||||||
match! tableExists "page" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating page table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE page (
|
|
||||||
id TEXT PRIMARY KEY,
|
|
||||||
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
|
||||||
author_id TEXT NOT NULL REFERENCES web_log_user (id),
|
|
||||||
title TEXT NOT NULL,
|
|
||||||
permalink TEXT NOT NULL,
|
|
||||||
published_on TEXT NOT NULL,
|
|
||||||
updated_on TEXT NOT NULL,
|
|
||||||
is_in_page_list INTEGER NOT NULL DEFAULT 0,
|
|
||||||
template TEXT,
|
|
||||||
page_text TEXT NOT NULL);
|
|
||||||
CREATE INDEX page_web_log_idx ON page (web_log_id);
|
|
||||||
CREATE INDEX page_author_idx ON page (author_id);
|
|
||||||
CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)"""
|
|
||||||
do! write cmd
|
|
||||||
match! tableExists "page_meta" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating page_meta table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE page_meta (
|
|
||||||
page_id TEXT NOT NULL REFERENCES page (id),
|
|
||||||
name TEXT NOT NULL,
|
|
||||||
value TEXT NOT NULL,
|
|
||||||
PRIMARY KEY (page_id, name, value))"""
|
|
||||||
do! write cmd
|
|
||||||
match! tableExists "page_permalink" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating page_permalink table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE page_permalink (
|
|
||||||
page_id TEXT NOT NULL REFERENCES page (id),
|
|
||||||
permalink TEXT NOT NULL,
|
|
||||||
PRIMARY KEY (page_id, permalink))"""
|
|
||||||
do! write cmd
|
|
||||||
match! tableExists "page_revision" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating page_revision table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE page_revision (
|
|
||||||
page_id TEXT NOT NULL REFERENCES page (id),
|
|
||||||
as_of TEXT NOT NULL,
|
|
||||||
revision_text TEXT NOT NULL,
|
|
||||||
PRIMARY KEY (page_id, as_of))"""
|
|
||||||
do! write cmd
|
|
||||||
|
|
||||||
// Post tables
|
|
||||||
match! tableExists "post" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating post table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE post (
|
|
||||||
id TEXT PRIMARY KEY,
|
|
||||||
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
|
||||||
author_id TEXT NOT NULL REFERENCES web_log_user (id),
|
|
||||||
status TEXT NOT NULL,
|
|
||||||
title TEXT NOT NULL,
|
|
||||||
permalink TEXT NOT NULL,
|
|
||||||
published_on TEXT,
|
|
||||||
updated_on TEXT NOT NULL,
|
|
||||||
template TEXT,
|
|
||||||
post_text TEXT NOT NULL);
|
|
||||||
CREATE INDEX post_web_log_idx ON post (web_log_id);
|
|
||||||
CREATE INDEX post_author_idx ON post (author_id);
|
|
||||||
CREATE INDEX post_status_idx ON post (web_log_id, status, updated_on);
|
|
||||||
CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)"""
|
|
||||||
do! write cmd
|
|
||||||
match! tableExists "post_category" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating post_category table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE post_category (
|
|
||||||
post_id TEXT NOT NULL REFERENCES post (id),
|
|
||||||
category_id TEXT NOT NULL REFERENCES category (id),
|
|
||||||
PRIMARY KEY (post_id, category_id));
|
|
||||||
CREATE INDEX post_category_category_idx ON post_category (category_id)"""
|
|
||||||
do! write cmd
|
|
||||||
match! tableExists "post_episode" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating post_episode table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE post_episode (
|
|
||||||
post_id TEXT PRIMARY KEY REFERENCES post(id),
|
|
||||||
media TEXT NOT NULL,
|
|
||||||
length INTEGER NOT NULL,
|
|
||||||
duration TEXT,
|
|
||||||
media_type TEXT,
|
|
||||||
image_url TEXT,
|
|
||||||
subtitle TEXT,
|
|
||||||
explicit TEXT,
|
|
||||||
chapter_file TEXT,
|
|
||||||
chapter_type TEXT,
|
|
||||||
transcript_url TEXT,
|
|
||||||
transcript_type TEXT,
|
|
||||||
transcript_lang TEXT,
|
|
||||||
transcript_captions INTEGER,
|
|
||||||
season_number INTEGER,
|
|
||||||
season_description TEXT,
|
|
||||||
episode_number TEXT,
|
|
||||||
episode_description TEXT)"""
|
|
||||||
do! write cmd
|
|
||||||
match! tableExists "post_tag" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating post_tag table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE post_tag (
|
|
||||||
post_id TEXT NOT NULL REFERENCES post (id),
|
|
||||||
tag TEXT NOT NULL,
|
|
||||||
PRIMARY KEY (post_id, tag))"""
|
|
||||||
do! write cmd
|
|
||||||
match! tableExists "post_meta" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating post_meta table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE post_meta (
|
|
||||||
post_id TEXT NOT NULL REFERENCES post (id),
|
|
||||||
name TEXT NOT NULL,
|
|
||||||
value TEXT NOT NULL,
|
|
||||||
PRIMARY KEY (post_id, name, value))"""
|
|
||||||
do! write cmd
|
|
||||||
match! tableExists "post_permalink" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating post_permalink table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE post_permalink (
|
|
||||||
post_id TEXT NOT NULL REFERENCES post (id),
|
|
||||||
permalink TEXT NOT NULL,
|
|
||||||
PRIMARY KEY (post_id, permalink))"""
|
|
||||||
do! write cmd
|
|
||||||
match! tableExists "post_revision" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating post_revision table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE post_revision (
|
|
||||||
post_id TEXT NOT NULL REFERENCES post (id),
|
|
||||||
as_of TEXT NOT NULL,
|
|
||||||
revision_text TEXT NOT NULL,
|
|
||||||
PRIMARY KEY (post_id, as_of))"""
|
|
||||||
do! write cmd
|
|
||||||
match! tableExists "post_comment" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating post_comment table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE post_comment (
|
|
||||||
id TEXT PRIMARY KEY,
|
|
||||||
post_id TEXT NOT NULL REFERENCES post(id),
|
|
||||||
in_reply_to_id TEXT,
|
|
||||||
name TEXT NOT NULL,
|
|
||||||
email TEXT NOT NULL,
|
|
||||||
url TEXT,
|
|
||||||
status TEXT NOT NULL,
|
|
||||||
posted_on TEXT NOT NULL,
|
|
||||||
comment_text TEXT NOT NULL);
|
|
||||||
CREATE INDEX post_comment_post_idx ON post_comment (post_id)"""
|
|
||||||
do! write cmd
|
|
||||||
|
|
||||||
// Tag map table
|
|
||||||
match! tableExists "tag_map" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating tag_map table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE tag_map (
|
|
||||||
id TEXT PRIMARY KEY,
|
|
||||||
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
|
||||||
tag TEXT NOT NULL,
|
|
||||||
url_value TEXT NOT NULL);
|
|
||||||
CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)"""
|
|
||||||
do! write cmd
|
|
||||||
|
|
||||||
// Uploaded file table
|
|
||||||
match! tableExists "upload" with
|
|
||||||
| true -> ()
|
|
||||||
| false ->
|
|
||||||
log.LogInformation "Creating upload table..."
|
|
||||||
cmd.CommandText <- """
|
|
||||||
CREATE TABLE upload (
|
|
||||||
id TEXT PRIMARY KEY,
|
|
||||||
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
|
||||||
path TEXT NOT NULL,
|
|
||||||
updated_on TEXT NOT NULL,
|
|
||||||
data BLOB NOT NULL);
|
|
||||||
CREATE INDEX upload_web_log_idx ON upload (web_log_id);
|
|
||||||
CREATE INDEX upload_path_idx ON upload (web_log_id, path)"""
|
|
||||||
do! write cmd
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -5,6 +5,9 @@ module internal MyWebLog.Data.Utils
|
||||||
open MyWebLog
|
open MyWebLog
|
||||||
open MyWebLog.ViewModels
|
open MyWebLog.ViewModels
|
||||||
|
|
||||||
|
/// The current database version
|
||||||
|
let currentDbVersion = "v2-rc2"
|
||||||
|
|
||||||
/// Create a category hierarchy from the given list of categories
|
/// Create a category hierarchy from the given list of categories
|
||||||
let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq {
|
let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq {
|
||||||
for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do
|
for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do
|
||||||
|
@ -20,3 +23,36 @@ let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames =
|
||||||
yield! orderByHierarchy cats (Some cat.Id) (Some fullSlug) ([ cat.Name ] |> List.append parentNames)
|
yield! orderByHierarchy cats (Some cat.Id) (Some fullSlug) ([ cat.Name ] |> List.append parentNames)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/// Get lists of items removed from and added to the given lists
|
||||||
|
let diffLists<'T, 'U when 'U : equality> oldItems newItems (f : 'T -> 'U) =
|
||||||
|
let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other))
|
||||||
|
List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems
|
||||||
|
|
||||||
|
/// Find meta items added and removed
|
||||||
|
let diffMetaItems (oldItems : MetaItem list) newItems =
|
||||||
|
diffLists oldItems newItems (fun item -> $"{item.Name}|{item.Value}")
|
||||||
|
|
||||||
|
/// Find the permalinks added and removed
|
||||||
|
let diffPermalinks oldLinks newLinks =
|
||||||
|
diffLists oldLinks newLinks Permalink.toString
|
||||||
|
|
||||||
|
/// Find the revisions added and removed
|
||||||
|
let diffRevisions oldRevs newRevs =
|
||||||
|
diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.ToUnixTimeTicks ()}|{MarkupText.toString rev.Text}")
|
||||||
|
|
||||||
|
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)
|
||||||
|
|
||||||
|
open Microsoft.Extensions.Logging
|
||||||
|
|
||||||
|
/// Log a migration step
|
||||||
|
let logMigrationStep<'T> (log : ILogger<'T>) migration message =
|
||||||
|
log.LogInformation $"Migrating %s{migration}: %s{message}"
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
|
|
||||||
open System
|
open System
|
||||||
open MyWebLog
|
open MyWebLog
|
||||||
|
open NodaTime
|
||||||
|
|
||||||
/// A category under which a post may be identified
|
/// A category under which a post may be identified
|
||||||
[<CLIMutable; NoComparison; NoEquality>]
|
[<CLIMutable; NoComparison; NoEquality>]
|
||||||
|
@ -64,7 +65,7 @@ type Comment =
|
||||||
Status : CommentStatus
|
Status : CommentStatus
|
||||||
|
|
||||||
/// When the comment was posted
|
/// When the comment was posted
|
||||||
PostedOn : DateTime
|
PostedOn : Instant
|
||||||
|
|
||||||
/// The text of the comment
|
/// The text of the comment
|
||||||
Text : string
|
Text : string
|
||||||
|
@ -82,7 +83,7 @@ module Comment =
|
||||||
Email = ""
|
Email = ""
|
||||||
Url = None
|
Url = None
|
||||||
Status = Pending
|
Status = Pending
|
||||||
PostedOn = DateTime.UtcNow
|
PostedOn = Noda.epoch
|
||||||
Text = ""
|
Text = ""
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -106,10 +107,10 @@ type Page =
|
||||||
Permalink : Permalink
|
Permalink : Permalink
|
||||||
|
|
||||||
/// When this page was published
|
/// When this page was published
|
||||||
PublishedOn : DateTime
|
PublishedOn : Instant
|
||||||
|
|
||||||
/// When this page was last updated
|
/// When this page was last updated
|
||||||
UpdatedOn : DateTime
|
UpdatedOn : Instant
|
||||||
|
|
||||||
/// Whether this page shows as part of the web log's navigation
|
/// Whether this page shows as part of the web log's navigation
|
||||||
IsInPageList : bool
|
IsInPageList : bool
|
||||||
|
@ -140,8 +141,8 @@ module Page =
|
||||||
AuthorId = WebLogUserId.empty
|
AuthorId = WebLogUserId.empty
|
||||||
Title = ""
|
Title = ""
|
||||||
Permalink = Permalink.empty
|
Permalink = Permalink.empty
|
||||||
PublishedOn = DateTime.MinValue
|
PublishedOn = Noda.epoch
|
||||||
UpdatedOn = DateTime.MinValue
|
UpdatedOn = Noda.epoch
|
||||||
IsInPageList = false
|
IsInPageList = false
|
||||||
Template = None
|
Template = None
|
||||||
Text = ""
|
Text = ""
|
||||||
|
@ -173,10 +174,10 @@ type Post =
|
||||||
Permalink : Permalink
|
Permalink : Permalink
|
||||||
|
|
||||||
/// The instant on which the post was originally published
|
/// The instant on which the post was originally published
|
||||||
PublishedOn : DateTime option
|
PublishedOn : Instant option
|
||||||
|
|
||||||
/// The instant on which the post was last updated
|
/// The instant on which the post was last updated
|
||||||
UpdatedOn : DateTime
|
UpdatedOn : Instant
|
||||||
|
|
||||||
/// The template to use in displaying the post
|
/// The template to use in displaying the post
|
||||||
Template : string option
|
Template : string option
|
||||||
|
@ -215,7 +216,7 @@ module Post =
|
||||||
Title = ""
|
Title = ""
|
||||||
Permalink = Permalink.empty
|
Permalink = Permalink.empty
|
||||||
PublishedOn = None
|
PublishedOn = None
|
||||||
UpdatedOn = DateTime.MinValue
|
UpdatedOn = Noda.epoch
|
||||||
Text = ""
|
Text = ""
|
||||||
Template = None
|
Template = None
|
||||||
CategoryIds = []
|
CategoryIds = []
|
||||||
|
@ -288,7 +289,7 @@ type ThemeAsset =
|
||||||
Id : ThemeAssetId
|
Id : ThemeAssetId
|
||||||
|
|
||||||
/// The updated date (set from the file date from the ZIP archive)
|
/// The updated date (set from the file date from the ZIP archive)
|
||||||
UpdatedOn : DateTime
|
UpdatedOn : Instant
|
||||||
|
|
||||||
/// The data for the asset
|
/// The data for the asset
|
||||||
Data : byte[]
|
Data : byte[]
|
||||||
|
@ -300,7 +301,7 @@ module ThemeAsset =
|
||||||
/// An empty theme asset
|
/// An empty theme asset
|
||||||
let empty =
|
let empty =
|
||||||
{ Id = ThemeAssetId (ThemeId "", "")
|
{ Id = ThemeAssetId (ThemeId "", "")
|
||||||
UpdatedOn = DateTime.MinValue
|
UpdatedOn = Noda.epoch
|
||||||
Data = [||]
|
Data = [||]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -317,7 +318,7 @@ type Upload =
|
||||||
Path : Permalink
|
Path : Permalink
|
||||||
|
|
||||||
/// The updated date/time for this upload
|
/// The updated date/time for this upload
|
||||||
UpdatedOn : DateTime
|
UpdatedOn : Instant
|
||||||
|
|
||||||
/// The data for the upload
|
/// The data for the upload
|
||||||
Data : byte[]
|
Data : byte[]
|
||||||
|
@ -331,7 +332,7 @@ module Upload =
|
||||||
{ Id = UploadId.empty
|
{ Id = UploadId.empty
|
||||||
WebLogId = WebLogId.empty
|
WebLogId = WebLogId.empty
|
||||||
Path = Permalink.empty
|
Path = Permalink.empty
|
||||||
UpdatedOn = DateTime.MinValue
|
UpdatedOn = Noda.epoch
|
||||||
Data = [||]
|
Data = [||]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -410,10 +411,11 @@ module WebLog =
|
||||||
let _, leadPath = hostAndPath webLog
|
let _, leadPath = hostAndPath webLog
|
||||||
$"{leadPath}/{Permalink.toString permalink}"
|
$"{leadPath}/{Permalink.toString permalink}"
|
||||||
|
|
||||||
/// Convert a UTC date/time to the web log's local date/time
|
/// Convert an Instant (UTC reference) to the web log's local date/time
|
||||||
let localTime webLog (date : DateTime) =
|
let localTime webLog (date : Instant) =
|
||||||
TimeZoneInfo.ConvertTimeFromUtc
|
match DateTimeZoneProviders.Tzdb[webLog.TimeZone] with
|
||||||
(DateTime (date.Ticks, DateTimeKind.Utc), TimeZoneInfo.FindSystemTimeZoneById webLog.TimeZone)
|
| null -> date.ToDateTimeUtc ()
|
||||||
|
| tz -> date.InZone(tz).ToDateTimeUnspecified ()
|
||||||
|
|
||||||
|
|
||||||
/// A user of the web log
|
/// A user of the web log
|
||||||
|
@ -440,9 +442,6 @@ type WebLogUser =
|
||||||
/// The hash of the user's password
|
/// The hash of the user's password
|
||||||
PasswordHash : string
|
PasswordHash : string
|
||||||
|
|
||||||
/// Salt used to calculate the user's password hash
|
|
||||||
Salt : Guid
|
|
||||||
|
|
||||||
/// The URL of the user's personal site
|
/// The URL of the user's personal site
|
||||||
Url : string option
|
Url : string option
|
||||||
|
|
||||||
|
@ -450,10 +449,10 @@ type WebLogUser =
|
||||||
AccessLevel : AccessLevel
|
AccessLevel : AccessLevel
|
||||||
|
|
||||||
/// When the user was created
|
/// When the user was created
|
||||||
CreatedOn : DateTime
|
CreatedOn : Instant
|
||||||
|
|
||||||
/// When the user last logged on
|
/// When the user last logged on
|
||||||
LastSeenOn : DateTime option
|
LastSeenOn : Instant option
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Functions to support web log users
|
/// Functions to support web log users
|
||||||
|
@ -468,10 +467,9 @@ module WebLogUser =
|
||||||
LastName = ""
|
LastName = ""
|
||||||
PreferredName = ""
|
PreferredName = ""
|
||||||
PasswordHash = ""
|
PasswordHash = ""
|
||||||
Salt = Guid.Empty
|
|
||||||
Url = None
|
Url = None
|
||||||
AccessLevel = Author
|
AccessLevel = Author
|
||||||
CreatedOn = DateTime.UnixEpoch
|
CreatedOn = Noda.epoch
|
||||||
LastSeenOn = None
|
LastSeenOn = None
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -7,9 +7,10 @@
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<PackageReference Include="Markdig" Version="0.30.2" />
|
<PackageReference Include="Markdig" Version="0.30.3" />
|
||||||
<PackageReference Update="FSharp.Core" Version="6.0.5" />
|
<PackageReference Update="FSharp.Core" Version="6.0.5" />
|
||||||
<PackageReference Include="Markdown.ColorCode" Version="1.0.1" />
|
<PackageReference Include="Markdown.ColorCode" Version="1.0.1" />
|
||||||
|
<PackageReference Include="NodaTime" Version="3.1.2" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
</Project>
|
</Project>
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
namespace MyWebLog
|
namespace MyWebLog
|
||||||
|
|
||||||
open System
|
open System
|
||||||
|
open NodaTime
|
||||||
|
|
||||||
/// Support functions for domain definition
|
/// Support functions for domain definition
|
||||||
[<AutoOpen>]
|
[<AutoOpen>]
|
||||||
|
@ -12,6 +13,29 @@ module private Helpers =
|
||||||
Convert.ToBase64String(Guid.NewGuid().ToByteArray ()).Replace('/', '_').Replace('+', '-').Substring (0, 22)
|
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
|
||||||
|
|
||||||
|
|
||||||
|
/// Truncate an instant to remove fractional seconds
|
||||||
|
let toSecondsPrecision (value : Instant) =
|
||||||
|
Instant.FromUnixTimeSeconds (value.ToUnixTimeSeconds ())
|
||||||
|
|
||||||
|
/// The current Instant, with fractional seconds truncated
|
||||||
|
let now () =
|
||||||
|
toSecondsPrecision (clock.GetCurrentInstant ())
|
||||||
|
|
||||||
|
/// Convert a date/time to an Instant with whole seconds
|
||||||
|
let fromDateTime (dt : DateTime) =
|
||||||
|
toSecondsPrecision (Instant.FromDateTimeUtc (DateTime (dt.Ticks, DateTimeKind.Utc)))
|
||||||
|
|
||||||
|
|
||||||
/// A user's access level
|
/// A user's access level
|
||||||
type AccessLevel =
|
type AccessLevel =
|
||||||
/// The user may create and publish posts and edit the ones they have created
|
/// The user may create and publish posts and edit the ones they have created
|
||||||
|
@ -137,6 +161,8 @@ module ExplicitRating =
|
||||||
| x -> raise (invalidArg "rating" $"{x} is not a valid explicit rating")
|
| x -> raise (invalidArg "rating" $"{x} is not a valid explicit rating")
|
||||||
|
|
||||||
|
|
||||||
|
open NodaTime.Text
|
||||||
|
|
||||||
/// A podcast episode
|
/// A podcast episode
|
||||||
type Episode =
|
type Episode =
|
||||||
{ /// The URL to the media file for the episode (may be permalink)
|
{ /// The URL to the media file for the episode (may be permalink)
|
||||||
|
@ -146,7 +172,7 @@ type Episode =
|
||||||
Length : int64
|
Length : int64
|
||||||
|
|
||||||
/// The duration of the episode
|
/// The duration of the episode
|
||||||
Duration : TimeSpan option
|
Duration : Duration option
|
||||||
|
|
||||||
/// The media type of the file (overrides podcast default if present)
|
/// The media type of the file (overrides podcast default if present)
|
||||||
MediaType : string option
|
MediaType : string option
|
||||||
|
@ -214,6 +240,10 @@ module Episode =
|
||||||
EpisodeNumber = None
|
EpisodeNumber = None
|
||||||
EpisodeDescription = None
|
EpisodeDescription = None
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/// Format a duration for an episode
|
||||||
|
let formatDuration ep =
|
||||||
|
ep.Duration |> Option.map (DurationPattern.CreateWithInvariantCulture("H:mm:ss").Format)
|
||||||
|
|
||||||
|
|
||||||
open Markdig
|
open Markdig
|
||||||
|
@ -269,12 +299,11 @@ module MetaItem =
|
||||||
let empty =
|
let empty =
|
||||||
{ Name = ""; Value = "" }
|
{ Name = ""; Value = "" }
|
||||||
|
|
||||||
|
|
||||||
/// A revision of a page or post
|
/// A revision of a page or post
|
||||||
[<CLIMutable; NoComparison; NoEquality>]
|
[<CLIMutable; NoComparison; NoEquality>]
|
||||||
type Revision =
|
type Revision =
|
||||||
{ /// When this revision was saved
|
{ /// When this revision was saved
|
||||||
AsOf : DateTime
|
AsOf : Instant
|
||||||
|
|
||||||
/// The text of the revision
|
/// The text of the revision
|
||||||
Text : MarkupText
|
Text : MarkupText
|
||||||
|
@ -285,7 +314,7 @@ module Revision =
|
||||||
|
|
||||||
/// An empty revision
|
/// An empty revision
|
||||||
let empty =
|
let empty =
|
||||||
{ AsOf = DateTime.UtcNow
|
{ AsOf = Noda.epoch
|
||||||
Text = Html ""
|
Text = Html ""
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
|
|
||||||
open System
|
open System
|
||||||
open MyWebLog
|
open MyWebLog
|
||||||
|
open NodaTime
|
||||||
|
|
||||||
/// Helper functions for view models
|
/// Helper functions for view models
|
||||||
[<AutoOpen>]
|
[<AutoOpen>]
|
||||||
|
@ -138,8 +139,8 @@ type DisplayPage =
|
||||||
AuthorId = WebLogUserId.toString page.AuthorId
|
AuthorId = WebLogUserId.toString page.AuthorId
|
||||||
Title = page.Title
|
Title = page.Title
|
||||||
Permalink = Permalink.toString page.Permalink
|
Permalink = Permalink.toString page.Permalink
|
||||||
PublishedOn = page.PublishedOn
|
PublishedOn = WebLog.localTime webLog page.PublishedOn
|
||||||
UpdatedOn = page.UpdatedOn
|
UpdatedOn = WebLog.localTime webLog page.UpdatedOn
|
||||||
IsInPageList = page.IsInPageList
|
IsInPageList = page.IsInPageList
|
||||||
IsDefault = pageId = webLog.DefaultPage
|
IsDefault = pageId = webLog.DefaultPage
|
||||||
Text = ""
|
Text = ""
|
||||||
|
@ -154,8 +155,8 @@ type DisplayPage =
|
||||||
AuthorId = WebLogUserId.toString page.AuthorId
|
AuthorId = WebLogUserId.toString page.AuthorId
|
||||||
Title = page.Title
|
Title = page.Title
|
||||||
Permalink = Permalink.toString page.Permalink
|
Permalink = Permalink.toString page.Permalink
|
||||||
PublishedOn = page.PublishedOn
|
PublishedOn = WebLog.localTime webLog page.PublishedOn
|
||||||
UpdatedOn = page.UpdatedOn
|
UpdatedOn = WebLog.localTime webLog page.UpdatedOn
|
||||||
IsInPageList = page.IsInPageList
|
IsInPageList = page.IsInPageList
|
||||||
IsDefault = pageId = webLog.DefaultPage
|
IsDefault = pageId = webLog.DefaultPage
|
||||||
Text = addBaseToRelativeUrls extra page.Text
|
Text = addBaseToRelativeUrls extra page.Text
|
||||||
|
@ -179,7 +180,7 @@ with
|
||||||
|
|
||||||
/// Create a display revision from an actual revision
|
/// Create a display revision from an actual revision
|
||||||
static member fromRevision webLog (rev : Revision) =
|
static member fromRevision webLog (rev : Revision) =
|
||||||
{ AsOf = rev.AsOf
|
{ AsOf = rev.AsOf.ToDateTimeUtc ()
|
||||||
AsOfLocal = WebLog.localTime webLog rev.AsOf
|
AsOfLocal = WebLog.localTime webLog rev.AsOf
|
||||||
Format = MarkupText.sourceType rev.Text
|
Format = MarkupText.sourceType rev.Text
|
||||||
}
|
}
|
||||||
|
@ -703,7 +704,7 @@ type EditPostModel =
|
||||||
match post.Revisions |> List.sortByDescending (fun r -> r.AsOf) |> List.tryHead with
|
match post.Revisions |> List.sortByDescending (fun r -> r.AsOf) |> List.tryHead with
|
||||||
| Some rev -> rev
|
| Some rev -> rev
|
||||||
| None -> Revision.empty
|
| None -> Revision.empty
|
||||||
let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.empty ] } else post
|
let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.empty ] } else post
|
||||||
let episode = defaultArg post.Episode Episode.empty
|
let episode = defaultArg post.Episode Episode.empty
|
||||||
{ PostId = PostId.toString post.Id
|
{ PostId = PostId.toString post.Id
|
||||||
Title = post.Title
|
Title = post.Title
|
||||||
|
@ -723,7 +724,7 @@ type EditPostModel =
|
||||||
IsEpisode = Option.isSome post.Episode
|
IsEpisode = Option.isSome post.Episode
|
||||||
Media = episode.Media
|
Media = episode.Media
|
||||||
Length = episode.Length
|
Length = episode.Length
|
||||||
Duration = defaultArg (episode.Duration |> Option.map (fun it -> it.ToString """hh\:mm\:ss""")) ""
|
Duration = defaultArg (Episode.formatDuration episode) ""
|
||||||
MediaType = defaultArg episode.MediaType ""
|
MediaType = defaultArg episode.MediaType ""
|
||||||
ImageUrl = defaultArg episode.ImageUrl ""
|
ImageUrl = defaultArg episode.ImageUrl ""
|
||||||
Subtitle = defaultArg episode.Subtitle ""
|
Subtitle = defaultArg episode.Subtitle ""
|
||||||
|
@ -781,7 +782,8 @@ type EditPostModel =
|
||||||
Some {
|
Some {
|
||||||
Media = this.Media
|
Media = this.Media
|
||||||
Length = this.Length
|
Length = this.Length
|
||||||
Duration = noneIfBlank this.Duration |> Option.map TimeSpan.Parse
|
Duration = noneIfBlank this.Duration
|
||||||
|
|> Option.map (TimeSpan.Parse >> Duration.FromTimeSpan)
|
||||||
MediaType = noneIfBlank this.MediaType
|
MediaType = noneIfBlank this.MediaType
|
||||||
ImageUrl = noneIfBlank this.ImageUrl
|
ImageUrl = noneIfBlank this.ImageUrl
|
||||||
Subtitle = noneIfBlank this.Subtitle
|
Subtitle = noneIfBlank this.Subtitle
|
||||||
|
|
|
@ -56,7 +56,6 @@ module Extensions =
|
||||||
defaultArg (this.UserAccessLevel |> Option.map (AccessLevel.hasAccess level)) false
|
defaultArg (this.UserAccessLevel |> Option.map (AccessLevel.hasAccess level)) false
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
open System.Collections.Concurrent
|
open System.Collections.Concurrent
|
||||||
|
|
||||||
/// <summary>
|
/// <summary>
|
||||||
|
|
|
@ -5,6 +5,7 @@ open System.Threading.Tasks
|
||||||
open Giraffe
|
open Giraffe
|
||||||
open MyWebLog
|
open MyWebLog
|
||||||
open MyWebLog.ViewModels
|
open MyWebLog.ViewModels
|
||||||
|
open NodaTime
|
||||||
|
|
||||||
/// ~~ DASHBOARDS ~~
|
/// ~~ DASHBOARDS ~~
|
||||||
module Dashboard =
|
module Dashboard =
|
||||||
|
@ -12,23 +13,22 @@ module Dashboard =
|
||||||
// GET /admin/dashboard
|
// GET /admin/dashboard
|
||||||
let user : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
let user : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||||
let getCount (f : WebLogId -> Task<int>) = f ctx.WebLog.Id
|
let getCount (f : WebLogId -> Task<int>) = f ctx.WebLog.Id
|
||||||
let data = ctx.Data
|
let data = ctx.Data
|
||||||
let posts = getCount (data.Post.CountByStatus Published)
|
let! posts = getCount (data.Post.CountByStatus Published)
|
||||||
let drafts = getCount (data.Post.CountByStatus Draft)
|
let! drafts = getCount (data.Post.CountByStatus Draft)
|
||||||
let pages = getCount data.Page.CountAll
|
let! pages = getCount data.Page.CountAll
|
||||||
let listed = getCount data.Page.CountListed
|
let! listed = getCount data.Page.CountListed
|
||||||
let cats = getCount data.Category.CountAll
|
let! cats = getCount data.Category.CountAll
|
||||||
let topCats = getCount data.Category.CountTopLevel
|
let! topCats = getCount data.Category.CountTopLevel
|
||||||
let! _ = Task.WhenAll (posts, drafts, pages, listed, cats, topCats)
|
|
||||||
return!
|
return!
|
||||||
hashForPage "Dashboard"
|
hashForPage "Dashboard"
|
||||||
|> addToHash ViewContext.Model {
|
|> addToHash ViewContext.Model {
|
||||||
Posts = posts.Result
|
Posts = posts
|
||||||
Drafts = drafts.Result
|
Drafts = drafts
|
||||||
Pages = pages.Result
|
Pages = pages
|
||||||
ListedPages = listed.Result
|
ListedPages = listed
|
||||||
Categories = cats.Result
|
Categories = cats
|
||||||
TopLevelCategories = topCats.Result
|
TopLevelCategories = topCats
|
||||||
}
|
}
|
||||||
|> adminView "dashboard" next ctx
|
|> adminView "dashboard" next ctx
|
||||||
}
|
}
|
||||||
|
@ -344,7 +344,8 @@ module Theme =
|
||||||
do! asset.Open().CopyToAsync stream
|
do! asset.Open().CopyToAsync stream
|
||||||
do! data.ThemeAsset.Save
|
do! data.ThemeAsset.Save
|
||||||
{ Id = ThemeAssetId (themeId, assetName)
|
{ Id = ThemeAssetId (themeId, assetName)
|
||||||
UpdatedOn = asset.LastWriteTime.DateTime
|
UpdatedOn = LocalDateTime.FromDateTime(asset.LastWriteTime.DateTime)
|
||||||
|
.InZoneLeniently(DateTimeZone.Utc).ToInstant ()
|
||||||
Data = stream.ToArray ()
|
Data = stream.ToArray ()
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
@ -95,8 +95,8 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[
|
||||||
let item = SyndicationItem (
|
let item = SyndicationItem (
|
||||||
Id = WebLog.absoluteUrl webLog post.Permalink,
|
Id = WebLog.absoluteUrl webLog post.Permalink,
|
||||||
Title = TextSyndicationContent.CreateHtmlContent post.Title,
|
Title = TextSyndicationContent.CreateHtmlContent post.Title,
|
||||||
PublishDate = DateTimeOffset post.PublishedOn.Value,
|
PublishDate = post.PublishedOn.Value.ToDateTimeOffset (),
|
||||||
LastUpdatedTime = DateTimeOffset post.UpdatedOn,
|
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset (),
|
||||||
Content = TextSyndicationContent.CreatePlaintextContent plainText)
|
Content = TextSyndicationContent.CreatePlaintextContent plainText)
|
||||||
item.AddPermalink (Uri item.Id)
|
item.AddPermalink (Uri item.Id)
|
||||||
|
|
||||||
|
@ -163,8 +163,8 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
|
||||||
item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor)
|
item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor)
|
||||||
item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit)
|
item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit)
|
||||||
episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it))
|
episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it))
|
||||||
episode.Duration
|
Episode.formatDuration episode
|
||||||
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.ToString """hh\:mm\:ss"""))
|
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it))
|
||||||
|
|
||||||
match episode.ChapterFile with
|
match episode.ChapterFile with
|
||||||
| Some chapters ->
|
| Some chapters ->
|
||||||
|
@ -381,7 +381,7 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
|
||||||
addNamespace feed "content" Namespace.content
|
addNamespace feed "content" Namespace.content
|
||||||
setTitleAndDescription feedType webLog cats feed
|
setTitleAndDescription feedType webLog cats feed
|
||||||
|
|
||||||
feed.LastUpdatedTime <- (List.head posts).UpdatedOn |> DateTimeOffset
|
feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset ()
|
||||||
feed.Generator <- ctx.Generator
|
feed.Generator <- ctx.Generator
|
||||||
feed.Items <- posts |> Seq.ofList |> Seq.map toItem
|
feed.Items <- posts |> Seq.ofList |> Seq.map toItem
|
||||||
feed.Language <- "en"
|
feed.Language <- "en"
|
||||||
|
|
|
@ -419,10 +419,11 @@ let getCategoryIds slug ctx =
|
||||||
|
|
||||||
open System
|
open System
|
||||||
open System.Globalization
|
open System.Globalization
|
||||||
|
open NodaTime
|
||||||
|
|
||||||
/// Parse a date/time to UTC
|
/// Parse a date/time to UTC
|
||||||
let parseToUtc (date : string) =
|
let parseToUtc (date : string) =
|
||||||
DateTime.Parse (date, null, DateTimeStyles.AdjustToUniversal)
|
Instant.FromDateTimeUtc (DateTime.Parse (date, null, DateTimeStyles.AdjustToUniversal))
|
||||||
|
|
||||||
open Microsoft.Extensions.DependencyInjection
|
open Microsoft.Extensions.DependencyInjection
|
||||||
open Microsoft.Extensions.Logging
|
open Microsoft.Extensions.Logging
|
||||||
|
|
|
@ -139,15 +139,13 @@ let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
|
||||||
| _, None -> return! Error.notFound next ctx
|
| _, None -> return! Error.notFound next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
open System
|
|
||||||
|
|
||||||
// POST /admin/page/{id}/revision/{revision-date}/restore
|
// POST /admin/page/{id}/revision/{revision-date}/restore
|
||||||
let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||||
match! findPageRevision pgId revDate ctx with
|
match! findPageRevision pgId revDate ctx with
|
||||||
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
|
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
|
||||||
do! ctx.Data.Page.Update
|
do! ctx.Data.Page.Update
|
||||||
{ pg with
|
{ pg with
|
||||||
Revisions = { rev with AsOf = DateTime.UtcNow }
|
Revisions = { rev with AsOf = Noda.now () }
|
||||||
:: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
|
:: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
|
||||||
}
|
}
|
||||||
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
|
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
|
||||||
|
@ -173,7 +171,7 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
|
||||||
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||||
let! model = ctx.BindFormAsync<EditPageModel> ()
|
let! model = ctx.BindFormAsync<EditPageModel> ()
|
||||||
let data = ctx.Data
|
let data = ctx.Data
|
||||||
let now = DateTime.UtcNow
|
let now = Noda.now ()
|
||||||
let tryPage =
|
let tryPage =
|
||||||
if model.IsNew then
|
if model.IsNew then
|
||||||
{ Page.empty with
|
{ Page.empty with
|
||||||
|
|
|
@ -52,9 +52,9 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage (data :
|
||||||
let! olderPost, newerPost =
|
let! olderPost, newerPost =
|
||||||
match listType with
|
match listType with
|
||||||
| SinglePost ->
|
| SinglePost ->
|
||||||
let post = List.head posts
|
let post = List.head posts
|
||||||
let dateTime = defaultArg post.PublishedOn post.UpdatedOn
|
let target = defaultArg post.PublishedOn post.UpdatedOn
|
||||||
data.Post.FindSurroundingPosts webLog.Id dateTime
|
data.Post.FindSurroundingPosts webLog.Id target
|
||||||
| _ -> Task.FromResult (None, None)
|
| _ -> Task.FromResult (None, None)
|
||||||
let newerLink =
|
let newerLink =
|
||||||
match listType, pageNbr with
|
match listType, pageNbr with
|
||||||
|
@ -350,7 +350,7 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
|
||||||
| Some post, Some rev when canEdit post.AuthorId ctx ->
|
| Some post, Some rev when canEdit post.AuthorId ctx ->
|
||||||
do! ctx.Data.Post.Update
|
do! ctx.Data.Post.Update
|
||||||
{ post with
|
{ post with
|
||||||
Revisions = { rev with AsOf = DateTime.UtcNow }
|
Revisions = { rev with AsOf = Noda.now () }
|
||||||
:: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
|
:: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
|
||||||
}
|
}
|
||||||
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
|
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
|
||||||
|
@ -376,7 +376,6 @@ let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fu
|
||||||
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||||
let! model = ctx.BindFormAsync<EditPostModel> ()
|
let! model = ctx.BindFormAsync<EditPostModel> ()
|
||||||
let data = ctx.Data
|
let data = ctx.Data
|
||||||
let now = DateTime.UtcNow
|
|
||||||
let tryPost =
|
let tryPost =
|
||||||
if model.IsNew then
|
if model.IsNew then
|
||||||
{ Post.empty with
|
{ Post.empty with
|
||||||
|
@ -389,7 +388,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||||
| Some post when canEdit post.AuthorId ctx ->
|
| Some post when canEdit post.AuthorId ctx ->
|
||||||
let priorCats = post.CategoryIds
|
let priorCats = post.CategoryIds
|
||||||
let updatedPost =
|
let updatedPost =
|
||||||
model.UpdatePost post now
|
model.UpdatePost post (Noda.now ())
|
||||||
|> function
|
|> function
|
||||||
| post ->
|
| post ->
|
||||||
if model.SetPublished then
|
if model.SetPublished then
|
||||||
|
|
|
@ -94,7 +94,7 @@ module Asset =
|
||||||
| Some asset ->
|
| Some asset ->
|
||||||
match Upload.checkModified asset.UpdatedOn ctx with
|
match Upload.checkModified asset.UpdatedOn ctx with
|
||||||
| Some threeOhFour -> return! threeOhFour next ctx
|
| Some threeOhFour -> return! threeOhFour next ctx
|
||||||
| None -> return! Upload.sendFile asset.UpdatedOn path asset.Data next ctx
|
| None -> return! Upload.sendFile (asset.UpdatedOn.ToDateTimeUtc ()) path asset.Data next ctx
|
||||||
| None -> return! Error.notFound next ctx
|
| None -> return! Error.notFound next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -29,15 +29,17 @@ module private Helpers =
|
||||||
|
|
||||||
// ~~ SERVING UPLOADS ~~
|
// ~~ SERVING UPLOADS ~~
|
||||||
|
|
||||||
|
open System.Globalization
|
||||||
open Giraffe
|
open Giraffe
|
||||||
open Microsoft.AspNetCore.Http
|
open Microsoft.AspNetCore.Http
|
||||||
|
open NodaTime
|
||||||
|
|
||||||
/// Determine if the file has been modified since the date/time specified by the If-Modified-Since header
|
/// Determine if the file has been modified since the date/time specified by the If-Modified-Since header
|
||||||
let checkModified since (ctx : HttpContext) : HttpHandler option =
|
let checkModified since (ctx : HttpContext) : HttpHandler option =
|
||||||
match ctx.Request.Headers.IfModifiedSince with
|
match ctx.Request.Headers.IfModifiedSince with
|
||||||
| it when it.Count < 1 -> None
|
| it when it.Count < 1 -> None
|
||||||
| it when since > DateTime.Parse it[0] -> None
|
| it when since > Instant.FromDateTimeUtc (DateTime.Parse (it[0], null, DateTimeStyles.AdjustToUniversal)) -> None
|
||||||
| _ -> Some (setStatusCode 304 >=> setBodyFromString "Not Modified")
|
| _ -> Some (setStatusCode 304)
|
||||||
|
|
||||||
|
|
||||||
open Microsoft.AspNetCore.Http.Headers
|
open Microsoft.AspNetCore.Http.Headers
|
||||||
|
@ -73,7 +75,7 @@ let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
|
||||||
| Some upload ->
|
| Some upload ->
|
||||||
match checkModified upload.UpdatedOn ctx with
|
match checkModified upload.UpdatedOn ctx with
|
||||||
| Some threeOhFour -> return! threeOhFour next ctx
|
| Some threeOhFour -> return! threeOhFour next ctx
|
||||||
| None -> return! sendFile upload.UpdatedOn path upload.Data next ctx
|
| None -> return! sendFile (upload.UpdatedOn.ToDateTimeUtc ()) path upload.Data next ctx
|
||||||
| None -> return! Error.notFound next ctx
|
| None -> return! Error.notFound next ctx
|
||||||
else
|
else
|
||||||
return! Error.notFound next ctx
|
return! Error.notFound next ctx
|
||||||
|
@ -143,7 +145,8 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||||
let upload = Seq.head ctx.Request.Form.Files
|
let upload = Seq.head ctx.Request.Form.Files
|
||||||
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
|
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
|
||||||
Path.GetExtension(upload.FileName).ToLowerInvariant ())
|
Path.GetExtension(upload.FileName).ToLowerInvariant ())
|
||||||
let localNow = WebLog.localTime ctx.WebLog DateTime.Now
|
let now = Noda.now ()
|
||||||
|
let localNow = WebLog.localTime ctx.WebLog now
|
||||||
let year = localNow.ToString "yyyy"
|
let year = localNow.ToString "yyyy"
|
||||||
let month = localNow.ToString "MM"
|
let month = localNow.ToString "MM"
|
||||||
let! form = ctx.BindFormAsync<UploadFileModel> ()
|
let! form = ctx.BindFormAsync<UploadFileModel> ()
|
||||||
|
@ -156,7 +159,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||||
{ Id = UploadId.create ()
|
{ Id = UploadId.create ()
|
||||||
WebLogId = ctx.WebLog.Id
|
WebLogId = ctx.WebLog.Id
|
||||||
Path = Permalink $"{year}/{month}/{fileName}"
|
Path = Permalink $"{year}/{month}/{fileName}"
|
||||||
UpdatedOn = DateTime.UtcNow
|
UpdatedOn = now
|
||||||
Data = stream.ToArray ()
|
Data = stream.ToArray ()
|
||||||
}
|
}
|
||||||
do! ctx.Data.Upload.Add file
|
do! ctx.Data.Upload.Add file
|
||||||
|
|
|
@ -2,19 +2,32 @@
|
||||||
module MyWebLog.Handlers.User
|
module MyWebLog.Handlers.User
|
||||||
|
|
||||||
open System
|
open System
|
||||||
open System.Security.Cryptography
|
open Microsoft.AspNetCore.Http
|
||||||
open System.Text
|
open Microsoft.AspNetCore.Identity
|
||||||
|
open MyWebLog
|
||||||
|
open NodaTime
|
||||||
|
|
||||||
// ~~ LOG ON / LOG OFF ~~
|
// ~~ LOG ON / LOG OFF ~~
|
||||||
|
|
||||||
/// Hash a password for a given user
|
/// Create a password hash a password for a given user
|
||||||
let hashedPassword (plainText : string) (email : string) (salt : Guid) =
|
let createPasswordHash user password =
|
||||||
let allSalt = Array.concat [ salt.ToByteArray (); Encoding.UTF8.GetBytes email ]
|
PasswordHasher<WebLogUser>().HashPassword (user, password)
|
||||||
use alg = new Rfc2898DeriveBytes (plainText, allSalt, 2_048)
|
|
||||||
Convert.ToBase64String (alg.GetBytes 64)
|
/// Verify whether a password is valid
|
||||||
|
let verifyPassword user password (ctx : HttpContext) = backgroundTask {
|
||||||
|
match user with
|
||||||
|
| Some usr ->
|
||||||
|
let hasher = PasswordHasher<WebLogUser> ()
|
||||||
|
match hasher.VerifyHashedPassword (usr, usr.PasswordHash, password) with
|
||||||
|
| PasswordVerificationResult.Success -> return Ok ()
|
||||||
|
| PasswordVerificationResult.SuccessRehashNeeded ->
|
||||||
|
do! ctx.Data.WebLogUser.Update { usr with PasswordHash = hasher.HashPassword (usr, password) }
|
||||||
|
return Ok ()
|
||||||
|
| _ -> return Error "Log on attempt unsuccessful"
|
||||||
|
| None -> return Error "Log on attempt unsuccessful"
|
||||||
|
}
|
||||||
|
|
||||||
open Giraffe
|
open Giraffe
|
||||||
open MyWebLog
|
|
||||||
open MyWebLog.ViewModels
|
open MyWebLog.ViewModels
|
||||||
|
|
||||||
// GET /user/log-on
|
// GET /user/log-on
|
||||||
|
@ -35,10 +48,12 @@ open Microsoft.AspNetCore.Authentication.Cookies
|
||||||
|
|
||||||
// POST /user/log-on
|
// POST /user/log-on
|
||||||
let doLogOn : HttpHandler = fun next ctx -> task {
|
let doLogOn : HttpHandler = fun next ctx -> task {
|
||||||
let! model = ctx.BindFormAsync<LogOnModel> ()
|
let! model = ctx.BindFormAsync<LogOnModel> ()
|
||||||
let data = ctx.Data
|
let data = ctx.Data
|
||||||
match! data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id with
|
let! tryUser = data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id
|
||||||
| Some user when user.PasswordHash = hashedPassword model.Password user.Email user.Salt ->
|
match! verifyPassword tryUser model.Password ctx with
|
||||||
|
| Ok _ ->
|
||||||
|
let user = tryUser.Value
|
||||||
let claims = seq {
|
let claims = seq {
|
||||||
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id)
|
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id)
|
||||||
Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
|
Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
|
||||||
|
@ -59,8 +74,8 @@ let doLogOn : HttpHandler = fun next ctx -> task {
|
||||||
match model.ReturnTo with
|
match model.ReturnTo with
|
||||||
| Some url -> redirectTo false url next ctx
|
| Some url -> redirectTo false url next ctx
|
||||||
| None -> redirectToGet "admin/dashboard" next ctx
|
| None -> redirectToGet "admin/dashboard" next ctx
|
||||||
| _ ->
|
| Error msg ->
|
||||||
do! addMessage ctx { UserMessage.error with Message = "Log on attempt unsuccessful" }
|
do! addMessage ctx { UserMessage.error with Message = msg }
|
||||||
return! logOn model.ReturnTo next ctx
|
return! logOn model.ReturnTo next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -147,7 +162,9 @@ let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandl
|
||||||
|> addToHash ViewContext.Model model
|
|> addToHash ViewContext.Model model
|
||||||
|> addToHash "access_level" (AccessLevel.toString user.AccessLevel)
|
|> addToHash "access_level" (AccessLevel.toString user.AccessLevel)
|
||||||
|> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn)
|
|> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn)
|
||||||
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog (defaultArg user.LastSeenOn DateTime.UnixEpoch))
|
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog
|
||||||
|
(defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
|
||||||
|
|
||||||
|> adminView "my-info" next ctx
|
|> adminView "my-info" next ctx
|
||||||
|
|
||||||
|
|
||||||
|
@ -164,19 +181,13 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||||
let data = ctx.Data
|
let data = ctx.Data
|
||||||
match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
|
match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
|
||||||
| Some user when model.NewPassword = model.NewPasswordConfirm ->
|
| Some user when model.NewPassword = model.NewPasswordConfirm ->
|
||||||
let pw, salt =
|
let pw = if model.NewPassword = "" then user.PasswordHash else createPasswordHash user model.NewPassword
|
||||||
if model.NewPassword = "" then
|
|
||||||
user.PasswordHash, user.Salt
|
|
||||||
else
|
|
||||||
let newSalt = Guid.NewGuid ()
|
|
||||||
hashedPassword model.NewPassword user.Email newSalt, newSalt
|
|
||||||
let user =
|
let user =
|
||||||
{ user with
|
{ user with
|
||||||
FirstName = model.FirstName
|
FirstName = model.FirstName
|
||||||
LastName = model.LastName
|
LastName = model.LastName
|
||||||
PreferredName = model.PreferredName
|
PreferredName = model.PreferredName
|
||||||
PasswordHash = pw
|
PasswordHash = pw
|
||||||
Salt = salt
|
|
||||||
}
|
}
|
||||||
do! data.WebLogUser.Update user
|
do! data.WebLogUser.Update user
|
||||||
let pwMsg = if model.NewPassword = "" then "" else " and updated your password"
|
let pwMsg = if model.NewPassword = "" then "" else " and updated your password"
|
||||||
|
@ -198,9 +209,9 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
|
||||||
let tryUser =
|
let tryUser =
|
||||||
if model.IsNew then
|
if model.IsNew then
|
||||||
{ WebLogUser.empty with
|
{ WebLogUser.empty with
|
||||||
Id = WebLogUserId.create ()
|
Id = WebLogUserId.create ()
|
||||||
WebLogId = ctx.WebLog.Id
|
WebLogId = ctx.WebLog.Id
|
||||||
CreatedOn = DateTime.UtcNow
|
CreatedOn = Noda.now ()
|
||||||
} |> someTask
|
} |> someTask
|
||||||
else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
|
else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
|
||||||
match! tryUser with
|
match! tryUser with
|
||||||
|
@ -211,9 +222,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
|
||||||
else
|
else
|
||||||
let toUpdate =
|
let toUpdate =
|
||||||
if model.Password = "" then updatedUser
|
if model.Password = "" then updatedUser
|
||||||
else
|
else { updatedUser with PasswordHash = createPasswordHash updatedUser model.Password }
|
||||||
let salt = Guid.NewGuid ()
|
|
||||||
{ updatedUser with PasswordHash = hashedPassword model.Password model.Email salt; Salt = salt }
|
|
||||||
do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate
|
do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate
|
||||||
do! addMessage ctx
|
do! addMessage ctx
|
||||||
{ UserMessage.success with
|
{ UserMessage.success with
|
||||||
|
@ -227,4 +236,3 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
|
||||||
next ctx
|
next ctx
|
||||||
| None -> return! Error.notFound next ctx
|
| None -> return! Error.notFound next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -4,6 +4,7 @@ open System
|
||||||
open System.IO
|
open System.IO
|
||||||
open Microsoft.Extensions.DependencyInjection
|
open Microsoft.Extensions.DependencyInjection
|
||||||
open MyWebLog.Data
|
open MyWebLog.Data
|
||||||
|
open NodaTime
|
||||||
|
|
||||||
/// Create the web log information
|
/// Create the web log information
|
||||||
let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
|
let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
|
||||||
|
@ -41,22 +42,19 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
|
||||||
}
|
}
|
||||||
|
|
||||||
// Create the admin user
|
// Create the admin user
|
||||||
let salt = Guid.NewGuid ()
|
let now = Noda.now ()
|
||||||
let now = DateTime.UtcNow
|
let user =
|
||||||
|
{ WebLogUser.empty with
|
||||||
do! data.WebLogUser.Add
|
Id = userId
|
||||||
{ WebLogUser.empty with
|
WebLogId = webLogId
|
||||||
Id = userId
|
Email = args[3]
|
||||||
WebLogId = webLogId
|
FirstName = "Admin"
|
||||||
Email = args[3]
|
LastName = "User"
|
||||||
FirstName = "Admin"
|
PreferredName = "Admin"
|
||||||
LastName = "User"
|
AccessLevel = accessLevel
|
||||||
PreferredName = "Admin"
|
CreatedOn = now
|
||||||
PasswordHash = Handlers.User.hashedPassword args[4] args[3] salt
|
}
|
||||||
Salt = salt
|
do! data.WebLogUser.Add { user with PasswordHash = Handlers.User.createPasswordHash user args[4] }
|
||||||
AccessLevel = accessLevel
|
|
||||||
CreatedOn = now
|
|
||||||
}
|
|
||||||
|
|
||||||
// Create the default home page
|
// Create the default home page
|
||||||
do! data.Page.Add
|
do! data.Page.Add
|
||||||
|
@ -70,8 +68,8 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
|
||||||
UpdatedOn = now
|
UpdatedOn = now
|
||||||
Text = "<p>This is your default home page.</p>"
|
Text = "<p>This is your default home page.</p>"
|
||||||
Revisions = [
|
Revisions = [
|
||||||
{ AsOf = now
|
{ AsOf = now
|
||||||
Text = Html "<p>This is your default home page.</p>"
|
Text = Html "<p>This is your default home page.</p>"
|
||||||
}
|
}
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
@ -155,7 +153,6 @@ let loadTheme (args : string[]) (sp : IServiceProvider) = task {
|
||||||
/// Back up a web log's data
|
/// Back up a web log's data
|
||||||
module Backup =
|
module Backup =
|
||||||
|
|
||||||
open System.Threading.Tasks
|
|
||||||
open MyWebLog.Converters
|
open MyWebLog.Converters
|
||||||
open Newtonsoft.Json
|
open Newtonsoft.Json
|
||||||
|
|
||||||
|
@ -165,7 +162,7 @@ module Backup =
|
||||||
Id : ThemeAssetId
|
Id : ThemeAssetId
|
||||||
|
|
||||||
/// The updated date for this asset
|
/// The updated date for this asset
|
||||||
UpdatedOn : DateTime
|
UpdatedOn : Instant
|
||||||
|
|
||||||
/// The data for this asset, base-64 encoded
|
/// The data for this asset, base-64 encoded
|
||||||
Data : string
|
Data : string
|
||||||
|
@ -197,7 +194,7 @@ module Backup =
|
||||||
Path : Permalink
|
Path : Permalink
|
||||||
|
|
||||||
/// The date/time this upload was last updated (file time)
|
/// The date/time this upload was last updated (file time)
|
||||||
UpdatedOn : DateTime
|
UpdatedOn : Instant
|
||||||
|
|
||||||
/// The data for the upload, base-64 encoded
|
/// The data for the upload, base-64 encoded
|
||||||
Data : string
|
Data : string
|
||||||
|
@ -251,10 +248,9 @@ module Backup =
|
||||||
Uploads : EncodedUpload list
|
Uploads : EncodedUpload list
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Create a JSON serializer (uses RethinkDB data implementation's JSON converters)
|
/// Create a JSON serializer
|
||||||
let private getSerializer prettyOutput =
|
let private getSerializer prettyOutput =
|
||||||
let serializer = JsonSerializer.CreateDefault ()
|
let serializer = Json.configure (JsonSerializer.CreateDefault ())
|
||||||
Json.all () |> Seq.iter serializer.Converters.Add
|
|
||||||
if prettyOutput then serializer.Formatting <- Formatting.Indented
|
if prettyOutput then serializer.Formatting <- Formatting.Indented
|
||||||
serializer
|
serializer
|
||||||
|
|
||||||
|
@ -382,7 +378,8 @@ module Backup =
|
||||||
printfn ""
|
printfn ""
|
||||||
printfn "- Importing theme..."
|
printfn "- Importing theme..."
|
||||||
do! data.Theme.Save restore.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
|
// Restore web log data
|
||||||
|
|
||||||
|
@ -393,19 +390,20 @@ module Backup =
|
||||||
do! data.WebLogUser.Restore restore.Users
|
do! data.WebLogUser.Restore restore.Users
|
||||||
|
|
||||||
printfn "- Restoring categories and tag mappings..."
|
printfn "- Restoring categories and tag mappings..."
|
||||||
do! data.TagMap.Restore restore.TagMappings
|
if not (List.isEmpty restore.TagMappings) then do! data.TagMap.Restore restore.TagMappings
|
||||||
do! data.Category.Restore restore.Categories
|
if not (List.isEmpty restore.Categories) then do! data.Category.Restore restore.Categories
|
||||||
|
|
||||||
printfn "- Restoring pages..."
|
printfn "- Restoring pages..."
|
||||||
do! data.Page.Restore restore.Pages
|
if not (List.isEmpty restore.Pages) then do! data.Page.Restore restore.Pages
|
||||||
|
|
||||||
printfn "- Restoring posts..."
|
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
|
// TODO: comments not yet implemented
|
||||||
|
|
||||||
printfn "- Restoring uploads..."
|
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
|
displayStats "Restored for <>NAME<>:" restore.WebLog restore
|
||||||
}
|
}
|
||||||
|
@ -490,3 +488,22 @@ let upgradeUser (args : string[]) (sp : IServiceProvider) = task {
|
||||||
| 3 -> do! doUserUpgrade args[1] args[2] (sp.GetRequiredService<IData> ())
|
| 3 -> do! doUserUpgrade args[1] args[2] (sp.GetRequiredService<IData> ())
|
||||||
| _ -> eprintfn "Usage: myWebLog upgrade-user [web-log-url-base] [email-address]"
|
| _ -> eprintfn "Usage: myWebLog upgrade-user [web-log-url-base] [email-address]"
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/// Set a user's password
|
||||||
|
let doSetPassword urlBase email password (data : IData) = task {
|
||||||
|
match! data.WebLog.FindByHost urlBase with
|
||||||
|
| Some webLog ->
|
||||||
|
match! data.WebLogUser.FindByEmail email webLog.Id with
|
||||||
|
| Some user ->
|
||||||
|
do! data.WebLogUser.Update { user with PasswordHash = Handlers.User.createPasswordHash user password }
|
||||||
|
printfn $"Password for user {email} at {webLog.Name} set successfully"
|
||||||
|
| None -> eprintfn $"ERROR: no user {email} found at {urlBase}"
|
||||||
|
| None -> eprintfn $"ERROR: no web log found for {urlBase}"
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Set a user's password if the command-line arguments are good
|
||||||
|
let setPassword (args : string[]) (sp : IServiceProvider) = task {
|
||||||
|
match args.Length with
|
||||||
|
| 4 -> do! doSetPassword args[1] args[2] args[3] (sp.GetRequiredService<IData> ())
|
||||||
|
| _ -> eprintfn "Usage: myWebLog set-password [web-log-url-base] [email-address] [password]"
|
||||||
|
}
|
||||||
|
|
|
@ -29,11 +29,14 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>)
|
||||||
open System
|
open System
|
||||||
open Microsoft.Extensions.DependencyInjection
|
open Microsoft.Extensions.DependencyInjection
|
||||||
open MyWebLog.Data
|
open MyWebLog.Data
|
||||||
|
open Newtonsoft.Json
|
||||||
|
open Npgsql
|
||||||
|
|
||||||
/// Logic to obtain a data connection and implementation based on configured values
|
/// Logic to obtain a data connection and implementation based on configured values
|
||||||
module DataImplementation =
|
module DataImplementation =
|
||||||
|
|
||||||
open MyWebLog.Converters
|
open MyWebLog.Converters
|
||||||
|
// open Npgsql.Logging
|
||||||
open RethinkDb.Driver.FSharp
|
open RethinkDb.Driver.FSharp
|
||||||
open RethinkDb.Driver.Net
|
open RethinkDb.Driver.Net
|
||||||
|
|
||||||
|
@ -43,23 +46,29 @@ module DataImplementation =
|
||||||
let await it = (Async.AwaitTask >> Async.RunSynchronously) it
|
let await it = (Async.AwaitTask >> Async.RunSynchronously) it
|
||||||
let connStr name = config.GetConnectionString name
|
let connStr name = config.GetConnectionString name
|
||||||
let hasConnStr name = (connStr >> isNull >> not) name
|
let hasConnStr name = (connStr >> isNull >> not) name
|
||||||
let createSQLite connStr =
|
let createSQLite connStr : IData =
|
||||||
let log = sp.GetRequiredService<ILogger<SQLiteData>> ()
|
let log = sp.GetRequiredService<ILogger<SQLiteData>> ()
|
||||||
let conn = new SqliteConnection (connStr)
|
let conn = new SqliteConnection (connStr)
|
||||||
log.LogInformation $"Using SQLite database {conn.DataSource}"
|
log.LogInformation $"Using SQLite database {conn.DataSource}"
|
||||||
await (SQLiteData.setUpConnection conn)
|
await (SQLiteData.setUpConnection conn)
|
||||||
SQLiteData (conn, log)
|
SQLiteData (conn, log, Json.configure (JsonSerializer.CreateDefault ()))
|
||||||
|
|
||||||
if hasConnStr "SQLite" then
|
if hasConnStr "SQLite" then
|
||||||
upcast createSQLite (connStr "SQLite")
|
createSQLite (connStr "SQLite")
|
||||||
elif hasConnStr "RethinkDB" then
|
elif hasConnStr "RethinkDB" then
|
||||||
let log = sp.GetRequiredService<ILogger<RethinkDbData>> ()
|
let log = sp.GetRequiredService<ILogger<RethinkDbData>> ()
|
||||||
Json.all () |> Seq.iter Converter.Serializer.Converters.Add
|
let _ = Json.configure Converter.Serializer
|
||||||
let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB")
|
let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB")
|
||||||
let conn = await (rethinkCfg.CreateConnectionAsync log)
|
let conn = await (rethinkCfg.CreateConnectionAsync log)
|
||||||
upcast RethinkDbData (conn, rethinkCfg, log)
|
RethinkDbData (conn, rethinkCfg, log)
|
||||||
|
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 ()))
|
||||||
else
|
else
|
||||||
upcast createSQLite "Data Source=./myweblog.db;Cache=Shared"
|
createSQLite "Data Source=./myweblog.db;Cache=Shared"
|
||||||
|
|
||||||
|
|
||||||
open System.Threading.Tasks
|
open System.Threading.Tasks
|
||||||
|
@ -76,6 +85,7 @@ let showHelp () =
|
||||||
printfn "init Initializes a new web log"
|
printfn "init Initializes a new web log"
|
||||||
printfn "load-theme Load a theme"
|
printfn "load-theme Load a theme"
|
||||||
printfn "restore Restore a JSON file backup (prompt before overwriting)"
|
printfn "restore Restore a JSON file backup (prompt before overwriting)"
|
||||||
|
printfn "set-password Set a password for a specific user"
|
||||||
printfn "upgrade-user Upgrade a WebLogAdmin user to a full Administrator"
|
printfn "upgrade-user Upgrade a WebLogAdmin user to a full Administrator"
|
||||||
printfn " "
|
printfn " "
|
||||||
printfn "For more information on a particular command, run it with no options."
|
printfn "For more information on a particular command, run it with no options."
|
||||||
|
@ -88,6 +98,7 @@ open Giraffe.EndpointRouting
|
||||||
open Microsoft.AspNetCore.Authentication.Cookies
|
open Microsoft.AspNetCore.Authentication.Cookies
|
||||||
open Microsoft.AspNetCore.Builder
|
open Microsoft.AspNetCore.Builder
|
||||||
open Microsoft.AspNetCore.HttpOverrides
|
open Microsoft.AspNetCore.HttpOverrides
|
||||||
|
open Microsoft.Extensions.Caching.Distributed
|
||||||
open NeoSmart.Caching.Sqlite
|
open NeoSmart.Caching.Sqlite
|
||||||
open RethinkDB.DistributedCache
|
open RethinkDB.DistributedCache
|
||||||
|
|
||||||
|
@ -108,8 +119,9 @@ let rec main args =
|
||||||
let _ = builder.Services.AddAuthorization ()
|
let _ = builder.Services.AddAuthorization ()
|
||||||
let _ = builder.Services.AddAntiforgery ()
|
let _ = builder.Services.AddAntiforgery ()
|
||||||
|
|
||||||
let sp = builder.Services.BuildServiceProvider ()
|
let sp = builder.Services.BuildServiceProvider ()
|
||||||
let data = DataImplementation.get sp
|
let data = DataImplementation.get sp
|
||||||
|
let _ = builder.Services.AddSingleton<JsonSerializer> data.Serializer
|
||||||
|
|
||||||
task {
|
task {
|
||||||
do! data.StartUp ()
|
do! data.StartUp ()
|
||||||
|
@ -121,23 +133,36 @@ let rec main args =
|
||||||
match data with
|
match data with
|
||||||
| :? RethinkDbData as rethink ->
|
| :? RethinkDbData as rethink ->
|
||||||
// A RethinkDB connection is designed to work as a singleton
|
// A RethinkDB connection is designed to work as a singleton
|
||||||
builder.Services.AddSingleton<IData> data |> ignore
|
let _ = builder.Services.AddSingleton<IData> data
|
||||||
builder.Services.AddDistributedRethinkDBCache (fun opts ->
|
let _ =
|
||||||
opts.TableName <- "Session"
|
builder.Services.AddDistributedRethinkDBCache (fun opts ->
|
||||||
opts.Connection <- rethink.Conn)
|
opts.TableName <- "Session"
|
||||||
|> ignore
|
opts.Connection <- rethink.Conn)
|
||||||
|
()
|
||||||
| :? SQLiteData as sql ->
|
| :? SQLiteData as sql ->
|
||||||
// ADO.NET connections are designed to work as per-request instantiation
|
// ADO.NET connections are designed to work as per-request instantiation
|
||||||
let cfg = sp.GetRequiredService<IConfiguration> ()
|
let cfg = sp.GetRequiredService<IConfiguration> ()
|
||||||
builder.Services.AddScoped<SqliteConnection> (fun sp ->
|
let _ =
|
||||||
let conn = new SqliteConnection (sql.Conn.ConnectionString)
|
builder.Services.AddScoped<SqliteConnection> (fun sp ->
|
||||||
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
|
let conn = new SqliteConnection (sql.Conn.ConnectionString)
|
||||||
conn)
|
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
|
||||||
|> ignore
|
conn)
|
||||||
builder.Services.AddScoped<IData, SQLiteData> () |> ignore
|
let _ = builder.Services.AddScoped<IData, SQLiteData> () |> ignore
|
||||||
// Use SQLite for caching as well
|
// Use SQLite for caching as well
|
||||||
let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./session.db"
|
let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./session.db"
|
||||||
builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath) |> ignore
|
let _ = builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath)
|
||||||
|
()
|
||||||
|
| :? PostgresData ->
|
||||||
|
// ADO.NET connections are designed to work as per-request instantiation
|
||||||
|
let cfg = sp.GetRequiredService<IConfiguration> ()
|
||||||
|
let _ =
|
||||||
|
builder.Services.AddScoped<NpgsqlConnection> (fun sp ->
|
||||||
|
new NpgsqlConnection (cfg.GetConnectionString "PostgreSQL"))
|
||||||
|
let _ = builder.Services.AddScoped<IData, PostgresData> ()
|
||||||
|
let _ =
|
||||||
|
builder.Services.AddSingleton<IDistributedCache> (fun sp ->
|
||||||
|
Postgres.DistributedCache (cfg.GetConnectionString "PostgreSQL") :> IDistributedCache)
|
||||||
|
()
|
||||||
| _ -> ()
|
| _ -> ()
|
||||||
|
|
||||||
let _ = builder.Services.AddSession(fun opts ->
|
let _ = builder.Services.AddSession(fun opts ->
|
||||||
|
@ -159,6 +184,7 @@ let rec main args =
|
||||||
| Some it when it = "restore" -> Maintenance.Backup.restoreFromBackup args app.Services
|
| Some it when it = "restore" -> Maintenance.Backup.restoreFromBackup args app.Services
|
||||||
| Some it when it = "do-restore" -> Maintenance.Backup.restoreFromBackup args app.Services
|
| Some it when it = "do-restore" -> Maintenance.Backup.restoreFromBackup args app.Services
|
||||||
| Some it when it = "upgrade-user" -> Maintenance.upgradeUser args app.Services
|
| Some it when it = "upgrade-user" -> Maintenance.upgradeUser args app.Services
|
||||||
|
| Some it when it = "set-password" -> Maintenance.setPassword args app.Services
|
||||||
| Some it when it = "help" -> showHelp ()
|
| Some it when it = "help" -> showHelp ()
|
||||||
| Some it ->
|
| Some it ->
|
||||||
printfn $"""Unrecognized command "{it}" - valid commands are:"""
|
printfn $"""Unrecognized command "{it}" - valid commands are:"""
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
{
|
{
|
||||||
"Generator": "myWebLog 2.0-rc1",
|
"Generator": "myWebLog 2.0-rc2",
|
||||||
"Logging": {
|
"Logging": {
|
||||||
"LogLevel": {
|
"LogLevel": {
|
||||||
"MyWebLog.Handlers": "Information"
|
"MyWebLog.Handlers": "Information"
|
||||||
|
|
|
@ -1,2 +1,2 @@
|
||||||
myWebLog Admin
|
myWebLog Admin
|
||||||
2.0.0-rc1
|
2.0.0-rc2
|
|
@ -1,2 +1,2 @@
|
||||||
myWebLog Default Theme
|
myWebLog Default Theme
|
||||||
2.0.0-rc1
|
2.0.0-rc2
|
Loading…
Reference in New Issue
Block a user