Add slug and upload dest to settings (#2)

- Change how functions are registered

.gitignore

@@ -260,4 +260,8 @@ paket-files/
 src/MyWebLog/wwwroot/img/daniel-j-summers
 src/MyWebLog/wwwroot/img/bit-badger
 
-.ionide
+.ionide
+src/MyWebLog/appsettings.Production.json
+
+# SQLite database files
+src/MyWebLog/*.db*

build.fsx

@@ -33,7 +33,6 @@ let version =
 /// Zip a theme distributed with myWebLog
 let zipTheme (name : string) (_ : TargetParameter) =
     let path = $"src/{name}-theme"
-    Trace.log $"Path = {path}"
     !! $"{path}/**/*"
     |> Zip.filesAsSpecs path //$"src/{name}-theme"
     |> Seq.filter (fun (_, name) -> not (name.EndsWith ".zip"))
@@ -79,14 +78,16 @@ Target.create "PackageLinux" (packageFor "linux-x64")
 Target.create "RepackageLinux" (fun _ ->
     let workDir = $"{releasePath}/linux"
     let zipArchive = $"{releasePath}/myWebLog-{version}.linux-x64.zip"
+    let sh command args = 
+        CreateProcess.fromRawCommand command args
+        |> CreateProcess.redirectOutput
+        |> Proc.run
+        |> ignore
     Shell.mkdir workDir
     Zip.unzip workDir zipArchive
     Shell.cd workDir
-    [ "cfj"; $"../myWebLog-{version}.linux-x64.tar.bz2"; "." ]
-    |> CreateProcess.fromRawCommand "tar"
-    |> CreateProcess.redirectOutput
-    |> Proc.run
-    |> ignore
+    sh "chmod" [ "+x"; "app/MyWebLog" ]
+    sh "tar" [ "cfj"; $"../myWebLog-{version}.linux-x64.tar.bz2"; "." ]
     Shell.cd "../.."
     Shell.rm zipArchive
     Shell.rm_rf workDir

src/MyWebLog.Data/Converters.fs

@@ -65,6 +65,13 @@ module Json =
         override _.ReadJson (reader : JsonReader, _ : Type, _ : PageId, _ : bool, _ : JsonSerializer) =
             (string >> PageId) reader.Value
 
+    type PodcastMediumConverter () =
+        inherit JsonConverter<PodcastMedium> ()
+        override _.WriteJson (writer : JsonWriter, value : PodcastMedium, _ : JsonSerializer) =
+            writer.WriteValue (PodcastMedium.toString value)
+        override _.ReadJson (reader : JsonReader, _ : Type, _ : PodcastMedium, _ : bool, _ : JsonSerializer) =
+            (string >> PodcastMedium.parse) reader.Value
+
     type PostIdConverter () =
         inherit JsonConverter<PostId> ()
         override _.WriteJson (writer : JsonWriter, value : PostId, _ : JsonSerializer) =
@@ -92,7 +99,21 @@ module Json =
             writer.WriteValue (ThemeId.toString value)
         override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) =
             (string >> ThemeId) reader.Value
-        
+    
+    type UploadDestinationConverter () =
+        inherit JsonConverter<UploadDestination> ()
+        override _.WriteJson (writer : JsonWriter, value : UploadDestination, _ : JsonSerializer) =
+            writer.WriteValue (UploadDestination.toString value)
+        override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadDestination, _ : bool, _ : JsonSerializer) =
+            (string >> UploadDestination.parse) reader.Value
+    
+    type UploadIdConverter () =
+        inherit JsonConverter<UploadId> ()
+        override _.WriteJson (writer : JsonWriter, value : UploadId, _ : JsonSerializer) =
+            writer.WriteValue (UploadId.toString value)
+        override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadId, _ : bool, _ : JsonSerializer) =
+            (string >> UploadId) reader.Value
+    
     type WebLogIdConverter () =
         inherit JsonConverter<WebLogId> ()
         override _.WriteJson (writer : JsonWriter, value : WebLogId, _ : JsonSerializer) =
@@ -113,20 +134,23 @@ module Json =
     let all () : JsonConverter seq =
         seq {
             // Our converters
-            CategoryIdConverter       ()
-            CommentIdConverter        ()
-            CustomFeedIdConverter     ()
-            CustomFeedSourceConverter ()
-            ExplicitRatingConverter   ()
-            MarkupTextConverter       ()
-            PermalinkConverter        ()
-            PageIdConverter           ()
-            PostIdConverter           ()
-            TagMapIdConverter         ()
-            ThemeAssetIdConverter     ()
-            ThemeIdConverter          ()
-            WebLogIdConverter         ()
-            WebLogUserIdConverter     ()
+            CategoryIdConverter        ()
+            CommentIdConverter         ()
+            CustomFeedIdConverter      ()
+            CustomFeedSourceConverter  ()
+            ExplicitRatingConverter    ()
+            MarkupTextConverter        ()
+            PermalinkConverter         ()
+            PageIdConverter            ()
+            PodcastMediumConverter     ()
+            PostIdConverter            ()
+            TagMapIdConverter          ()
+            ThemeAssetIdConverter      ()
+            ThemeIdConverter           ()
+            UploadDestinationConverter ()
+            UploadIdConverter          ()
+            WebLogIdConverter          ()
+            WebLogUserIdConverter      ()
             // Handles DUs with no associated data, as well as option fields
-            CompactUnionJsonConverter ()
+            CompactUnionJsonConverter  ()
         }

src/MyWebLog.Data/Interfaces.fs

@@ -199,6 +199,28 @@ type IThemeAssetData =
     abstract member save : ThemeAsset -> Task<unit>
 
 
+/// Functions to manipulate uploaded files
+type IUploadData =
+    
+    /// Add an uploaded file
+    abstract member add : Upload -> Task<unit>
+    
+    /// Delete an uploaded file
+    abstract member delete : UploadId -> WebLogId -> Task<Result<string, string>>
+    
+    /// Find an uploaded file by its path for the given web log
+    abstract member findByPath : string -> WebLogId -> Task<Upload option>
+    
+    /// Find all uploaded files for a web log (excludes data)
+    abstract member findByWebLog : WebLogId -> Task<Upload list>
+    
+    /// Find all uploaded files for a web log
+    abstract member findByWebLogWithData : WebLogId -> Task<Upload list>
+    
+    /// Restore uploaded files from a backup
+    abstract member restore : Upload list -> Task<unit>
+
+
 /// Functions to manipulate web logs
 type IWebLogData =
     
@@ -270,6 +292,9 @@ type IData =
     /// Theme asset data functions
     abstract member ThemeAsset : IThemeAssetData
     
+    /// Uploaded file functions
+    abstract member Upload : IUploadData
+    
     /// Web log data functions
     abstract member WebLog : IWebLogData
     

src/MyWebLog.Data/MyWebLog.Data.fsproj

@@ -25,6 +25,15 @@
 		<Compile Include="Interfaces.fs" />
 		<Compile Include="Utils.fs" />
 		<Compile Include="RethinkDbData.fs" />
+		<Compile Include="SQLite\Helpers.fs" />
+		<Compile Include="SQLite\SQLiteCategoryData.fs" />
+		<Compile Include="SQLite\SQLitePageData.fs" />
+		<Compile Include="SQLite\SQLitePostData.fs" />
+		<Compile Include="SQLite\SQLiteTagMapData.fs" />
+		<Compile Include="SQLite\SQLiteThemeData.fs" />
+		<Compile Include="SQLite\SQLiteUploadData.fs" />
+		<Compile Include="SQLite\SQLiteWebLogData.fs" />
+		<Compile Include="SQLite\SQLiteWebLogUserData.fs" />
 		<Compile Include="SQLiteData.fs" />
 	</ItemGroup>
 

src/MyWebLog.Data/RethinkDbData.fs

@@ -33,6 +33,9 @@ module private RethinkHelpers =
         /// The theme asset table
         let ThemeAsset = "ThemeAsset"
         
+        /// The uploaded file table
+        let Upload = "Upload"
+        
         /// The web log table
         let WebLog = "WebLog"
 
@@ -40,10 +43,7 @@ module private RethinkHelpers =
         let WebLogUser = "WebLogUser"
 
         /// A list of all tables
-        let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; WebLog; WebLogUser ]
-        
-        /// A list of all tables with a webLogId field
-        let allForWebLog = [ Comment; Post; Category; TagMap; Page; WebLogUser ]
+        let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ]
 
 
     /// Shorthand for the ReQL starting point
@@ -128,6 +128,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     indexCreate "webLogAndUrl" (fun row -> r.Array (row["webLogId"], row["urlValue"]) :> obj)
                     write; withRetryOnce; ignoreResult conn
                 }
+        // Uploaded files need an index by web log ID and path, as that is how they are retrieved
+        if Table.Upload = table then
+            if not (indexes |> List.contains "webLogAndPath") then
+                log.LogInformation $"Creating index {table}.webLogAndPath..."
+                do! rethink {
+                    withTable table
+                    indexCreate "webLogAndPath" (fun row -> r.Array (row["webLogId"], row["path"]) :> obj)
+                    write; withRetryOnce; ignoreResult conn
+                }
         // Users log on with e-mail
         if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then
             log.LogInformation $"Creating index {table}.logOn..."
@@ -728,6 +737,69 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 }
         }
         
+        member _.Upload = {
+            new IUploadData with
+                
+                member _.add upload = rethink {
+                    withTable Table.Upload
+                    insert upload
+                    write; withRetryDefault; ignoreResult conn
+                }
+                
+                member _.delete uploadId webLogId = backgroundTask {
+                    let! upload =
+                        rethink<Upload> {
+                            withTable Table.Upload
+                            get uploadId
+                            resultOption; withRetryOptionDefault
+                        }
+                        |> verifyWebLog<Upload> webLogId (fun u -> u.webLogId) <| conn
+                    match upload with
+                    | Some up ->
+                        do! rethink {
+                            withTable Table.Upload
+                            get uploadId
+                            delete
+                            write; withRetryDefault; ignoreResult conn
+                        }
+                        return Ok (Permalink.toString up.path)
+                    | None -> return Result.Error $"Upload ID {UploadId.toString uploadId} not found"
+                }
+                
+                member _.findByPath path webLogId =
+                    rethink<Upload> {
+                        withTable Table.Upload
+                        getAll [ r.Array (webLogId, path) ] "webLogAndPath"
+                        resultCursor; withRetryCursorDefault; toList
+                    }
+                    |> tryFirst <| conn
+                
+                member _.findByWebLog webLogId = rethink<Upload> {
+                    withTable Table.Upload
+                    between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
+                        [ Index "webLogAndPath" ]
+                    without [ "data" ]
+                    resultCursor; withRetryCursorDefault; toList conn
+                }
+                
+                member _.findByWebLogWithData webLogId = rethink<Upload> {
+                    withTable Table.Upload
+                    between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
+                        [ Index "webLogAndPath" ]
+                    resultCursor; withRetryCursorDefault; toList conn
+                }
+                
+                member _.restore uploads = backgroundTask {
+                    // Files can be large; we'll do 5 at a time
+                    for batch in uploads |> List.chunkBySize 5 do
+                        do! rethink {
+                            withTable Table.TagMap
+                            insert batch
+                            write; withRetryOnce; ignoreResult conn
+                        }
+                }
+        }
+        
         member _.WebLog = {
             new IWebLogData with
                 
@@ -743,19 +815,50 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 }
                 
                 member _.delete webLogId = backgroundTask {
-                    for table in Table.allForWebLog do
-                        do! rethink {
-                            withTable table
-                            getAll [ webLogId ] (nameof webLogId)
-                            delete
-                            write; withRetryOnce; ignoreResult conn
-                        }
-                    do! rethink {
-                        withTable Table.WebLog
-                        get webLogId
-                        delete
-                        write; withRetryOnce; ignoreResult conn
-                    }
+                     // Comments should be deleted by post IDs
+                     let! thePostIds = rethink<{| id : string |} list> {
+                         withTable Table.Post
+                         getAll [ webLogId ] (nameof webLogId)
+                         pluck [ "id" ]
+                         result; withRetryOnce conn
+                     }
+                     if not (List.isEmpty thePostIds) then
+                         let postIds = thePostIds |> List.map (fun it -> it.id :> obj)
+                         do! rethink {
+                             withTable Table.Comment
+                             getAll postIds "postId"
+                             delete
+                             write; withRetryOnce; ignoreResult conn
+                         }
+                     // Tag mappings do not have a straightforward webLogId index
+                     do! rethink {
+                         withTable Table.TagMap
+                         between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
+                                     [ Index "webLogAndTag" ]
+                         delete
+                         write; withRetryOnce; ignoreResult conn
+                     }
+                     // Uploaded files do not have a straightforward webLogId index
+                     do! rethink {
+                         withTable Table.Upload
+                         between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
+                                     [ Index "webLogAndPath" ]
+                         delete
+                         write; withRetryOnce; ignoreResult conn
+                     }
+                     for table in [ Table.Post; Table.Category; Table.Page; Table.WebLogUser ] do
+                         do! rethink {
+                             withTable table
+                             getAll [ webLogId ] (nameof webLogId)
+                             delete
+                             write; withRetryOnce; ignoreResult conn
+                         }
+                     do! rethink {
+                         withTable Table.WebLog
+                         get webLogId
+                         delete
+                         write; withRetryOnce; ignoreResult conn
+                     }
                 }
                 
                 member _.findByHost url =
@@ -785,12 +888,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     get webLog.id
                     update [
                         "name",         webLog.name :> obj
+                        "slug",         webLog.slug
                         "subtitle",     webLog.subtitle
                         "defaultPage",  webLog.defaultPage
                         "postsPerPage", webLog.postsPerPage
                         "timeZone",     webLog.timeZone
                         "themePath",    webLog.themePath
                         "autoHtmx",     webLog.autoHtmx
+                        "uploads",      webLog.uploads
                     ]
                     write; withRetryDefault; ignoreResult conn
                 }
@@ -880,6 +985,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
             do! ensureIndexes Table.Page       [ "webLogId"; "authorId" ]
             do! ensureIndexes Table.Post       [ "webLogId"; "authorId" ]
             do! ensureIndexes Table.TagMap     []
+            do! ensureIndexes Table.Upload     []
             do! ensureIndexes Table.WebLog     [ "urlBase" ]
             do! ensureIndexes Table.WebLogUser [ "webLogId" ]
         }

src/MyWebLog.Data/SQLite/Helpers.fs

