22 Commits

Author SHA1 Message Date
07aff16c3a Version bump 2022-07-16 13:38:44 -04:00
d290e6e8a6 Complete page / post revision maint (#13)
- Fix log on redirection
- Move page handlers to its own file
- Add version to admin area footer
- Move generator to HttpContext extension property
2022-07-16 12:33:34 -04:00
039d09aed5 WIP on page revisions (#13)
- Simplify redirectToGet usage
- Move a few functions to HttpContext extension properties
- Modify bare response to allow content not from a template
- Fix uploaded date/time handling
2022-07-15 22:51:51 -04:00
d667d09372 WIP on revision mgt template (#13) 2022-07-14 23:25:29 -04:00
2906c20efa Upgrade htmx to v1.8.0 (#18) 2022-07-14 18:55:52 -04:00
355ade8c87 Add slug and upload dest to settings (#2) 2022-07-07 12:42:37 -04:00
1d096d696b Add types to admin functions
- Change how functions are registered
2022-07-06 10:30:30 -04:00
ce3816a8ae Use web log slug for backup file name (#16) 2022-07-04 19:06:32 -04:00
879710a0a3 Add funding (#7)/GUID (#4)/medium (#3) to podcast
- Add info log for non-default DB connections
2022-07-04 18:40:32 -04:00
c957279162 Add and delete uploaded files (#2) 2022-07-04 13:19:16 -04:00
9307ace24a WIP on saving uploads (#2) 2022-07-01 20:59:21 -04:00
feada6f11f Add copy links to upload list (#2) 2022-06-30 18:56:24 -04:00
0567dff54a WIP on upload admin (#2) 2022-06-28 22:18:56 -04:00
c29bbc04ac WIP on uploads (#2)
- Add data types and fields
- Implement in both RethinkDB and SQLite
- Add uploads to backup/restore
- Add empty upload folder to project
- Add indexes to SQLite tables (#15)
2022-06-28 17:34:18 -04:00
46bd785a1f Make program executable (#14)
- Bump versions for next release
2022-06-28 08:39:43 -04:00
3203f1b2ee Bump versions 2022-06-28 06:33:38 -04:00
7203fa5a38 Invalidate cache when theme uploaded (#12)
- Add episode to display page (leftover from #9)
- Show episode label based on structure (also #9)
2022-06-27 22:16:53 -04:00
16603bbcaf Render feed from episode (#9)
- Render chapter if present (#5)
- Render transcript if present (#8)
- Require transcript type if URL entered (#8)
2022-06-27 20:34:30 -04:00
80c65bcad6 Add episode fields to UI (#9)
- Add chapter fields (#5)
- Add transcript fields (#8)
2022-06-27 17:47:00 -04:00
9fbb1bb14d Add episode fields to post view model
Parts of #9 / #5 / #8
2022-06-27 07:36:29 -04:00
707b67c630 Reorganize SQLite data files
- Add episode data structure (#9)
- Add fields for chapters (#6) and transcripts (#8)
- Add fields for medium (#3), funding (#7), and GUID (#4)
- Fix RethinkDB restore problems (#10)
- Save custom feeds in SQLite (#11)
2022-06-24 21:56:07 -04:00
dfb0ff3b9c Fix RethinkDB restore (#10)
- Also fixed replacement base URL issue
2022-06-24 08:47:22 -04:00
47 changed files with 4708 additions and 2458 deletions

6
.gitignore vendored
View File

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

View File

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

View File

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

View File

@@ -199,6 +199,28 @@ type IThemeAssetData =
abstract member save : ThemeAsset -> Task<unit> 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 /// Functions to manipulate web logs
type IWebLogData = type IWebLogData =
@@ -270,6 +292,9 @@ type IData =
/// Theme asset data functions /// Theme asset data functions
abstract member ThemeAsset : IThemeAssetData abstract member ThemeAsset : IThemeAssetData
/// Uploaded file functions
abstract member Upload : IUploadData
/// Web log data functions /// Web log data functions
abstract member WebLog : IWebLogData abstract member WebLog : IWebLogData

View File

@@ -11,7 +11,7 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.6" /> <PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.7" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" /> <PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" />
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" /> <PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" /> <PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
@@ -25,6 +25,15 @@
<Compile Include="Interfaces.fs" /> <Compile Include="Interfaces.fs" />
<Compile Include="Utils.fs" /> <Compile Include="Utils.fs" />
<Compile Include="RethinkDbData.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" /> <Compile Include="SQLiteData.fs" />
</ItemGroup> </ItemGroup>

View File

@@ -33,6 +33,9 @@ module private RethinkHelpers =
/// The theme asset table /// The theme asset table
let ThemeAsset = "ThemeAsset" let ThemeAsset = "ThemeAsset"
/// The uploaded file table
let Upload = "Upload"
/// The web log table /// The web log table
let WebLog = "WebLog" let WebLog = "WebLog"
@@ -40,10 +43,7 @@ module private RethinkHelpers =
let WebLogUser = "WebLogUser" let WebLogUser = "WebLogUser"
/// A list of all tables /// A list of all tables
let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; WebLog; WebLogUser ] let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ]
/// A list of all tables with a webLogId field
let allForWebLog = [ Comment; Post; Category; TagMap; Page; WebLogUser ]
/// Shorthand for the ReQL starting point /// 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) indexCreate "webLogAndUrl" (fun row -> r.Array (row["webLogId"], row["urlValue"]) :> obj)
write; withRetryOnce; ignoreResult conn 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 // Users log on with e-mail
if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then
log.LogInformation $"Creating index {table}.logOn..." 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 = { member _.WebLog = {
new IWebLogData with new IWebLogData with
@@ -743,19 +815,50 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
} }
member _.delete webLogId = backgroundTask { member _.delete webLogId = backgroundTask {
for table in Table.allForWebLog do // Comments should be deleted by post IDs
do! rethink { let! thePostIds = rethink<{| id : string |} list> {
withTable table withTable Table.Post
getAll [ webLogId ] (nameof webLogId) getAll [ webLogId ] (nameof webLogId)
delete pluck [ "id" ]
write; withRetryOnce; ignoreResult conn result; withRetryOnce conn
} }
do! rethink { if not (List.isEmpty thePostIds) then
withTable Table.WebLog let postIds = thePostIds |> List.map (fun it -> it.id :> obj)
get webLogId do! rethink {
delete withTable Table.Comment
write; withRetryOnce; ignoreResult conn 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 = member _.findByHost url =
@@ -785,12 +888,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get webLog.id get webLog.id
update [ update [
"name", webLog.name :> obj "name", webLog.name :> obj
"slug", webLog.slug
"subtitle", webLog.subtitle "subtitle", webLog.subtitle
"defaultPage", webLog.defaultPage "defaultPage", webLog.defaultPage
"postsPerPage", webLog.postsPerPage "postsPerPage", webLog.postsPerPage
"timeZone", webLog.timeZone "timeZone", webLog.timeZone
"themePath", webLog.themePath "themePath", webLog.themePath
"autoHtmx", webLog.autoHtmx "autoHtmx", webLog.autoHtmx
"uploads", webLog.uploads
] ]
write; withRetryDefault; ignoreResult conn 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.Page [ "webLogId"; "authorId" ]
do! ensureIndexes Table.Post [ "webLogId"; "authorId" ] do! ensureIndexes Table.Post [ "webLogId"; "authorId" ]
do! ensureIndexes Table.TagMap [] do! ensureIndexes Table.TagMap []
do! ensureIndexes Table.Upload []
do! ensureIndexes Table.WebLog [ "urlBase" ] do! ensureIndexes Table.WebLog [ "urlBase" ]
do! ensureIndexes Table.WebLogUser [ "webLogId" ] do! ensureIndexes Table.WebLogUser [ "webLogId" ]
} }

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

File diff suppressed because it is too large Load Diff

View File

@@ -190,6 +190,9 @@ type Post =
/// The tags for the post /// The tags for the post
tags : string list tags : string list
/// Podcast episode information for this post
episode : Episode option
/// Metadata for the post /// Metadata for the post
metadata : MetaItem list metadata : MetaItem list
@@ -217,6 +220,7 @@ module Post =
template = None template = None
categoryIds = [] categoryIds = []
tags = [] tags = []
episode = None
metadata = [] metadata = []
priorPermalinks = [] priorPermalinks = []
revisions = [] 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 /// A web log
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type WebLog = type WebLog =
@@ -300,6 +335,9 @@ type WebLog =
/// The name of the web log /// The name of the web log
name : string name : string
/// The slug of the web log
slug : string
/// A subtitle for the web log /// A subtitle for the web log
subtitle : string option subtitle : string option
@@ -323,6 +361,9 @@ type WebLog =
/// Whether to automatically load htmx /// Whether to automatically load htmx
autoHtmx : bool autoHtmx : bool
/// Where uploads are placed
uploads : UploadDestination
} }
/// Functions to support web logs /// Functions to support web logs
@@ -332,6 +373,7 @@ module WebLog =
let empty = let empty =
{ id = WebLogId.empty { id = WebLogId.empty
name = "" name = ""
slug = ""
subtitle = None subtitle = None
defaultPage = "" defaultPage = ""
postsPerPage = 10 postsPerPage = 10
@@ -340,6 +382,7 @@ module WebLog =
timeZone = "" timeZone = ""
rss = RssOptions.empty rss = RssOptions.empty
autoHtmx = false autoHtmx = false
uploads = Database
} }
/// Get the host (including scheme) and extra path from the URL base /// Get the host (including scheme) and extra path from the URL base
@@ -362,11 +405,6 @@ module WebLog =
TimeZoneInfo.ConvertTimeFromUtc TimeZoneInfo.ConvertTimeFromUtc
(DateTime (date.Ticks, DateTimeKind.Utc), TimeZoneInfo.FindSystemTimeZoneById webLog.timeZone) (DateTime (date.Ticks, DateTimeKind.Utc), TimeZoneInfo.FindSystemTimeZoneById webLog.timeZone)
/// Convert a date/time in the web log's local date/time to UTC
let utcTime webLog (date : DateTime) =
TimeZoneInfo.ConvertTimeToUtc
(DateTime (date.Ticks, DateTimeKind.Unspecified), TimeZoneInfo.FindSystemTimeZoneById webLog.timeZone)
/// A user of the web log /// A user of the web log
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]

View File

@@ -68,6 +68,109 @@ module CommentStatus =
| it -> invalidOp $"{it} is not a valid post status" | 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 Markdig
open Markdown.ColorCode open Markdown.ColorCode
@@ -171,6 +274,43 @@ module PageId =
let create () = PageId (newId ()) 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 /// Statuses for posts
type PostStatus = type PostStatus =
/// The post should not be publicly available /// The post should not be publicly available
@@ -248,30 +388,6 @@ module CustomFeedSource =
| source -> invalidArg "feedSource" $"{source} is not a valid feed source" | 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 /// Options for a feed that describes a podcast
type PodcastOptions = type PodcastOptions =
{ /// The title of the podcast { /// 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) /// The base URL for relative URL media files for this podcast (optional; defaults to web log base)
mediaBaseUrl : string option 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 /// An identifier for a web log
type WebLogId = WebLogId of string type WebLogId = WebLogId of string

View File

@@ -9,7 +9,30 @@ module private Helpers =
/// Create a string option if a string is blank /// Create a string option if a string is blank
let noneIfBlank (it : string) = 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 /// Details about a category, used to display category lists
@@ -124,27 +147,59 @@ type DisplayPage =
} }
/// The model used to display the admin dashboard /// Information about a revision used for display
[<NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type DashboardModel = type DisplayRevision =
{ /// The number of published posts { /// The as-of date/time for the revision
posts : int asOf : DateTime
/// The number of post drafts /// The as-of date/time for the revision in the web log's local time zone
drafts : int asOfLocal : DateTime
/// The number of pages /// The format of the text of the revision
pages : int format : string
/// The number of pages in the page list
listedPages : int
/// The number of categories
categories : int
/// The top-level categories
topLevelCategories : int
} }
with
/// Create a display revision from an actual revision
static member fromRevision webLog (rev : Revision) =
{ asOf = rev.asOf
asOfLocal = WebLog.localTime webLog rev.asOf
format = MarkupText.sourceType rev.text
}
open System.IO
/// Information about an uploaded file used for display
[<NoComparison; NoEquality>]
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 /// View model for editing categories
@@ -229,6 +284,18 @@ type EditCustomFeedModel =
/// The base URL for relative URL media files for this podcast (optional; defaults to web log base) /// The base URL for relative URL media files for this podcast (optional; defaults to web log base)
mediaBaseUrl : string 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 /// An empty custom feed model
@@ -250,6 +317,10 @@ type EditCustomFeedModel =
explicit = "no" explicit = "no"
defaultMediaType = "audio/mpeg" defaultMediaType = "audio/mpeg"
mediaBaseUrl = "" mediaBaseUrl = ""
fundingUrl = ""
fundingText = ""
guid = ""
medium = ""
} }
/// Create a model from a custom feed /// Create a model from a custom feed
@@ -277,6 +348,12 @@ type EditCustomFeedModel =
explicit = ExplicitRating.toString p.explicit explicit = ExplicitRating.toString p.explicit
defaultMediaType = defaultArg p.defaultMediaType "" defaultMediaType = defaultArg p.defaultMediaType ""
mediaBaseUrl = defaultArg p.mediaBaseUrl "" 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 | None -> rss
@@ -300,6 +377,10 @@ type EditCustomFeedModel =
explicit = ExplicitRating.parse this.explicit explicit = ExplicitRating.parse this.explicit
defaultMediaType = noneIfBlank this.defaultMediaType defaultMediaType = noneIfBlank this.defaultMediaType
mediaBaseUrl = noneIfBlank this.mediaBaseUrl 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 else
None None
@@ -402,7 +483,62 @@ type EditPostModel =
/// Whether all revisions should be purged and the override date set as the updated date as well /// Whether all revisions should be purged and the override date set as the updated date as well
setUpdated : bool 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 /// Create an edit model from an existing past
static member fromPost webLog (post : Post) = static member fromPost webLog (post : Post) =
let latest = let latest =
@@ -410,21 +546,93 @@ type EditPostModel =
| Some rev -> rev | Some rev -> rev
| None -> Revision.empty | None -> Revision.empty
let post = if post.metadata |> List.isEmpty then { post with metadata = [ MetaItem.empty ] } else post let post = if post.metadata |> List.isEmpty then { post with metadata = [ MetaItem.empty ] } else post
{ postId = PostId.toString post.id let episode = defaultArg post.episode Episode.empty
title = post.title { postId = PostId.toString post.id
permalink = Permalink.toString post.permalink title = post.title
source = MarkupText.sourceType latest.text permalink = Permalink.toString post.permalink
text = MarkupText.text latest.text source = MarkupText.sourceType latest.text
tags = String.Join (", ", post.tags) text = MarkupText.text latest.text
template = defaultArg post.template "" tags = String.Join (", ", post.tags)
categoryIds = post.categoryIds |> List.map CategoryId.toString |> Array.ofList template = defaultArg post.template ""
status = PostStatus.toString post.status categoryIds = post.categoryIds |> List.map CategoryId.toString |> Array.ofList
doPublish = false status = PostStatus.toString post.status
metaNames = post.metadata |> List.map (fun m -> m.name) |> Array.ofList doPublish = false
metaValues = post.metadata |> List.map (fun m -> m.value) |> Array.ofList metaNames = post.metadata |> List.map (fun m -> m.name) |> Array.ofList
setPublished = false metaValues = post.metadata |> List.map (fun m -> m.value) |> Array.ofList
pubOverride = post.publishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable setPublished = false
setUpdated = 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
} }
@@ -580,6 +788,39 @@ type ManagePermalinksModel =
} }
/// View model to manage revisions
[<CLIMutable; NoComparison; NoEquality>]
type ManageRevisionsModel =
{ /// The ID for the entity being edited
id : string
/// The type of entity being edited ("page" or "post")
entity : string
/// The current title of the page or post
currentTitle : string
/// The revisions for the page or post
revisions : DisplayRevision[]
}
/// Create a revision model from a page
static member fromPage webLog (pg : Page) =
{ id = PageId.toString pg.id
entity = "page"
currentTitle = pg.title
revisions = pg.revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
}
/// Create a revision model from a post
static member fromPost webLog (post : Post) =
{ id = PostId.toString post.id
entity = "post"
currentTitle = post.title
revisions = post.revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
}
/// View model for posts in a list /// View model for posts in a list
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type PostListItem = type PostListItem =
@@ -613,6 +854,9 @@ type PostListItem =
/// Tags for the post /// Tags for the post
tags : string list tags : string list
/// The podcast episode information for this post
episode : Episode option
/// Metadata for the post /// Metadata for the post
metadata : MetaItem list metadata : MetaItem list
} }
@@ -631,6 +875,7 @@ type PostListItem =
text = if extra = "" then post.text else post.text.Replace ("href=\"/", $"href=\"{extra}/") text = if extra = "" then post.text else post.text.Replace ("href=\"/", $"href=\"{extra}/")
categoryIds = post.categoryIds |> List.map CategoryId.toString categoryIds = post.categoryIds |> List.map CategoryId.toString
tags = post.tags tags = post.tags
episode = post.episode
metadata = post.metadata metadata = post.metadata
} }
@@ -666,6 +911,9 @@ type SettingsModel =
{ /// The name of the web log { /// The name of the web log
name : string name : string
/// The slug of the web log
slug : string
/// The subtitle of the web log /// The subtitle of the web log
subtitle : string subtitle : string
@@ -683,32 +931,48 @@ type SettingsModel =
/// Whether to automatically load htmx /// Whether to automatically load htmx
autoHtmx : bool autoHtmx : bool
/// The default location for uploads
uploads : string
} }
/// Create a settings model from a web log /// Create a settings model from a web log
static member fromWebLog (webLog : WebLog) = static member fromWebLog (webLog : WebLog) =
{ name = webLog.name { name = webLog.name
slug = webLog.slug
subtitle = defaultArg webLog.subtitle "" subtitle = defaultArg webLog.subtitle ""
defaultPage = webLog.defaultPage defaultPage = webLog.defaultPage
postsPerPage = webLog.postsPerPage postsPerPage = webLog.postsPerPage
timeZone = webLog.timeZone timeZone = webLog.timeZone
themePath = webLog.themePath themePath = webLog.themePath
autoHtmx = webLog.autoHtmx autoHtmx = webLog.autoHtmx
uploads = UploadDestination.toString webLog.uploads
} }
/// Update a web log with settings from the form /// Update a web log with settings from the form
member this.update (webLog : WebLog) = member this.update (webLog : WebLog) =
{ webLog with { webLog with
name = this.name name = this.name
slug = this.slug
subtitle = if this.subtitle = "" then None else Some this.subtitle subtitle = if this.subtitle = "" then None else Some this.subtitle
defaultPage = this.defaultPage defaultPage = this.defaultPage
postsPerPage = this.postsPerPage postsPerPage = this.postsPerPage
timeZone = this.timeZone timeZone = this.timeZone
themePath = this.themePath themePath = this.themePath
autoHtmx = this.autoHtmx 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>] [<CLIMutable; NoComparison; NoEquality>]
type UserMessage = type UserMessage =
{ /// The level of the message { /// The level of the message

View File

@@ -7,16 +7,45 @@ open MyWebLog.Data
[<AutoOpen>] [<AutoOpen>]
module Extensions = module Extensions =
open System.Security.Claims
open Microsoft.AspNetCore.Antiforgery
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.DependencyInjection
/// Hold variable for the configured generator string
let mutable private generatorString : string option = None
type HttpContext with type HttpContext with
/// The web log for the current request
member this.WebLog = this.Items["webLog"] :?> WebLog
/// The anti-CSRF service
member this.AntiForgery = this.RequestServices.GetRequiredService<IAntiforgery> ()
/// The cross-site request forgery token set for this request
member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this
/// The data implementation /// The data implementation
member this.Data = this.RequestServices.GetRequiredService<IData> () member this.Data = this.RequestServices.GetRequiredService<IData> ()
/// The generator string
member this.Generator =
match generatorString with
| Some gen -> gen
| None ->
let cfg = this.RequestServices.GetRequiredService<IConfiguration> ()
generatorString <-
match Option.ofObj cfg["Generator"] with
| Some gen -> Some gen
| None -> Some "generator not configured"
generatorString.Value
/// The user ID for the current request
member this.UserId =
WebLogUserId (this.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value
/// The web log for the current request
member this.WebLog = this.Items["webLog"] :?> WebLog
open System.Collections.Concurrent open System.Collections.Concurrent
/// <summary> /// <summary>

View File

@@ -222,16 +222,17 @@ let register () =
Template.RegisterTag<PageFootTag> "page_foot" Template.RegisterTag<PageFootTag> "page_foot"
Template.RegisterTag<UserLinksTag> "user_links" Template.RegisterTag<UserLinksTag> "user_links"
[ // Domain types [ // 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>
// View models typeof<RssOptions>; typeof<TagMap>; typeof<UploadDestination>; typeof<WebLog>
typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayCustomFeed>; typeof<DisplayPage> // View models
typeof<EditCategoryModel>; typeof<EditCustomFeedModel>; typeof<EditPageModel>; typeof<EditPostModel> typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayCustomFeed>; typeof<DisplayPage>
typeof<EditRssModel>; typeof<EditTagMapModel>; typeof<EditUserModel>; typeof<LogOnModel> typeof<DisplayRevision>; typeof<DisplayUpload>; typeof<EditCategoryModel>; typeof<EditCustomFeedModel>
typeof<ManagePermalinksModel>; typeof<PostDisplay>; typeof<PostListItem>; typeof<SettingsModel> typeof<EditPageModel>; typeof<EditPostModel>; typeof<EditRssModel>; typeof<EditTagMapModel>
typeof<UserMessage> typeof<EditUserModel>; typeof<LogOnModel>; typeof<ManagePermalinksModel>; typeof<ManageRevisionsModel>
// Framework types typeof<PostDisplay>; typeof<PostListItem>; typeof<SettingsModel>; typeof<UserMessage>
typeof<AntiforgeryTokenSet>; typeof<int option>; typeof<KeyValuePair>; typeof<MetaItem list> // Framework types
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, [| "*" |])) |> List.iter (fun it -> Template.RegisterSafeType (it, [| "*" |]))

View File

@@ -39,10 +39,10 @@ let dashboard : HttpHandler = fun next ctx -> task {
let listCategories : HttpHandler = fun next ctx -> task { let listCategories : HttpHandler = fun next ctx -> task {
let! catListTemplate = TemplateCache.get "admin" "category-list-body" ctx.Data let! catListTemplate = TemplateCache.get "admin" "category-list-body" ctx.Data
let hash = Hash.FromAnonymousObject {| let hash = Hash.FromAnonymousObject {|
page_title = "Categories"
csrf = ctx.CsrfTokenSet
web_log = ctx.WebLog web_log = ctx.WebLog
categories = CategoryCache.get ctx categories = CategoryCache.get ctx
page_title = "Categories"
csrf = csrfToken ctx
|} |}
hash.Add ("category_list", catListTemplate.Render hash) hash.Add ("category_list", catListTemplate.Render hash)
return! viewForTheme "admin" "category-list" next ctx hash return! viewForTheme "admin" "category-list" next ctx hash
@@ -53,7 +53,7 @@ let listCategoriesBare : HttpHandler = fun next ctx -> task {
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
categories = CategoryCache.get ctx categories = CategoryCache.get ctx
csrf = csrfToken ctx csrf = ctx.CsrfTokenSet
|} |}
|> bareForTheme "admin" "category-list-body" next ctx |> bareForTheme "admin" "category-list-body" next ctx
} }
@@ -73,9 +73,9 @@ let editCategory catId : HttpHandler = fun next ctx -> task {
| Some (title, cat) -> | Some (title, cat) ->
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = EditCategoryModel.fromCategory cat
page_title = title page_title = title
csrf = ctx.CsrfTokenSet
model = EditCategoryModel.fromCategory cat
categories = CategoryCache.get ctx categories = CategoryCache.get ctx
|} |}
|> bareForTheme "admin" "category-edit" next ctx |> bareForTheme "admin" "category-edit" next ctx
@@ -118,156 +118,16 @@ let deleteCategory catId : HttpHandler = fun next ctx -> task {
return! listCategoriesBare next ctx return! listCategoriesBare next ctx
} }
// -- PAGES -- open Microsoft.AspNetCore.Http
// GET /admin/pages
// GET /admin/pages/page/{pageNbr}
let listPages pageNbr : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let! pages = ctx.Data.Page.findPageOfPages webLog.id pageNbr
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
pages = pages |> List.map (DisplayPage.fromPageMinimal webLog)
page_title = "Pages"
page_nbr = pageNbr
prev_page = if pageNbr = 2 then "" else $"/page/{pageNbr - 1}"
next_page = $"/page/{pageNbr + 1}"
|}
|> viewForTheme "admin" "page-list" next ctx
}
// GET /admin/page/{id}/edit
let editPage pgId : HttpHandler = fun next ctx -> task {
let! result = task {
match pgId with
| "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new" })
| _ ->
match! ctx.Data.Page.findFullById (PageId pgId) ctx.WebLog.id with
| Some page -> return Some ("Edit Page", page)
| None -> return None
}
match result with
| Some (title, page) ->
let model = EditPageModel.fromPage page
let! templates = templatesForTheme ctx "page"
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
|}
|> viewForTheme "admin" "page-edit" next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/page/{id}/permalinks
let editPagePermalinks pgId : HttpHandler = fun next ctx -> task {
match! ctx.Data.Page.findFullById (PageId pgId) ctx.WebLog.id with
| Some pg ->
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = ManagePermalinksModel.fromPage pg
page_title = $"Manage Prior Permalinks"
|}
|> viewForTheme "admin" "permalinks" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/page/permalinks
let savePagePermalinks : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let links = model.prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Page.updatePriorPermalinks (PageId model.id) webLog.id links with
| true ->
do! addMessage ctx { UserMessage.success with message = "Page permalinks saved successfully" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/page/{model.id}/permalinks")) next ctx
| false -> return! Error.notFound next ctx
}
// POST /admin/page/{id}/delete
let deletePage pgId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
match! ctx.Data.Page.delete (PageId pgId) webLog.id with
| true ->
do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Page deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with message = "Page not found; nothing deleted" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/pages")) next ctx
}
open System
#nowarn "3511"
// POST /admin/page/save
let savePage : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> ()
let webLog = ctx.WebLog
let data = ctx.Data
let now = DateTime.UtcNow
let! pg = task {
match model.pageId with
| "new" ->
return Some
{ Page.empty with
id = PageId.create ()
webLogId = webLog.id
authorId = userId ctx
publishedOn = now
}
| pgId -> return! data.Page.findFullById (PageId pgId) webLog.id
}
match pg with
| Some page ->
let updateList = page.showInPageList <> model.isShownInPageList
let revision = { asOf = now; text = MarkupText.parse $"{model.source}: {model.text}" }
// Detect a permalink change, and add the prior one to the prior list
let page =
match Permalink.toString page.permalink with
| "" -> page
| link when link = model.permalink -> page
| _ -> { page with priorPermalinks = page.permalink :: page.priorPermalinks }
let page =
{ page with
title = model.title
permalink = Permalink model.permalink
updatedOn = now
showInPageList = model.isShownInPageList
template = match model.template with "" -> None | tmpl -> Some tmpl
text = MarkupText.toHtml revision.text
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 page.revisions |> List.tryHead with
| Some r when r.text = revision.text -> page.revisions
| _ -> revision :: page.revisions
}
do! (if model.pageId = "new" then data.Page.add else data.Page.update) page
if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Page saved successfully" }
return!
redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/page/{PageId.toString page.id}/edit")) next ctx
| None -> return! Error.notFound next ctx
}
// -- TAG MAPPINGS -- // -- TAG MAPPINGS --
open Microsoft.AspNetCore.Http
/// Get the hash necessary to render the tag mapping list /// Get the hash necessary to render the tag mapping list
let private tagMappingHash (ctx : HttpContext) = task { let private tagMappingHash (ctx : HttpContext) = task {
let! mappings = ctx.Data.TagMap.findByWebLog ctx.WebLog.id let! mappings = ctx.Data.TagMap.findByWebLog ctx.WebLog.id
return Hash.FromAnonymousObject {| return Hash.FromAnonymousObject {|
csrf = ctx.CsrfTokenSet
web_log = ctx.WebLog web_log = ctx.WebLog
csrf = csrfToken ctx
mappings = mappings mappings = mappings
mapping_ids = mappings |> List.map (fun it -> { name = it.tag; value = TagMapId.toString it.id }) mapping_ids = mappings |> List.map (fun it -> { name = it.tag; value = TagMapId.toString it.id })
|} |}
@@ -302,9 +162,9 @@ let editMapping tagMapId : HttpHandler = fun next ctx -> task {
| Some tm -> | Some tm ->
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = EditTagMapModel.fromMapping tm
page_title = if isNew then "Add Tag Mapping" else $"Mapping for {tm.tag} Tag" page_title = if isNew then "Add Tag Mapping" else $"Mapping for {tm.tag} Tag"
csrf = ctx.CsrfTokenSet
model = EditTagMapModel.fromMapping tm
|} |}
|> bareForTheme "admin" "tag-mapping-edit" next ctx |> bareForTheme "admin" "tag-mapping-edit" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@@ -337,6 +197,7 @@ let deleteMapping tagMapId : HttpHandler = fun next ctx -> task {
// -- THEMES -- // -- THEMES --
open System
open System.IO open System.IO
open System.IO.Compression open System.IO.Compression
open System.Text.RegularExpressions open System.Text.RegularExpressions
@@ -346,8 +207,8 @@ open MyWebLog.Data
let themeUpdatePage : HttpHandler = fun next ctx -> task { let themeUpdatePage : HttpHandler = fun next ctx -> task {
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
csrf = csrfToken ctx
page_title = "Upload Theme" page_title = "Upload Theme"
csrf = ctx.CsrfTokenSet
|} |}
|> viewForTheme "admin" "upload-theme" next ctx |> viewForTheme "admin" "upload-theme" next ctx
} }
@@ -440,14 +301,15 @@ let updateTheme : HttpHandler = fun next ctx -> task {
do! themeFile.CopyToAsync stream do! themeFile.CopyToAsync stream
do! loadThemeFromZip themeName stream true data do! loadThemeFromZip themeName stream true data
do! ThemeAssetCache.refreshTheme (ThemeId themeName) data do! ThemeAssetCache.refreshTheme (ThemeId themeName) data
TemplateCache.invalidateTheme themeName
do! addMessage ctx { UserMessage.success with message = "Theme updated successfully" } do! addMessage ctx { UserMessage.success with message = "Theme updated successfully" }
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/dashboard")) next ctx return! redirectToGet "admin/dashboard" next ctx
| Ok _ -> | Ok _ ->
do! addMessage ctx { UserMessage.error with message = "You may not replace the admin theme" } do! addMessage ctx { UserMessage.error with message = "You may not replace the admin theme" }
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/theme/update")) next ctx return! redirectToGet "admin/theme/update" next ctx
| Error message -> | Error message ->
do! addMessage ctx { UserMessage.error with message = message } do! addMessage ctx { UserMessage.error with message = message }
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/theme/update")) next ctx return! redirectToGet "admin/theme/update" next ctx
else else
return! RequestErrors.BAD_REQUEST "Bad request" next ctx return! RequestErrors.BAD_REQUEST "Bad request" next ctx
} }
@@ -464,23 +326,26 @@ let settings : HttpHandler = fun next ctx -> task {
let! themes = data.Theme.all () let! themes = data.Theme.all ()
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
csrf = csrfToken ctx page_title = "Web Log Settings"
model = SettingsModel.fromWebLog webLog csrf = ctx.CsrfTokenSet
pages = web_log = webLog
seq { model = SettingsModel.fromWebLog webLog
KeyValuePair.Create ("posts", "- First Page of Posts -") pages = seq
{ KeyValuePair.Create ("posts", "- First Page of Posts -")
yield! allPages yield! allPages
|> List.sortBy (fun p -> p.title.ToLower ()) |> List.sortBy (fun p -> p.title.ToLower ())
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.id, p.title)) |> List.map (fun p -> KeyValuePair.Create (PageId.toString p.id, p.title))
} }
|> Array.ofSeq |> Array.ofSeq
themes = themes themes =
|> Seq.ofList themes
|> Seq.map (fun it -> |> Seq.ofList
KeyValuePair.Create (ThemeId.toString it.id, $"{it.name} (v{it.version})")) |> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.id, $"{it.name} (v{it.version})"))
|> Array.ofSeq |> Array.ofSeq
web_log = webLog upload_values = [|
page_title = "Web Log Settings" KeyValuePair.Create (UploadDestination.toString Database, "Database")
KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
|]
|} |}
|> viewForTheme "admin" "settings" next ctx |> viewForTheme "admin" "settings" next ctx
} }
@@ -492,13 +357,20 @@ let saveSettings : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<SettingsModel> () let! model = ctx.BindFormAsync<SettingsModel> ()
match! data.WebLog.findById webLog.id with match! data.WebLog.findById webLog.id with
| Some webLog -> | Some webLog ->
let webLog = model.update webLog let oldSlug = webLog.slug
let webLog = model.update webLog
do! data.WebLog.updateSettings webLog do! data.WebLog.updateSettings webLog
// Update cache // Update cache
WebLogCache.set webLog 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" } do! addMessage ctx { UserMessage.success with message = "Web log settings saved successfully" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings")) next ctx return! redirectToGet "admin/settings" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }

