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…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user