@@ -0,0 +1,311 @@
+/// Helper functions for the SQLite data implementation
+[<AutoOpen>]
+module MyWebLog.Data.SQLite.Helpers
+
+open System
+open Microsoft.Data.Sqlite
+open MyWebLog
+
+/// Run a command that returns a count
+let count (cmd : SqliteCommand) = backgroundTask {
+    let! it = cmd.ExecuteScalarAsync ()
+    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
+let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) =
+    seq { while rdr.Read () do it rdr }
+    |> List.ofSeq
+
+/// Verify that the web log ID matches before returning an item
+let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) =
+    if rdr.Read () then
+        let item = it rdr
+        if prop item = webLogId then Some item else None
+    else
+        None
+
+/// Execute a command that returns no data
+let write (cmd : SqliteCommand) = backgroundTask {
+    let! _ = cmd.ExecuteNonQueryAsync ()
+    ()
+}
+
+/// Functions to map domain items from a data reader
+module Map =
+    
+    open System.IO
+    
+    /// Get a boolean value from a data reader
+    let getBoolean col (rdr : SqliteDataReader) = rdr.GetBoolean (rdr.GetOrdinal col)
+    
+    /// Get a date/time value from a data reader
+    let getDateTime col (rdr : SqliteDataReader) = rdr.GetDateTime (rdr.GetOrdinal col)
+    
+    /// Get a Guid value from a data reader
+    let getGuid col (rdr : SqliteDataReader) = rdr.GetGuid (rdr.GetOrdinal col)
+    
+    /// Get an int value from a data reader
+    let getInt col (rdr : SqliteDataReader) = rdr.GetInt32 (rdr.GetOrdinal col)
+    
+    /// Get a long (64-bit int) value from a data reader
+    let getLong col (rdr : SqliteDataReader) = rdr.GetInt64 (rdr.GetOrdinal col)
+    
+    /// Get a BLOB stream value from a data reader
+    let getStream col (rdr : SqliteDataReader) = rdr.GetStream (rdr.GetOrdinal col)
+    
+    /// Get a string value from a data reader
+    let getString col (rdr : SqliteDataReader) = rdr.GetString (rdr.GetOrdinal col)
+    
+    /// Get a timespan value from a data reader
+    let getTimeSpan col (rdr : SqliteDataReader) = rdr.GetTimeSpan (rdr.GetOrdinal col)
+    
+    /// Get a possibly null boolean value from a data reader
+    let tryBoolean col (rdr : SqliteDataReader) =
+        if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getBoolean col rdr)
+    
+    /// Get a possibly null date/time value from a data reader
+    let tryDateTime col (rdr : SqliteDataReader) =
+        if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getDateTime col rdr)
+    
+    /// Get a possibly null Guid value from a data reader
+    let tryGuid col (rdr : SqliteDataReader) =
+        if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getGuid col rdr)
+    
+    /// Get a possibly null int value from a data reader
+    let tryInt col (rdr : SqliteDataReader) =
+        if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getInt col rdr)
+    
+    /// Get a possibly null string value from a data reader
+    let tryString col (rdr : SqliteDataReader) =
+        if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr)
+    
+    /// Get a possibly null timespan value from a data reader
+    let tryTimeSpan col (rdr : SqliteDataReader) =
+        if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
+    
+    /// Create a category ID from the current row in the given data reader
+    let toCategoryId = getString "id" >> CategoryId
+    
+    /// Create a category from the current row in the given data reader
+    let toCategory (rdr : SqliteDataReader) : Category =
+        { id          = toCategoryId rdr
+          webLogId    = WebLogId (getString "web_log_id" rdr)
+          name        = getString "name" rdr
+          slug        = getString "slug" rdr
+          description = tryString "description" rdr
+          parentId    = tryString "parent_id" rdr |> Option.map CategoryId
+        }
+    
+    /// Create a custom feed from the current row in the given data reader
+    let toCustomFeed (rdr : SqliteDataReader) : CustomFeed =
+        { id      = CustomFeedId (getString "id" rdr)
+          source  = CustomFeedSource.parse (getString "source" rdr)
+          path    = Permalink (getString "path" rdr)
+          podcast =
+              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          = Permalink (getString "image_url" rdr)
+                      iTunesCategory    = getString "itunes_category" rdr
+                      iTunesSubcategory = tryString "itunes_subcategory" rdr
+                      explicit          = ExplicitRating.parse (getString "explicit" rdr)
+                      defaultMediaType  = tryString "default_media_type" rdr
+                      mediaBaseUrl      = tryString "media_base_url" rdr
+                      guid              = tryGuid "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 : SqliteDataReader) : MetaItem =
+        { name  = getString "name" rdr
+          value = getString "value" rdr
+        }
+    
+    /// Create a permalink from the current row in the given data reader
+    let toPermalink = getString "permalink" >> Permalink
+    
+    /// Create a page from the current row in the given data reader
+    let toPage (rdr : SqliteDataReader) : Page =
+        { Page.empty with
+            id             = PageId (getString "id" rdr)
+            webLogId       = WebLogId (getString "web_log_id" rdr)
+            authorId       = WebLogUserId (getString "author_id" rdr)
+            title          = getString "title" rdr
+            permalink      = toPermalink rdr
+            publishedOn    = getDateTime "published_on" rdr
+            updatedOn      = getDateTime "updated_on" rdr
+            showInPageList = getBoolean "show_in_page_list" rdr
+            template       = tryString "template" rdr
+            text           = getString "page_text" rdr
+        }
+    
+    /// Create a post from the current row in the given data reader
+    let toPost (rdr : SqliteDataReader) : Post =
+        { Post.empty with
+            id             = PostId (getString "id" rdr)
+            webLogId       = WebLogId (getString "web_log_id" rdr)
+            authorId       = WebLogUserId (getString "author_id" rdr)
+            status         = PostStatus.parse (getString "status" rdr)
+            title          = getString "title" rdr
+            permalink      = toPermalink rdr
+            publishedOn    = tryDateTime "published_on" rdr
+            updatedOn      = getDateTime "updated_on" rdr
+            template       = tryString "template" rdr
+            text           = getString "post_text" rdr
+            episode        =
+                match tryString "media" rdr with
+                | Some media ->
+                    Some {
+                        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
+    let toRevision (rdr : SqliteDataReader) : Revision =
+        { asOf = getDateTime "as_of" rdr
+          text = MarkupText.parse (getString "revision_text" rdr)
+        }
+    
+    /// Create a tag mapping from the current row in the given data reader
+    let toTagMap (rdr : SqliteDataReader) : TagMap =
+        { id       = TagMapId (getString "id" rdr)
+          webLogId = WebLogId (getString "web_log_id" rdr)
+          tag      = getString "tag" rdr
+          urlValue = getString "url_value" rdr
+        }
+    
+    /// Create a theme from the current row in the given data reader (excludes templates)
+    let toTheme (rdr : SqliteDataReader) : Theme =
+        { Theme.empty with
+            id      = ThemeId (getString "id" rdr)
+            name    = getString "name" rdr
+            version = getString "version" rdr
+        }
+    
+    /// Create a theme asset from the current row in the given data reader
+    let toThemeAsset includeData (rdr : SqliteDataReader) : ThemeAsset =
+        let assetData =
+            if includeData then
+                use dataStream = new MemoryStream ()
+                use blobStream = getStream "data" rdr
+                blobStream.CopyTo dataStream
+                dataStream.ToArray ()
+            else
+                [||]
+        { id        = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
+          updatedOn = getDateTime "updated_on" rdr
+          data      = assetData
+        }
+    
+    /// Create a theme template from the current row in the given data reader
+    let toThemeTemplate (rdr : SqliteDataReader) : ThemeTemplate =
+        { name = getString "name" rdr
+          text = getString "template" rdr
+        }
+    
+    /// Create an uploaded file from the current row in the given data reader
+    let toUpload includeData (rdr : SqliteDataReader) : Upload =
+        let data =
+            if includeData then
+                use dataStream = new MemoryStream ()
+                use blobStream = getStream "data" rdr
+                blobStream.CopyTo dataStream
+                dataStream.ToArray ()
+            else
+                [||]
+        { id        = UploadId (getString "id" rdr)
+          webLogId  = WebLogId (getString "web_log_id" rdr)
+          path      = Permalink (getString "path" rdr)
+          updatedOn = getDateTime "updated_on" rdr
+          data      = data
+        }
+    
+    /// Create a web log from the current row in the given data reader
+    let toWebLog (rdr : SqliteDataReader) : WebLog =
+        { id           = WebLogId (getString "id" rdr)
+          name         = getString "name" rdr
+          slug         = getString "slug" rdr
+          subtitle     = tryString "subtitle" rdr
+          defaultPage  = getString "default_page" rdr
+          postsPerPage = getInt "posts_per_page" rdr
+          themePath    = getString "theme_id" rdr
+          urlBase      = getString "url_base" rdr
+          timeZone     = getString "time_zone" rdr
+          autoHtmx     = getBoolean "auto_htmx" rdr
+          uploads      = UploadDestination.parse (getString "uploads" rdr)
+          rss          = {
+              feedEnabled     = getBoolean "feed_enabled" rdr
+              feedName        = getString "feed_name" rdr
+              itemsInFeed     = tryInt "items_in_feed" rdr
+              categoryEnabled = getBoolean "category_enabled" rdr
+              tagEnabled      = getBoolean "tag_enabled" rdr
+              copyright       = tryString "copyright" rdr
+              customFeeds     = []
+          }
+        }
+    
+    /// Create a web log user from the current row in the given data reader
+    let toWebLogUser (rdr : SqliteDataReader) : WebLogUser =
+        { id                 = WebLogUserId (getString "id" rdr)
+          webLogId           = WebLogId (getString "web_log_id" rdr)
+          userName           = getString "user_name" rdr
+          firstName          = getString "first_name" rdr
+          lastName           = getString "last_name" rdr
+          preferredName      = getString "preferred_name" rdr
+          passwordHash       = getString "password_hash" rdr
+          salt               = getGuid "salt" rdr
+          url                = tryString "url" rdr
+          authorizationLevel = AuthorizationLevel.parse (getString "authorization_level" 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
+let addWebLogId (cmd : SqliteCommand) webLogId =
+    cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore

src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs

@@ -0,0 +1,174 @@
+namespace MyWebLog.Data.SQLite
+
+open System.Threading.Tasks
+open Microsoft.Data.Sqlite
+open MyWebLog
+open MyWebLog.Data
+
+/// SQLite myWebLog category data implementation        
+type SQLiteCategoryData (conn : SqliteConnection) =
+    
+    /// Add parameters for category INSERT or UPDATE statements
+    let addCategoryParameters (cmd : SqliteCommand) (cat : Category) =
+        [ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.id)
+          cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.webLogId)
+          cmd.Parameters.AddWithValue ("@name", cat.name)
+          cmd.Parameters.AddWithValue ("@slug", cat.slug)
+          cmd.Parameters.AddWithValue ("@description", maybe cat.description)
+          cmd.Parameters.AddWithValue ("@parentId", maybe (cat.parentId |> Option.map CategoryId.toString))
+        ] |> ignore
+    
+    /// Add a category
+    let add cat = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            INSERT INTO category (
+                id, web_log_id, name, slug, description, parent_id
+            ) VALUES (
+                @id, @webLogId, @name, @slug, @description, @parentId
+            )"""
+        addCategoryParameters cmd cat
+        let! _ = cmd.ExecuteNonQueryAsync ()
+        ()
+    }
+    
+    /// Count all categories for the given web log
+    let countAll webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE web_log_id = @webLogId"
+        addWebLogId cmd webLogId
+        return! count cmd
+    }
+    
+    /// Count all top-level categories for the given web log
+    let countTopLevel webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <-
+            "SELECT COUNT(id) FROM category WHERE web_log_id = @webLogId AND parent_id IS NULL"
+        addWebLogId cmd webLogId
+        return! count cmd
+    }
+    
+    /// Retrieve all categories for the given web log in a DotLiquid-friendly format
+    let findAllForView webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM category WHERE web_log_id = @webLogId"
+        addWebLogId cmd webLogId
+        use! rdr = cmd.ExecuteReaderAsync ()
+        let cats =
+            seq {
+                while rdr.Read () do
+                    Map.toCategory rdr
+            }
+            |> Seq.sortBy (fun cat -> cat.name.ToLowerInvariant ())
+            |> List.ofSeq
+        do! rdr.CloseAsync ()
+        let  ordered = Utils.orderByHierarchy cats None None []
+        let! counts  =
+            ordered
+            |> Seq.map (fun it -> backgroundTask {
+                // Parent category post counts include posts in subcategories
+                cmd.Parameters.Clear ()
+                addWebLogId cmd webLogId
+                cmd.CommandText <- """
+                    SELECT COUNT(DISTINCT p.id)
+                      FROM post p
+                           INNER JOIN post_category pc ON pc.post_id = p.id
+                     WHERE p.web_log_id = @webLogId
+                       AND p.status     = 'Published'
+                       AND pc.category_id IN ("""
+                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
+                return it.id, postCount
+                })
+            |> Task.WhenAll
+        return
+            ordered
+            |> Seq.map (fun cat ->
+                { cat with
+                    postCount = counts
+                                |> Array.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 = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM category WHERE id = @id"
+        cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return Helpers.verifyWebLog<Category> webLogId (fun c -> c.webLogId) Map.toCategory rdr
+    }
+    
+    /// Find all categories for the given web log
+    let findByWebLog webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM category WHERE web_log_id = @webLogId"
+        cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return toList Map.toCategory rdr
+    }
+    
+    /// Delete a category
+    let delete catId webLogId = backgroundTask {
+        match! findById catId webLogId with
+        | Some _ ->
+            use cmd = conn.CreateCommand ()
+            // Delete the category off all posts where it is assigned
+            cmd.CommandText <- """
+                DELETE FROM post_category
+                 WHERE category_id = @id
+                   AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)"""
+            let catIdParameter = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
+            cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
+            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
+            return true
+        | None -> return false
+    }
+    
+    /// Restore categories from a backup
+    let restore cats = backgroundTask {
+        for cat in cats do
+            do! add cat
+    }
+    
+    /// Update a category
+    let update cat = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            UPDATE category
+               SET name        = @name,
+                   slug        = @slug,
+                   description = @description,
+                   parent_id   = @parentId
+             WHERE id         = @id
+               AND web_log_id = @webLogId"""
+        addCategoryParameters cmd cat
+        do! write cmd
+    }
+    
+    interface ICategoryData with
+        member _.add cat = add 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 = update cat

src/MyWebLog.Data/SQLite/SQLitePageData.fs

@@ -0,0 +1,366 @@
+namespace MyWebLog.Data.SQLite
+
+open System.Threading.Tasks
+open Microsoft.Data.Sqlite
+open MyWebLog
+open MyWebLog.Data
+
+/// SQLite myWebLog page data implementation        
+type SQLitePageData (conn : SqliteConnection) =
+    
+    // SUPPORT FUNCTIONS
+    
+    /// Add parameters for page INSERT or UPDATE statements
+    let addPageParameters (cmd : SqliteCommand) (page : Page) =
+        [ cmd.Parameters.AddWithValue ("@id", PageId.toString page.id)
+          cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.webLogId)
+          cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.authorId)
+          cmd.Parameters.AddWithValue ("@title", page.title)
+          cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.permalink)
+          cmd.Parameters.AddWithValue ("@publishedOn", page.publishedOn)
+          cmd.Parameters.AddWithValue ("@updatedOn", page.updatedOn)
+          cmd.Parameters.AddWithValue ("@showInPageList", page.showInPageList)
+          cmd.Parameters.AddWithValue ("@template", maybe page.template)
+          cmd.Parameters.AddWithValue ("@text", page.text)
+        ] |> 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
+    let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.id) |> ignore
+        
+        cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId"
+        use! rdr = cmd.ExecuteReaderAsync ()
+        let page = { page with priorPermalinks = toList Map.toPermalink rdr }
+        do! rdr.CloseAsync ()
+        
+        cmd.CommandText <- "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC"
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return { page with revisions = toList Map.toRevision rdr }
+    }
+    
+    /// Return a page with no text (or meta items, prior permalinks, or revisions)
+    let pageWithoutTextOrMeta rdr =
+        { Map.toPage rdr with text = "" }
+    
+    /// Update a page's metadata items
+    let updatePageMeta pageId 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 ("@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
+    let updatePagePermalinks pageId oldLinks newLinks = backgroundTask {
+        let toDelete, toAdd = diffPermalinks oldLinks newLinks
+        if List.isEmpty toDelete && List.isEmpty toAdd then
+            return ()
+        else
+            use cmd = conn.CreateCommand ()
+            [ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
+              cmd.Parameters.Add ("@link", SqliteType.Text)
+            ] |> ignore
+            let runCmd link = backgroundTask {
+                cmd.Parameters["@link"].Value <- Permalink.toString link
+                do! write cmd
+            }
+            cmd.CommandText <- "DELETE FROM page_permalink WHERE page_id = @pageId AND permalink = @link" 
+            toDelete
+            |> List.map runCmd
+            |> Task.WhenAll
+            |> ignore
+            cmd.CommandText <- "INSERT INTO page_permalink VALUES (@pageId, @link)"
+            toAdd
+            |> List.map runCmd
+            |> Task.WhenAll
+            |> ignore
+    }
+    
+    /// Update a page's revisions
+    let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
+        let toDelete, toAdd = diffRevisions oldRevs newRevs
+        if List.isEmpty toDelete && List.isEmpty toAdd then
+            return ()
+        else
+            use cmd = conn.CreateCommand ()
+            let runCmd withText rev = backgroundTask {
+                cmd.Parameters.Clear ()
+                [ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
+                  cmd.Parameters.AddWithValue ("@asOf", rev.asOf)
+                ] |> ignore
+                if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.text) |> ignore
+                do! write cmd
+            }
+            cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf" 
+            toDelete
+            |> List.map (runCmd false)
+            |> Task.WhenAll
+            |> ignore
+            cmd.CommandText <- "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)"
+            toAdd
+            |> List.map (runCmd true)
+            |> Task.WhenAll
+            |> ignore
+    }
+    
+    // IMPLEMENTATION FUNCTIONS
+    
+    /// Add a page
+    let add page = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        // The page itself
+        cmd.CommandText <- """
+            INSERT INTO page (
+                id, web_log_id, author_id, title, permalink, published_on, updated_on, show_in_page_list, template,
+                page_text
+            ) VALUES (
+                @id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @showInPageList, @template,
+                @text
+            )"""
+        addPageParameters cmd page
+        do! write cmd
+        do! updatePageMeta       page.id [] page.metadata
+        do! updatePagePermalinks page.id [] page.priorPermalinks
+        do! updatePageRevisions  page.id [] page.revisions
+    }
+    
+    /// Get all pages for a web log (without text, revisions, prior permalinks, or metadata)
+    let all webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)"
+        addWebLogId cmd webLogId
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return toList pageWithoutTextOrMeta rdr
+    }
+    
+    /// Count all pages for the given web log
+    let countAll webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE web_log_id = @webLogId"
+        addWebLogId cmd webLogId
+        return! count cmd
+    }
+    
+    /// Count all pages shown in the page list for the given web log
+    let countListed webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            SELECT COUNT(id)
+              FROM page
+             WHERE web_log_id        = @webLogId
+               AND show_in_page_list = @showInPageList"""
+        addWebLogId cmd webLogId
+        cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore
+        return! count cmd
+    }
+    
+    /// Find a page by its ID (without revisions and prior permalinks)
+    let findById pageId webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM page WHERE id = @id"
+        cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        match Helpers.verifyWebLog<Page> webLogId (fun it -> it.webLogId) Map.toPage rdr with
+        | Some page ->
+            let! page = appendPageMeta page
+            return Some page
+        | None -> return None
+    }
+    
+    /// Find a complete page by its ID
+    let findFullById pageId webLogId = backgroundTask {
+        match! findById pageId webLogId with
+        | Some page ->
+            let! page = appendPageRevisionsAndPermalinks page
+            return Some page
+        | None -> return None
+    }
+    
+    let delete pageId webLogId = backgroundTask {
+        match! findById pageId webLogId with
+        | Some _ ->
+            use cmd = conn.CreateCommand ()
+            cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
+            cmd.CommandText <- """
+                DELETE FROM page_revision  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"""
+            do! write cmd
+            return true
+        | None -> return false
+    }
+    
+    /// Find a page by its permalink for the given web log
+    let findByPermalink permalink webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link"
+        addWebLogId cmd webLogId
+        cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        if rdr.Read () then
+            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
+    let findCurrentPermalink permalinks webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            SELECT p.permalink
+              FROM page p
+                   INNER JOIN page_permalink pp ON pp.page_id = p.id
+             WHERE p.web_log_id = @webLogId
+               AND pp.permalink IN ("""
+        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
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return if rdr.Read () then Some (Map.toPermalink rdr) else None
+    }
+    
+    /// Get all complete pages for the given web log
+    let findFullByWebLog webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId"
+        addWebLogId cmd webLogId
+        use! rdr = cmd.ExecuteReaderAsync ()
+        let! pages =
+            toList Map.toPage rdr
+            |> List.map (fun page -> backgroundTask {
+                let! page = appendPageMeta page
+                return! appendPageRevisionsAndPermalinks page
+            })
+            |> Task.WhenAll
+        return List.ofArray pages
+    }
+    
+    /// Get all listed pages for the given web log (without revisions, prior permalinks, or text)
+    let findListed webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            SELECT *
+              FROM page
+             WHERE web_log_id        = @webLogId
+               AND show_in_page_list = @showInPageList
+             ORDER BY LOWER(title)"""
+        addWebLogId cmd webLogId
+        cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        let! pages =
+            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)
+    let findPageOfPages webLogId pageNbr = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            SELECT *
+              FROM page
+             WHERE web_log_id = @webLogId
+             ORDER BY LOWER(title)
+             LIMIT @pageSize OFFSET @toSkip"""
+        addWebLogId cmd webLogId
+        [ cmd.Parameters.AddWithValue ("@pageSize", 26)
+          cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25)
+        ] |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return toList Map.toPage rdr
+    }
+    
+    /// Restore pages from a backup
+    let restore pages = backgroundTask {
+        for page in pages do
+            do! add page
+    }
+    
+    /// Update a page
+    let update (page : Page) = backgroundTask {
+        match! findFullById page.id page.webLogId with
+        | Some oldPage ->
+            use cmd = conn.CreateCommand ()
+            cmd.CommandText <- """
+                UPDATE page
+                   SET author_id         = @authorId,
+                       title             = @title,
+                       permalink         = @permalink,
+                       published_on      = @publishedOn,
+                       updated_on        = @updatedOn,
+                       show_in_page_list = @showInPageList,
+                       template          = @template,
+                       page_text         = @text
+                 WHERE id         = @pageId
+                   AND web_log_id = @webLogId"""
+            addPageParameters cmd page
+            do! write cmd
+            do! updatePageMeta       page.id oldPage.metadata        page.metadata
+            do! updatePagePermalinks page.id oldPage.priorPermalinks page.priorPermalinks
+            do! updatePageRevisions  page.id oldPage.revisions       page.revisions
+            return ()
+        | None -> return ()
+    }
+    
+    /// Update a page's prior permalinks
+    let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
+        match! findFullById pageId webLogId with
+        | Some page ->
+            do! updatePagePermalinks pageId page.priorPermalinks permalinks
+            return true
+        | None -> return false
+    }
+    
+    interface IPageData with
+        member _.add page = add 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 = update page
+        member _.updatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks

src/MyWebLog.Data/SQLite/SQLitePostData.fs