View File

@@ -2,21 +2,20 @@
module MyWebLog.Handlers.Error module MyWebLog.Handlers.Error
open System.Net open System.Net
open System.Threading.Tasks
open Giraffe open Giraffe
open Microsoft.AspNetCore.Http
open MyWebLog open MyWebLog
/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response /// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
let notAuthorized : HttpHandler = fun next ctx -> task { let notAuthorized : HttpHandler =
if ctx.Request.Method = "GET" then handleContext (fun ctx ->
let returnUrl = WebUtility.UrlEncode ctx.Request.Path if ctx.Request.Method = "GET" then
return! let returnUrl = WebUtility.UrlEncode ctx.Request.Path
redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink $"user/log-on?returnUrl={returnUrl}")) next ctx redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink $"user/log-on?returnUrl={returnUrl}"))
else earlyReturn ctx
return! (setStatusCode 401 >=> fun _ _ -> Task.FromResult<HttpContext option> None) next ctx else
} setStatusCode 401 earlyReturn ctx)
/// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there /// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there
let notFound : HttpHandler = let notFound : HttpHandler = fun _ ->
setStatusCode 404 >=> text "Not found" (setStatusCode 404 >=> text "Not found") earlyReturn

View File

@@ -2,6 +2,7 @@
module MyWebLog.Handlers.Feed module MyWebLog.Handlers.Feed
open System open System
open System.Collections.Generic
open System.IO open System.IO
open System.Net open System.Net
open System.ServiceModel.Syndication open System.ServiceModel.Syndication
@@ -76,6 +77,9 @@ module private Namespace =
/// iTunes elements /// iTunes elements
let iTunes = "http://www.itunes.com/dtds/podcast-1.0.dtd" 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 /// Enables chapters
let psc = "http://podlove.org/simple-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 |> List.iter item.Categories.Add
item 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 /// Add episode information to a podcast feed item
let private addEpisode webLog (feed : CustomFeed) (post : Post) (item : SyndicationItem) = let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (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 epMediaUrl = let epMediaUrl =
match (meta >> Option.get >> value) "episode_media_file" with match episode.media with
| link when link.StartsWith "http" -> link | link when link.StartsWith "http" -> link
| link when Option.isSome podcast.mediaBaseUrl -> $"{podcast.mediaBaseUrl.Value}{link}" | link when Option.isSome podcast.mediaBaseUrl -> $"{podcast.mediaBaseUrl.Value}{link}"
| link -> WebLog.absoluteUrl webLog (Permalink link) | link -> WebLog.absoluteUrl webLog (Permalink link)
let epMediaType = let epMediaType = [ episode.mediaType; podcast.defaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
match meta "episode_media_type", podcast.defaultMediaType with let epImageUrl = defaultArg episode.imageUrl (Permalink.toString podcast.imageUrl) |> toAbsolute webLog
| Some epType, _ -> Some epType.value let epExplicit = defaultArg episode.explicit podcast.explicit |> ExplicitRating.toString
| 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 xmlDoc = XmlDocument () let xmlDoc = XmlDocument ()
let enclosure = let enclosure =
let it = xmlDoc.CreateElement "enclosure" let it = xmlDoc.CreateElement "enclosure"
it.SetAttribute ("url", epMediaUrl) 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)) epMediaType |> Option.iter (fun typ -> it.SetAttribute ("type", typ))
it it
let image = 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 ("creator", Namespace.dc, podcast.displayedAuthor)
item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.displayedAuthor) item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.displayedAuthor)
item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit) item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit)
meta "episode_subtitle" episode.subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it))
|> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it.value)) episode.duration
meta "episode_duration" |> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.ToString """hh\:mm\:ss"""))
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.value))
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 if post.metadata |> List.exists (fun it -> it.name = "chapter") then
try try
@@ -216,7 +256,12 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
let xmlDoc = XmlDocument () 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) |> List.iter (fun (alias, nsUrl) -> addNamespace rssFeed alias nsUrl)
let categorization = 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 ("author", Namespace.iTunes, podcast.displayedAuthor)
rssFeed.ElementExtensions.Add ("explicit", Namespace.iTunes, ExplicitRating.toString podcast.explicit) rssFeed.ElementExtensions.Add ("explicit", Namespace.iTunes, ExplicitRating.toString podcast.explicit)
podcast.subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub)) 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 /// Get the feed's self reference and non-feed link
let private selfAndLink webLog feedType ctx = let private selfAndLink webLog feedType ctx =
@@ -314,10 +370,9 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
let toItem post = let toItem post =
let item = toFeedItem webLog authors cats tagMaps post let item = toFeedItem webLog authors cats tagMaps post
match podcast with match podcast, post.episode with
| Some feed when post.metadata |> List.exists (fun it -> it.name = "episode_media_file") -> | Some feed, Some episode -> addEpisode webLog (Option.get feed.podcast) episode post item
addEpisode webLog feed post item | Some _, _ ->
| Some _ ->
warn "Feed" ctx $"[{webLog.name} {Permalink.toString self}] \"{stripHtml post.title}\" has no media" warn "Feed" ctx $"[{webLog.name} {Permalink.toString self}] \"{stripHtml post.title}\" has no media"
item item
| _ -> item | _ -> item
@@ -327,7 +382,7 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
setTitleAndDescription feedType webLog cats feed setTitleAndDescription feedType webLog cats feed
feed.LastUpdatedTime <- (List.head posts).updatedOn |> DateTimeOffset feed.LastUpdatedTime <- (List.head posts).updatedOn |> DateTimeOffset
feed.Generator <- generator ctx feed.Generator <- ctx.Generator
feed.Items <- posts |> Seq.ofList |> Seq.map toItem feed.Items <- posts |> Seq.ofList |> Seq.map toItem
feed.Language <- "en" feed.Language <- "en"
feed.Id <- WebLog.absoluteUrl webLog link feed.Id <- WebLog.absoluteUrl webLog link
@@ -361,23 +416,23 @@ let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> bac
open DotLiquid open DotLiquid
// GET: /admin/rss/settings // GET: /admin/settings/rss
let editSettings : HttpHandler = fun next ctx -> task { let editSettings : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog let webLog = ctx.WebLog
let feeds = let feeds =
webLog.rss.customFeeds webLog.rss.customFeeds
|> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx)) |> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx))
|> Array.ofList |> Array.ofList
return! Hash.FromAnonymousObject return! Hash.FromAnonymousObject {|
{| csrf = csrfToken ctx
page_title = "RSS Settings" page_title = "RSS Settings"
csrf = ctx.CsrfTokenSet
model = EditRssModel.fromRssOptions webLog.rss model = EditRssModel.fromRssOptions webLog.rss
custom_feeds = feeds custom_feeds = feeds
|} |}
|> viewForTheme "admin" "rss-settings" next ctx |> viewForTheme "admin" "rss-settings" next ctx
} }
// POST: /admin/rss/settings // POST: /admin/settings/rss
let saveSettings : HttpHandler = fun next ctx -> task { let saveSettings : HttpHandler = fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
let! model = ctx.BindFormAsync<EditRssModel> () let! model = ctx.BindFormAsync<EditRssModel> ()
@@ -387,11 +442,11 @@ let saveSettings : HttpHandler = fun next ctx -> task {
do! data.WebLog.updateRssOptions webLog do! data.WebLog.updateRssOptions webLog
WebLogCache.set webLog WebLogCache.set webLog
do! addMessage ctx { UserMessage.success with message = "RSS settings updated successfully" } do! addMessage ctx { UserMessage.success with message = "RSS settings updated successfully" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings/rss")) next ctx return! redirectToGet "admin/settings/rss" next ctx
| None -> return! Error.notFound next ctx | 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 editCustomFeed feedId : HttpHandler = fun next ctx -> task {
let customFeed = let customFeed =
match feedId with match feedId with
@@ -399,17 +454,27 @@ let editCustomFeed feedId : HttpHandler = fun next ctx -> task {
| _ -> ctx.WebLog.rss.customFeeds |> List.tryFind (fun f -> f.id = CustomFeedId feedId) | _ -> ctx.WebLog.rss.customFeeds |> List.tryFind (fun f -> f.id = CustomFeedId feedId)
match customFeed with match customFeed with
| Some f -> | Some f ->
return! Hash.FromAnonymousObject return! Hash.FromAnonymousObject {|
{| csrf = csrfToken ctx page_title = $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
page_title = $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed""" csrf = ctx.CsrfTokenSet
model = EditCustomFeedModel.fromFeed f model = EditCustomFeedModel.fromFeed f
categories = CategoryCache.get ctx 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 |> viewForTheme "admin" "custom-feed-edit" next ctx
| None -> return! Error.notFound 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 saveCustomFeed : HttpHandler = fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
match! data.WebLog.findById ctx.WebLog.id with match! data.WebLog.findById ctx.WebLog.id with
@@ -429,13 +494,12 @@ let saveCustomFeed : HttpHandler = fun next ctx -> task {
UserMessage.success with UserMessage.success with
message = $"""Successfully {if model.id = "new" then "add" else "sav"}ed custom feed""" message = $"""Successfully {if model.id = "new" then "add" else "sav"}ed custom feed"""
} }
let nextUrl = $"admin/settings/rss/{CustomFeedId.toString feed.id}/edit" return! redirectToGet $"admin/settings/rss/{CustomFeedId.toString feed.id}/edit" next ctx
return! redirectToGet (WebLog.relativeUrl webLog (Permalink nextUrl)) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx | 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 deleteCustomFeed feedId : HttpHandler = fun next ctx -> task {
let data = ctx.Data let data = ctx.Data
match! data.WebLog.findById ctx.WebLog.id with match! data.WebLog.findById ctx.WebLog.id with
@@ -454,6 +518,6 @@ let deleteCustomFeed feedId : HttpHandler = fun next ctx -> task {
do! addMessage ctx { UserMessage.success with message = "Custom feed deleted successfully" } do! addMessage ctx { UserMessage.success with message = "Custom feed deleted successfully" }
else else
do! addMessage ctx { UserMessage.warning with message = "Custom feed not found; no action taken" } do! addMessage ctx { UserMessage.warning with message = "Custom feed not found; no action taken" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings/rss")) next ctx return! redirectToGet "admin/settings/rss" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }

View File

@@ -52,24 +52,6 @@ let messages (ctx : HttpContext) = task {
| None -> return [||] | None -> return [||]
} }
/// Hold variable for the configured generator string
let mutable private generatorString : string option = None
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection
/// Get the generator string
let generator (ctx : HttpContext) =
match generatorString with
| Some gen -> gen
| None ->
let cfg = ctx.RequestServices.GetRequiredService<IConfiguration> ()
generatorString <-
match Option.ofObj cfg["Generator"] with
| Some gen -> Some gen
| None -> Some "generator not configured"
generatorString.Value
open MyWebLog open MyWebLog
open DotLiquid open DotLiquid
@@ -94,14 +76,14 @@ let private populateHash hash ctx = task {
hash.Add ("page_list", PageListCache.get ctx) hash.Add ("page_list", PageListCache.get ctx)
hash.Add ("current_page", ctx.Request.Path.Value.Substring 1) hash.Add ("current_page", ctx.Request.Path.Value.Substring 1)
hash.Add ("messages", messages) hash.Add ("messages", messages)
hash.Add ("generator", generator ctx) hash.Add ("generator", ctx.Generator)
hash.Add ("htmx_script", htmxScript) hash.Add ("htmx_script", htmxScript)
do! commitSession ctx do! commitSession ctx
} }
/// Render a view for the specified theme, using the specified template, layout, and hash /// Render a view for the specified theme, using the specified template, layout, and hash
let viewForTheme theme template next ctx = fun (hash : Hash) -> task { let viewForTheme theme template next ctx (hash : Hash) = task {
do! populateHash hash ctx do! populateHash hash ctx
// NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render; // NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render;
@@ -119,13 +101,14 @@ let viewForTheme theme template next ctx = fun (hash : Hash) -> task {
} }
/// Render a bare view for the specified theme, using the specified template and hash /// Render a bare view for the specified theme, using the specified template and hash
let bareForTheme theme template next ctx = fun (hash : Hash) -> task { let bareForTheme theme template next ctx (hash : Hash) = task {
do! populateHash hash ctx do! populateHash hash ctx
// Bare templates are rendered with layout-bare if not (hash.ContainsKey "content") then
let! contentTemplate = TemplateCache.get theme template ctx.Data let! contentTemplate = TemplateCache.get theme template ctx.Data
hash.Add ("content", contentTemplate.Render hash) hash.Add ("content", contentTemplate.Render hash)
// Bare templates are rendered with layout-bare
let! layoutTemplate = TemplateCache.get theme "layout-bare" ctx.Data let! layoutTemplate = TemplateCache.get theme "layout-bare" ctx.Data
// add messages as HTTP headers // add messages as HTTP headers
@@ -138,7 +121,7 @@ let bareForTheme theme template next ctx = fun (hash : Hash) -> task {
| Some detail -> $"{m.level}|||{m.message}|||{detail}" | Some detail -> $"{m.level}|||{m.message}|||{detail}"
| None -> $"{m.level}|||{m.message}" | None -> $"{m.level}|||{m.message}"
|> setHttpHeader "X-Message") |> setHttpHeader "X-Message")
withHxNoPush withHxNoPushUrl
htmlString (layoutTemplate.Render hash) htmlString (layoutTemplate.Render hash)
} }
@@ -146,36 +129,21 @@ let bareForTheme theme template next ctx = fun (hash : Hash) -> task {
} }
/// Return a view for the web log's default theme /// Return a view for the web log's default theme
let themedView template next ctx = fun (hash : Hash) -> task { let themedView template next ctx hash =
return! viewForTheme (deriveWebLogFromHash hash ctx).themePath template next ctx hash viewForTheme (deriveWebLogFromHash hash ctx).themePath template next ctx hash
}
/// Redirect after doing some action; commits session and issues a temporary redirect /// Redirect after doing some action; commits session and issues a temporary redirect
let redirectToGet url : HttpHandler = fun next ctx -> task { let redirectToGet url : HttpHandler = fun _ ctx -> task {
do! commitSession ctx do! commitSession ctx
return! redirectTo false url next ctx return! redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink url)) earlyReturn ctx
} }
open System.Security.Claims
/// Get the user ID for the current request
let userId (ctx : HttpContext) =
WebLogUserId (ctx.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value
open Microsoft.AspNetCore.Antiforgery
/// Get the Anti-CSRF service
let private antiForgery (ctx : HttpContext) = ctx.RequestServices.GetRequiredService<IAntiforgery> ()
/// Get the cross-site request forgery token set
let csrfToken (ctx : HttpContext) =
(antiForgery ctx).GetAndStoreTokens ctx
/// Validate the cross-site request forgery token in the current request /// Validate the cross-site request forgery token in the current request
let validateCsrf : HttpHandler = fun next ctx -> task { let validateCsrf : HttpHandler = fun next ctx -> task {
match! (antiForgery ctx).IsRequestValidAsync ctx with match! ctx.AntiForgery.IsRequestValidAsync ctx with
| true -> return! next ctx | true -> return! next ctx
| false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" next ctx | false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" earlyReturn ctx
} }
/// Require a user to be logged on /// Require a user to be logged on
@@ -226,6 +194,14 @@ let getCategoryIds slug ctx =
|> Seq.map (fun c -> CategoryId c.id) |> Seq.map (fun c -> CategoryId c.id)
|> List.ofSeq |> List.ofSeq
open System
open System.Globalization
/// Parse a date/time to UTC
let parseToUtc (date : string) =
DateTime.Parse (date, null, DateTimeStyles.AdjustToUniversal)
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
/// Log level for debugging /// Log level for debugging

View File

@@ -0,0 +1,221 @@
/// Handlers to manipulate pages
module MyWebLog.Handlers.Page
open DotLiquid
open Giraffe
open MyWebLog
open MyWebLog.ViewModels
// GET /admin/pages
// GET /admin/pages/page/{pageNbr}
let all pageNbr : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let! pages = ctx.Data.Page.findPageOfPages webLog.id pageNbr
return!
Hash.FromAnonymousObject {|
page_title = "Pages"
csrf = ctx.CsrfTokenSet
pages = pages |> List.map (DisplayPage.fromPageMinimal webLog)
page_nbr = pageNbr
prev_page = if pageNbr = 2 then "" else $"/page/{pageNbr - 1}"
next_page = $"/page/{pageNbr + 1}"
|}
|> viewForTheme "admin" "page-list" next ctx
}
// GET /admin/page/{id}/edit
let edit pgId : HttpHandler = fun next ctx -> task {
let! result = task {
match pgId with
| "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new" })
| _ ->
match! ctx.Data.Page.findFullById (PageId pgId) ctx.WebLog.id with
| Some page -> return Some ("Edit Page", page)
| None -> return None
}
match result with
| Some (title, page) ->
let model = EditPageModel.fromPage page
let! templates = templatesForTheme ctx "page"
return!
Hash.FromAnonymousObject {|
page_title = title
csrf = ctx.CsrfTokenSet
model = model
metadata = Array.zip model.metaNames model.metaValues
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
templates = templates
|}
|> viewForTheme "admin" "page-edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/page/{id}/delete
let delete pgId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
match! ctx.Data.Page.delete (PageId pgId) webLog.id with
| true ->
do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Page deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with message = "Page not found; nothing deleted" }
return! redirectToGet "admin/pages" next ctx
}
// GET /admin/page/{id}/permalinks
let editPermalinks pgId : HttpHandler = fun next ctx -> task {
match! ctx.Data.Page.findFullById (PageId pgId) ctx.WebLog.id with
| Some pg ->
return!
Hash.FromAnonymousObject {|
page_title = "Manage Prior Permalinks"
csrf = ctx.CsrfTokenSet
model = ManagePermalinksModel.fromPage pg
|}
|> viewForTheme "admin" "permalinks" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/page/permalinks
let savePermalinks : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let links = model.prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Page.updatePriorPermalinks (PageId model.id) webLog.id links with
| true ->
do! addMessage ctx { UserMessage.success with message = "Page permalinks saved successfully" }
return! redirectToGet $"admin/page/{model.id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
}
// GET /admin/page/{id}/revisions
let editRevisions pgId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
match! ctx.Data.Page.findFullById (PageId pgId) webLog.id with
| Some pg ->
return!
Hash.FromAnonymousObject {|
page_title = "Manage Page Revisions"
csrf = ctx.CsrfTokenSet
model = ManageRevisionsModel.fromPage webLog pg
|}
|> viewForTheme "admin" "revisions" next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/page/{id}/revisions/purge
let purgeRevisions pgId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let data = ctx.Data
match! data.Page.findFullById (PageId pgId) webLog.id with
| Some pg ->
do! data.Page.update { pg with revisions = [ List.head pg.revisions ] }
do! addMessage ctx { UserMessage.success with message = "Prior revisions purged successfully" }
return! redirectToGet $"admin/page/{pgId}/revisions" next ctx
| None -> return! Error.notFound next ctx
}
open Microsoft.AspNetCore.Http
/// Find the page and the requested revision
let private findPageRevision pgId revDate (ctx : HttpContext) = task {
match! ctx.Data.Page.findFullById (PageId pgId) ctx.WebLog.id with
| Some pg ->
let asOf = parseToUtc revDate
return Some pg, pg.revisions |> List.tryFind (fun r -> r.asOf = asOf)
| None -> return None, None
}
// GET /admin/page/{id}/revision/{revision-date}/preview
let previewRevision (pgId, revDate) : HttpHandler = fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some _, Some rev ->
return!
Hash.FromAnonymousObject {|
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.text}</div>"""
|}
|> bareForTheme "admin" "" next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
open System
// POST /admin/page/{id}/revision/{revision-date}/restore
let restoreRevision (pgId, revDate) : HttpHandler = fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev ->
do! ctx.Data.Page.update
{ pg with
revisions = { rev with asOf = DateTime.UtcNow }
:: (pg.revisions |> List.filter (fun r -> r.asOf <> rev.asOf))
}
do! addMessage ctx { UserMessage.success with message = "Revision restored successfully" }
return! redirectToGet $"admin/page/{pgId}/revisions" next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/page/{id}/revision/{revision-date}/delete
let deleteRevision (pgId, revDate) : HttpHandler = fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev ->
do! ctx.Data.Page.update { pg with revisions = pg.revisions |> List.filter (fun r -> r.asOf <> rev.asOf) }
do! addMessage ctx { UserMessage.success with message = "Revision deleted successfully" }
return! bareForTheme "admin" "" next ctx (Hash.FromAnonymousObject {| content = "" |})
| None, _
| _, None -> return! Error.notFound next ctx
}
#nowarn "3511"
// POST /admin/page/save
let save : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> ()
let webLog = ctx.WebLog
let data = ctx.Data
let now = DateTime.UtcNow
let! pg = task {
match model.pageId with
| "new" ->
return Some
{ Page.empty with
id = PageId.create ()
webLogId = webLog.id
authorId = ctx.UserId
publishedOn = now
}
| pgId -> return! data.Page.findFullById (PageId pgId) webLog.id
}
match pg with
| Some page ->
let updateList = page.showInPageList <> model.isShownInPageList
let revision = { asOf = now; text = MarkupText.parse $"{model.source}: {model.text}" }
// Detect a permalink change, and add the prior one to the prior list
let page =
match Permalink.toString page.permalink with
| "" -> page
| link when link = model.permalink -> page
| _ -> { page with priorPermalinks = page.permalink :: page.priorPermalinks }
let page =
{ page with
title = model.title
permalink = Permalink model.permalink
updatedOn = now
showInPageList = model.isShownInPageList
template = match model.template with "" -> None | tmpl -> Some tmpl
text = MarkupText.toHtml revision.text
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 page.revisions |> List.tryHead with
| Some r when r.text = revision.text -> page.revisions
| _ -> revision :: page.revisions
}
do! (if model.pageId = "new" then data.Page.add else data.Page.update) page
if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Page saved successfully" }
return! redirectToGet $"admin/page/{PageId.toString page.id}/edit" next ctx
| None -> return! Error.notFound next ctx
}

View File

@@ -2,6 +2,7 @@
module MyWebLog.Handlers.Post module MyWebLog.Handlers.Post
open System open System
open System.Collections.Generic
open MyWebLog open MyWebLog
/// Parse a slug and page number from an "everything else" URL /// Parse a slug and page number from an "everything else" URL
@@ -197,9 +198,9 @@ let home : HttpHandler = fun next ctx -> task {
| Some page -> | Some page ->
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
page_title = page.title
page = DisplayPage.fromPage webLog page page = DisplayPage.fromPage webLog page
categories = CategoryCache.get ctx categories = CategoryCache.get ctx
page_title = page.title
is_home = true is_home = true
|} |}
|> themedView (defaultArg page.template "single-page") next ctx |> themedView (defaultArg page.template "single-page") next ctx
@@ -214,7 +215,7 @@ let all pageNbr : HttpHandler = fun next ctx -> task {
let! posts = data.Post.findPageOfPosts webLog.id pageNbr 25 let! posts = data.Post.findPageOfPosts webLog.id pageNbr 25
let! hash = preparePostList webLog posts AdminList "" pageNbr 25 ctx data let! hash = preparePostList webLog posts AdminList "" pageNbr 25 ctx data
hash.Add ("page_title", "Posts") hash.Add ("page_title", "Posts")
hash.Add ("csrf", csrfToken ctx) hash.Add ("csrf", ctx.CsrfTokenSet)
return! viewForTheme "admin" "post-list" next ctx hash return! viewForTheme "admin" "post-list" next ctx hash
} }
@@ -237,27 +238,42 @@ let edit postId : HttpHandler = fun next ctx -> task {
let model = EditPostModel.fromPost webLog post let model = EditPostModel.fromPost webLog post
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
csrf = csrfToken ctx page_title = title
model = model csrf = ctx.CsrfTokenSet
metadata = Array.zip model.metaNames model.metaValues model = model
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]) metadata = Array.zip model.metaNames model.metaValues
page_title = title |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
templates = templates templates = templates
categories = cats categories = cats
explicit_values = [|
KeyValuePair.Create ("", "&ndash; Default &ndash;")
KeyValuePair.Create (ExplicitRating.toString Yes, "Yes")
KeyValuePair.Create (ExplicitRating.toString No, "No")
KeyValuePair.Create (ExplicitRating.toString Clean, "Clean")
|]
|} |}
|> viewForTheme "admin" "post-edit" next ctx |> viewForTheme "admin" "post-edit" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// POST /admin/post/{id}/delete
let delete postId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
match! ctx.Data.Post.delete (PostId postId) webLog.id with
| true -> do! addMessage ctx { UserMessage.success with message = "Post deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with message = "Post not found; nothing deleted" }
return! redirectToGet "admin/posts" next ctx
}
// GET /admin/post/{id}/permalinks // GET /admin/post/{id}/permalinks
let editPermalinks postId : HttpHandler = fun next ctx -> task { let editPermalinks postId : HttpHandler = fun next ctx -> task {
match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with
| Some post -> | Some post ->
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
csrf = csrfToken ctx page_title = "Manage Prior Permalinks"
csrf = ctx.CsrfTokenSet
model = ManagePermalinksModel.fromPost post model = ManagePermalinksModel.fromPost post
page_title = $"Manage Prior Permalinks"
|} |}
|> viewForTheme "admin" "permalinks" next ctx |> viewForTheme "admin" "permalinks" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@@ -271,17 +287,83 @@ let savePermalinks : HttpHandler = fun next ctx -> task {
match! ctx.Data.Post.updatePriorPermalinks (PostId model.id) webLog.id links with match! ctx.Data.Post.updatePriorPermalinks (PostId model.id) webLog.id links with
| true -> | true ->
do! addMessage ctx { UserMessage.success with message = "Post permalinks saved successfully" } do! addMessage ctx { UserMessage.success with message = "Post permalinks saved successfully" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{model.id}/permalinks")) next ctx return! redirectToGet $"admin/post/{model.id}/permalinks" next ctx
| false -> return! Error.notFound next ctx | false -> return! Error.notFound next ctx
} }
// POST /admin/post/{id}/delete // GET /admin/post/{id}/revisions
let delete postId : HttpHandler = fun next ctx -> task { let editRevisions postId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with
match! ctx.Data.Post.delete (PostId postId) webLog.id with | Some post ->
| true -> do! addMessage ctx { UserMessage.success with message = "Post deleted successfully" } return!
| false -> do! addMessage ctx { UserMessage.error with message = "Post not found; nothing deleted" } Hash.FromAnonymousObject {|
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/posts")) next ctx page_title = "Manage Post Revisions"
csrf = ctx.CsrfTokenSet
model = ManageRevisionsModel.fromPost ctx.WebLog post
|}
|> viewForTheme "admin" "revisions" next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/post/{id}/revisions/purge
let purgeRevisions postId : HttpHandler = fun next ctx -> task {
let data = ctx.Data
match! data.Post.findFullById (PostId postId) ctx.WebLog.id with
| Some post ->
do! data.Post.update { post with revisions = [ List.head post.revisions ] }
do! addMessage ctx { UserMessage.success with message = "Prior revisions purged successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| None -> return! Error.notFound next ctx
}
open Microsoft.AspNetCore.Http
/// Find the post and the requested revision
let private findPostRevision postId revDate (ctx : HttpContext) = task {
match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with
| Some post ->
let asOf = parseToUtc revDate
return Some post, post.revisions |> List.tryFind (fun r -> r.asOf = asOf)
| None -> return None, None
}
// GET /admin/post/{id}/revision/{revision-date}/preview
let previewRevision (postId, revDate) : HttpHandler = fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some _, Some rev ->
return!
Hash.FromAnonymousObject {|
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.text}</div>"""
|}
|> bareForTheme "admin" "" next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/revision/{revision-date}/restore
let restoreRevision (postId, revDate) : HttpHandler = fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev ->
do! ctx.Data.Post.update
{ post with
revisions = { rev with asOf = DateTime.UtcNow }
:: (post.revisions |> List.filter (fun r -> r.asOf <> rev.asOf))
}
do! addMessage ctx { UserMessage.success with message = "Revision restored successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/revision/{revision-date}/delete
let deleteRevision (postId, revDate) : HttpHandler = fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev ->
do! ctx.Data.Post.update { post with revisions = post.revisions |> List.filter (fun r -> r.asOf <> rev.asOf) }
do! addMessage ctx { UserMessage.success with message = "Revision deleted successfully" }
return! bareForTheme "admin" "" next ctx (Hash.FromAnonymousObject {| content = "" |})
| None, _
| _, None -> return! Error.notFound next ctx
} }
#nowarn "3511" #nowarn "3511"
@@ -299,7 +381,7 @@ let save : HttpHandler = fun next ctx -> task {
{ Post.empty with { Post.empty with
id = PostId.create () id = PostId.create ()
webLogId = webLog.id webLogId = webLog.id
authorId = userId ctx authorId = ctx.UserId
} }
| postId -> return! data.Post.findFullById (PostId postId) webLog.id | postId -> return! data.Post.findFullById (PostId postId) webLog.id
} }
@@ -312,35 +394,11 @@ let save : HttpHandler = fun next ctx -> task {
| "" -> post | "" -> post
| link when link = model.permalink -> post | link when link = model.permalink -> post
| _ -> { post with priorPermalinks = post.permalink :: post.priorPermalinks } | _ -> { post with priorPermalinks = post.permalink :: post.priorPermalinks }
let post = let post = model.updatePost post revision now
{ 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 = let post =
match model.setPublished with match model.setPublished with
| true -> | true ->
let dt = WebLog.utcTime webLog model.pubOverride.Value let dt = parseToUtc (model.pubOverride.Value.ToString "o")
match model.setUpdated with match model.setUpdated with
| true -> | true ->
{ post with { post with
@@ -359,7 +417,6 @@ let save : HttpHandler = fun next ctx -> task {
|> List.length = List.length pst.Value.categoryIds) then |> List.length = List.length pst.Value.categoryIds) then
do! CategoryCache.update ctx do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Post saved successfully" } do! addMessage ctx { UserMessage.success with message = "Post saved successfully" }
return! return! redirectToGet $"admin/post/{PostId.toString post.id}/edit" next ctx
redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{PostId.toString post.id}/edit")) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }

View File

@@ -29,7 +29,7 @@ module CatchAll =
// Current post // Current post
match data.Post.findByPermalink permalink webLog.id |> await with match data.Post.findByPermalink permalink webLog.id |> await with
| Some post -> | Some post ->
debug (fun () -> $"Found post by permalink") debug (fun () -> "Found post by permalink")
let model = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 ctx data |> await let model = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 ctx data |> await
model.Add ("page_title", post.title) model.Add ("page_title", post.title)
yield fun next ctx -> themedView (defaultArg post.template "single-post") next ctx model yield fun next ctx -> themedView (defaultArg post.template "single-post") next ctx model
@@ -37,12 +37,12 @@ module CatchAll =
// Current page // Current page
match data.Page.findByPermalink permalink webLog.id |> await with match data.Page.findByPermalink permalink webLog.id |> await with
| Some page -> | Some page ->
debug (fun () -> $"Found page by permalink") debug (fun () -> "Found page by permalink")
yield fun next ctx -> yield fun next ctx ->
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
page_title = page.title
page = DisplayPage.fromPage webLog page page = DisplayPage.fromPage webLog page
categories = CategoryCache.get ctx categories = CategoryCache.get ctx
page_title = page.title
is_page = true is_page = true
|} |}
|> themedView (defaultArg page.template "single-page") next ctx |> themedView (defaultArg page.template "single-page") next ctx
@@ -50,7 +50,7 @@ module CatchAll =
// RSS feed // RSS feed
match Feed.deriveFeedType ctx textLink with match Feed.deriveFeedType ctx textLink with
| Some (feedType, postCount) -> | Some (feedType, postCount) ->
debug (fun () -> $"Found RSS feed") debug (fun () -> "Found RSS feed")
yield Feed.generate feedType postCount yield Feed.generate feedType postCount
| None -> () | None -> ()
// Post differing only by trailing slash // Post differing only by trailing slash
@@ -58,28 +58,28 @@ module CatchAll =
Permalink (if textLink.EndsWith "/" then textLink[1..textLink.Length - 2] else $"{textLink[1..]}/") Permalink (if textLink.EndsWith "/" then textLink[1..textLink.Length - 2] else $"{textLink[1..]}/")
match data.Post.findByPermalink altLink webLog.id |> await with match data.Post.findByPermalink altLink webLog.id |> await with
| Some post -> | Some post ->
debug (fun () -> $"Found post by trailing-slash-agnostic permalink") debug (fun () -> "Found post by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog post.permalink) yield redirectTo true (WebLog.relativeUrl webLog post.permalink)
| None -> () | None -> ()
// Page differing only by trailing slash // Page differing only by trailing slash
match data.Page.findByPermalink altLink webLog.id |> await with match data.Page.findByPermalink altLink webLog.id |> await with
| Some page -> | Some page ->
debug (fun () -> $"Found page by trailing-slash-agnostic permalink") debug (fun () -> "Found page by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog page.permalink) yield redirectTo true (WebLog.relativeUrl webLog page.permalink)
| None -> () | None -> ()
// Prior post // Prior post
match data.Post.findCurrentPermalink [ permalink; altLink ] webLog.id |> await with match data.Post.findCurrentPermalink [ permalink; altLink ] webLog.id |> await with
| Some link -> | Some link ->
debug (fun () -> $"Found post by prior permalink") debug (fun () -> "Found post by prior permalink")
yield redirectTo true (WebLog.relativeUrl webLog link) yield redirectTo true (WebLog.relativeUrl webLog link)
| None -> () | None -> ()
// Prior page // Prior page
match data.Page.findCurrentPermalink [ permalink; altLink ] webLog.id |> await with match data.Page.findCurrentPermalink [ permalink; altLink ] webLog.id |> await with
| Some link -> | Some link ->
debug (fun () -> $"Found page by prior permalink") debug (fun () -> "Found page by prior permalink")
yield redirectTo true (WebLog.relativeUrl webLog link) yield redirectTo true (WebLog.relativeUrl webLog link)
| None -> () | None -> ()
debug (fun () -> $"No content found") debug (fun () -> "No content found")
} }
// GET {all-of-the-above} // GET {all-of-the-above}
@@ -93,55 +93,25 @@ module CatchAll =
/// Serve theme assets /// Serve theme assets
module Asset = 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} // 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 let path = urlParts |> Seq.skip 1 |> Seq.head
match! ctx.Data.ThemeAsset.findById (ThemeAssetId.ofString path) with match! ctx.Data.ThemeAsset.findById (ThemeAssetId.ofString path) with
| Some asset -> | Some asset ->
match checkModified asset ctx with match Upload.checkModified asset.updatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx | Some threeOhFour -> return! threeOhFour next ctx
| None -> | None -> return! Upload.sendFile asset.updatedOn path asset.data next ctx
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! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
/// The primary myWebLog router /// The primary myWebLog router
let router : HttpHandler = choose [ let router : HttpHandler = choose [
GET >=> choose [ GET_HEAD >=> choose [
route "/" >=> Post.home route "/" >=> Post.home
] ]
subRoute "/admin" (requireUser >=> choose [ subRoute "/admin" (requireUser >=> choose [
GET >=> choose [ GET_HEAD >=> choose [
subRoute "/categor" (choose [ subRoute "/categor" (choose [
route "ies" >=> Admin.listCategories route "ies" >=> Admin.listCategories
route "ies/bare" >=> Admin.listCategoriesBare route "ies/bare" >=> Admin.listCategoriesBare
@@ -149,16 +119,20 @@ let router : HttpHandler = choose [
]) ])
route "/dashboard" >=> Admin.dashboard route "/dashboard" >=> Admin.dashboard
subRoute "/page" (choose [ subRoute "/page" (choose [
route "s" >=> Admin.listPages 1 route "s" >=> Page.all 1
routef "s/page/%i" Admin.listPages routef "s/page/%i" Page.all
routef "/%s/edit" Admin.editPage routef "/%s/edit" Page.edit
routef "/%s/permalinks" Admin.editPagePermalinks routef "/%s/permalinks" Page.editPermalinks
routef "/%s/revision/%s/preview" Page.previewRevision
routef "/%s/revisions" Page.editRevisions
]) ])
subRoute "/post" (choose [ subRoute "/post" (choose [
route "s" >=> Post.all 1 route "s" >=> Post.all 1
routef "s/page/%i" Post.all routef "s/page/%i" Post.all
routef "/%s/edit" Post.edit routef "/%s/edit" Post.edit
routef "/%s/permalinks" Post.editPermalinks routef "/%s/permalinks" Post.editPermalinks
routef "/%s/revision/%s/preview" Post.previewRevision
routef "/%s/revisions" Post.editRevisions
]) ])
subRoute "/settings" (choose [ subRoute "/settings" (choose [
route "" >=> Admin.settings route "" >=> Admin.settings
@@ -173,6 +147,10 @@ let router : HttpHandler = choose [
]) ])
]) ])
route "/theme/update" >=> Admin.themeUpdatePage route "/theme/update" >=> Admin.themeUpdatePage
subRoute "/upload" (choose [
route "s" >=> Upload.list
route "/new" >=> Upload.showNew
])
route "/user/edit" >=> User.edit route "/user/edit" >=> User.edit
] ]
POST >=> validateCsrf >=> choose [ POST >=> validateCsrf >=> choose [
@@ -181,14 +159,20 @@ let router : HttpHandler = choose [
routef "/%s/delete" Admin.deleteCategory routef "/%s/delete" Admin.deleteCategory
]) ])
subRoute "/page" (choose [ subRoute "/page" (choose [
route "/save" >=> Admin.savePage route "/save" >=> Page.save
route "/permalinks" >=> Admin.savePagePermalinks route "/permalinks" >=> Page.savePermalinks
routef "/%s/delete" Admin.deletePage routef "/%s/delete" Page.delete
routef "/%s/revision/%s/delete" Page.deleteRevision
routef "/%s/revision/%s/restore" Page.restoreRevision
routef "/%s/revisions/purge" Page.purgeRevisions
]) ])
subRoute "/post" (choose [ subRoute "/post" (choose [
route "/save" >=> Post.save route "/save" >=> Post.save
route "/permalinks" >=> Post.savePermalinks route "/permalinks" >=> Post.savePermalinks
routef "/%s/delete" Post.delete routef "/%s/delete" Post.delete
routef "/%s/revision/%s/delete" Post.deleteRevision
routef "/%s/revision/%s/restore" Post.restoreRevision
routef "/%s/revisions/purge" Post.purgeRevisions
]) ])
subRoute "/settings" (choose [ subRoute "/settings" (choose [
route "" >=> Admin.saveSettings route "" >=> Admin.saveSettings
@@ -203,6 +187,11 @@ let router : HttpHandler = choose [
]) ])
]) ])
route "/theme/update" >=> Admin.updateTheme 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 route "/user/save" >=> User.save
] ]
]) ])
@@ -210,7 +199,8 @@ let router : HttpHandler = choose [
GET_HEAD >=> routef "/page/%i" Post.pageOfPosts GET_HEAD >=> routef "/page/%i" Post.pageOfPosts
GET_HEAD >=> routef "/page/%i/" Post.redirectToPageOfPosts GET_HEAD >=> routef "/page/%i/" Post.redirectToPageOfPosts
GET_HEAD >=> routexp "/tag/(.*)" Post.pageOfTaggedPosts 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 [ subRoute "/user" (choose [
GET_HEAD >=> choose [ GET_HEAD >=> choose [
route "/log-on" >=> User.logOn None route "/log-on" >=> User.logOn None

View File

@@ -0,0 +1,214 @@
/// 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 {|
page_title = "Uploaded Files"
csrf = ctx.CsrfTokenSet
files = allFiles
|}
|> viewForTheme "admin" "upload-list" next ctx
}
// GET /admin/upload/new
let showNew : HttpHandler = fun next ctx -> task {
return!
Hash.FromAnonymousObject {|
page_title = "Upload a File"
csrf = ctx.CsrfTokenSet
destination = UploadDestination.toString ctx.WebLog.uploads
|}
|> viewForTheme "admin" "upload-new" next ctx
}
/// Redirect to the upload list
let showUploads : HttpHandler =
redirectToGet "admin/uploads"
// 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
}

View File

@@ -13,6 +13,7 @@ let hashedPassword (plainText : string) (email : string) (salt : Guid) =
open DotLiquid open DotLiquid
open Giraffe open Giraffe
open MyWebLog
open MyWebLog.ViewModels open MyWebLog.ViewModels
// GET /user/log-on // GET /user/log-on
@@ -26,9 +27,9 @@ let logOn returnUrl : HttpHandler = fun next ctx -> task {
| false -> None | false -> None
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
model = { LogOnModel.empty with returnTo = returnTo }
page_title = "Log On" page_title = "Log On"
csrf = csrfToken ctx csrf = ctx.CsrfTokenSet
model = { LogOnModel.empty with returnTo = returnTo }
|} |}
|> viewForTheme "admin" "log-on" next ctx |> viewForTheme "admin" "log-on" next ctx
} }
@@ -36,13 +37,11 @@ let logOn returnUrl : HttpHandler = fun next ctx -> task {
open System.Security.Claims open System.Security.Claims
open Microsoft.AspNetCore.Authentication open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies open Microsoft.AspNetCore.Authentication.Cookies
open MyWebLog
// POST /user/log-on // POST /user/log-on
let doLogOn : HttpHandler = fun next ctx -> task { let doLogOn : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel> () let! model = ctx.BindFormAsync<LogOnModel> ()
let webLog = ctx.WebLog match! ctx.Data.WebLogUser.findByEmail model.emailAddress ctx.WebLog.id with
match! ctx.Data.WebLogUser.findByEmail model.emailAddress webLog.id with
| Some user when user.passwordHash = hashedPassword model.password user.userName user.salt -> | Some user when user.passwordHash = hashedPassword model.password user.userName user.salt ->
let claims = seq { let claims = seq {
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.id) Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.id)
@@ -55,9 +54,8 @@ let doLogOn : HttpHandler = fun next ctx -> task {
do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity, do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity,
AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow)) AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow))
do! addMessage ctx do! addMessage ctx
{ UserMessage.success with message = $"Logged on successfully | Welcome to {webLog.name}!" } { UserMessage.success with message = $"Logged on successfully | Welcome to {ctx.WebLog.name}!" }
return! redirectToGet (defaultArg model.returnTo (WebLog.relativeUrl webLog (Permalink "admin/dashboard"))) return! redirectToGet (defaultArg (model.returnTo |> Option.map (fun it -> it[1..])) "admin/dashboard") next ctx
next ctx
| _ -> | _ ->
do! addMessage ctx { UserMessage.error with message = "Log on attempt unsuccessful" } do! addMessage ctx { UserMessage.error with message = "Log on attempt unsuccessful" }
return! logOn model.returnTo next ctx return! logOn model.returnTo next ctx
@@ -67,19 +65,19 @@ let doLogOn : HttpHandler = fun next ctx -> task {
let logOff : HttpHandler = fun next ctx -> task { let logOff : HttpHandler = fun next ctx -> task {
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
do! addMessage ctx { UserMessage.info with message = "Log off successful" } do! addMessage ctx { UserMessage.info with message = "Log off successful" }
return! redirectToGet (WebLog.relativeUrl ctx.WebLog Permalink.empty) next ctx return! redirectToGet "" next ctx
} }
/// Display the user edit page, with information possibly filled in /// Display the user edit page, with information possibly filled in
let private showEdit (hash : Hash) : HttpHandler = fun next ctx -> task { let private showEdit (hash : Hash) : HttpHandler = fun next ctx -> task {
hash.Add ("page_title", "Edit Your Information") hash.Add ("page_title", "Edit Your Information")
hash.Add ("csrf", csrfToken ctx) hash.Add ("csrf", ctx.CsrfTokenSet)
return! viewForTheme "admin" "user-edit" next ctx hash return! viewForTheme "admin" "user-edit" next ctx hash
} }
// GET /admin/user/edit // GET /admin/user/edit
let edit : HttpHandler = fun next ctx -> task { let edit : HttpHandler = fun next ctx -> task {
match! ctx.Data.WebLogUser.findById (userId ctx) ctx.WebLog.id with match! ctx.Data.WebLogUser.findById ctx.UserId ctx.WebLog.id with
| Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) next ctx | Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@@ -89,7 +87,7 @@ let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel> () let! model = ctx.BindFormAsync<EditUserModel> ()
if model.newPassword = model.newPasswordConfirm then if model.newPassword = model.newPasswordConfirm then
let data = ctx.Data let data = ctx.Data
match! data.WebLogUser.findById (userId ctx) ctx.WebLog.id with match! data.WebLogUser.findById ctx.UserId ctx.WebLog.id with
| Some user -> | Some user ->
let pw, salt = let pw, salt =
if model.newPassword = "" then if model.newPassword = "" then
@@ -108,7 +106,7 @@ let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
do! data.WebLogUser.update user do! data.WebLogUser.update user
let pwMsg = if model.newPassword = "" then "" else " and updated your password" let pwMsg = if model.newPassword = "" then "" else " and updated your password"
do! addMessage ctx { UserMessage.success with message = $"Saved your information{pwMsg} successfully" } do! addMessage ctx { UserMessage.success with message = $"Saved your information{pwMsg} successfully" }
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/user/edit")) next ctx return! redirectToGet "admin/user/edit" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
else else
do! addMessage ctx { UserMessage.error with message = "Passwords did not match; no updates made" } do! addMessage ctx { UserMessage.error with message = "Passwords did not match; no updates made" }

View File

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

View File

@@ -10,14 +10,16 @@
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Content Include="appsettings.json" CopyToOutputDirectory="Always" /> <Content Include="appsettings*.json" CopyToOutputDirectory="Always" />
<Compile Include="Caches.fs" /> <Compile Include="Caches.fs" />
<Compile Include="Handlers\Error.fs" /> <Compile Include="Handlers\Error.fs" />
<Compile Include="Handlers\Helpers.fs" /> <Compile Include="Handlers\Helpers.fs" />
<Compile Include="Handlers\Admin.fs" /> <Compile Include="Handlers\Admin.fs" />
<Compile Include="Handlers\Feed.fs" /> <Compile Include="Handlers\Feed.fs" />
<Compile Include="Handlers\Page.fs" />
<Compile Include="Handlers\Post.fs" /> <Compile Include="Handlers\Post.fs" />
<Compile Include="Handlers\User.fs" /> <Compile Include="Handlers\User.fs" />
<Compile Include="Handlers\Upload.fs" />
<Compile Include="Handlers\Routes.fs" /> <Compile Include="Handlers\Routes.fs" />
<Compile Include="DotLiquidBespoke.fs" /> <Compile Include="DotLiquidBespoke.fs" />
<Compile Include="Maintenance.fs" /> <Compile Include="Maintenance.fs" />
@@ -27,8 +29,8 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="DotLiquid" Version="2.2.656" /> <PackageReference Include="DotLiquid" Version="2.2.656" />
<PackageReference Include="Giraffe" Version="6.0.0" /> <PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.7.0" /> <PackageReference Include="Giraffe.Htmx" Version="1.8.0" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.7.0" /> <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.0" />
<PackageReference Include="NeoSmart.Caching.Sqlite" Version="6.0.1" /> <PackageReference Include="NeoSmart.Caching.Sqlite" Version="6.0.1" />
<PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" /> <PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" />
<PackageReference Update="FSharp.Core" Version="6.0.5" /> <PackageReference Update="FSharp.Core" Version="6.0.5" />
@@ -41,7 +43,7 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<None Include=".\wwwroot\img\*.png" CopyToOutputDirectory="Always" /> <None Include=".\wwwroot\upload\*" CopyToOutputDirectory="Always" />
</ItemGroup> </ItemGroup>
</Project> </Project>

View File

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

View File

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

View File

View File

@@ -12,6 +12,7 @@
{{ "admin/dashboard" | nav_link: "Dashboard" }} {{ "admin/dashboard" | nav_link: "Dashboard" }}
{{ "admin/pages" | nav_link: "Pages" }} {{ "admin/pages" | nav_link: "Pages" }}
{{ "admin/posts" | nav_link: "Posts" }} {{ "admin/posts" | nav_link: "Posts" }}
{{ "admin/uploads" | nav_link: "Uploads" }}
{{ "admin/categories" | nav_link: "Categories" }} {{ "admin/categories" | nav_link: "Categories" }}
{{ "admin/settings" | nav_link: "Settings" }} {{ "admin/settings" | nav_link: "Settings" }}
</ul> </ul>
@@ -47,6 +48,8 @@
<div class="container-fluid"> <div class="container-fluid">
<div class="row"> <div class="row">
<div class="col-xs-12 text-end"> <div class="col-xs-12 text-end">
{%- assign version = generator | split: " " -%}
<small class="me-1 align-baseline">v{{ version[1] }}</small>
<img src="{{ "themes/admin/logo-light.png" | relative_link }}" alt="myWebLog" width="120" height="34"> <img src="{{ "themes/admin/logo-light.png" | relative_link }}" alt="myWebLog" width="120" height="34">
</div> </div>
</div> </div>

View File

@@ -185,7 +185,7 @@
</div> </div>
</div> </div>
</div> </div>
<div class="row"> <div class="row pb-3">
<div class="col-12 col-lg-10 offset-lg-1"> <div class="col-12 col-lg-10 offset-lg-1">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="mediaBaseUrl" id="mediaBaseUrl" class="form-control" <input type="text" name="mediaBaseUrl" id="mediaBaseUrl" class="form-control"
@@ -195,6 +195,57 @@
</div> </div>
</div> </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> </fieldset>
</div> </div>
</div> </div>

View File

@@ -16,8 +16,15 @@
value="{{ model.permalink }}"> value="{{ model.permalink }}">
<label for="permalink">Permalink</label> <label for="permalink">Permalink</label>
{%- if model.page_id != "new" %} {%- if model.page_id != "new" %}
{%- capture perm_edit %}admin/page/{{ model.page_id }}/permalinks{% endcapture -%} <span class="form-text">
<span class="form-text"><a href="{{ perm_edit | relative_link }}">Manage Permalinks</a></span> <a href="{{ "admin/page/" | append: model.page_id | append: "/permalinks" | relative_link }}">
Manage Permalinks
</a>
<span class="text-muted"> &bull; </span>
<a href="{{ "admin/page/" | append: model.page_id | append: "/revisions" | relative_link }}">
Manage Revisions
</a>
</span>
{% endif -%} {% endif -%}
</div> </div>
<div class="mb-2"> <div class="mb-2">

View File

@@ -16,18 +16,27 @@
value="{{ model.permalink }}"> value="{{ model.permalink }}">
<label for="permalink">Permalink</label> <label for="permalink">Permalink</label>
{%- if model.post_id != "new" %} {%- if model.post_id != "new" %}
{%- capture perm_edit %}admin/post/{{ model.post_id }}/permalinks{% endcapture -%} <span class="form-text">
<span class="form-text"><a href="{{ perm_edit | relative_link }}">Manage Permalinks</a></span> <a href="{{ "admin/post/" | append: model.post_id | append: "/permalinks" | relative_link }}">
Manage Permalinks
</a>
<span class="text-muted"> &bull; </span>
<a href="{{ "admin/post/" | append: model.post_id | append: "/revisions" | relative_link }}">
Manage Revisions
</a>
</span>
{% endif -%} {% endif -%}
</div> </div>
<div class="mb-2"> <div class="mb-2">
<label for="text">Text</label> &nbsp; &nbsp; <label for="text">Text</label> &nbsp; &nbsp;
<input type="radio" name="source" id="source_html" class="btn-check" value="HTML" <div class="btn-group btn-group-sm" role="group" aria-label="Text format button group">
{%- if model.source == "HTML" %} checked="checked"{% endif %}> <input type="radio" name="source" id="source_html" class="btn-check" value="HTML"
<label class="btn btn-sm btn-outline-secondary" for="source_html">HTML</label> {%- if model.source == "HTML" %} checked="checked"{% endif %}>
<input type="radio" name="source" id="source_md" class="btn-check" value="Markdown" <label class="btn btn-sm btn-outline-secondary" for="source_html">HTML</label>
{%- if model.source == "Markdown" %} checked="checked"{% endif %}> <input type="radio" name="source" id="source_md" class="btn-check" value="Markdown"
<label class="btn btn-sm btn-outline-secondary" for="source_md">Markdown</label> {%- if model.source == "Markdown" %} checked="checked"{% endif %}>
<label class="btn btn-sm btn-outline-secondary" for="source_md">Markdown</label>
</div>
</div> </div>
<div class="pb-3"> <div class="pb-3">
<textarea name="text" id="text" class="form-control" rows="20">{{ model.text }}</textarea> <textarea name="text" id="text" class="form-control" rows="20">{{ model.text }}</textarea>
@@ -39,13 +48,198 @@
<div class="form-text">comma-delimited</div> <div class="form-text">comma-delimited</div>
</div> </div>
{% if model.status == "Draft" %} {% 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"> <input type="checkbox" name="doPublish" id="doPublish" class="form-check-input" value="true">
<label for="doPublish" class="form-check-label">Publish This Post</label> <label for="doPublish" class="form-check-label">Publish This Post</label>
</div> </div>
{% endif %} {% endif %}
<button type="submit" class="btn btn-primary pb-2">Save Changes</button> <button type="submit" class="btn btn-primary pb-2">Save Changes</button>
<hr class="mb-3"> <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"> <fieldset class="pb-3">
<legend> <legend>
Metadata Metadata
@@ -55,11 +249,6 @@
</button> </button>
</legend> </legend>
<div id="metaItemContainer" class="collapse"> <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"> <div id="metaItems" class="container">
{%- for meta in metadata %} {%- for meta in metadata %}
<div id="meta_{{ meta[0] }}" class="row mb-3"> <div id="meta_{{ meta[0] }}" class="row mb-3">

View File

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

View File

@@ -0,0 +1,68 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form method="post" hx-target="body">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="id" value="{{ model.id }}">
<div class="container mb-3">
<div class="row">
<div class="col">
<p style="line-height:1.2rem;">
<strong>{{ model.current_title }}</strong><br>
<small class="text-muted">
<a href="{{ "admin/" | append: model.entity | append: "/" | append: model.id | append: "/edit" | relative_link }}">
&laquo; Back to Edit {{ model.entity | capitalize }}
</a>
</small>
</p>
</div>
</div>
{%- assign revision_count = model.revisions | size -%}
{%- assign rev_url_base = "admin/" | append: model.entity | append: "/" | append: model.id | append: "/revision" -%}
{%- if revision_count > 1 %}
<div class="row mb-3">
<div class="col">
<button type="button" class="btn btn-sm btn-danger"
hx-post="{{ rev_url_base | append: "s/purge" | relative_link }}"
hx-confirm="This will remove all revisions but the current one; are you sure this is what you wish to do?">
Delete All Prior Revisions
</button>
</div>
</div>
{%- endif %}
<div class="row mwl-table-heading">
<div class="col">Revision</div>
</div>
{% for rev in model.revisions %}
{%- assign as_of_string = rev.as_of | date: "o" -%}
{%- assign as_of_id = "rev_" | append: as_of_string | replace: "\.", "_" | replace: ":", "-" -%}
<div id="{{ as_of_id }}" class="row pb-3 mwl-table-detail">
<div class="col-12 mb-1">
{{ rev.as_of_local | date: "MMMM d, yyyy" }} at {{ rev.as_of_local | date: "h:mmtt" | downcase }}
<span class="badge bg-secondary text-uppercase ms-2">{{ rev.format }}</span>
{%- if forloop.first %}
<span class="badge bg-primary text-uppercase ms-2">Current Revision</span>
{%- endif %}<br>
{% unless forloop.first %}
{%- assign rev_url_prefix = rev_url_base | append: "/" | append: as_of_string -%}
{%- assign rev_restore = rev_url_prefix | append: "/restore" | relative_link -%}
{%- assign rev_delete = rev_url_prefix | append: "/delete" | relative_link -%}
<small>
<a href="{{ rev_url_prefix | append: "/preview" | relative_link }}" hx-target="#{{ as_of_id }}_preview">
Preview
</a>
<span class="text-muted"> &bull; </span>
<a href="{{ rev_restore }}" hx-post="{{ rev_restore }}">Restore as Current</a>
<span class="text-muted"> &bull; </span>
<a href="{{ rev_delete }}" hx-post="{{ rev_delete }}" hx-target="#{{ as_of_id }}" hx-swap="outerHTML"
class="text-danger">
Delete
</a>
</small>
{% endunless %}
</div>
{% unless forloop.first %}<div id="{{ as_of_id }}_preview" class="col-12"></div>{% endunless %}
</div>
{% endfor %}
</div>
</form>
</article>

View File

@@ -8,26 +8,33 @@
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="container"> <div class="container">
<div class="row"> <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"> <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> <label for="name">Name</label>
</div> </div>
</div> </div>
<div class="col-12 col-md-6 col-xl-4 pb-3"> <div class="col-12 col-md-6 col-xl-4 pb-3">
<div class="form-floating"> <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> <label for="subtitle">Subtitle</label>
</div> </div>
</div> </div>
<div class="col-12 col-md-4 col-xl-2 pb-3"> <div class="col-12 col-md-6 col-xl-4 offset-xl-1 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="form-floating"> <div class="form-floating">
<select name="themePath" id="themePath" class="form-control" required> <select name="themePath" id="themePath" class="form-control" required>
{% for theme in themes -%} {% for theme in themes -%}
@@ -39,19 +46,12 @@
<label for="themePath">Theme</label> <label for="themePath">Theme</label>
</div> </div>
</div> </div>
<div class="col-12 col-md-4 col-xl-3 pb-3"> <div class="col-12 col-md-6 offset-md-1 col-xl-4 offset-xl-0 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="form-floating"> <div class="form-floating">
<select name="defaultPage" id="defaultPage" class="form-control" required> <select name="defaultPage" id="defaultPage" class="form-control" required>
{% for pg in pages -%} {% for pg in pages -%}
<option value="{{ pg[0] }}" <option value="{{ pg[0] }}"
{%- if pg[0] == model.default_page %} selected="selected"{% endif %}> {%- if pg[0] == model.default_page %} selected="selected"{% endif %}>
{{ pg[1] }} {{ pg[1] }}
</option> </option>
{%- endfor %} {%- endfor %}
@@ -59,6 +59,22 @@
<label for="defaultPage">Default Page</label> <label for="defaultPage">Default Page</label>
</div> </div>
</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="col-12 col-md-4 col-xl-2">
<div class="form-check form-switch"> <div class="form-check form-switch">
<input type="checkbox" name="autoHtmx" id="autoHtmx" class="form-check-input" value="true" <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> <a href="https://htmx.org" target="_blank" rel="noopener">What is this?</a>
</span> </span>
</div> </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>
<div class="row pb-3"> <div class="row pb-3">
<div class="col text-center"> <div class="col text-center">

View File

@@ -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>

View File

@@ -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>

View File

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

View File

@@ -85,3 +85,10 @@ a.text-danger:link:hover, a.text-danger:visited:hover {
background-color: var(--light-accent); background-color: var(--light-accent);
color: var(--dark-gray); color: var(--dark-gray);
} }
.mwl-revision-preview {
max-height: 90vh;
overflow: auto;
border: solid 1px black;
border-radius: .5rem;
padding: .5rem;
}

View File

@@ -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, nextMetaIndex : 0,
/** The next index for a permalink */ /**
* The next index for a permalink
* @type {number}
*/
nextPermalink : 0, nextPermalink : 0,
/** /**
* Set the next meta item index * Set the next meta item index
* @param idx The index to set * @param {number} idx The index to set
*/ */
setNextMetaIndex(idx) { setNextMetaIndex(idx) {
this.nextMetaIndex = idx this.nextMetaIndex = idx
@@ -15,7 +24,7 @@
/** /**
* Set the next permalink index * Set the next permalink index
* @param idx The index to set * @param {number} idx The index to set
*/ */
setPermalinkIndex(idx) { setPermalinkIndex(idx) {
this.nextPermalink = idx this.nextPermalink = idx
@@ -204,42 +213,38 @@
}, },
/** /**
* Add podcast episode metadata fields * Enable or disable podcast fields
*/ */
addPodcastFields() { toggleEpisodeFields() {
[ [ "episode_media_file", true, "required; relative URL will be appended to configured base media path" ], const disabled = !document.getElementById("isEpisode").checked
[ "episode_media_length", true, "required; file size in bytes" ], ;[ "media", "mediaType", "length", "duration", "subtitle", "imageUrl", "explicit", "chapterFile", "chapterType",
[ "episode_duration", false, "suggested; format is HH:MM:SS" ], "transcriptUrl", "transcriptType", "transcriptLang", "transcriptCaptions", "seasonNumber", "seasonDescription",
[ "episode_media_type", false, "optional; blank uses podcast default" ], "episodeNumber", "episodeDescription"
[ "episode_image", false, "optional; relative URLs are served from this web log" ], ].forEach(it => document.getElementById(it).disabled = disabled)
[ "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()
}, },
/** /**
* Check to enable or disable podcast fields * Check to enable or disable podcast fields
*/ */
checkPodcast() { checkPodcast() {
document.getElementById("podcastFields").disabled = !document.getElementById("isPodcast").checked 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 * 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) { customFeedBy(source) {
const categoryInput = document.getElementById("sourceValueCat") const categoryInput = document.getElementById("sourceValueCat")
@@ -257,7 +262,7 @@
/** /**
* Remove a metadata item * 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) { removeMetaItem(idx) {
document.getElementById(`meta_${idx}`).remove() document.getElementById(`meta_${idx}`).remove()
@@ -265,15 +270,22 @@
/** /**
* Remove a permalink * Remove a permalink
* @param idx The index of the permalink to remove * @param {number} idx The index of the permalink to remove
*/ */
removePermalink(idx) { removePermalink(idx) {
document.getElementById(`link_${idx}`).remove() 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 * 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) { showMessage(messages) {
const msgs = messages.split(", ") const msgs = messages.split(", ")