@@ -0,0 +1,579 @@
+namespace MyWebLog.Data.SQLite
+
+open System
+open System.Threading.Tasks
+open Microsoft.Data.Sqlite
+open MyWebLog
+open MyWebLog.Data
+
+/// SQLite myWebLog post data implementation        
+type SQLitePostData (conn : SqliteConnection) =
+
+    // SUPPORT FUNCTIONS
+    
+    /// Add parameters for post INSERT or UPDATE statements
+    let addPostParameters (cmd : SqliteCommand) (post : Post) =
+        [ cmd.Parameters.AddWithValue ("@id", PostId.toString post.id)
+          cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.webLogId)
+          cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.authorId)
+          cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.status)
+          cmd.Parameters.AddWithValue ("@title", post.title)
+          cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.permalink)
+          cmd.Parameters.AddWithValue ("@publishedOn", maybe post.publishedOn)
+          cmd.Parameters.AddWithValue ("@updatedOn", post.updatedOn)
+          cmd.Parameters.AddWithValue ("@template", maybe post.template)
+          cmd.Parameters.AddWithValue ("@text", post.text)
+        ] |> ignore
+    
+    /// Add parameters for episode INSERT or UPDATE statements
+    let addEpisodeParameters (cmd : SqliteCommand) (ep : Episode) =
+        [ 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 ()
+        cmd.Parameters.AddWithValue ("@id", PostId.toString post.id) |> ignore
+        
+        cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id"
+        use! rdr = cmd.ExecuteReaderAsync ()
+        let post = { post with categoryIds = toList Map.toCategoryId rdr }
+        do! rdr.CloseAsync ()
+        
+        cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id"
+        use! rdr = cmd.ExecuteReaderAsync ()
+        let post = { 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
+    let appendPostRevisionsAndPermalinks (post : Post) = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.Parameters.AddWithValue ("@postId", PostId.toString post.id) |> ignore
+        
+        cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId"
+        use! rdr = cmd.ExecuteReaderAsync ()
+        let post = { post with priorPermalinks = toList Map.toPermalink rdr }
+        do! rdr.CloseAsync ()
+        
+        cmd.CommandText <- "SELECT as_of, revision_text FROM post_revision WHERE post_id = @postId ORDER BY as_of DESC"
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return { post with revisions = toList Map.toRevision rdr }
+    }
+    
+    /// Return a post with no revisions, prior permalinks, or text
+    let postWithoutText rdr =
+        { Map.toPost rdr with text = "" }
+    
+    /// Update a post's assigned categories
+    let updatePostCategories postId oldCats newCats = backgroundTask {
+        let toDelete, toAdd = diffLists oldCats newCats CategoryId.toString
+        if List.isEmpty toDelete && List.isEmpty toAdd then
+            return ()
+        else
+            use cmd = conn.CreateCommand ()
+            [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
+              cmd.Parameters.Add ("@categoryId", SqliteType.Text)
+            ] |> ignore
+            let runCmd catId = backgroundTask {
+                cmd.Parameters["@categoryId"].Value <- CategoryId.toString catId
+                do! write cmd
+            }
+            cmd.CommandText <- "DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId" 
+            toDelete
+            |> List.map runCmd
+            |> Task.WhenAll
+            |> ignore
+            cmd.CommandText <- "INSERT INTO post_category VALUES (@postId, @categoryId)"
+            toAdd
+            |> List.map runCmd
+            |> Task.WhenAll
+            |> ignore
+    }
+    
+    /// Update a post's assigned categories
+    let updatePostTags postId (oldTags : string list) newTags = backgroundTask {
+        let toDelete, toAdd = diffLists oldTags newTags id
+        if List.isEmpty toDelete && List.isEmpty toAdd then
+            return ()
+        else
+            use cmd = conn.CreateCommand ()
+            [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
+              cmd.Parameters.Add ("@tag", SqliteType.Text)
+            ] |> ignore
+            let runCmd (tag : string) = backgroundTask {
+                cmd.Parameters["@tag"].Value <- tag
+                do! write cmd
+            }
+            cmd.CommandText <- "DELETE FROM post_tag WHERE post_id = @postId AND tag = @tag" 
+            toDelete
+            |> List.map runCmd
+            |> Task.WhenAll
+            |> ignore
+            cmd.CommandText <- "INSERT INTO post_tag VALUES (@postId, @tag)"
+            toAdd
+            |> List.map runCmd
+            |> Task.WhenAll
+            |> 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
+    let updatePostPermalinks postId oldLinks newLinks = backgroundTask {
+        let toDelete, toAdd = diffPermalinks oldLinks newLinks
+        if List.isEmpty toDelete && List.isEmpty toAdd then
+            return ()
+        else
+            use cmd = conn.CreateCommand ()
+            [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
+              cmd.Parameters.Add ("@link", SqliteType.Text)
+            ] |> ignore
+            let runCmd link = backgroundTask {
+                cmd.Parameters["@link"].Value <- Permalink.toString link
+                do! write cmd
+            }
+            cmd.CommandText <- "DELETE FROM post_permalink WHERE post_id = @postId AND permalink = @link" 
+            toDelete
+            |> List.map runCmd
+            |> Task.WhenAll
+            |> ignore
+            cmd.CommandText <- "INSERT INTO post_permalink VALUES (@postId, @link)"
+            toAdd
+            |> List.map runCmd
+            |> Task.WhenAll
+            |> ignore
+    }
+    
+    /// Update a post's revisions
+    let updatePostRevisions postId oldRevs newRevs = backgroundTask {
+        let toDelete, toAdd = diffRevisions oldRevs newRevs
+        if List.isEmpty toDelete && List.isEmpty toAdd then
+            return ()
+        else
+            use cmd = conn.CreateCommand ()
+            let runCmd withText rev = backgroundTask {
+                cmd.Parameters.Clear ()
+                [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
+                  cmd.Parameters.AddWithValue ("@asOf", rev.asOf)
+                ] |> ignore
+                if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.text) |> ignore
+                do! write cmd
+            }
+            cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf" 
+            toDelete
+            |> List.map (runCmd false)
+            |> Task.WhenAll
+            |> ignore
+            cmd.CommandText <- "INSERT INTO post_revision VALUES (@postId, @asOf, @text)"
+            toAdd
+            |> List.map (runCmd true)
+            |> Task.WhenAll
+            |> ignore
+    }
+    
+    /// 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"
+    
+    // IMPLEMENTATION FUNCTIONS
+    
+    /// Add a post
+    let add post = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            INSERT INTO post (
+                id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text
+            ) VALUES (
+                @id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text
+            )"""
+        addPostParameters cmd post
+        do! write cmd
+        do! updatePostCategories post.id [] post.categoryIds
+        do! updatePostTags       post.id [] post.tags
+        do! updatePostEpisode    post
+        do! updatePostMeta       post.id [] post.metadata
+        do! updatePostPermalinks post.id [] post.priorPermalinks
+        do! updatePostRevisions  post.id [] post.revisions
+    }
+    
+    /// Count posts in a status for the given web log
+    let countByStatus status webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE web_log_id = @webLogId AND status = @status"
+        addWebLogId cmd webLogId
+        cmd.Parameters.AddWithValue ("@status", PostStatus.toString status) |> ignore
+        return! count cmd
+    }
+    
+    /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
+    let findByPermalink permalink webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId AND p.permalink  = @link"
+        addWebLogId cmd webLogId
+        cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        if rdr.Read () then
+            let! post = appendPostCategoryTagAndMeta (Map.toPost rdr)
+            return Some post
+        else
+            return None
+    }
+    
+    /// Find a complete post by its ID for the given web log
+    let findFullById postId webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
+        cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        match Helpers.verifyWebLog<Post> webLogId (fun p -> p.webLogId) Map.toPost rdr with
+        | Some post ->
+            let! post = appendPostCategoryTagAndMeta     post
+            let! post = appendPostRevisionsAndPermalinks post
+            return Some post
+        | None ->
+            return None
+    }
+    
+    /// Delete a post by its ID for the given web log
+    let delete postId webLogId = backgroundTask {
+        match! findFullById postId webLogId with
+        | Some _ ->
+            use cmd = conn.CreateCommand ()
+            cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
+            cmd.CommandText <- """
+                DELETE FROM post_revision  WHERE post_id = @id;
+                DELETE FROM post_permalink WHERE post_id = @id;
+                DELETE FROM post_meta      WHERE post_id = @id;
+                DELETE FROM post_episode   WHERE post_id = @id;
+                DELETE FROM post_tag       WHERE post_id = @id;
+                DELETE FROM post_category  WHERE post_id = @id;
+                DELETE FROM post           WHERE id      = @id"""
+            do! write cmd
+            return true
+        | None -> return false
+    }
+    
+    /// Find the current permalink from a list of potential prior permalinks for the given web log
+    let findCurrentPermalink permalinks webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            SELECT p.permalink
+              FROM post p
+                   INNER JOIN post_permalink pp ON pp.post_id = p.id
+             WHERE p.web_log_id = @webLogId
+               AND pp.permalink IN ("""
+        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
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return if rdr.Read () then Some (Map.toPermalink rdr) else None
+    }
+    
+    /// Get all complete posts for the given web log
+    let findFullByWebLog webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId"
+        addWebLogId cmd webLogId
+        use! rdr = cmd.ExecuteReaderAsync ()
+        let! posts =
+            toList Map.toPost rdr
+            |> List.map (fun post -> backgroundTask {
+                let! post = appendPostCategoryTagAndMeta post
+                return! appendPostRevisionsAndPermalinks post
+            })
+            |> Task.WhenAll
+        return List.ofArray posts
+    }
+    
+    /// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
+    let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- $"""
+            {selectPost}
+                   INNER JOIN post_category pc ON pc.post_id = p.id
+             WHERE p.web_log_id = @webLogId
+               AND p.status     = @status
+               AND pc.category_id IN ("""
+        categoryIds
+        |> List.iteri (fun idx catId ->
+            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
+        cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        let! posts =
+            toList Map.toPost rdr
+            |> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
+            |> Task.WhenAll
+        return List.ofArray posts
+    }
+    
+    /// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks)
+    let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- $"""
+            {selectPost}
+              WHERE p.web_log_id = @webLogId
+              ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
+              LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
+        addWebLogId cmd webLogId
+        use! rdr = cmd.ExecuteReaderAsync ()
+        let! posts =
+            toList postWithoutText rdr
+            |> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
+            |> Task.WhenAll
+        return List.ofArray posts
+    }
+    
+    /// Get a page of published posts for the given web log (excludes revisions and prior permalinks)
+    let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- $"""
+            {selectPost}
+              WHERE p.web_log_id = @webLogId
+                AND p.status     = @status
+              ORDER BY p.published_on DESC
+              LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
+        addWebLogId cmd webLogId
+        cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        let! posts =
+            toList Map.toPost rdr
+            |> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
+            |> Task.WhenAll
+        return List.ofArray posts
+    }
+    
+    /// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
+    let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- $"""
+            {selectPost}
+                    INNER JOIN post_tag pt ON pt.post_id = p.id
+              WHERE p.web_log_id = @webLogId
+                AND p.status     = @status
+                AND pt.tag       = @tag
+              ORDER BY p.published_on DESC
+              LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
+        addWebLogId cmd webLogId
+        [ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
+          cmd.Parameters.AddWithValue ("@tag", tag)
+        ] |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        let! posts =
+            toList Map.toPost rdr
+            |> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
+            |> Task.WhenAll
+        return List.ofArray posts
+    }
+    
+    /// Find the next newest and oldest post from a publish date for the given web log
+    let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- $"""
+            {selectPost}
+             WHERE p.web_log_id   = @webLogId
+               AND p.status       = @status
+               AND p.published_on < @publishedOn
+             ORDER BY p.published_on DESC
+             LIMIT 1"""
+        addWebLogId cmd webLogId
+        [ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
+          cmd.Parameters.AddWithValue ("@publishedOn", publishedOn)
+        ] |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        let! older = backgroundTask {
+            if rdr.Read () then
+                let! post = appendPostCategoryTagAndMeta (postWithoutText rdr)
+                return Some post
+            else
+                return None
+        }
+        do! rdr.CloseAsync ()
+        cmd.CommandText <- $"""
+            {selectPost}
+             WHERE p.web_log_id   = @webLogId
+               AND p.status       = @status
+               AND p.published_on > @publishedOn
+             ORDER BY p.published_on
+             LIMIT 1"""
+        use! rdr = cmd.ExecuteReaderAsync ()
+        let! newer = backgroundTask {
+            if rdr.Read () then
+                let! post = appendPostCategoryTagAndMeta (postWithoutText rdr)
+                return Some post
+            else
+                return None
+        }
+        return older, newer
+    }
+    
+    /// Restore posts from a backup
+    let restore posts = backgroundTask {
+        for post in posts do
+            do! add post
+    }
+    
+    /// Update a post
+    let update (post : Post) = backgroundTask {
+        match! findFullById post.id post.webLogId with
+        | Some oldPost ->
+            use cmd = conn.CreateCommand ()
+            cmd.CommandText <- """
+                UPDATE post
+                   SET author_id    = @authorId,
+                       status       = @status,
+                       title        = @title,
+                       permalink    = @permalink,
+                       published_on = @publishedOn,
+                       updated_on   = @updatedOn,
+                       template     = @template,
+                       post_text    = @text
+                 WHERE id         = @id
+                   AND web_log_id = @webLogId"""
+            addPostParameters cmd post
+            do! write cmd
+            do! updatePostCategories post.id oldPost.categoryIds     post.categoryIds
+            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! updatePostRevisions  post.id oldPost.revisions       post.revisions
+        | None -> return ()
+    }
+    
+    /// Update prior permalinks for a post
+    let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
+        match! findFullById postId webLogId with
+        | Some post ->
+            do! updatePostPermalinks postId post.priorPermalinks permalinks
+            return true
+        | None -> return false
+    }
+    
+    interface IPostData with
+        member _.add post = add post
+        member _.countByStatus status webLogId = countByStatus status webLogId
+        member _.delete postId webLogId = delete 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 = update post
+        member _.updatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks

src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs

@@ -0,0 +1,108 @@
+namespace MyWebLog.Data.SQLite
+
+open Microsoft.Data.Sqlite
+open MyWebLog
+open MyWebLog.Data
+
+/// SQLite myWebLog tag mapping data implementation        
+type SQLiteTagMapData (conn : SqliteConnection) =
+
+    /// Find a tag mapping by its ID for the given web log
+    let findById tagMapId webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM tag_map WHERE id = @id"
+        cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return Helpers.verifyWebLog<TagMap> webLogId (fun tm -> tm.webLogId) Map.toTagMap rdr
+    }
+    
+    /// Delete a tag mapping for the given web log
+    let delete tagMapId webLogId = backgroundTask {
+        match! findById tagMapId webLogId with
+        | Some _ ->
+            use cmd = conn.CreateCommand ()
+            cmd.CommandText <- "DELETE FROM tag_map WHERE id = @id"
+            cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore
+            do! write cmd
+            return true
+        | None -> return false
+    }
+    
+    /// Find a tag mapping by its URL value for the given web log
+    let findByUrlValue (urlValue : string) webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue"
+        addWebLogId cmd webLogId
+        cmd.Parameters.AddWithValue ("@urlValue", urlValue) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return if rdr.Read () then Some (Map.toTagMap rdr) else None
+    }
+    
+    /// Get all tag mappings for the given web log
+    let findByWebLog webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM tag_map WHERE web_log_id = @webLogId ORDER BY tag"
+        addWebLogId cmd webLogId
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return toList Map.toTagMap rdr
+    }
+    
+    /// Find any tag mappings in a list of tags for the given web log
+    let findMappingForTags (tags : string list) webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            SELECT *
+              FROM tag_map
+             WHERE web_log_id = @webLogId
+               AND tag IN ("""
+        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
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return toList Map.toTagMap rdr
+    }
+    
+    /// Save a tag mapping
+    let save (tagMap : TagMap) = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        match! findById tagMap.id tagMap.webLogId with
+        | Some _ ->
+            cmd.CommandText <- """
+                UPDATE tag_map
+                   SET tag       = @tag,
+                       url_value = @urlValue
+                 WHERE id         = @id
+                   AND web_log_id = @webLogId"""
+        | None ->
+            cmd.CommandText <- """
+                INSERT INTO tag_map (
+                    id, web_log_id, tag, url_value
+                ) VALUES (
+                    @id, @webLogId, @tag, @urlValue
+                )"""
+        addWebLogId cmd tagMap.webLogId
+        [ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.id)
+          cmd.Parameters.AddWithValue ("@tag", tagMap.tag)
+          cmd.Parameters.AddWithValue ("@urlValue", tagMap.urlValue)
+        ] |> ignore
+        do! write cmd
+    }
+    
+    /// Restore tag mappings from a backup
+    let restore tagMaps = backgroundTask {
+        for tagMap in tagMaps do
+            do! save tagMap
+    }
+    
+    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 this.restore tagMaps = restore tagMaps

src/MyWebLog.Data/SQLite/SQLiteThemeData.fs

@@ -0,0 +1,207 @@
+namespace MyWebLog.Data.SQLite
+
+open System.Threading.Tasks
+open Microsoft.Data.Sqlite
+open MyWebLog
+open MyWebLog.Data
+
+/// SQLite myWebLog theme data implementation        
+type SQLiteThemeData (conn : SqliteConnection) =
+    
+    /// Retrieve all themes (except 'admin'; excludes templates)
+    let all () = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id"
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return toList Map.toTheme rdr
+    }
+    
+    /// Find a theme by its ID
+    let findById themeId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM theme WHERE id = @id"
+        cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        if rdr.Read () then
+            let theme = Map.toTheme rdr
+            let templateCmd = conn.CreateCommand ()
+            templateCmd.CommandText <- "SELECT * FROM theme_template WHERE theme_id = @id"
+            templateCmd.Parameters.Add cmd.Parameters["@id"] |> ignore
+            use! templateRdr = templateCmd.ExecuteReaderAsync ()
+            return Some { theme with templates = toList Map.toThemeTemplate templateRdr }
+        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
+    }
+    
+    /// Save a theme
+    let save (theme : Theme) = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        let! oldTheme = findById theme.id
+        cmd.CommandText <-
+            match oldTheme with
+            | Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id"
+            | None -> "INSERT INTO theme VALUES (@id, @name, @version)"
+        [ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.id)
+          cmd.Parameters.AddWithValue ("@name", theme.name)
+          cmd.Parameters.AddWithValue ("@version", theme.version)
+        ] |> ignore
+        do! write cmd
+        
+        let toDelete, toAdd =
+            diffLists (oldTheme |> Option.map (fun t -> t.templates) |> Option.defaultValue [])
+                      theme.templates (fun t -> t.name)
+        let toUpdate =
+            theme.templates
+            |> List.filter (fun t ->
+                not (toDelete |> List.exists (fun d -> d.name = t.name))
+                && not (toAdd |> List.exists (fun a -> a.name = t.name)))
+        cmd.CommandText <-
+            "UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name"
+        cmd.Parameters.Clear ()
+        [ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.id)
+          cmd.Parameters.Add ("@name", SqliteType.Text)
+          cmd.Parameters.Add ("@template", SqliteType.Text)
+        ] |> ignore
+        toUpdate
+        |> List.map (fun template -> backgroundTask {
+            cmd.Parameters["@name"    ].Value <- template.name
+            cmd.Parameters["@template"].Value <- template.text
+            do! write cmd
+        })
+        |> Task.WhenAll
+        |> ignore
+        cmd.CommandText <- "INSERT INTO theme_template VALUES (@themeId, @name, @template)"
+        toAdd
+        |> List.map (fun template -> backgroundTask {
+            cmd.Parameters["@name"    ].Value <- template.name
+            cmd.Parameters["@template"].Value <- template.text
+            do! write cmd
+        })
+        |> Task.WhenAll
+        |> ignore
+        cmd.CommandText <- "DELETE FROM theme_template WHERE theme_id = @themeId AND name = @name"
+        cmd.Parameters.Remove cmd.Parameters["@template"]
+        toDelete
+        |> List.map (fun template -> backgroundTask {
+            cmd.Parameters["@name"].Value <- template.name
+            do! write cmd
+        })
+        |> Task.WhenAll
+        |> ignore
+    }
+    
+    interface IThemeData with
+        member _.all () = all ()
+        member _.findById themeId = findById themeId
+        member _.findByIdWithoutText themeId = findByIdWithoutText themeId
+        member _.save theme = save theme
+
+
+open System.IO
+
+/// SQLite myWebLog theme data implementation        
+type SQLiteThemeAssetData (conn : SqliteConnection) =
+    
+    /// Get all theme assets (excludes data)
+    let all () = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset"
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return toList (Map.toThemeAsset false) rdr
+    }
+    
+    /// Delete all assets for the given theme
+    let deleteByTheme themeId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "DELETE FROM theme_asset WHERE theme_id = @themeId"
+        cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString themeId) |> ignore
+        do! write cmd
+    }
+    
+    /// Find a theme asset by its ID
+    let findById assetId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
+        let (ThemeAssetId (ThemeId themeId, path)) = assetId
+        [ cmd.Parameters.AddWithValue ("@themeId", themeId)
+          cmd.Parameters.AddWithValue ("@path", path)
+        ] |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return if rdr.Read () then Some (Map.toThemeAsset true rdr) else None
+    }
+    
+    /// Get theme assets for the given theme (excludes data)
+    let findByTheme themeId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId"
+        cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString themeId) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return toList (Map.toThemeAsset false) rdr
+    }
+    
+    /// Get theme assets for the given theme
+    let findByThemeWithData themeId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId"
+        cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString themeId) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return toList (Map.toThemeAsset true) rdr
+    }
+    
+    /// Save a theme asset
+    let save (asset : ThemeAsset) = backgroundTask {
+        use sideCmd = conn.CreateCommand ()
+        sideCmd.CommandText <-
+            "SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path"
+        let (ThemeAssetId (ThemeId themeId, path)) = asset.id
+        [ sideCmd.Parameters.AddWithValue ("@themeId", themeId)
+          sideCmd.Parameters.AddWithValue ("@path", path)
+        ] |> ignore
+        let! exists = count sideCmd
+        
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <-
+            if exists = 1 then
+                """UPDATE theme_asset
+                      SET updated_on = @updatedOn,
+                          data       = ZEROBLOB(@dataLength)
+                    WHERE theme_id = @themeId
+                      AND path     = @path"""
+            else
+                """INSERT INTO theme_asset (
+                       theme_id, path, updated_on, data
+                   ) VALUES (
+                       @themeId, @path, @updatedOn, ZEROBLOB(@dataLength)
+                   )"""
+        [ cmd.Parameters.AddWithValue ("@themeId", themeId)
+          cmd.Parameters.AddWithValue ("@path", path)
+          cmd.Parameters.AddWithValue ("@updatedOn", asset.updatedOn)
+          cmd.Parameters.AddWithValue ("@dataLength", asset.data.Length)
+        ] |> ignore
+        do! write cmd
+        
+        sideCmd.CommandText <- "SELECT ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
+        let! rowId = sideCmd.ExecuteScalarAsync ()
+        
+        use dataStream = new MemoryStream (asset.data)
+        use blobStream = new SqliteBlob (conn, "theme_asset", "data", rowId :?> int64)
+        do! dataStream.CopyToAsync blobStream
+    }
+    
+    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

src/MyWebLog.Data/SQLite/SQLiteUploadData.fs

@@ -0,0 +1,101 @@
+namespace MyWebLog.Data.SQLite
+
+open System.IO
+open Microsoft.Data.Sqlite
+open MyWebLog
+open MyWebLog.Data
+
+/// SQLite myWebLog web log data implementation        
+type SQLiteUploadData (conn : SqliteConnection) =
+
+    /// Add parameters for uploaded file INSERT and UPDATE statements
+    let addUploadParameters (cmd : SqliteCommand) (upload : Upload) =
+        [ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.id)
+          cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.webLogId)
+          cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.path)
+          cmd.Parameters.AddWithValue ("@updatedOn", upload.updatedOn)
+          cmd.Parameters.AddWithValue ("@dataLength", upload.data.Length)
+        ] |> ignore
+    
+    /// Save an uploaded file
+    let add upload = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            INSERT INTO upload (
+                id, web_log_id, path, updated_on, data
+            ) VALUES (
+                @id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength)
+            )"""
+        addUploadParameters cmd upload
+        do! write cmd
+        
+        cmd.CommandText <- "SELECT ROWID FROM upload WHERE id = @id"
+        let! rowId = cmd.ExecuteScalarAsync ()
+        
+        use dataStream = new MemoryStream (upload.data)
+        use blobStream = new SqliteBlob (conn, "upload", "data", rowId :?> int64)
+        do! dataStream.CopyToAsync blobStream
+    }
+    
+    /// Delete an uploaded file by its ID
+    let delete uploadId webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            SELECT id, web_log_id, path, updated_on
+              FROM upload
+             WHERE id         = @id
+               AND web_log_id = @webLogId"""
+        addWebLogId cmd webLogId
+        cmd.Parameters.AddWithValue ("@id", UploadId.toString uploadId) |> ignore
+        let! rdr = cmd.ExecuteReaderAsync ()
+        if (rdr.Read ()) then
+            let upload = Map.toUpload false rdr
+            do! rdr.CloseAsync ()
+            cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
+            do! write cmd
+            return Ok (Permalink.toString upload.path)
+        else
+            return Error $"""Upload ID {cmd.Parameters["@id"]} not found"""
+    }
+    
+    /// Find an uploaded file by its path for the given web log
+    let findByPath (path : string) webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT *, ROWID FROM upload WHERE web_log_id = @webLogId AND path = @path"
+        addWebLogId cmd webLogId
+        cmd.Parameters.AddWithValue ("@path", path) |> ignore
+        let! rdr = cmd.ExecuteReaderAsync ()
+        return if rdr.Read () then Some (Map.toUpload true rdr) else None
+    }
+    
+    /// Find all uploaded files for the given web log (excludes data)
+    let findByWebLog webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT id, web_log_id, path, updated_on FROM upload WHERE web_log_id = @webLogId"
+        addWebLogId cmd webLogId
+        let! rdr = cmd.ExecuteReaderAsync ()
+        return toList (Map.toUpload false) rdr
+    }
+    
+    /// Find all uploaded files for the given web log
+    let findByWebLogWithData webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT *, ROWID FROM upload WHERE web_log_id = @webLogId"
+        addWebLogId cmd webLogId
+        let! rdr = cmd.ExecuteReaderAsync ()
+        return toList (Map.toUpload true) rdr
+    }
+    
+    /// Restore uploads from a backup
+    let restore uploads = backgroundTask {
+        for upload in uploads do do! add upload
+    }
+    
+    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
+        

src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs

@@ -0,0 +1,334 @@
+namespace MyWebLog.Data.SQLite
+
+open System.Threading.Tasks
+open Microsoft.Data.Sqlite
+open MyWebLog
+open MyWebLog.Data
+
+// The web log podcast insert loop is not statically compilable; this is OK
+#nowarn "3511"
+
+/// SQLite myWebLog web log data implementation        
+type SQLiteWebLogData (conn : SqliteConnection) =
+    
+    // SUPPORT FUNCTIONS
+    
+    /// Add parameters for web log INSERT or web log/RSS options UPDATE statements
+    let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) =
+        [ cmd.Parameters.AddWithValue ("@feedEnabled", webLog.rss.feedEnabled)
+          cmd.Parameters.AddWithValue ("@feedName", webLog.rss.feedName)
+          cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.rss.itemsInFeed)
+          cmd.Parameters.AddWithValue ("@categoryEnabled", webLog.rss.categoryEnabled)
+          cmd.Parameters.AddWithValue ("@tagEnabled", webLog.rss.tagEnabled)
+          cmd.Parameters.AddWithValue ("@copyright", maybe webLog.rss.copyright)
+        ] |> ignore
+    
+    /// Add parameters for web log INSERT or UPDATE statements
+    let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) =
+        [ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.id)
+          cmd.Parameters.AddWithValue ("@name", webLog.name)
+          cmd.Parameters.AddWithValue ("@slug", webLog.slug)
+          cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.subtitle)
+          cmd.Parameters.AddWithValue ("@defaultPage", webLog.defaultPage)
+          cmd.Parameters.AddWithValue ("@postsPerPage", webLog.postsPerPage)
+          cmd.Parameters.AddWithValue ("@themeId", webLog.themePath)
+          cmd.Parameters.AddWithValue ("@urlBase", webLog.urlBase)
+          cmd.Parameters.AddWithValue ("@timeZone", webLog.timeZone)
+          cmd.Parameters.AddWithValue ("@autoHtmx", webLog.autoHtmx)
+          cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.uploads)
+        ] |> ignore
+        addWebLogRssParameters cmd webLog
+    
+    /// Add parameters for custom feed INSERT or UPDATE statements
+    let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) =
+        [ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.id)
+          cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId)
+          cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.source)
+          cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.path)
+        ] |> ignore
+    
+    /// Add parameters for podcast INSERT or UPDATE statements
+    let addPodcastParameters (cmd : SqliteCommand) feedId (podcast : PodcastOptions) =
+        [ cmd.Parameters.AddWithValue ("@feedId", CustomFeedId.toString feedId)
+          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 ("@iTunesCategory", podcast.iTunesCategory)
+          cmd.Parameters.AddWithValue ("@iTunesSubcategory", maybe podcast.iTunesSubcategory)
+          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 ("@guid", maybe podcast.guid)
+          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
+    let getCustomFeeds (webLog : WebLog) = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            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
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return toList Map.toCustomFeed rdr
+    }
+    
+    /// 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 } }
+    }
+    
+    /// 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,
+                itunes_category, itunes_subcategory, explicit, default_media_type, media_base_url, guid, funding_url,
+                funding_text, medium
+            ) VALUES (
+                @feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl,
+                @iTunesCategory, @iTunesSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @guid, @fundingUrl,
+                @fundingText, @medium
+            )"""
+        addPodcastParameters cmd feedId podcast
+        do! write cmd
+    }
+    
+    /// Update the custom feeds for a web log
+    let updateCustomFeeds (webLog : WebLog) = backgroundTask {
+        let! feeds = getCustomFeeds webLog
+        let toDelete, toAdd = diffLists feeds webLog.rss.customFeeds (fun it -> $"{CustomFeedId.toString it.id}")
+        let toId (feed : CustomFeed) = feed.id
+        let toUpdate =
+            webLog.rss.customFeeds
+            |> List.filter (fun f ->
+                not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.id))
+        use cmd = conn.CreateCommand ()
+        cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
+        toDelete
+        |> List.map (fun it -> backgroundTask {
+            cmd.CommandText <- """
+                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
+            do! write cmd
+        })
+        |> Task.WhenAll
+        |> ignore
+        cmd.Parameters.Clear ()
+        toAdd
+        |> List.map (fun it -> backgroundTask {
+            cmd.CommandText <- """
+                INSERT INTO web_log_feed (
+                    id, web_log_id, source, path
+                ) VALUES (
+                    @id, @webLogId, @source, @path
+                )"""
+            cmd.Parameters.Clear ()
+            addCustomFeedParameters cmd webLog.id it
+            do! write cmd
+            match it.podcast with
+            | Some podcast -> do! addPodcast it.id podcast
+            | None -> ()
+        })
+        |> Task.WhenAll
+        |> ignore
+        toUpdate
+        |> List.map (fun it -> backgroundTask {
+            cmd.CommandText <- """
+                UPDATE web_log_feed
+                   SET source = @source,
+                       path   = @path
+                 WHERE id         = @id
+                   AND web_log_id = @webLogId"""
+            cmd.Parameters.Clear ()
+            addCustomFeedParameters cmd webLog.id it
+            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,
+                               itunes_category    = @iTunesCategory,
+                               itunes_subcategory = @iTunesSubcategory,
+                               explicit           = @explicit,
+                               default_media_type = @defaultMediaType,
+                               media_base_url     = @mediaBaseUrl,
+                               guid               = @guid,
+                               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
+        |> ignore
+    }
+    
+    // IMPLEMENTATION FUNCTIONS
+    
+    /// Add a web log
+    let add webLog = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            INSERT INTO web_log (
+                id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
+                uploads, feed_enabled, feed_name, items_in_feed, category_enabled, tag_enabled, copyright
+            ) VALUES (
+                @id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
+                @uploads, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled, @copyright
+            )"""
+        addWebLogParameters cmd webLog
+        do! write cmd
+        do! updateCustomFeeds webLog
+    }
+    
+    /// Retrieve all web logs
+    let all () = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM web_log"
+        use! rdr = cmd.ExecuteReaderAsync ()
+        let! webLogs =
+            toList Map.toWebLog rdr
+            |> List.map (fun webLog -> backgroundTask { return! appendCustomFeeds webLog })
+            |> Task.WhenAll
+        return List.ofArray webLogs
+    }
+    
+    /// Delete a web log by its ID
+    let delete webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        addWebLogId cmd webLogId
+        let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
+        let postSubQuery = subQuery "post"
+        let pageSubQuery = subQuery "page"
+        cmd.CommandText <- $"""
+            DELETE FROM post_comment         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_episode         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_meta            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_permalink       WHERE page_id IN {pageSubQuery};
+            DELETE FROM page_meta            WHERE page_id IN {pageSubQuery};
+            DELETE FROM page                 WHERE web_log_id = @webLogId;
+            DELETE FROM category             WHERE web_log_id = @webLogId;
+            DELETE FROM tag_map              WHERE web_log_id = @webLogId;
+            DELETE FROM upload               WHERE web_log_id = @webLogId;
+            DELETE FROM web_log_user         WHERE web_log_id = @webLogId;
+            DELETE FROM web_log_feed_podcast WHERE feed_id IN {subQuery "web_log_feed"};
+            DELETE FROM web_log_feed         WHERE web_log_id = @webLogId;
+            DELETE FROM web_log              WHERE id         = @webLogId"""
+        do! write cmd
+    }
+    
+    /// Find a web log by its host (URL base)
+    let findByHost (url : string) = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM web_log WHERE url_base = @urlBase"
+        cmd.Parameters.AddWithValue ("@urlBase", url) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        if rdr.Read () then
+            let! webLog = appendCustomFeeds (Map.toWebLog rdr)
+            return Some webLog
+        else
+            return None
+    }
+    
+    /// Find a web log by its ID
+    let findById webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM web_log WHERE id = @webLogId"
+        addWebLogId cmd webLogId
+        use! rdr = cmd.ExecuteReaderAsync ()
+        if rdr.Read () then
+            let! webLog = appendCustomFeeds (Map.toWebLog rdr)
+            return Some webLog
+        else
+            return None
+    }
+    
+    /// Update settings for a web log
+    let updateSettings webLog = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            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,
+                   feed_enabled     = @feedEnabled,
+                   feed_name        = @feedName,
+                   items_in_feed    = @itemsInFeed,
+                   category_enabled = @categoryEnabled,
+                   tag_enabled      = @tagEnabled,
+                   copyright        = @copyright
+             WHERE id = @id"""
+        addWebLogParameters cmd webLog
+        do! write cmd
+    }
+    
+    /// Update RSS options for a web log
+    let updateRssOptions webLog = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            UPDATE web_log
+               SET feed_enabled     = @feedEnabled,
+                   feed_name        = @feedName,
+                   items_in_feed    = @itemsInFeed,
+                   category_enabled = @categoryEnabled,
+                   tag_enabled      = @tagEnabled,
+                   copyright        = @copyright
+             WHERE id = @id"""
+        addWebLogRssParameters cmd webLog
+        do! write cmd
+        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

src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs

@@ -0,0 +1,120 @@
+namespace MyWebLog.Data.SQLite
+
+open Microsoft.Data.Sqlite
+open MyWebLog
+open MyWebLog.Data
+
+/// SQLite myWebLog user data implementation        
+type SQLiteWebLogUserData (conn : SqliteConnection) =
+    
+    // SUPPORT FUNCTIONS
+
+    /// Add parameters for web log user INSERT or UPDATE statements
+    let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) =
+        [ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.id)
+          cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.webLogId)
+          cmd.Parameters.AddWithValue ("@userName", user.userName)
+          cmd.Parameters.AddWithValue ("@firstName", user.firstName)
+          cmd.Parameters.AddWithValue ("@lastName", user.lastName)
+          cmd.Parameters.AddWithValue ("@preferredName", user.preferredName)
+          cmd.Parameters.AddWithValue ("@passwordHash", user.passwordHash)
+          cmd.Parameters.AddWithValue ("@salt", user.salt)
+          cmd.Parameters.AddWithValue ("@url", maybe user.url)
+          cmd.Parameters.AddWithValue ("@authorizationLevel", AuthorizationLevel.toString user.authorizationLevel)
+        ] |> ignore
+    
+    // IMPLEMENTATION FUNCTIONS
+    
+    /// Add a user
+    let add user = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            INSERT INTO web_log_user (
+                id, web_log_id, user_name, first_name, last_name, preferred_name, password_hash, salt, url,
+                authorization_level
+            ) VALUES (
+                @id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url,
+                @authorizationLevel
+            )"""
+        addWebLogUserParameters cmd user
+        do! write cmd
+    }
+    
+    /// Find a user by their e-mail address for the given web log
+    let findByEmail (email : string) webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND user_name = @userName"
+        addWebLogId cmd webLogId
+        cmd.Parameters.AddWithValue ("@userName", email) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return if rdr.Read () then Some (Map.toWebLogUser rdr) else None
+    }
+    
+    /// Find a user by their ID for the given web log
+    let findById userId webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id"
+        cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return Helpers.verifyWebLog<WebLogUser> webLogId (fun u -> u.webLogId) Map.toWebLogUser rdr 
+    }
+    
+    /// Get all users for the given web log
+    let findByWebLog webLogId = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId"
+        addWebLogId cmd webLogId
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return toList Map.toWebLogUser rdr
+    }
+    
+    /// Find the names of users by their IDs for the given web log
+    let findNames webLogId userIds = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND id IN ("
+        userIds
+        |> 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
+        use! rdr = cmd.ExecuteReaderAsync ()
+        return
+            toList Map.toWebLogUser rdr
+            |> List.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u })
+    }
+    
+    /// Restore users from a backup
+    let restore users = backgroundTask {
+        for user in users do
+            do! add user
+    }
+    
+    /// Update a user
+    let update user = backgroundTask {
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- """
+            UPDATE web_log_user
+               SET user_name           = @userName,
+                   first_name          = @firstName,
+                   last_name           = @lastName,
+                   preferred_name      = @preferredName,
+                   password_hash       = @passwordHash,
+                   salt                = @salt,
+                   url                 = @url,
+                   authorization_level = @authorizationLevel
+             WHERE id         = @id
+               AND web_log_id = @webLogId"""
+        addWebLogUserParameters cmd user
+        do! write cmd
+    }
+    
+    interface IWebLogUserData with
+        member _.add user = add user
+        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 this.restore users = restore users
+        member _.update user = update user

src/MyWebLog.Domain/DataTypes.fs

@@ -190,6 +190,9 @@ type Post =
         /// The tags for the post
         tags : string list
 
+        /// Podcast episode information for this post
+        episode : Episode option
+        
         /// Metadata for the post
         metadata : MetaItem list
         
@@ -217,6 +220,7 @@ module Post =
           template        = None
           categoryIds     = []
           tags            = []
+          episode         = None
           metadata        = []
           priorPermalinks = []
           revisions       = []
@@ -291,6 +295,37 @@ type ThemeAsset =
     }
 
 
+/// An uploaded file
+type Upload =
+    {   /// The ID of the upload
+        id : UploadId
+        
+        /// The ID of the web log to which this upload belongs
+        webLogId : WebLogId
+        
+        /// The link at which this upload is served
+        path : Permalink
+        
+        /// The updated date/time for this upload
+        updatedOn : DateTime
+        
+        /// The data for the upload
+        data : byte[]
+    }
+
+/// Functions to support uploaded files
+module Upload =
+    
+    /// An empty upload
+    let empty = {
+        id        = UploadId.empty
+        webLogId  = WebLogId.empty
+        path      = Permalink.empty
+        updatedOn = DateTime.MinValue
+        data      = [||]
+    }
+
+
 /// A web log
 [<CLIMutable; NoComparison; NoEquality>]
 type WebLog =
@@ -300,6 +335,9 @@ type WebLog =
         /// The name of the web log
         name : string
 
+        /// The slug of the web log
+        slug : string
+        
         /// A subtitle for the web log
         subtitle : string option
 
@@ -323,6 +361,9 @@ type WebLog =
         
         /// Whether to automatically load htmx
         autoHtmx : bool
+        
+        /// Where uploads are placed
+        uploads : UploadDestination
     }
 
 /// Functions to support web logs
@@ -332,6 +373,7 @@ module WebLog =
     let empty =
         { id           = WebLogId.empty
           name         = ""
+          slug         = ""
           subtitle     = None
           defaultPage  = ""
           postsPerPage = 10
@@ -340,6 +382,7 @@ module WebLog =
           timeZone     = ""
           rss          = RssOptions.empty
           autoHtmx     = false
+          uploads      = Database
         }
     
     /// Get the host (including scheme) and extra path from the URL base

src/MyWebLog.Domain/SupportTypes.fs

@@ -68,6 +68,109 @@ module CommentStatus =
         | it         -> invalidOp $"{it} is not a valid post status"
 
 
+/// Valid values for the iTunes explicit rating
+type ExplicitRating =
+    | Yes
+    | No
+    | Clean
+
+/// Functions to support iTunes explicit ratings
+module ExplicitRating =
+    /// Convert an explicit rating to a string
+    let toString : ExplicitRating -> string =
+        function
+        | Yes   -> "yes"
+        | No    -> "no"
+        | Clean -> "clean"
+    
+    /// Parse a string into an explicit rating
+    let parse : string -> ExplicitRating =
+        function
+        | "yes"   -> Yes
+        | "no"    -> No
+        | "clean" -> Clean
+        | x       -> raise (invalidArg "rating" $"{x} is not a valid explicit rating")
+
+
+/// A podcast episode
+type Episode =
+    {   /// The URL to the media file for the episode (may be permalink)
+        media : string
+        
+        /// The length of the media file, in bytes
+        length : int64
+        
+        /// The duration of the episode
+        duration : TimeSpan option
+        
+        /// The media type of the file (overrides podcast default if present)
+        mediaType : string option
+        
+        /// The URL to the image file for this episode (overrides podcast image if present, may be permalink)
+        imageUrl : string option
+        
+        /// A subtitle for this episode
+        subtitle : string option
+        
+        /// This episode's explicit rating (overrides podcast rating if present)
+        explicit : ExplicitRating option
+        
+        /// A link to a chapter file
+        chapterFile : string option
+        
+        /// The MIME type for the chapter file
+        chapterType : string option
+        
+        /// The URL for the transcript of the episode (may be permalink)
+        transcriptUrl : string option
+        
+        /// The MIME type of the transcript
+        transcriptType : string option
+        
+        /// The language in which the transcript is written
+        transcriptLang : string option
+        
+        /// If true, the transcript will be declared (in the feed) to be a captions file
+        transcriptCaptions : bool option
+        
+        /// The season number (for serialized podcasts)
+        seasonNumber : int option
+        
+        /// A description of the season
+        seasonDescription : string option
+        
+        /// The episode number
+        episodeNumber : double option
+        
+        /// A description of the episode
+        episodeDescription : string option
+    }
+
+/// Functions to support episodes
+module Episode =
+    
+    /// An empty episode
+    let empty = {
+        media              = ""
+        length             = 0L
+        duration           = None
+        mediaType          = None
+        imageUrl           = None
+        subtitle           = None
+        explicit           = None
+        chapterFile        = None
+        chapterType        = None
+        transcriptUrl      = None
+        transcriptType     = None
+        transcriptLang     = None
+        transcriptCaptions = None
+        seasonNumber       = None
+        seasonDescription  = None
+        episodeNumber      = None
+        episodeDescription = None
+    }
+
+
 open Markdig
 open Markdown.ColorCode
 
@@ -171,6 +274,43 @@ module PageId =
     let create () = PageId (newId ())
 
 
+/// PodcastIndex.org podcast:medium allowed values
+type PodcastMedium =
+    | Podcast
+    | Music
+    | Video
+    | Film
+    | Audiobook
+    | Newsletter
+    | Blog
+
+/// Functions to support podcast medium
+module PodcastMedium =
+    
+    /// Convert a podcast medium to a string
+    let toString =
+        function
+        | Podcast    -> "podcast"
+        | Music      -> "music"
+        | Video      -> "video"
+        | Film       -> "film"
+        | Audiobook  -> "audiobook"
+        | Newsletter -> "newsletter"
+        | Blog       -> "blog"
+    
+    /// Parse a string into a podcast medium
+    let parse value =
+        match value with
+        | "podcast"    -> Podcast
+        | "music"      -> Music
+        | "video"      -> Video
+        | "film"       -> Film
+        | "audiobook"  -> Audiobook
+        | "newsletter" -> Newsletter
+        | "blog"       -> Blog
+        | it           -> invalidOp $"{it} is not a valid podcast medium"
+
+
 /// Statuses for posts
 type PostStatus =
     /// The post should not be publicly available
@@ -248,30 +388,6 @@ module CustomFeedSource =
         | source -> invalidArg "feedSource" $"{source} is not a valid feed source"
 
 
-/// Valid values for the iTunes explicit rating
-type ExplicitRating =
-    | Yes
-    | No
-    | Clean
-
-/// Functions to support iTunes explicit ratings
-module ExplicitRating =
-    /// Convert an explicit rating to a string
-    let toString : ExplicitRating -> string =
-        function
-        | Yes   -> "yes"
-        | No    -> "no"
-        | Clean -> "clean"
-    
-    /// Parse a string into an explicit rating
-    let parse : string -> ExplicitRating =
-        function
-        | "yes"   -> Yes
-        | "no"    -> No
-        | "clean" -> Clean
-        | x       -> raise (invalidArg "rating" $"{x} is not a valid explicit rating")
-
-
 /// Options for a feed that describes a podcast
 type PodcastOptions =
     {   /// The title of the podcast
@@ -309,6 +425,18 @@ type PodcastOptions =
         
         /// The base URL for relative URL media files for this podcast (optional; defaults to web log base)
         mediaBaseUrl : string option
+        
+        /// A GUID for this podcast
+        guid : Guid option
+        
+        /// A URL at which information on supporting the podcast may be found (supports permalinks)
+        fundingUrl : string option
+        
+        /// The text to be displayed in the funding item within the feed
+        fundingText : string option
+        
+        /// The medium (what the podcast IS, not what it is ABOUT)
+        medium : PodcastMedium option
     }
 
 
@@ -428,6 +556,41 @@ type ThemeTemplate =
     }
 
 
+/// Where uploads should be placed
+type UploadDestination =
+    | Database
+    | Disk
+
+/// Functions to support upload destinations
+module UploadDestination =
+    
+    /// Convert an upload destination to its string representation
+    let toString = function Database -> "database" | Disk -> "disk"
+    
+    /// Parse an upload destination from its string representation
+    let parse value =
+        match value with
+        | "database" -> Database
+        | "disk"     -> Disk
+        | it         -> invalidOp $"{it} is not a valid upload destination"
+
+
+/// An identifier for an upload
+type UploadId = UploadId of string
+
+/// Functions to support upload IDs
+module UploadId =
+    
+    /// An empty upload ID
+    let empty = UploadId ""
+    
+    /// Convert an upload ID to a string
+    let toString = function UploadId ui -> ui
+    
+    /// Create a new upload ID
+    let create () = UploadId (newId ())
+
+
 /// An identifier for a web log
 type WebLogId = WebLogId of string
 

src/MyWebLog.Domain/ViewModels.fs

@@ -9,7 +9,30 @@ module private Helpers =
     
     /// Create a string option if a string is blank
     let noneIfBlank (it : string) =
-        match it.Trim () with "" -> None | trimmed -> Some trimmed
+        match (defaultArg (Option.ofObj it) "").Trim () with "" -> None | trimmed -> Some trimmed
+
+
+/// The model used to display the admin dashboard
+[<NoComparison; NoEquality>]
+type DashboardModel =
+    {   /// The number of published posts
+        posts : int
+
+        /// The number of post drafts
+        drafts : int
+
+        /// The number of pages
+        pages : int
+
+        /// The number of pages in the page list
+        listedPages : int
+
+        /// The number of categories
+        categories : int
+
+        /// The top-level categories
+        topLevelCategories : int
+    }
 
 
 /// Details about a category, used to display category lists
@@ -124,27 +147,37 @@ type DisplayPage =
         }
 
 
-/// The model used to display the admin dashboard
+open System.IO
+
+/// Information about an uploaded file used for display
 [<NoComparison; NoEquality>]
-type DashboardModel =
-    {   /// The number of published posts
-        posts : int
-
-        /// The number of post drafts
-        drafts : int
-
-        /// The number of pages
-        pages : int
-
-        /// The number of pages in the page list
-        listedPages : int
-
-        /// The number of categories
-        categories : int
-
-        /// The top-level categories
-        topLevelCategories : int
+type DisplayUpload =
+    {   /// The ID of the uploaded file
+        id : string
+        
+        /// The name of the uploaded file
+        name : string
+        
+        /// The path at which the file is served
+        path : string
+        
+        /// The date/time the file was updated
+        updatedOn : DateTime option
+        
+        /// The source for this file (created from UploadDestination DU)
+        source : string
     }
+    
+    /// Create a display uploaded file
+    static member fromUpload webLog source (upload : Upload) =
+        let path = Permalink.toString upload.path
+        let name = Path.GetFileName path
+        { id        = UploadId.toString upload.id
+          name      = name
+          path      = path.Replace (name, "")
+          updatedOn = Some (WebLog.localTime webLog upload.updatedOn)
+          source    = UploadDestination.toString source
+        }
 
 
 /// View model for editing categories
@@ -229,6 +262,18 @@ type EditCustomFeedModel =
         
         /// The base URL for relative URL media files for this podcast (optional; defaults to web log base)
         mediaBaseUrl : string
+        
+        /// The URL for funding information for the podcast
+        fundingUrl : string
+        
+        /// The text for the funding link
+        fundingText : string
+        
+        /// A unique identifier to follow this podcast
+        guid : string
+        
+        /// The medium for the content of this podcast
+        medium : string
     }
     
     /// An empty custom feed model
@@ -250,6 +295,10 @@ type EditCustomFeedModel =
           explicit          = "no"
           defaultMediaType  = "audio/mpeg"
           mediaBaseUrl      = ""
+          fundingUrl        = ""
+          fundingText       = ""
+          guid              = ""
+          medium            = ""
         }
     
     /// Create a model from a custom feed
@@ -277,6 +326,12 @@ type EditCustomFeedModel =
                 explicit          = ExplicitRating.toString p.explicit
                 defaultMediaType  = defaultArg p.defaultMediaType ""
                 mediaBaseUrl      = defaultArg p.mediaBaseUrl ""
+                fundingUrl        = defaultArg p.fundingUrl ""
+                fundingText       = defaultArg p.fundingText ""
+                guid              = p.guid
+                                    |> Option.map (fun it -> it.ToString().ToLowerInvariant ())
+                                    |> Option.defaultValue ""
+                medium            = p.medium |> Option.map PodcastMedium.toString |> Option.defaultValue ""
             }
         | None -> rss
     
@@ -300,6 +355,10 @@ type EditCustomFeedModel =
                         explicit          = ExplicitRating.parse this.explicit
                         defaultMediaType  = noneIfBlank this.defaultMediaType
                         mediaBaseUrl      = noneIfBlank this.mediaBaseUrl
+                        guid              = noneIfBlank this.guid |> Option.map Guid.Parse
+                        fundingUrl        = noneIfBlank this.fundingUrl
+                        fundingText       = noneIfBlank this.fundingText
+                        medium            = noneIfBlank this.medium |> Option.map PodcastMedium.parse
                     }
                 else
                     None
@@ -402,7 +461,62 @@ type EditPostModel =
         
         /// Whether all revisions should be purged and the override date set as the updated date as well
         setUpdated : bool
+        
+        /// Whether this post has a podcast episode
+        isEpisode : bool
+        
+        /// The URL for the media for this episode (may be permalink)
+        media : string
+        
+        /// The size (in bytes) of the media for this episode
+        length : int64
+        
+        /// The duration of the media for this episode
+        duration : string
+        
+        /// The media type (optional, defaults to podcast-defined media type)
+        mediaType : string
+        
+        /// The URL for the image for this episode (may be permalink; optional, defaults to podcast image)
+        imageUrl : string
+        
+        /// A subtitle for the episode (optional)
+        subtitle : string
+        
+        /// The explicit rating for this episode (optional, defaults to podcast setting)
+        explicit : string
+        
+        /// The URL for the chapter file for the episode (may be permalink; optional)
+        chapterFile : string
+        
+        /// The type of the chapter file (optional; defaults to application/json+chapters if chapterFile is provided)
+        chapterType : string
+        
+        /// The URL for the transcript (may be permalink; optional)
+        transcriptUrl : string
+        
+        /// The MIME type for the transcript (optional, recommended if transcriptUrl is provided)
+        transcriptType : string
+        
+        /// The language of the transcript (optional)
+        transcriptLang : string
+        
+        /// Whether the provided transcript should be presented as captions
+        transcriptCaptions : bool
+        
+        /// The season number (optional)
+        seasonNumber : int
+        
+        /// A description of this season (optional, ignored if season number is not provided)
+        seasonDescription : string
+        
+        /// The episode number (decimal; optional)
+        episodeNumber : string
+        
+        /// A description of this episode (optional, ignored if episode number is not provided)
+        episodeDescription : string
     }
+    
     /// Create an edit model from an existing past
     static member fromPost webLog (post : Post) =
         let latest =
@@ -410,21 +524,93 @@ type EditPostModel =
             | Some rev -> rev
             | None -> Revision.empty
         let post = if post.metadata |> List.isEmpty then { post with metadata = [ MetaItem.empty ] } else post
-        { postId       = PostId.toString post.id
-          title        = post.title
-          permalink    = Permalink.toString post.permalink
-          source       = MarkupText.sourceType latest.text
-          text         = MarkupText.text       latest.text
-          tags         = String.Join (", ", post.tags)
-          template     = defaultArg post.template ""
-          categoryIds  = post.categoryIds |> List.map CategoryId.toString |> Array.ofList
-          status       = PostStatus.toString post.status
-          doPublish    = false
-          metaNames    = post.metadata |> List.map (fun m -> m.name)  |> Array.ofList
-          metaValues   = post.metadata |> List.map (fun m -> m.value) |> Array.ofList
-          setPublished = false
-          pubOverride  = post.publishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable
-          setUpdated   = false
+        let episode = defaultArg post.episode Episode.empty
+        { postId             = PostId.toString post.id
+          title              = post.title
+          permalink          = Permalink.toString post.permalink
+          source             = MarkupText.sourceType latest.text
+          text               = MarkupText.text       latest.text
+          tags               = String.Join (", ", post.tags)
+          template           = defaultArg post.template ""
+          categoryIds        = post.categoryIds |> List.map CategoryId.toString |> Array.ofList
+          status             = PostStatus.toString post.status
+          doPublish          = false
+          metaNames          = post.metadata |> List.map (fun m -> m.name)  |> Array.ofList
+          metaValues         = post.metadata |> List.map (fun m -> m.value) |> Array.ofList
+          setPublished       = false
+          pubOverride        = post.publishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable
+          setUpdated         = false
+          isEpisode          = Option.isSome post.episode
+          media              = episode.media
+          length             = episode.length
+          duration           = defaultArg (episode.duration |> Option.map (fun it -> it.ToString """hh\:mm\:ss""")) ""
+          mediaType          = defaultArg episode.mediaType ""
+          imageUrl           = defaultArg episode.imageUrl ""
+          subtitle           = defaultArg episode.subtitle ""
+          explicit           = defaultArg (episode.explicit |> Option.map ExplicitRating.toString) ""
+          chapterFile        = defaultArg episode.chapterFile ""
+          chapterType        = defaultArg episode.chapterType ""
+          transcriptUrl      = defaultArg episode.transcriptUrl ""
+          transcriptType     = defaultArg episode.transcriptType ""
+          transcriptLang     = defaultArg episode.transcriptLang ""
+          transcriptCaptions = defaultArg episode.transcriptCaptions false
+          seasonNumber       = defaultArg episode.seasonNumber 0
+          seasonDescription  = defaultArg episode.seasonDescription ""
+          episodeNumber      = defaultArg (episode.episodeNumber |> Option.map string) ""  
+          episodeDescription = defaultArg episode.episodeDescription ""
+        }
+    
+    /// Update a post with values from the submitted form
+    member this.updatePost (post : Post) (revision : Revision) now =
+        { post with
+            title       = this.title
+            permalink   = Permalink this.permalink
+            publishedOn = if this.doPublish then Some now else post.publishedOn
+            updatedOn   = now
+            text        = MarkupText.toHtml revision.text
+            tags        = this.tags.Split ","
+                          |> Seq.ofArray
+                          |> Seq.map (fun it -> it.Trim().ToLower ())
+                          |> Seq.filter (fun it -> it <> "")
+                          |> Seq.sort
+                          |> List.ofSeq
+            template    = match this.template.Trim () with "" -> None | tmpl -> Some tmpl
+            categoryIds = this.categoryIds |> Array.map CategoryId |> List.ofArray
+            status      = if this.doPublish then Published else post.status
+            metadata    = Seq.zip this.metaNames this.metaValues
+                          |> Seq.filter (fun it -> fst it > "")
+                          |> Seq.map (fun it -> { name = fst it; value = snd it })
+                          |> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}")
+                          |> List.ofSeq
+            revisions   = match post.revisions |> List.tryHead with
+                          | Some r when r.text = revision.text -> post.revisions
+                          | _ -> revision :: post.revisions
+            episode     =
+                if this.isEpisode then
+                    Some {
+                        media              = this.media
+                        length             = this.length
+                        duration           = noneIfBlank this.duration |> Option.map TimeSpan.Parse
+                        mediaType          = noneIfBlank this.mediaType
+                        imageUrl           = noneIfBlank this.imageUrl
+                        subtitle           = noneIfBlank this.subtitle
+                        explicit           = noneIfBlank this.explicit |> Option.map ExplicitRating.parse
+                        chapterFile        = noneIfBlank this.chapterFile
+                        chapterType        = noneIfBlank this.chapterType
+                        transcriptUrl      = noneIfBlank this.transcriptUrl
+                        transcriptType     = noneIfBlank this.transcriptType
+                        transcriptLang     = noneIfBlank this.transcriptLang
+                        transcriptCaptions = if this.transcriptCaptions then Some true else None
+                        seasonNumber       = if this.seasonNumber = 0 then None else Some this.seasonNumber
+                        seasonDescription  = noneIfBlank this.seasonDescription
+                        episodeNumber      = match noneIfBlank this.episodeNumber |> Option.map Double.Parse with
+                                             | Some it when it = 0.0 -> None
+                                             | Some it -> Some (double it)
+                                             | None -> None
+                        episodeDescription = noneIfBlank this.episodeDescription
+                    }
+                else
+                    None
         }
 
 
@@ -613,6 +799,9 @@ type PostListItem =
         /// Tags for the post
         tags : string list
         
+        /// The podcast episode information for this post
+        episode : Episode option
+        
         /// Metadata for the post
         metadata : MetaItem list
     }
@@ -631,6 +820,7 @@ type PostListItem =
           text        = if extra = "" then post.text else post.text.Replace ("href=\"/", $"href=\"{extra}/")
           categoryIds = post.categoryIds |> List.map CategoryId.toString
           tags        = post.tags
+          episode     = post.episode
           metadata    = post.metadata
         }
 
@@ -666,6 +856,9 @@ type SettingsModel =
     {   /// The name of the web log
         name : string
 
+        /// The slug of the web log
+        slug : string
+        
         /// The subtitle of the web log
         subtitle : string
 
@@ -683,32 +876,48 @@ type SettingsModel =
         
         /// Whether to automatically load htmx
         autoHtmx : bool
+        
+        /// The default location for uploads
+        uploads : string
     }
     
     /// Create a settings model from a web log
     static member fromWebLog (webLog : WebLog) =
         { name         = webLog.name
+          slug         = webLog.slug
           subtitle     = defaultArg webLog.subtitle ""
           defaultPage  = webLog.defaultPage
           postsPerPage = webLog.postsPerPage
           timeZone     = webLog.timeZone
           themePath    = webLog.themePath
           autoHtmx     = webLog.autoHtmx
+          uploads      = UploadDestination.toString webLog.uploads
         }
     
     /// Update a web log with settings from the form
     member this.update (webLog : WebLog) =
         { webLog with
             name         = this.name
+            slug         = this.slug
             subtitle     = if this.subtitle = "" then None else Some this.subtitle
             defaultPage  = this.defaultPage
             postsPerPage = this.postsPerPage
             timeZone     = this.timeZone
             themePath    = this.themePath
             autoHtmx     = this.autoHtmx
+            uploads      = UploadDestination.parse this.uploads
         }
 
 
+/// View model for uploading a file
+[<CLIMutable; NoComparison; NoEquality>]
+type UploadFileModel =
+    {   /// The upload destination
+        destination : string
+    }
+
+
+/// A message displayed to the user
 [<CLIMutable; NoComparison; NoEquality>]
 type UserMessage =
     {   /// The level of the message

src/MyWebLog/DotLiquidBespoke.fs

@@ -223,15 +223,16 @@ let register () =
     Template.RegisterTag<UserLinksTag> "user_links"
     
     [   // Domain types
-        typeof<CustomFeed>; typeof<MetaItem>; typeof<Page>; typeof<RssOptions>; typeof<TagMap>; typeof<WebLog>
+        typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>;    typeof<MetaItem>; typeof<Page>
+        typeof<RssOptions>; typeof<TagMap>;  typeof<UploadDestination>; typeof<WebLog>
         // View models
-        typeof<DashboardModel>;        typeof<DisplayCategory>;     typeof<DisplayCustomFeed>; typeof<DisplayPage>
-        typeof<EditCategoryModel>;     typeof<EditCustomFeedModel>; typeof<EditPageModel>;     typeof<EditPostModel>
-        typeof<EditRssModel>;          typeof<EditTagMapModel>;     typeof<EditUserModel>;     typeof<LogOnModel>
-        typeof<ManagePermalinksModel>; typeof<PostDisplay>;         typeof<PostListItem>;      typeof<SettingsModel>
-        typeof<UserMessage>
+        typeof<DashboardModel>; typeof<DisplayCategory>;       typeof<DisplayCustomFeed>;   typeof<DisplayPage>
+        typeof<DisplayUpload>;  typeof<EditCategoryModel>;     typeof<EditCustomFeedModel>; typeof<EditPageModel>
+        typeof<EditPostModel>;  typeof<EditRssModel>;          typeof<EditTagMapModel>;     typeof<EditUserModel>
+        typeof<LogOnModel>;     typeof<ManagePermalinksModel>; typeof<PostDisplay>;         typeof<PostListItem>
+        typeof<SettingsModel>;  typeof<UserMessage>
         // Framework types
-        typeof<AntiforgeryTokenSet>; typeof<int option>;    typeof<KeyValuePair>; typeof<MetaItem list>
-        typeof<string list>;         typeof<string option>; typeof<TagMap list>
+        typeof<AntiforgeryTokenSet>; typeof<DateTime option>; typeof<int option>;    typeof<KeyValuePair>
+        typeof<MetaItem list>;       typeof<string list>;     typeof<string option>; typeof<TagMap list>
     ]
     |> List.iter (fun it -> Template.RegisterSafeType (it, [| "*" |]))

src/MyWebLog/Handlers/Admin.fs

@@ -440,6 +440,7 @@ let updateTheme : HttpHandler = fun next ctx -> task {
             do! themeFile.CopyToAsync stream
             do! loadThemeFromZip themeName stream true data
             do! ThemeAssetCache.refreshTheme (ThemeId themeName) data
+            TemplateCache.invalidateTheme themeName
             do! addMessage ctx { UserMessage.success with message = "Theme updated successfully" }
             return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/dashboard")) next ctx
         | Ok _ ->
@@ -474,11 +475,15 @@ let settings : HttpHandler = fun next ctx -> task {
                            |> List.map (fun p -> KeyValuePair.Create (PageId.toString p.id, p.title))
                 }
                 |> Array.ofSeq
-            themes     = themes
-                         |> Seq.ofList
-                         |> Seq.map (fun it ->
-                             KeyValuePair.Create (ThemeId.toString it.id, $"{it.name} (v{it.version})"))
-                         |> Array.ofSeq
+            themes =
+                themes
+                 |> Seq.ofList
+                 |> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.id, $"{it.name} (v{it.version})"))
+                 |> Array.ofSeq
+            upload_values =
+                [|  KeyValuePair.Create (UploadDestination.toString Database, "Database")
+                    KeyValuePair.Create (UploadDestination.toString Disk,     "Disk")
+                |]
             web_log    = webLog
             page_title = "Web Log Settings"
         |}
@@ -492,11 +497,18 @@ let saveSettings : HttpHandler = fun next ctx -> task {
     let! model  = ctx.BindFormAsync<SettingsModel> ()
     match! data.WebLog.findById webLog.id with
     | Some webLog ->
-        let webLog = model.update webLog
+        let oldSlug = webLog.slug
+        let webLog  = model.update webLog
         do! data.WebLog.updateSettings webLog
 
         // Update cache
         WebLogCache.set webLog
+        
+        if oldSlug <> webLog.slug then
+            // Rename disk directory if it exists
+            let uploadRoot = Path.Combine ("wwwroot", "upload")
+            let oldDir     = Path.Combine (uploadRoot, oldSlug)
+            if Directory.Exists oldDir then Directory.Move (oldDir, Path.Combine (uploadRoot, webLog.slug))
     
         do! addMessage ctx { UserMessage.success with message = "Web log settings saved successfully" }
         return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings")) next ctx

src/MyWebLog/Handlers/Feed.fs

@@ -2,6 +2,7 @@
 module MyWebLog.Handlers.Feed
 
 open System
+open System.Collections.Generic
 open System.IO
 open System.Net
 open System.ServiceModel.Syndication
@@ -76,6 +77,9 @@ module private Namespace =
     /// iTunes elements
     let iTunes = "http://www.itunes.com/dtds/podcast-1.0.dtd"
 
+    /// Podcast Index (AKA "podcasting 2.0")
+    let podcast = "https://podcastindex.org/namespace/1.0"
+    
     /// Enables chapters
     let psc = "http://podlove.org/simple-chapters/"
 
@@ -126,37 +130,26 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[
     |> List.iter item.Categories.Add
     item
 
+/// Convert non-absolute URLs to an absolute URL for this web log
+let toAbsolute webLog (link : string) =
+    if link.StartsWith "http" then link else WebLog.absoluteUrl webLog (Permalink link)
+
 /// Add episode information to a podcast feed item
-let private addEpisode webLog (feed : CustomFeed) (post : Post) (item : SyndicationItem) =
-    let podcast = Option.get feed.podcast
-    let meta name = post.metadata |> List.tryFind (fun it -> it.name = name)
-    let value (item : MetaItem) = item.value
+let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (post : Post) (item : SyndicationItem) =
     let epMediaUrl =
-        match (meta >> Option.get >> value) "episode_media_file" with
+        match episode.media with
         | link when link.StartsWith "http" -> link
         | link when Option.isSome podcast.mediaBaseUrl -> $"{podcast.mediaBaseUrl.Value}{link}"
         | link -> WebLog.absoluteUrl webLog (Permalink link)
-    let epMediaType =
-        match meta "episode_media_type", podcast.defaultMediaType with
-        | Some epType, _ -> Some epType.value
-        | None, Some defType -> Some defType
-        | _ -> None
-    let epImageUrl =
-        match defaultArg ((meta >> Option.map value) "episode_image") (Permalink.toString podcast.imageUrl) with
-        | link when link.StartsWith "http" -> link
-        | link -> WebLog.absoluteUrl webLog (Permalink link)
-    let epExplicit =
-        try
-            (meta >> Option.map (value >> ExplicitRating.parse)) "episode_explicit"
-            |> Option.defaultValue podcast.explicit
-            |> ExplicitRating.toString
-        with :? ArgumentException -> ExplicitRating.toString podcast.explicit
+    let epMediaType = [ episode.mediaType; podcast.defaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
+    let epImageUrl = defaultArg episode.imageUrl (Permalink.toString podcast.imageUrl) |> toAbsolute webLog
+    let epExplicit = defaultArg episode.explicit podcast.explicit |> ExplicitRating.toString
     
     let xmlDoc    = XmlDocument ()
     let enclosure =
         let it = xmlDoc.CreateElement "enclosure"
         it.SetAttribute ("url", epMediaUrl)
-        meta "episode_media_length" |> Option.iter (fun len -> it.SetAttribute ("length", len.value))
+        it.SetAttribute ("length", string episode.length)
         epMediaType |> Option.iter (fun typ -> it.SetAttribute ("type", typ))
         it
     let image =
@@ -169,10 +162,57 @@ let private addEpisode webLog (feed : CustomFeed) (post : Post) (item : Syndicat
     item.ElementExtensions.Add ("creator",  Namespace.dc,     podcast.displayedAuthor)
     item.ElementExtensions.Add ("author",   Namespace.iTunes, podcast.displayedAuthor)
     item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit)
-    meta "episode_subtitle"
-    |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it.value))
-    meta "episode_duration"
-    |> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.value))
+    episode.subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it))
+    episode.duration
+    |> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.ToString """hh\:mm\:ss"""))
+    
+    match episode.chapterFile with
+    | Some chapters ->
+        let url = toAbsolute webLog chapters
+        let typ =
+            match episode.chapterType with
+            | Some mime -> Some mime
+            | None when chapters.EndsWith ".json" -> Some "application/json+chapters"
+            | None -> None
+        let elt = xmlDoc.CreateElement ("podcast", "chapters", Namespace.podcast)
+        elt.SetAttribute ("url", url)
+        typ |> Option.iter (fun it -> elt.SetAttribute ("type", it))
+        item.ElementExtensions.Add elt
+    | None -> ()
+    
+    match episode.transcriptUrl with
+    | Some transcript ->
+        let url = toAbsolute webLog transcript
+        let elt = xmlDoc.CreateElement ("podcast", "transcript", Namespace.podcast)
+        elt.SetAttribute ("url", url)
+        elt.SetAttribute ("type", Option.get episode.transcriptType)
+        episode.transcriptLang |> Option.iter (fun it -> elt.SetAttribute ("language", it))
+        if defaultArg episode.transcriptCaptions false then
+            elt.SetAttribute ("rel", "captions")
+        item.ElementExtensions.Add elt
+    | None -> ()
+    
+    match episode.seasonNumber with
+    | Some season ->
+        match episode.seasonDescription with
+        | Some desc ->
+            let elt = xmlDoc.CreateElement ("podcast", "season", Namespace.podcast)
+            elt.SetAttribute ("name", desc)
+            elt.InnerText <- string season
+            item.ElementExtensions.Add elt
+        | None -> item.ElementExtensions.Add ("season", Namespace.podcast, string season)
+    | None -> ()
+    
+    match episode.episodeNumber with
+    | Some epNumber ->
+        match episode.episodeDescription with
+        | Some desc ->
+            let elt = xmlDoc.CreateElement ("podcast", "episode", Namespace.podcast)
+            elt.SetAttribute ("name", desc)
+            elt.InnerText <- string epNumber
+            item.ElementExtensions.Add elt
+        | None -> item.ElementExtensions.Add ("episode", Namespace.podcast, string epNumber)
+    | None -> ()
     
     if post.metadata |> List.exists (fun it -> it.name = "chapter") then
         try
@@ -216,7 +256,12 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
     
     let xmlDoc = XmlDocument ()
     
-    [ "dc", Namespace.dc; "itunes", Namespace.iTunes; "psc", Namespace.psc; "rawvoice", Namespace.rawVoice ]
+    [ "dc",       Namespace.dc
+      "itunes",   Namespace.iTunes
+      "podcast",  Namespace.podcast
+      "psc",      Namespace.psc
+      "rawvoice", Namespace.rawVoice
+    ]
     |> List.iter (fun (alias, nsUrl) -> addNamespace rssFeed alias nsUrl)
     
     let categorization =
@@ -259,6 +304,17 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
     rssFeed.ElementExtensions.Add ("author",    Namespace.iTunes,   podcast.displayedAuthor)
     rssFeed.ElementExtensions.Add ("explicit",  Namespace.iTunes,   ExplicitRating.toString podcast.explicit)
     podcast.subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub))
+    podcast.fundingUrl
+    |> Option.iter (fun url ->
+        let funding = xmlDoc.CreateElement ("podcast", "funding", Namespace.podcast)
+        funding.SetAttribute ("url", toAbsolute webLog url)
+        funding.InnerText <- defaultArg podcast.fundingText "Support This Podcast"
+        rssFeed.ElementExtensions.Add funding)
+    podcast.guid
+    |> Option.iter (fun guid ->
+        rssFeed.ElementExtensions.Add ("guid", Namespace.podcast, guid.ToString().ToLowerInvariant ()))
+    podcast.medium
+    |> Option.iter (fun med -> rssFeed.ElementExtensions.Add ("medium", Namespace.podcast, PodcastMedium.toString med))
 
 /// Get the feed's self reference and non-feed link
 let private selfAndLink webLog feedType ctx =
@@ -314,10 +370,9 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
     
     let toItem post =
         let item = toFeedItem webLog authors cats tagMaps post
-        match podcast with
-        | Some feed when post.metadata |> List.exists (fun it -> it.name = "episode_media_file") ->
-            addEpisode webLog feed post item
-        | Some _ ->
+        match podcast, post.episode with
+        | Some feed, Some episode -> addEpisode webLog (Option.get feed.podcast) episode post item
+        | Some _, _ ->
             warn "Feed" ctx $"[{webLog.name} {Permalink.toString self}] \"{stripHtml post.title}\" has no media"
             item
         | _ -> item
@@ -361,7 +416,7 @@ let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> bac
 
 open DotLiquid
 
-// GET: /admin/rss/settings
+// GET: /admin/settings/rss
 let editSettings : HttpHandler = fun next ctx -> task {
     let webLog = ctx.WebLog
     let feeds =
@@ -377,7 +432,7 @@ let editSettings : HttpHandler = fun next ctx -> task {
         |> viewForTheme "admin" "rss-settings" next ctx
 }
 
-// POST: /admin/rss/settings
+// POST: /admin/settings/rss
 let saveSettings : HttpHandler = fun next ctx -> task {
     let  data  = ctx.Data
     let! model = ctx.BindFormAsync<EditRssModel> ()
@@ -391,7 +446,7 @@ let saveSettings : HttpHandler = fun next ctx -> task {
     | None -> return! Error.notFound next ctx
 }
 
-// GET: /admin/rss/{id}/edit
+// GET: /admin/settings/rss/{id}/edit
 let editCustomFeed feedId : HttpHandler = fun next ctx -> task {
     let customFeed =
         match feedId with
@@ -400,16 +455,26 @@ let editCustomFeed feedId : HttpHandler = fun next ctx -> task {
     match customFeed with
     | Some f ->
         return! Hash.FromAnonymousObject
-            {|  csrf       = csrfToken ctx
-                page_title = $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
-                model      = EditCustomFeedModel.fromFeed f
-                categories = CategoryCache.get ctx
+            {|  csrf          = csrfToken ctx
+                page_title    = $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
+                model         = EditCustomFeedModel.fromFeed f
+                categories    = CategoryCache.get ctx
+                medium_values = [|
+                    KeyValuePair.Create ("", "&ndash; Unspecified &ndash;")
+                    KeyValuePair.Create (PodcastMedium.toString Podcast, "Podcast")
+                    KeyValuePair.Create (PodcastMedium.toString Music, "Music")
+                    KeyValuePair.Create (PodcastMedium.toString Video, "Video")
+                    KeyValuePair.Create (PodcastMedium.toString Film, "Film")
+                    KeyValuePair.Create (PodcastMedium.toString Audiobook, "Audiobook")
+                    KeyValuePair.Create (PodcastMedium.toString Newsletter, "Newsletter")
+                    KeyValuePair.Create (PodcastMedium.toString Blog, "Blog")
+                |]
             |}
             |> viewForTheme "admin" "custom-feed-edit" next ctx
     | None -> return! Error.notFound next ctx
 }
 
-// POST: /admin/rss/save
+// POST: /admin/settings/rss/save
 let saveCustomFeed : HttpHandler = fun next ctx -> task {
     let data = ctx.Data
     match! data.WebLog.findById ctx.WebLog.id with
@@ -435,7 +500,7 @@ let saveCustomFeed : HttpHandler = fun next ctx -> task {
     | None -> return! Error.notFound next ctx
 }
 
-// POST /admin/rss/{id}/delete
+// POST /admin/settings/rss/{id}/delete
 let deleteCustomFeed feedId : HttpHandler = fun next ctx -> task {
     let data = ctx.Data
     match! data.WebLog.findById ctx.WebLog.id with

src/MyWebLog/Handlers/Post.fs

@@ -2,6 +2,7 @@
 module MyWebLog.Handlers.Post
 
 open System
+open System.Collections.Generic
 open MyWebLog
 
 /// Parse a slug and page number from an "everything else" URL
@@ -237,13 +238,19 @@ let edit postId : HttpHandler = fun next ctx -> task {
         let  model     = EditPostModel.fromPost webLog post
         return!
             Hash.FromAnonymousObject {|
-                csrf       = csrfToken ctx
-                model      = model
-                metadata   = Array.zip model.metaNames model.metaValues
-                             |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
-                page_title = title
-                templates  = templates
-                categories = cats
+                csrf            = csrfToken ctx
+                model           = model
+                metadata        = Array.zip model.metaNames model.metaValues
+                                  |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
+                page_title      = title
+                templates       = templates
+                categories      = cats
+                explicit_values = [|
+                    KeyValuePair.Create ("", "– Default –")
+                    KeyValuePair.Create (ExplicitRating.toString Yes,   "Yes")
+                    KeyValuePair.Create (ExplicitRating.toString No,    "No")
+                    KeyValuePair.Create (ExplicitRating.toString Clean, "Clean")
+                |]
             |}
             |> viewForTheme "admin" "post-edit" next ctx
     | None -> return! Error.notFound next ctx
@@ -312,31 +319,7 @@ let save : HttpHandler = fun next ctx -> task {
             | "" -> post
             | link when link = model.permalink -> post
             | _ -> { post with priorPermalinks = post.permalink :: post.priorPermalinks }
-        let post =
-            { post with
-                title       = model.title
-                permalink   = Permalink model.permalink
-                publishedOn = if model.doPublish then Some now else post.publishedOn
-                updatedOn   = now
-                text        = MarkupText.toHtml revision.text
-                tags        = model.tags.Split ","
-                              |> Seq.ofArray
-                              |> Seq.map (fun it -> it.Trim().ToLower ())
-                              |> Seq.filter (fun it -> it <> "")
-                              |> Seq.sort
-                              |> List.ofSeq
-                template    = match model.template.Trim () with "" -> None | tmpl -> Some tmpl
-                categoryIds = model.categoryIds |> Array.map CategoryId |> List.ofArray
-                status      = if model.doPublish then Published else post.status
-                metadata    = Seq.zip model.metaNames model.metaValues
-                              |> Seq.filter (fun it -> fst it > "")
-                              |> Seq.map (fun it -> { name = fst it; value = snd it })
-                              |> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}")
-                              |> List.ofSeq
-                revisions   = match post.revisions |> List.tryHead with
-                              | Some r when r.text = revision.text -> post.revisions
-                              | _ -> revision :: post.revisions
-            }
+        let post = model.updatePost post revision now
         let post =
             match model.setPublished with
             | true ->

src/MyWebLog/Handlers/Routes.fs

@@ -93,55 +93,25 @@ module CatchAll =
 /// Serve theme assets
 module Asset =
     
-    open System
-    open Microsoft.AspNetCore.Http.Headers
-    open Microsoft.AspNetCore.StaticFiles
-    open Microsoft.Net.Http.Headers
-    
-    /// Determine if the asset has been modified since the date/time specified by the If-Modified-Since header
-    let private checkModified asset (ctx : HttpContext) : HttpHandler option =
-        match ctx.Request.Headers.IfModifiedSince with
-        | it when it.Count < 1 -> None
-        | it ->
-            if asset.updatedOn > DateTime.Parse it[0] then
-                None
-            else
-                Some (setStatusCode 304 >=> setBodyFromString "Not Modified")
-    
-    /// An instance of ASP.NET Core's file extension to MIME type converter
-    let private mimeMap = FileExtensionContentTypeProvider ()
-    
     // GET /theme/{theme}/{**path}
-    let serveAsset (urlParts : string seq) : HttpHandler = fun next ctx -> task {
+    let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
         let path = urlParts |> Seq.skip 1 |> Seq.head
         match! ctx.Data.ThemeAsset.findById (ThemeAssetId.ofString path) with
         | Some asset ->
-            match checkModified asset ctx with
+            match Upload.checkModified asset.updatedOn ctx with
             | Some threeOhFour -> return! threeOhFour next ctx
-            | None ->
-                let mimeType =
-                    match mimeMap.TryGetContentType path with
-                    | true,  typ -> typ
-                    | false, _   -> "application/octet-stream"
-                let headers = ResponseHeaders ctx.Response.Headers
-                headers.LastModified <- Some (DateTimeOffset asset.updatedOn) |> Option.toNullable
-                headers.ContentType  <- MediaTypeHeaderValue mimeType
-                headers.CacheControl <-
-                    let hdr = CacheControlHeaderValue()
-                    hdr.MaxAge <- Some (TimeSpan.FromDays 30) |> Option.toNullable
-                    hdr
-                return! setBody asset.data next ctx
+            | None -> return! Upload.sendFile asset.updatedOn path asset.data next ctx
         | None -> return! Error.notFound next ctx
     }
 
 
 /// The primary myWebLog router
 let router : HttpHandler = choose [
-    GET >=> choose [
+    GET_HEAD >=> choose [
         route "/" >=> Post.home
     ]
     subRoute "/admin" (requireUser >=> choose [
-        GET >=> choose [
+        GET_HEAD >=> choose [
             subRoute "/categor" (choose [
                 route  "ies"       >=> Admin.listCategories
                 route  "ies/bare"  >=> Admin.listCategoriesBare
@@ -173,6 +143,10 @@ let router : HttpHandler = choose [
                 ])
             ])
             route    "/theme/update" >=> Admin.themeUpdatePage
+            subRoute "/upload" (choose [
+                route "s"    >=> Upload.list
+                route "/new" >=> Upload.showNew
+            ])
             route    "/user/edit"    >=> User.edit
         ]
         POST >=> validateCsrf >=> choose [
@@ -203,6 +177,11 @@ let router : HttpHandler = choose [
                 ])
             ])
             route    "/theme/update" >=> Admin.updateTheme
+            subRoute "/upload" (choose [
+                route   "/save"        >=> Upload.save
+                routexp "/delete/(.*)"     Upload.deleteFromDisk
+                routef  "/%s/delete"       Upload.deleteFromDb
+            ])
             route    "/user/save"    >=> User.save
         ]
     ])
@@ -210,7 +189,8 @@ let router : HttpHandler = choose [
     GET_HEAD >=> routef  "/page/%i"        Post.pageOfPosts
     GET_HEAD >=> routef  "/page/%i/"       Post.redirectToPageOfPosts       
     GET_HEAD >=> routexp "/tag/(.*)"       Post.pageOfTaggedPosts
-    GET_HEAD >=> routexp "/themes/(.*)"    Asset.serveAsset
+    GET_HEAD >=> routexp "/themes/(.*)"    Asset.serve
+    GET_HEAD >=> routexp "/upload/(.*)"    Upload.serve
     subRoute "/user" (choose [
         GET_HEAD >=> choose [
             route "/log-on"  >=> User.logOn None

src/MyWebLog/Handlers/Upload.fs

@@ -0,0 +1,215 @@
+/// Handlers to manipulate uploaded files
+module MyWebLog.Handlers.Upload
+
+open System
+open System.IO
+open Giraffe
+open Microsoft.AspNetCore.Http
+open Microsoft.Net.Http.Headers
+open MyWebLog
+
+/// Helper functions for this module
+[<AutoOpen>]
+module private Helpers =
+    
+    open Microsoft.AspNetCore.StaticFiles
+    
+    /// A MIME type mapper instance to use when serving files from the database
+    let mimeMap = FileExtensionContentTypeProvider ()
+
+    /// A cache control header that instructs the browser to cache the result for no more than 30 days
+    let cacheForThirtyDays =
+        let hdr = CacheControlHeaderValue()
+        hdr.MaxAge <- Some (TimeSpan.FromDays 30) |> Option.toNullable
+        hdr
+    
+    /// Shorthand for the directory separator
+    let slash = Path.DirectorySeparatorChar
+    
+    /// The base directory where uploads are stored, relative to the executable
+    let uploadDir = Path.Combine ("wwwroot", "upload")
+
+
+/// 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 =
+    match ctx.Request.Headers.IfModifiedSince with
+    | it when it.Count < 1 -> None
+    | it when since > DateTime.Parse it[0] -> None
+    | _ -> Some (setStatusCode 304 >=> setBodyFromString "Not Modified")
+
+
+open Microsoft.AspNetCore.Http.Headers
+
+/// Derive a MIME type based on the extension of the file
+let deriveMimeType path =
+    match mimeMap.TryGetContentType path with true, typ -> typ | false, _ -> "application/octet-stream"
+
+/// Send a file, caching the response for 30 days
+let sendFile updatedOn path (data : byte[]) : HttpHandler = fun next ctx -> task {
+    let headers = ResponseHeaders ctx.Response.Headers
+    headers.ContentType  <- (deriveMimeType >> MediaTypeHeaderValue) path
+    headers.CacheControl <- cacheForThirtyDays
+    let stream = new MemoryStream (data)
+    return! streamData true stream None (Some (DateTimeOffset updatedOn)) next ctx
+}
+
+// GET /upload/{web-log-slug}/{**path}
+let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
+    let webLog = ctx.WebLog
+    let parts  = (urlParts |> Seq.skip 1 |> Seq.head).Split '/'
+    let slug   = Array.head parts
+    if slug = webLog.slug then
+        // Static file middleware will not work in subdirectories; check for an actual file first
+        let fileName = Path.Combine ("wwwroot", (Seq.head urlParts)[1..])
+        if File.Exists fileName then
+            return! streamFile true fileName None None next ctx
+        else
+            let path = String.Join ('/', Array.skip 1 parts)
+            match! ctx.Data.Upload.findByPath path webLog.id with
+            | Some upload ->
+                match checkModified upload.updatedOn ctx with
+                | Some threeOhFour -> return! threeOhFour next ctx
+                | None -> return! sendFile upload.updatedOn path upload.data next ctx
+            | None -> return! Error.notFound next ctx
+    else
+        return! Error.notFound next ctx
+}
+
+// ADMIN
+
+open System.Text.RegularExpressions
+open DotLiquid
+open MyWebLog.ViewModels
+
+/// Turn a string into a lowercase URL-safe slug
+let makeSlug it = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 ]").Replace (it, ""), "-")).ToLowerInvariant ()
+
+// GET /admin/uploads
+let list : HttpHandler = fun next ctx -> task {
+    let  webLog      = ctx.WebLog
+    let! dbUploads   = ctx.Data.Upload.findByWebLog webLog.id
+    let  diskUploads =
+        let path = Path.Combine (uploadDir, webLog.slug)
+        try
+            Directory.EnumerateFiles (path, "*", SearchOption.AllDirectories)
+            |> Seq.map (fun file ->
+                let name = Path.GetFileName file
+                let create =
+                    match File.GetCreationTime (Path.Combine (path, file)) with
+                    | dt when dt > DateTime.UnixEpoch -> Some dt
+                    | _ -> None
+                { DisplayUpload.id = ""
+                  name             = name
+                  path             = file.Replace($"{path}{slash}", "").Replace(name, "").Replace (slash, '/')
+                  updatedOn        = create
+                  source           = UploadDestination.toString Disk
+                })
+            |> List.ofSeq
+        with
+        | :? DirectoryNotFoundException -> [] // This is fine
+        | ex ->
+            warn "Upload" ctx $"Encountered {ex.GetType().Name} listing uploads for {path}:\n{ex.Message}"
+            []
+    let allFiles =
+        dbUploads
+        |> List.map (DisplayUpload.fromUpload webLog Database)
+        |> List.append diskUploads
+        |> List.sortByDescending (fun file -> file.updatedOn, file.path)
+
+    return!
+        Hash.FromAnonymousObject {|
+            csrf       = csrfToken ctx
+            page_title = "Uploaded Files"
+            files      = allFiles
+        |}
+        |> viewForTheme "admin" "upload-list" next ctx
+    }
+
+// GET /admin/upload/new
+let showNew : HttpHandler = fun next ctx -> task {
+    return!
+        Hash.FromAnonymousObject {|
+            csrf        = csrfToken ctx
+            destination = UploadDestination.toString ctx.WebLog.uploads
+            page_title  = "Upload a File"
+        |}
+        |> viewForTheme "admin" "upload-new" next ctx
+}
+
+/// Redirect to the upload list
+let showUploads : HttpHandler = fun next ctx -> task {
+    return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/uploads")) next ctx
+}
+
+// POST /admin/upload/save
+let save : HttpHandler = fun next ctx -> task {
+    if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
+        let upload    = Seq.head ctx.Request.Form.Files
+        let fileName  = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
+                                       Path.GetExtension(upload.FileName).ToLowerInvariant ())
+        let  webLog   = ctx.WebLog
+        let  localNow = WebLog.localTime webLog DateTime.Now
+        let  year     = localNow.ToString "yyyy"
+        let  month    = localNow.ToString "MM"
+        let! form     = ctx.BindFormAsync<UploadFileModel> ()
+        
+        match UploadDestination.parse form.destination with
+        | Database ->
+            use stream = new MemoryStream ()
+            do! upload.CopyToAsync stream
+            let file =
+                { id        = UploadId.create ()
+                  webLogId  = webLog.id
+                  path      = Permalink $"{year}/{month}/{fileName}"
+                  updatedOn = DateTime.UtcNow
+                  data      = stream.ToArray ()
+                }
+            do! ctx.Data.Upload.add file
+        | Disk ->
+            let fullPath = Path.Combine (uploadDir, webLog.slug, year, month)
+            let _        = Directory.CreateDirectory fullPath
+            use stream   = new FileStream (Path.Combine (fullPath, fileName), FileMode.Create)
+            do! upload.CopyToAsync stream
+        
+        do! addMessage ctx { UserMessage.success with message = $"File uploaded to {form.destination} successfully" }
+        return! showUploads next ctx
+    else
+        return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx
+}
+
+// POST /admin/upload/{id}/delete
+let deleteFromDb upId : HttpHandler = fun next ctx -> task {
+    let uploadId = UploadId upId
+    let webLog   = ctx.WebLog
+    let data     = ctx.Data
+    match! data.Upload.delete uploadId webLog.id with
+    | Ok fileName ->
+        do! addMessage ctx { UserMessage.success with message = $"{fileName} deleted successfully" }
+        return! showUploads next ctx
+    | Error _ -> return! Error.notFound next ctx
+}
+
+/// Remove a directory tree if it is empty
+let removeEmptyDirectories (webLog : WebLog) (filePath : string) =
+    let mutable path     = Path.GetDirectoryName filePath
+    let mutable finished = false
+    while (not finished) && path > "" do
+        let fullPath = Path.Combine (uploadDir, webLog.slug, path)
+        if Directory.EnumerateFileSystemEntries fullPath |> Seq.isEmpty then
+            Directory.Delete fullPath
+            path <- String.Join(slash, path.Split slash |> Array.rev |> Array.skip 1 |> Array.rev)
+        else
+            finished <- true
+    
+// POST /admin/upload/delete/{**path}
+let deleteFromDisk urlParts : HttpHandler = fun next ctx -> task {
+    let filePath = urlParts |> Seq.skip 1 |> Seq.head
+    let path = Path.Combine (uploadDir, ctx.WebLog.slug, filePath)
+    if File.Exists path then
+        File.Delete path
+        removeEmptyDirectories ctx.WebLog filePath
+        do! addMessage ctx { UserMessage.success with message = $"{filePath} deleted successfully" }
+        return! showUploads next ctx
+    else
+        return! Error.notFound next ctx
+}

src/MyWebLog/Maintenance.fs

@@ -23,11 +23,13 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
     let webLogId   = WebLogId.create ()
     let userId     = WebLogUserId.create ()
     let homePageId = PageId.create ()
+    let slug       = Handlers.Upload.makeSlug args[2]
     
     do! data.WebLog.add
             { WebLog.empty with
                 id          = webLogId
                 name        = args[2]
+                slug        = slug
                 urlBase     = args[1]
                 defaultPage = PageId.toString homePageId
                 timeZone    = timeZone
@@ -162,13 +164,48 @@ module Backup =
             }
     
         /// Create a theme asset from an encoded theme asset
-        static member fromAsset (asset : EncodedAsset) : ThemeAsset =
-            { id        = asset.id
-              updatedOn = asset.updatedOn
-              data      = Convert.FromBase64String asset.data
+        static member fromEncoded (encoded : EncodedAsset) : ThemeAsset =
+            { id        = encoded.id
+              updatedOn = encoded.updatedOn
+              data      = Convert.FromBase64String encoded.data
             }
     
+    /// An uploaded file, with the data base-64 encoded
+    type EncodedUpload =
+        {   /// The ID of the upload
+            id : UploadId
+            
+            /// The ID of the web log to which the upload belongs
+            webLogId : WebLogId
+            
+            /// The path at which this upload is served
+            path : Permalink
+            
+            /// The date/time this upload was last updated (file time)
+            updatedOn : DateTime
+            
+            /// The data for the upload, base-64 encoded
+            data : string
+        }
         
+        /// Create an encoded uploaded file from the original uploaded file
+        static member fromUpload (upload : Upload) : EncodedUpload =
+            { id        = upload.id
+              webLogId  = upload.webLogId
+              path      = upload.path
+              updatedOn = upload.updatedOn
+              data      = Convert.ToBase64String upload.data
+            }
+        
+        /// Create an uploaded file from an encoded uploaded file
+        static member fromEncoded (encoded : EncodedUpload) : Upload =
+            { id        = encoded.id
+              webLogId  = encoded.webLogId
+              path      = encoded.path
+              updatedOn = encoded.updatedOn
+              data      = Convert.FromBase64String encoded.data
+            }
+    
     /// A unified archive for a web log
     type Archive =
         {   /// The web log to which this archive belongs
@@ -194,6 +231,9 @@ module Backup =
             
             /// The posts for this web log (containing only the most recent revision)
             posts : Post list
+            
+            /// The uploaded files for this web log
+            uploads : EncodedUpload list
         }
     
     /// Create a JSON serializer (uses RethinkDB data implementation's JSON converters)
@@ -212,19 +252,21 @@ module Backup =
         let tagMapCount   = List.length archive.tagMappings
         let pageCount     = List.length archive.pages
         let postCount     = List.length archive.posts
+        let uploadCount   = List.length archive.uploads
         
         // Create a pluralized output based on the count
         let plural count ifOne ifMany =
             if count = 1 then ifOne else ifMany
             
         printfn ""
-        printfn $"""{msg.Replace ("{{NAME}}", webLog.name)}"""
+        printfn $"""{msg.Replace ("<>NAME<>", webLog.name)}"""
         printfn $""" - The theme "{archive.theme.name}" with {assetCount} asset{plural assetCount "" "s"}"""
         printfn $""" - {userCount} user{plural userCount "" "s"}"""
         printfn $""" - {categoryCount} categor{plural categoryCount "y" "ies"}"""
         printfn $""" - {tagMapCount} tag mapping{plural tagMapCount "" "s"}"""
         printfn $""" - {pageCount} page{plural pageCount "" "s"}"""
         printfn $""" - {postCount} post{plural postCount "" "s"}"""
+        printfn $""" - {uploadCount} uploaded file{plural uploadCount "" "s"}"""
 
     /// Create a backup archive
     let private createBackup webLog (fileName : string) prettyOutput (data : IData) = task {
@@ -248,6 +290,9 @@ module Backup =
         printfn "- Exporting posts..."
         let! posts = data.Post.findFullByWebLog webLog.id
         
+        printfn "- Exporting uploads..."
+        let! uploads = data.Upload.findByWebLogWithData webLog.id
+        
         printfn "- Writing archive..."
         let  archive    = {
             webLog      = webLog
@@ -256,8 +301,9 @@ module Backup =
             assets      = assets |> List.map EncodedAsset.fromAsset
             categories  = categories
             tagMappings = tagMaps
-            pages       = pages |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
-            posts       = posts |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
+            pages       = pages   |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
+            posts       = posts   |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
+            uploads     = uploads |> List.map EncodedUpload.fromUpload
         }
         
         // Write the structure to the backup file
@@ -267,7 +313,7 @@ module Backup =
         serializer.Serialize (writer, archive)
         writer.Close ()
         
-        displayStats "{{NAME}} backup contains:" webLog archive
+        displayStats $"{fileName} (for <>NAME<>) contains:" webLog archive
     }
     
     let private doRestore archive newUrlBase (data : IData) = task {
@@ -275,7 +321,7 @@ module Backup =
             match! data.WebLog.findById archive.webLog.id with
             | Some webLog when defaultArg newUrlBase webLog.urlBase = webLog.urlBase ->
                 do! data.WebLog.delete webLog.id
-                return archive
+                return { archive with webLog = { archive.webLog with urlBase = defaultArg newUrlBase webLog.urlBase } }
             | Some _ ->
                 // Err'body gets new IDs...
                 let newWebLogId = WebLogId.create ()
@@ -284,6 +330,7 @@ module Backup =
                 let newPageIds  = archive.pages       |> List.map (fun page -> page.id, PageId.create       ()) |> dict
                 let newPostIds  = archive.posts       |> List.map (fun post -> post.id, PostId.create       ()) |> dict
                 let newUserIds  = archive.users       |> List.map (fun user -> user.id, WebLogUserId.create ()) |> dict
+                let newUpIds    = archive.uploads     |> List.map (fun up   -> up.id,   UploadId.create     ()) |> dict
                 return
                     { archive with
                         webLog      = { archive.webLog with id = newWebLogId; urlBase = Option.get newUrlBase }
@@ -308,6 +355,8 @@ module Backup =
                                               authorId    = newUserIds[post.authorId]
                                               categoryIds = post.categoryIds |> List.map (fun c -> newCatIds[c])
                                           })
+                        uploads     = archive.uploads
+                                      |> List.map (fun u -> { u with id = newUpIds[u.id]; webLogId = newWebLogId })
                     }
             | None ->
                 return
@@ -320,7 +369,7 @@ module Backup =
         printfn ""
         printfn "- Importing theme..."
         do! data.Theme.save restore.theme
-        let! _ = restore.assets |> List.map (EncodedAsset.fromAsset >> data.ThemeAsset.save) |> Task.WhenAll
+        let! _ = restore.assets |> List.map (EncodedAsset.fromEncoded >> data.ThemeAsset.save) |> Task.WhenAll
         
         // Restore web log data
         
@@ -342,7 +391,10 @@ module Backup =
         
         // TODO: comments not yet implemented
         
-        displayStats "Restored for {{NAME}}:" restore.webLog restore
+        printfn "- Restoring uploads..."
+        do! data.Upload.restore (restore.uploads |> List.map EncodedUpload.fromEncoded)
+        
+        displayStats "Restored for <>NAME<>:" restore.webLog restore
     }
     
     /// Decide whether to restore a backup
@@ -371,17 +423,26 @@ module Backup =
         
     /// Generate a backup archive
     let generateBackup (args : string[]) (sp : IServiceProvider) = task {
-        if args.Length = 3 || args.Length = 4 then
+        let showUsage () =
+            printfn """Usage: MyWebLog backup [url-base] [*backup-file-name] [**"pretty"]"""
+            printfn """          * optional - default is [web-log-slug].json"""
+            printfn """         ** optional - default is non-pretty JSON output"""
+        if args.Length > 1 && args.Length < 5 then
             let data = sp.GetRequiredService<IData> ()
             match! data.WebLog.findByHost args[1] with
             | Some webLog ->
-                let fileName     = if args[2].EndsWith ".json" then args[2] else $"{args[2]}.json"
-                let prettyOutput = args.Length = 4 && args[3] = "pretty"
+                let fileName =
+                    if args.Length = 2 || (args.Length = 3 && args[2] = "pretty") then
+                        $"{webLog.slug}.json"
+                    elif args[2].EndsWith ".json" then
+                        args[2]
+                    else
+                        $"{args[2]}.json"
+                let prettyOutput = (args.Length = 3 && args[2] = "pretty") || (args.Length = 4 && args[3] = "pretty")
                 do! createBackup webLog fileName prettyOutput data
             | None -> printfn $"Error: no web log found for {args[1]}"
         else
-            printfn """Usage: MyWebLog backup [url-base] [backup-file-name] [*"pretty"]"""
-            printfn """         * optional - default is non-pretty JSON output"""
+            showUsage ()
     }
     
     /// Restore a backup archive

src/MyWebLog/MyWebLog.fsproj

@@ -10,7 +10,7 @@
   </PropertyGroup>
 
   <ItemGroup>
-    <Content Include="appsettings.json" CopyToOutputDirectory="Always" />
+    <Content Include="appsettings*.json" CopyToOutputDirectory="Always" />
     <Compile Include="Caches.fs" />
     <Compile Include="Handlers\Error.fs" />
     <Compile Include="Handlers\Helpers.fs" />
@@ -18,6 +18,7 @@
     <Compile Include="Handlers\Feed.fs" />
     <Compile Include="Handlers\Post.fs" />
     <Compile Include="Handlers\User.fs" />
+    <Compile Include="Handlers\Upload.fs" />
     <Compile Include="Handlers\Routes.fs" />
     <Compile Include="DotLiquidBespoke.fs" />
     <Compile Include="Maintenance.fs" />
@@ -41,7 +42,7 @@
   </ItemGroup>
 
   <ItemGroup>
-    <None Include=".\wwwroot\img\*.png" CopyToOutputDirectory="Always" />
+    <None Include=".\wwwroot\upload\*" CopyToOutputDirectory="Always" />
   </ItemGroup>
 
 </Project>

src/MyWebLog/Program.fs

@@ -41,13 +41,17 @@ module DataImplementation =
     let get (sp : IServiceProvider) : IData =
         let config = sp.GetRequiredService<IConfiguration> ()
         if (config.GetConnectionString >> isNull >> not) "SQLite" then
+            let log  = sp.GetRequiredService<ILogger<SQLiteData>> ()
             let conn = new SqliteConnection (config.GetConnectionString "SQLite")
+            log.LogInformation $"Using SQL database {conn.DataSource}"
             SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
             upcast SQLiteData (conn, sp.GetRequiredService<ILogger<SQLiteData>> ())
         elif (config.GetSection "RethinkDB").Exists () then
+            let log = sp.GetRequiredService<ILogger<RethinkDbData>> ()
             Json.all () |> Seq.iter Converter.Serializer.Converters.Add 
             let rethinkCfg = DataConfig.FromConfiguration (config.GetSection "RethinkDB")
             let conn       = rethinkCfg.CreateConnectionAsync () |> Async.AwaitTask |> Async.RunSynchronously
+            log.LogInformation $"Using RethinkDB database {rethinkCfg.Database}"
             upcast RethinkDbData (conn, rethinkCfg, sp.GetRequiredService<ILogger<RethinkDbData>> ())
         else
             let log  = sp.GetRequiredService<ILogger<SQLiteData>> ()
@@ -130,7 +134,8 @@ let rec main args =
     | Some it when it = "import-links" -> Maintenance.importLinks              args app.Services
     | Some it when it = "load-theme"   -> Maintenance.loadTheme                args app.Services
     | Some it when it = "backup"       -> Maintenance.Backup.generateBackup    args app.Services
-    | 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    
     | _ ->
         let _ = app.UseForwardedHeaders ()
         let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))

src/MyWebLog/appsettings.json

@@ -1,5 +1,5 @@
 {
-  "Generator": "myWebLog 2.0-beta01",
+  "Generator": "myWebLog 2.0-beta03",
   "Logging": {
     "LogLevel": {
       "MyWebLog.Handlers": "Information"

src/admin-theme/_layout.liquid

@@ -12,6 +12,7 @@
             {{ "admin/dashboard" | nav_link: "Dashboard" }}
             {{ "admin/pages" | nav_link: "Pages" }}
             {{ "admin/posts" | nav_link: "Posts" }}
+            {{ "admin/uploads" | nav_link: "Uploads" }}
             {{ "admin/categories" | nav_link: "Categories" }}
             {{ "admin/settings" | nav_link: "Settings" }}
           </ul>

src/admin-theme/custom-feed-edit.liquid

@@ -185,7 +185,7 @@
                 </div>
               </div>
             </div>
-            <div class="row">
+            <div class="row pb-3">
               <div class="col-12 col-lg-10 offset-lg-1">
                 <div class="form-floating">
                   <input type="text" name="mediaBaseUrl" id="mediaBaseUrl" class="form-control"
@@ -195,6 +195,57 @@
                 </div>
               </div>
             </div>
+            <div class="row">
+              <div class="col-12 col-lg-5 offset-lg-1 pb-3">
+                <div class="form-floating">
+                  <input type="text" name="fundingUrl" id="fundingUrl" class="form-control" placeholder="Funding URL"
+                         value="{{ model.funding_url }}">
+                  <label for="fundingUrl">Funding URL</label>
+                  <span class="form-text fst-italic">
+                    Optional; URL describing donation options for this podcast, relative URL supported
+                  </span>
+                </div>
+              </div>
+              <div class="col-12 col-lg-5 pb-3">
+                <div class="form-floating">
+                  <input type="text" name="fundingText" id="fundingText" class="form-control" maxlength="128"
+                         placeholder="Funding Text" value="{{ model.funding_text }}">
+                  <label for="fundingText">Funding Text</label>
+                  <span class="form-text fst-italic">Optional; text for the funding link</span>
+                </div>
+              </div>
+            </div>
+            <div class="row pb-3">
+              <div class="col-8 col-lg-5 offset-lg-1 pb-3">
+                <div class="form-floating">
+                  <input type="text" name="guid" id="guid" class="form-control" placeholder="GUID"
+                         value="{{ model.guid }}">
+                  <label for="guid">Podcast GUID</label>
+                  <span class="form-text fst-italic">
+                    Optional; v5 UUID uniquely identifying this podcast; once entered, do not change this value
+                    (<a href="https://github.com/Podcastindex-org/podcast-namespace/blob/main/docs/1.0.md#guid"
+                        target="_blank">documentation</a>)
+                  </span>
+                </div>
+              </div>
+              <div class="col-4 col-lg-3 offset-lg-2 pb-3">
+                <div class="form-floating">
+                  <select name="medium" id="medium" class="form-control">
+                    {% for med in medium_values -%}
+                      <option value="{{ med[0] }}"{% if model.medium == med[0] %} selected{% endif %}>
+                        {{ med[1] }}
+                      </option>
+                    {%- endfor %}
+                  </select>
+                  <label for="medium">Medium</label>
+                  <span class="form-text fst-italic">
+                    Optional; medium of the podcast content
+                    (<a href="https://github.com/Podcastindex-org/podcast-namespace/blob/main/docs/1.0.md#medium"
+                        target="_blank">documentation</a>)
+                  </span>
+                </div>
+              </div>
+            </div>
           </fieldset>
         </div>
       </div>

src/admin-theme/post-edit.liquid

@@ -22,12 +22,14 @@
           </div>
           <div class="mb-2">
             <label for="text">Text</label> &nbsp; &nbsp;
-            <input type="radio" name="source" id="source_html" class="btn-check" value="HTML"
-            {%- if model.source == "HTML" %} checked="checked"{% endif %}>
-            <label class="btn btn-sm btn-outline-secondary" for="source_html">HTML</label>
-            <input type="radio" name="source" id="source_md" class="btn-check" value="Markdown"
-            {%- if model.source == "Markdown" %} checked="checked"{% endif %}>
-            <label class="btn btn-sm btn-outline-secondary" for="source_md">Markdown</label>
+            <div class="btn-group btn-group-sm" role="group" aria-label="Text format button group">
+              <input type="radio" name="source" id="source_html" class="btn-check" value="HTML"
+              {%- if model.source == "HTML" %} checked="checked"{% endif %}>
+              <label class="btn btn-sm btn-outline-secondary" for="source_html">HTML</label>
+              <input type="radio" name="source" id="source_md" class="btn-check" value="Markdown"
+              {%- if model.source == "Markdown" %} checked="checked"{% endif %}>
+              <label class="btn btn-sm btn-outline-secondary" for="source_md">Markdown</label>
+            </div>
           </div>
           <div class="pb-3">
             <textarea name="text" id="text" class="form-control" rows="20">{{ model.text }}</textarea>
@@ -39,13 +41,198 @@
             <div class="form-text">comma-delimited</div>
           </div>
           {% if model.status == "Draft" %}
-            <div class="form-check pb-2">
+            <div class="form-check form-switch pb-2">
               <input type="checkbox" name="doPublish" id="doPublish" class="form-check-input" value="true">
               <label for="doPublish" class="form-check-label">Publish This Post</label>
             </div>
           {% endif %}
           <button type="submit" class="btn btn-primary pb-2">Save Changes</button>
           <hr class="mb-3">
+          <fieldset class="mb-3">
+            <legend>
+              <span class="form-check form-switch">
+                <small>
+                  <input type="checkbox" name="isEpisode" id="isEpisode" class="form-check-input" value="true"
+                         data-bs-toggle="collapse" data-bs-target="#episodeItems" onclick="Admin.toggleEpisodeFields()"
+                         {%- if model.is_episode %}checked="checked"{% endif %}>
+                </small>
+                <label for="isEpisode">Podcast Episode</label>
+              </span>
+            </legend>
+            <div id="episodeItems" class="container p-0 collapse{% if model.is_episode %} show{% endif %}">
+              <div class="row">
+                <div class="col-12 col-md-8 pb-3">
+                  <div class="form-floating">
+                    <input type="text" name="media" id="media" class="form-control" placeholder="Media" required
+                           value="{{ model.media }}">
+                    <label for="media">Media File</label>
+                    <div class="form-text">
+                      Relative URL will be appended to base media path (if set) or served from this web log
+                    </div>
+                  </div>
+                </div>
+                <div class="col-12 col-md-4 pb-3">
+                  <div class="form-floating">
+                    <input type="text" name="mediaType" id="mediaType" class="form-control" placeholder="Media Type"
+                           value="{{ model.media_type }}">
+                    <label for="mediaType">Media MIME Type</label>
+                    <div class="form-text">Optional; overrides podcast default</div>
+                  </div>
+                </div>
+              </div>
+              <div class="row pb-3">
+                <div class="col">
+                  <div class="form-floating">
+                    <input type="number" name="length" id="length" class="form-control" placeholder="Length" required
+                           value="{{ model.length }}">
+                    <label for="length">Media Length (bytes)</label>
+                    <div class="form-text">TODO: derive from above file name</div>
+                  </div>
+                </div>
+                <div class="col">
+                  <div class="form-floating">
+                    <input type="text" name="duration" id="duration" class="form-control" placeholder="Duration"
+                           value="{{ model.duration }}">
+                    <label for="duration">Duration</label>
+                    <div class="form-text">Recommended; enter in <code>HH:MM:SS</code> format</div>
+                  </div>
+                </div>
+              </div>
+              <div class="row pb-3">
+                <div class="col">
+                  <div class="form-floating">
+                    <input type="text" name="subtitle" id="subtitle" class="form-control" placeholder="Subtitle"
+                           value="{{ model.subtitle }}">
+                    <label for="subtitle">Subtitle</label>
+                    <div class="form-text">Optional; a subtitle for this episode</div>
+                  </div>
+                </div>
+              </div>
+              <div class="row">
+                <div class="col-12 col-md-8 pb-3">
+                  <div class="form-floating">
+                    <input type="text" name="imageUrl" id="imageUrl" class="form-control" placeholder="Image URL"
+                           value="{{ model.image_url }}">
+                    <label for="imageUrl">Image URL</label>
+                    <div class="form-text">
+                      Optional; overrides podcast default; relative URL served from this web log
+                    </div>
+                  </div>
+                </div>
+                <div class="col-12 col-md-4 pb-3">
+                  <div class="form-floating">
+                    <select name="explicit" id="explicit" class="form-control">
+                      {% for exp_value in explicit_values %}
+                        <option value="{{ exp_value[0] }}"
+                                {%- if model.explicit == exp_value[0] %} selected="selected"{% endif -%}>
+                          {{ exp_value[1] }}
+                        </option>
+                      {% endfor %}
+                    </select>
+                    <label for="explicit">Explicit Rating</label>
+                    <div class="form-text">Optional; overrides podcast default</div>
+                  </div>
+                </div>
+              </div>
+              <div class="row">
+                <div class="col-12 col-md-8 pb-3">
+                  <div class="form-floating">
+                    <input type="text" name="chapterFile" id="chapterFile" class="form-control"
+                           placeholder="Chapter File" value="{{ model.chapter_file }}">
+                    <label for="chapterFile">Chapter File</label>
+                    <div class="form-text">Optional; relative URL served from this web log</div>
+                  </div>
+                </div>
+                <div class="col-12 col-md-4 pb-3">
+                  <div class="form-floating">
+                    <input type="text" name="chapterType" id="chapterType" class="form-control"
+                           placeholder="Chapter Type" value="{{ model.chapter_type }}">
+                    <label for="chapterType">Chapter MIME Type</label>
+                    <div class="form-text">
+                      Optional; <code>application/json+chapters</code> assumed if chapter file ends with
+                      <code>.json</code>
+                    </div>
+                  </div>
+                </div>
+              </div>
+              <div class="row">
+                <div class="col-12 col-md-8 pb-3">
+                  <div class="form-floating">
+                    <input type="text" name="transcriptUrl" id="transcriptUrl" class="form-control"
+                           placeholder="Transcript URL" value="{{ model.transcript_url }}"
+                           onkeyup="Admin.requireTranscriptType()">
+                    <label for="transcriptUrl">Transcript URL</label>
+                    <div class="form-text">Optional; relative URL served from this web log</div>
+                  </div>
+                </div>
+                <div class="col-12 col-md-4 pb-3">
+                  <div class="form-floating">
+                    <input type="text" name="transcriptType" id="transcriptType" class="form-control"
+                           placeholder="Transcript Type" value="{{ model.transcript_type }}"
+                           {%- if model.transcript_url != "" %} required{% endif %}>
+                    <label for="transcriptType">Transcript MIME Type</label>
+                    <div class="form-text">Required if transcript URL provided</div>
+                  </div>
+                </div>
+              </div>
+              <div class="row pb-3">
+                <div class="col">
+                  <div class="form-floating">
+                    <input type="text" name="transcriptLang" id="transcriptLang" class="form-control"
+                           placeholder="Transcript Language" value="{{ model.transcript_lang }}">
+                    <label for="transcriptLang">Transcript Language</label>
+                    <div class="form-text">Optional; overrides podcast default</div>
+                  </div>
+                </div>
+                <div class="col d-flex justify-content-center">
+                  <div class="form-check form-switch align-self-center pb-3">
+                    <input type="checkbox" name="transcriptCaptions" id="transcriptCaptions" class="form-check-input"
+                           value="true" {% if model.transcript_captions %} checked="checked"{% endif %}>
+                    <label for="transcriptCaptions">This is a captions file</label>
+                  </div>
+                </div>
+              </div>
+              <div class="row pb-3">
+                <div class="col col-md-4">
+                  <div class="form-floating">
+                    <input type="number" name="seasonNumber" id="seasonNumber" class="form-control"
+                           placeholder="Season Number" value="{{ model.season_number }}">
+                    <label for="seasonNumber">Season Number</label>
+                    <div class="form-text">Optional</div>
+                  </div>
+                </div>
+                <div class="col col-md-8">
+                  <div class="form-floating">
+                    <input type="text" name="seasonDescription" id="seasonDescription" class="form-control"
+                           placeholder="Season Description" maxlength="128" value="{{ model.season_description }}">
+                    <label for="seasonDescription">Season Description</label>
+                    <div class="form-text">Optional</div>
+                  </div>
+                </div>
+              </div>
+              <div class="row pb-3">
+                <div class="col col-md-4">
+                  <div class="form-floating">
+                    <input type="number" name="episodeNumber" id="episodeNumber" class="form-control" step="0.01"
+                           placeholder="Episode Number" value="{{ model.episode_number }}">
+                    <label for="episodeNumber">Episode Number</label>
+                    <div class="form-text">Optional; up to 2 decimal points</div>
+                  </div>
+                </div>
+                <div class="col col-md-8">
+                  <div class="form-floating">
+                    <input type="text" name="episodeDescription" id="episodeDescription" class="form-control"
+                           placeholder="Episode Description" maxlength="128" value="{{ model.episode_description }}">
+                    <label for="episodeDescription">Episode Description</label>
+                    <div class="form-text">Optional</div>
+                  </div>
+                </div>
+              </div>
+            </div>
+            <script>
+              document.addEventListener("DOMContentLoaded", () => Admin.toggleEpisodeFields())
+            </script>
+          </fieldset>
           <fieldset class="pb-3">
             <legend>
               Metadata
@@ -55,11 +242,6 @@
               </button>
             </legend>
             <div id="metaItemContainer" class="collapse">
-              {%- unless model.meta_names contains "episode_media_file" %}
-                <button class="btn btn-sm btn-secondary" onclick="Admin.addPodcastFields()" id="addPodcastFieldButton">
-                  Add Podcast Episode Fields
-                </button>
-              {%- endunless %}
               <div id="metaItems" class="container">
                 {%- for meta in metadata %}
                   <div id="meta_{{ meta[0] }}" class="row mb-3">

src/admin-theme/post-list.liquid

@@ -42,10 +42,7 @@
             </span>
           </div>
           <div class="{{ title_col }}">
-            {%- assign media = post.metadata | value: "episode_media_file" -%}
-            {%- unless media == "-- episode_media_file not found --" -%}
-              <span class="badge bg-success float-end text-uppercase">Episode</span>
-            {%- endunless -%}
+            {%- if post.episode %}<span class="badge bg-success float-end text-uppercase mt-1">Episode</span>{% endif -%}
             {{ post.title }}<br>
             <small>
               <a href="{{ post | relative_link }}" target="_blank">View Post</a>

src/admin-theme/settings.liquid

@@ -8,26 +8,33 @@
     <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
     <div class="container">
       <div class="row">
-        <div class="col-12 col-md-6 col-xl-4 offset-xl-1 pb-3">
+        <div class="col-12 col-md-6 col-xl-4 pb-3">
           <div class="form-floating">
-            <input type="text" name="name" id="name" class="form-control" value="{{ model.name }}" required autofocus>
+            <input type="text" name="name" id="name" class="form-control" placeholder="Name" required autofocus
+                   value="{{ model.name }}">
             <label for="name">Name</label>
           </div>
         </div>
         <div class="col-12 col-md-6 col-xl-4 pb-3">
           <div class="form-floating">
-            <input type="text" name="subtitle" id="subtitle" class="form-control" value="{{ model.subtitle }}">
+            <input type="text" name="slug" id="slug" class="form-control" placeholder="Slug" required
+                   value="{{ model.slug }}">
+            <label for="slug">Slug</label>
+            <span class="form-text">
+              <span class="badge rounded-pill bg-warning text-dark">WARNING</span> changing this value may break links
+              (<a href="https://bitbadger.solutions/open-source/myweblog/configuring.html#blog-settings"
+                  target="_blank">more</a>)
+            </span>
+          </div>
+        </div>
+        <div class="col-12 col-md-6 col-xl-4 pb-3">
+          <div class="form-floating">
+            <input type="text" name="subtitle" id="subtitle" class="form-control" placeholder="Subtitle"
+                   value="{{ model.subtitle }}">
             <label for="subtitle">Subtitle</label>
           </div>
         </div>
-        <div class="col-12 col-md-4 col-xl-2 pb-3">
-          <div class="form-floating">
-            <input type="number" name="postsPerPage" id="postsPerPage" class="form-control" min="0" max="50" required
-                   value="{{ model.posts_per_page }}">
-            <label for="postsPerPage">Posts per Page</label>
-          </div>
-        </div>
-        <div class="col-12 col-md-4 col-xl-3 pb-3">
+        <div class="col-12 col-md-6 col-xl-4 offset-xl-1 pb-3">
           <div class="form-floating">
             <select name="themePath" id="themePath" class="form-control" required>
               {% for theme in themes -%}
@@ -39,19 +46,12 @@
             <label for="themePath">Theme</label>
           </div>
         </div>
-        <div class="col-12 col-md-4 col-xl-3 pb-3">
-          <div class="form-floating">
-            <input type="text" name="timeZone" id="timeZone" class="form-control" required
-                   value="{{ model.time_zone }}">
-            <label for="timeZone">Time Zone</label>
-          </div>
-        </div>
-        <div class="col-12 col-md-4 pb-3">
+        <div class="col-12 col-md-6 offset-md-1 col-xl-4 offset-xl-0 pb-3">
           <div class="form-floating">
             <select name="defaultPage" id="defaultPage" class="form-control" required>
               {% for pg in pages -%}
                 <option value="{{ pg[0] }}"
-                        {%- if pg[0] == model.default_page  %} selected="selected"{% endif %}>
+                {%- if pg[0] == model.default_page  %} selected="selected"{% endif %}>
                   {{ pg[1] }}
                 </option>
               {%- endfor %}
@@ -59,6 +59,22 @@
             <label for="defaultPage">Default Page</label>
           </div>
         </div>
+        <div class="col-12 col-md-4 col-xl-2 pb-3">
+          <div class="form-floating">
+            <input type="number" name="postsPerPage" id="postsPerPage" class="form-control" min="0" max="50" required
+                   value="{{ model.posts_per_page }}">
+            <label for="postsPerPage">Posts per Page</label>
+          </div>
+        </div>
+      </div>
+      <div class="row">
+        <div class="col-12 col-md-4 col-xl-3 offset-xl-2 pb-3">
+          <div class="form-floating">
+            <input type="text" name="timeZone" id="timeZone" class="form-control" placeholder="Time Zone" required
+                   value="{{ model.time_zone }}">
+            <label for="timeZone">Time Zone</label>
+          </div>
+        </div>
         <div class="col-12 col-md-4 col-xl-2">
           <div class="form-check form-switch">
             <input type="checkbox" name="autoHtmx" id="autoHtmx" class="form-check-input" value="true"
@@ -69,6 +85,16 @@
             <a href="https://htmx.org" target="_blank" rel="noopener">What is this?</a>
           </span>
         </div>
+        <div class="col-12 col-md-4 col-xl-3 pb-3">
+          <div class="form-floating">
+            <select name="uploads" id="uploads" class="form-control">
+              {%- for it in upload_values %}
+                <option value="{{ it[0] }}"{% if model.uploads == it[0] %} selected{% endif %}>{{ it[1] }}</option>
+              {%- endfor %}
+            </select>
+            <label for="uploads">Default Upload Destination</label>
+          </div>
+        </div>
       </div>
       <div class="row pb-3">
         <div class="col text-center">

src/admin-theme/upload-list.liquid

@@ -0,0 +1,73 @@
+<h2 class="my-3">{{ page_title }}</h2>
+<article>
+  {%- capture base_url %}{{ "" | relative_link }}{% endcapture -%}
+  {%- capture upload_path %}upload/{{ web_log.slug }}/{% endcapture -%}
+  {%- capture upload_base %}{{ base_url }}{{ upload_path }}{% endcapture -%}
+  <a href="{{ "admin/upload/new" | relative_link }}" class="btn btn-primary btn-sm mb-3">Upload a New File</a>
+  <form method="post" class="container" hx-target="body">
+    <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
+    <div class="row">
+      <div class="col text-muted text-center"><em>Uploaded files served from</em><br>{{ upload_base }}</div>
+    </div>
+    <div class="row mwl-table-heading">
+      <div class="col-6">File Name</div>
+      <div class="col-3">Path</div>
+      <div class="col-3">File Date/Time</div>
+    </div>
+    {%- assign file_count = files | size -%}
+    {%- if file_count > 0 %}
+      {% for file in files %}
+        <div class="row mwl-table-detail">
+          <div class="col-6">
+            {%- capture badge_class -%}
+              {%- if file.source == "disk" %}secondary{% else %}primary{% endif -%}
+            {%- endcapture -%}
+            {%- capture rel_url %}{{ upload_base }}{{ file.path }}{{ file.name }}{% endcapture -%}
+            {%- capture blog_rel %}{{ upload_path }}{{ file.path }}{{ file.name }}{% endcapture -%}
+            <span class="badge bg-{{ badge_class }} text-uppercase float-end mt-1">{{ file.source }}</span>
+            {{ file.name }}<br>
+            <small>
+              <a href="{{ rel_url }}" target="_blank">View File</a>
+              <span class="text-muted"> &bull; Copy </span>
+              <a href="{{ blog_rel | absolute_link }}" hx-boost="false"
+                 onclick="return Admin.copyText('{{ blog_rel | absolute_link }}', this)">
+                Absolute
+              </a>
+              <span class="text-muted"> | </span>
+              <a href="{{ blog_rel | relative_link }}" hx-boost="false"
+                 onclick="return Admin.copyText('{{ blog_rel | relative_link }}', this)">
+                Relative
+              </a>
+              {%- unless base_url == "/" %}
+                <span class="text-muted"> | </span>
+                <a href="{{ blog_rel }}" hx-boost="false"
+                   onclick="return Admin.copyText('/{{ blog_rel }}', this)">
+                  For Post
+                </a>
+              {%- endunless %}
+              <span class="text-muted"> Link &bull; </span>
+              {%- capture delete_url -%}
+                {%- if file.source == "disk" -%}
+                  admin/upload/delete/{{ file.path }}{{ file.name }}
+                {%- else -%}
+                  admin/upload/{{ file.id }}/delete
+                {%- endif -%}
+              {%- endcapture -%}
+              <a href="{{ delete_url | relative_link }}" hx-post="{{ delete_url | relative_link }}"
+                 hx-confirm="Are you sure you want to delete {{ file.name }}? This action cannot be undone."
+                 class="text-danger">Delete</a>
+            </small>
+          </div>
+          <div class="col-3">{{ file.path }}</div>
+          <div class="col-3">
+            {% if file.updated_on %}{{ file.updated_on.value | date: "yyyy-MM-dd/HH:mm" }}{% else %}--{% endif %}
+          </div>
+        </div>
+      {% endfor %}
+    {%- else -%}
+      <div class="row">
+        <div class="col text-muted fst-italic text-center">This web log has uploaded files</div>
+      </div>
+    {%- endif %}
+  </form>
+</article>

src/admin-theme/upload-new.liquid

@@ -0,0 +1,31 @@
+<h2>{{ page_title }}</h2>
+<article>
+  <form action="{{ "admin/upload/save" | relative_link }}"
+        method="post" class="container" enctype="multipart/form-data" hx-boost="false">
+    <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
+    <div class="row">
+      <div class="col-12 col-md-6 pb-3">
+        <div class="form-floating">
+          <input type="file" id="file" name="file" class="form-control" placeholder="File" required>
+          <label for="file">File to Upload</label>
+        </div>
+      </div>
+      <div class="col-12 col-md-6 pb-3 d-flex align-self-center justify-content-around">
+        Destination<br>
+        <div class="btn-group" role="group" aria-label="Upload destination button group">
+          <input type="radio" name="destination" id="destination_db" class="btn-check" value="database"
+          {%- if destination == "database" %} checked="checked"{% endif %}>
+          <label class="btn btn-outline-primary" for="destination_db">Database</label>
+          <input type="radio" name="destination" id="destination_disk" class="btn-check" value="disk"
+          {%- if destination == "disk" %} checked="checked"{% endif %}>
+          <label class="btn btn-outline-secondary" for="destination_disk">Disk</label>
+        </div>
+      </div>
+    </div>
+    <div class="row pb-3">
+      <div class="col text-center">
+        <button type="submit" class="btn btn-primary">Upload File</button>
+      </div>
+    </div>
+  </form>
+</article>

src/admin-theme/version.txt

@@ -1,2 +1,2 @@
 myWebLog Admin
-2.0.0-alpha34
+2.0.0-beta03

src/admin-theme/wwwroot/admin.js

@@ -1,13 +1,22 @@
-const Admin = {
-  /** The next index for a metadata item */
+/**
+ * Support functions for the administrative UI
+ */
+this.Admin = {
+  /**
+   * The next index for a metadata item
+   * @type {number}
+   */
   nextMetaIndex : 0,
 
-  /** The next index for a permalink */
+  /**
+   * The next index for a permalink
+   * @type {number}
+   */
   nextPermalink : 0,
   
   /**
    * Set the next meta item index
-   * @param idx The index to set
+   * @param {number} idx The index to set
    */
   setNextMetaIndex(idx) {
     this.nextMetaIndex = idx
@@ -15,7 +24,7 @@
 
   /**
    * Set the next permalink index
-   * @param idx The index to set
+   * @param {number} idx The index to set
    */
   setPermalinkIndex(idx) {
     this.nextPermalink = idx
@@ -204,42 +213,38 @@
   },
 
   /**
-   * Add podcast episode metadata fields
+   * Enable or disable podcast fields
    */
-  addPodcastFields() {
-    [ [ "episode_media_file",   true,  "required; relative URL will be appended to configured base media path" ],
-      [ "episode_media_length", true,  "required; file size in bytes" ],
-      [ "episode_duration",     false, "suggested; format is HH:MM:SS" ],
-      [ "episode_media_type",   false, "optional; blank uses podcast default" ],
-      [ "episode_image",        false, "optional; relative URLs are served from this web log" ],
-      [ "episode_subtitle",     false, "optional" ],
-      [ "episode_explicit",     false, "optional; blank uses podcast default"]
-    ].forEach(([fieldName, isRequired, hintText]) => {
-      const nameField = this.createMetaNameField()
-      nameField.value = fieldName
-      nameField.readOnly = true
-      
-      const valueField = this.createMetaValueField()
-      valueField.required = isRequired
-
-      this.createMetaRow(
-        this.createMetaRemoveColumn(),
-        this.createMetaNameColumn(nameField),
-        this.createMetaValueColumn(valueField, hintText))
-    })
-    document.getElementById("addPodcastFieldButton").remove()
+  toggleEpisodeFields() {
+    const disabled = !document.getElementById("isEpisode").checked
+    ;[ "media", "mediaType", "length", "duration", "subtitle", "imageUrl", "explicit", "chapterFile", "chapterType",
+       "transcriptUrl", "transcriptType", "transcriptLang", "transcriptCaptions", "seasonNumber", "seasonDescription",
+       "episodeNumber", "episodeDescription"
+    ].forEach(it => document.getElementById(it).disabled = disabled)
   },
-
+  
   /**
    * Check to enable or disable podcast fields
    */
   checkPodcast() {
     document.getElementById("podcastFields").disabled = !document.getElementById("isPodcast").checked
   },
+
+  /**
+   * Copy text to the clipboard
+   * @param {string} text The text to be copied
+   * @param {HTMLAnchorElement} elt The element on which the click was generated
+   * @return {boolean} False, to prevent navigation
+   */
+  copyText(text, elt) {
+    navigator.clipboard.writeText(text)
+    elt.innerText = "Copied"
+    return false
+  },
   
   /**
    * Toggle the source of a custom RSS feed
-   * @param source The source that was selected
+   * @param {string} source The source that was selected
    */
   customFeedBy(source) {
     const categoryInput = document.getElementById("sourceValueCat")
@@ -257,7 +262,7 @@
   
   /**
    * Remove a metadata item
-   * @param idx The index of the metadata item to remove
+   * @param {number} idx The index of the metadata item to remove
    */
   removeMetaItem(idx) {
     document.getElementById(`meta_${idx}`).remove()
@@ -265,15 +270,22 @@
 
   /**
    * Remove a permalink
-   * @param idx The index of the permalink to remove
+   * @param {number} idx The index of the permalink to remove
    */
   removePermalink(idx) {
     document.getElementById(`link_${idx}`).remove()
   },
 
+  /**
+   * Require transcript type if transcript URL is present
+   */
+  requireTranscriptType() {
+    document.getElementById("transcriptType").required = document.getElementById("transcriptUrl").value.trim() !== ""
+  },
+
   /**
    * Show messages that may have come with an htmx response
-   * @param messages The messages from the response
+   * @param {string} messages The messages from the response
    */
   showMessage(messages) {
     const msgs = messages.split(", ")