15 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
46 changed files with 2073 additions and 834 deletions

3
.gitignore vendored
View File

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

View File

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

View File

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

View File

@@ -11,7 +11,7 @@
</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.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
@@ -31,6 +31,7 @@
<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" />

View File

@@ -33,6 +33,9 @@ module private RethinkHelpers =
/// The theme asset table
let ThemeAsset = "ThemeAsset"
/// The uploaded file table
let Upload = "Upload"
/// The web log table
let WebLog = "WebLog"
@@ -40,7 +43,7 @@ module private RethinkHelpers =
let WebLogUser = "WebLogUser"
/// 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 ]
/// Shorthand for the ReQL starting point
@@ -125,6 +128,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
indexCreate "webLogAndUrl" (fun row -> r.Array (row["webLogId"], row["urlValue"]) :> obj)
write; withRetryOnce; ignoreResult conn
}
// Uploaded files need an index by web log ID and path, as that is how they are retrieved
if Table.Upload = table then
if not (indexes |> List.contains "webLogAndPath") then
log.LogInformation $"Creating index {table}.webLogAndPath..."
do! rethink {
withTable table
indexCreate "webLogAndPath" (fun row -> r.Array (row["webLogId"], row["path"]) :> obj)
write; withRetryOnce; ignoreResult conn
}
// Users log on with e-mail
if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then
log.LogInformation $"Creating index {table}.logOn..."
@@ -725,6 +737,69 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
}
}
member _.Upload = {
new IUploadData with
member _.add upload = rethink {
withTable Table.Upload
insert upload
write; withRetryDefault; ignoreResult conn
}
member _.delete uploadId webLogId = backgroundTask {
let! upload =
rethink<Upload> {
withTable Table.Upload
get uploadId
resultOption; withRetryOptionDefault
}
|> verifyWebLog<Upload> webLogId (fun u -> u.webLogId) <| conn
match upload with
| Some up ->
do! rethink {
withTable Table.Upload
get uploadId
delete
write; withRetryDefault; ignoreResult conn
}
return Ok (Permalink.toString up.path)
| None -> return Result.Error $"Upload ID {UploadId.toString uploadId} not found"
}
member _.findByPath path webLogId =
rethink<Upload> {
withTable Table.Upload
getAll [ r.Array (webLogId, path) ] "webLogAndPath"
resultCursor; withRetryCursorDefault; toList
}
|> tryFirst <| conn
member _.findByWebLog webLogId = rethink<Upload> {
withTable Table.Upload
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
[ Index "webLogAndPath" ]
without [ "data" ]
resultCursor; withRetryCursorDefault; toList conn
}
member _.findByWebLogWithData webLogId = rethink<Upload> {
withTable Table.Upload
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
[ Index "webLogAndPath" ]
resultCursor; withRetryCursorDefault; toList conn
}
member _.restore uploads = backgroundTask {
// Files can be large; we'll do 5 at a time
for batch in uploads |> List.chunkBySize 5 do
do! rethink {
withTable Table.TagMap
insert batch
write; withRetryOnce; ignoreResult conn
}
}
}
member _.WebLog = {
new IWebLogData with
@@ -763,6 +838,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
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
@@ -805,12 +888,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get webLog.id
update [
"name", webLog.name :> obj
"slug", webLog.slug
"subtitle", webLog.subtitle
"defaultPage", webLog.defaultPage
"postsPerPage", webLog.postsPerPage
"timeZone", webLog.timeZone
"themePath", webLog.themePath
"autoHtmx", webLog.autoHtmx
"uploads", webLog.uploads
]
write; withRetryDefault; ignoreResult conn
}
@@ -900,6 +985,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! ensureIndexes Table.Page [ "webLogId"; "authorId" ]
do! ensureIndexes Table.Post [ "webLogId"; "authorId" ]
do! ensureIndexes Table.TagMap []
do! ensureIndexes Table.Upload []
do! ensureIndexes Table.WebLog [ "urlBase" ]
do! ensureIndexes Table.WebLogUser [ "webLogId" ]
}

View File

@@ -248,10 +248,28 @@ module Map =
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
@@ -259,6 +277,7 @@ module Map =
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

View File

@@ -21,12 +21,12 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// 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
)"""
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 ()
()
@@ -70,13 +70,13 @@ type SQLiteCategoryData (conn : SqliteConnection) =
// 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 ("""
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)
@@ -125,10 +125,10 @@ type SQLiteCategoryData (conn : SqliteConnection) =
| 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)"""
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
@@ -150,14 +150,14 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// 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"""
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
}

View File

@@ -139,14 +139,14 @@ type SQLitePageData (conn : SqliteConnection) =
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
)"""
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
@@ -174,11 +174,11 @@ type SQLitePageData (conn : SqliteConnection) =
/// 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"""
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
@@ -211,11 +211,11 @@ type SQLitePageData (conn : SqliteConnection) =
| 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"""
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
@@ -238,12 +238,12 @@ type SQLitePageData (conn : SqliteConnection) =
/// 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 ("""
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}, "
@@ -274,12 +274,12 @@ type SQLitePageData (conn : SqliteConnection) =
/// 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)"""
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 ()
@@ -293,12 +293,12 @@ type SQLitePageData (conn : SqliteConnection) =
/// 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"""
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)
@@ -318,18 +318,18 @@ type SQLitePageData (conn : SqliteConnection) =
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"""
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

View File

@@ -146,26 +146,26 @@ type SQLitePostData (conn : SqliteConnection) =
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"""
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 ->
@@ -174,16 +174,16 @@ type SQLitePostData (conn : SqliteConnection) =
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
)"""
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 -> ()
@@ -278,14 +278,12 @@ type SQLitePostData (conn : SqliteConnection) =
/// 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
)"""
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
@@ -340,14 +338,14 @@ type SQLitePostData (conn : SqliteConnection) =
| 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"""
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
@@ -356,12 +354,12 @@ type SQLitePostData (conn : SqliteConnection) =
/// 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 ("""
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}, "
@@ -392,12 +390,12 @@ type SQLitePostData (conn : SqliteConnection) =
/// 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 ("""
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}, "
@@ -420,11 +418,11 @@ type SQLitePostData (conn : SqliteConnection) =
/// 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}"""
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 =
@@ -437,12 +435,12 @@ type SQLitePostData (conn : SqliteConnection) =
/// 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}"""
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 ()
@@ -456,14 +454,14 @@ type SQLitePostData (conn : SqliteConnection) =
/// 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}"""
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)
@@ -479,13 +477,13 @@ type SQLitePostData (conn : SqliteConnection) =
/// 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"""
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)
@@ -499,13 +497,13 @@ type SQLitePostData (conn : SqliteConnection) =
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"""
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
@@ -528,18 +526,18 @@ type SQLitePostData (conn : SqliteConnection) =
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"""
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

View File

@@ -50,11 +50,11 @@ type SQLiteTagMapData (conn : SqliteConnection) =
/// 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 ("""
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}, "
@@ -71,19 +71,19 @@ type SQLiteTagMapData (conn : SqliteConnection) =
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"""
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
)"""
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)

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

@@ -27,6 +27,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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)
@@ -34,6 +35,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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
@@ -69,11 +71,11 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// 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"""
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
@@ -88,16 +90,16 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// 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
)"""
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
}
@@ -115,9 +117,9 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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.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
})
@@ -126,12 +128,12 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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.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
@@ -143,12 +145,12 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|> 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.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
@@ -156,25 +158,25 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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.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
@@ -198,16 +200,14 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Add a web log
let add webLog = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""INSERT INTO web_log (
id, name, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone,
auto_htmx, feed_enabled, feed_name, items_in_feed, category_enabled, tag_enabled,
copyright
) VALUES (
@id, @name, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone,
@autoHtmx, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled,
@copyright
)"""
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
@@ -232,25 +232,26 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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 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"""
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
}
@@ -283,23 +284,25 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Update settings for a web log
let updateSettings webLog = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE web_log
SET name = @name,
subtitle = @subtitle,
default_page = @defaultPage,
posts_per_page = @postsPerPage,
theme_id = @themeId,
url_base = @urlBase,
time_zone = @timeZone,
auto_htmx = @autoHtmx,
feed_enabled = @feedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
category_enabled = @categoryEnabled,
tag_enabled = @tagEnabled,
copyright = @copyright
WHERE id = @id"""
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
}
@@ -307,15 +310,15 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// 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"""
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

View File

@@ -28,14 +28,14 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// 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
)"""
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
}
@@ -43,8 +43,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// 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"
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 ()
@@ -95,18 +94,18 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// 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"""
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
}

View File

@@ -36,6 +36,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
member _.TagMap = SQLiteTagMapData conn
member _.Theme = SQLiteThemeData conn
member _.ThemeAsset = SQLiteThemeAssetData conn
member _.Upload = SQLiteUploadData conn
member _.WebLog = SQLiteWebLogData conn
member _.WebLogUser = SQLiteWebLogUserData conn
@@ -48,8 +49,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating theme table..."
cmd.CommandText <-
"""CREATE TABLE theme (
cmd.CommandText <- """
CREATE TABLE theme (
id TEXT PRIMARY KEY,
name TEXT NOT NULL,
version TEXT NOT NULL)"""
@@ -58,8 +59,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating theme_template table..."
cmd.CommandText <-
"""CREATE TABLE theme_template (
cmd.CommandText <- """
CREATE TABLE theme_template (
theme_id TEXT NOT NULL REFERENCES theme (id),
name TEXT NOT NULL,
template TEXT NOT NULL,
@@ -69,8 +70,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating theme_asset table..."
cmd.CommandText <-
"""CREATE TABLE theme_asset (
cmd.CommandText <- """
CREATE TABLE theme_asset (
theme_id TEXT NOT NULL REFERENCES theme (id),
path TEXT NOT NULL,
updated_on TEXT NOT NULL,
@@ -83,10 +84,11 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating web_log table..."
cmd.CommandText <-
"""CREATE TABLE web_log (
cmd.CommandText <- """
CREATE TABLE web_log (
id TEXT PRIMARY KEY,
name TEXT NOT NULL,
slug TEXT NOT NULL,
subtitle TEXT,
default_page TEXT NOT NULL,
posts_per_page INTEGER NOT NULL,
@@ -94,30 +96,33 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
url_base TEXT NOT NULL,
time_zone TEXT NOT NULL,
auto_htmx INTEGER NOT NULL DEFAULT 0,
uploads TEXT NOT NULL,
feed_enabled INTEGER NOT NULL DEFAULT 0,
feed_name TEXT NOT NULL,
items_in_feed INTEGER,
category_enabled INTEGER NOT NULL DEFAULT 0,
tag_enabled INTEGER NOT NULL DEFAULT 0,
copyright TEXT)"""
copyright TEXT);
CREATE INDEX web_log_theme_idx ON web_log (theme_id)"""
do! write cmd
match! tableExists "web_log_feed" with
| true -> ()
| false ->
log.LogInformation "Creating web_log_feed table..."
cmd.CommandText <-
"""CREATE TABLE web_log_feed (
cmd.CommandText <- """
CREATE TABLE web_log_feed (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
source TEXT NOT NULL,
path TEXT NOT NULL)"""
path TEXT NOT NULL);
CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"""
do! write cmd
match! tableExists "web_log_feed_podcast" with
| true -> ()
| false ->
log.LogInformation "Creating web_log_feed_podcast table..."
cmd.CommandText <-
"""CREATE TABLE web_log_feed_podcast (
cmd.CommandText <- """
CREATE TABLE web_log_feed_podcast (
feed_id TEXT PRIMARY KEY REFERENCES web_log_feed (id),
title TEXT NOT NULL,
subtitle TEXT,
@@ -142,14 +147,15 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating category table..."
cmd.CommandText <-
"""CREATE TABLE category (
cmd.CommandText <- """
CREATE TABLE category (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
name TEXT NOT NULL,
slug TEXT NOT NULL,
description TEXT,
parent_id TEXT)"""
parent_id TEXT);
CREATE INDEX category_web_log_idx ON category (web_log_id)"""
do! write cmd
// Web log user table
@@ -157,8 +163,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating web_log_user table..."
cmd.CommandText <-
"""CREATE TABLE web_log_user (
cmd.CommandText <- """
CREATE TABLE web_log_user (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
user_name TEXT NOT NULL,
@@ -168,7 +174,9 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
password_hash TEXT NOT NULL,
salt TEXT NOT NULL,
url TEXT,
authorization_level TEXT NOT NULL)"""
authorization_level TEXT NOT NULL);
CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id);
CREATE INDEX web_log_user_user_name_idx ON web_log_user (web_log_id, user_name)"""
do! write cmd
// Page tables
@@ -176,8 +184,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating page table..."
cmd.CommandText <-
"""CREATE TABLE page (
cmd.CommandText <- """
CREATE TABLE page (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id),
@@ -187,14 +195,17 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
updated_on TEXT NOT NULL,
show_in_page_list INTEGER NOT NULL DEFAULT 0,
template TEXT,
page_text TEXT NOT NULL)"""
page_text TEXT NOT NULL);
CREATE INDEX page_web_log_idx ON page (web_log_id);
CREATE INDEX page_author_idx ON page (author_id);
CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)"""
do! write cmd
match! tableExists "page_meta" with
| true -> ()
| false ->
log.LogInformation "Creating page_meta table..."
cmd.CommandText <-
"""CREATE TABLE page_meta (
cmd.CommandText <- """
CREATE TABLE page_meta (
page_id TEXT NOT NULL REFERENCES page (id),
name TEXT NOT NULL,
value TEXT NOT NULL,
@@ -204,8 +215,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating page_permalink table..."
cmd.CommandText <-
"""CREATE TABLE page_permalink (
cmd.CommandText <- """
CREATE TABLE page_permalink (
page_id TEXT NOT NULL REFERENCES page (id),
permalink TEXT NOT NULL,
PRIMARY KEY (page_id, permalink))"""
@@ -214,8 +225,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating page_revision table..."
cmd.CommandText <-
"""CREATE TABLE page_revision (
cmd.CommandText <- """
CREATE TABLE page_revision (
page_id TEXT NOT NULL REFERENCES page (id),
as_of TEXT NOT NULL,
revision_text TEXT NOT NULL,
@@ -227,8 +238,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post table..."
cmd.CommandText <-
"""CREATE TABLE post (
cmd.CommandText <- """
CREATE TABLE post (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id),
@@ -238,24 +249,29 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
published_on TEXT,
updated_on TEXT NOT NULL,
template TEXT,
post_text TEXT NOT NULL)"""
post_text TEXT NOT NULL);
CREATE INDEX post_web_log_idx ON post (web_log_id);
CREATE INDEX post_author_idx ON post (author_id);
CREATE INDEX post_status_idx ON post (web_log_id, status, updated_on);
CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)"""
do! write cmd
match! tableExists "post_category" with
| true -> ()
| false ->
log.LogInformation "Creating post_category table..."
cmd.CommandText <-
"""CREATE TABLE post_category (
cmd.CommandText <- """
CREATE TABLE post_category (
post_id TEXT NOT NULL REFERENCES post (id),
category_id TEXT NOT NULL REFERENCES category (id),
PRIMARY KEY (post_id, category_id))"""
PRIMARY KEY (post_id, category_id));
CREATE INDEX post_category_category_idx ON post_category (category_id)"""
do! write cmd
match! tableExists "post_episode" with
| true -> ()
| false ->
log.LogInformation "Creating post_episode table..."
cmd.CommandText <-
"""CREATE TABLE post_episode (
cmd.CommandText <- """
CREATE TABLE post_episode (
post_id TEXT PRIMARY KEY REFERENCES post(id),
media TEXT NOT NULL,
length INTEGER NOT NULL,
@@ -279,8 +295,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post_tag table..."
cmd.CommandText <-
"""CREATE TABLE post_tag (
cmd.CommandText <- """
CREATE TABLE post_tag (
post_id TEXT NOT NULL REFERENCES post (id),
tag TEXT NOT NULL,
PRIMARY KEY (post_id, tag))"""
@@ -289,8 +305,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post_meta table..."
cmd.CommandText <-
"""CREATE TABLE post_meta (
cmd.CommandText <- """
CREATE TABLE post_meta (
post_id TEXT NOT NULL REFERENCES post (id),
name TEXT NOT NULL,
value TEXT NOT NULL,
@@ -300,8 +316,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post_permalink table..."
cmd.CommandText <-
"""CREATE TABLE post_permalink (
cmd.CommandText <- """
CREATE TABLE post_permalink (
post_id TEXT NOT NULL REFERENCES post (id),
permalink TEXT NOT NULL,
PRIMARY KEY (post_id, permalink))"""
@@ -310,8 +326,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post_revision table..."
cmd.CommandText <-
"""CREATE TABLE post_revision (
cmd.CommandText <- """
CREATE TABLE post_revision (
post_id TEXT NOT NULL REFERENCES post (id),
as_of TEXT NOT NULL,
revision_text TEXT NOT NULL,
@@ -321,8 +337,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post_comment table..."
cmd.CommandText <-
"""CREATE TABLE post_comment (
cmd.CommandText <- """
CREATE TABLE post_comment (
id TEXT PRIMARY KEY,
post_id TEXT NOT NULL REFERENCES post(id),
in_reply_to_id TEXT,
@@ -331,7 +347,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
url TEXT,
status TEXT NOT NULL,
posted_on TEXT NOT NULL,
comment_text TEXT NOT NULL)"""
comment_text TEXT NOT NULL);
CREATE INDEX post_comment_post_idx ON post_comment (post_id)"""
do! write cmd
// Tag map table
@@ -339,11 +356,28 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating tag_map table..."
cmd.CommandText <-
"""CREATE TABLE tag_map (
cmd.CommandText <- """
CREATE TABLE tag_map (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
tag TEXT NOT NULL,
url_value TEXT NOT NULL)"""
url_value TEXT NOT NULL);
CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)"""
do! write cmd
// Uploaded file table
match! tableExists "upload" with
| true -> ()
| false ->
log.LogInformation "Creating upload table..."
cmd.CommandText <- """
CREATE TABLE upload (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
path TEXT NOT NULL,
updated_on TEXT NOT NULL,
data BLOB NOT NULL);
CREATE INDEX upload_web_log_idx ON upload (web_log_id);
CREATE INDEX upload_path_idx ON upload (web_log_id, path)"""
do! write cmd
}

View File

@@ -295,6 +295,37 @@ type ThemeAsset =
}
/// An uploaded file
type Upload =
{ /// The ID of the upload
id : UploadId
/// The ID of the web log to which this upload belongs
webLogId : WebLogId
/// The link at which this upload is served
path : Permalink
/// The updated date/time for this upload
updatedOn : DateTime
/// The data for the upload
data : byte[]
}
/// Functions to support uploaded files
module Upload =
/// An empty upload
let empty = {
id = UploadId.empty
webLogId = WebLogId.empty
path = Permalink.empty
updatedOn = DateTime.MinValue
data = [||]
}
/// A web log
[<CLIMutable; NoComparison; NoEquality>]
type WebLog =
@@ -304,6 +335,9 @@ type WebLog =
/// The name of the web log
name : string
/// The slug of the web log
slug : string
/// A subtitle for the web log
subtitle : string option
@@ -327,6 +361,9 @@ type WebLog =
/// Whether to automatically load htmx
autoHtmx : bool
/// Where uploads are placed
uploads : UploadDestination
}
/// Functions to support web logs
@@ -336,6 +373,7 @@ module WebLog =
let empty =
{ id = WebLogId.empty
name = ""
slug = ""
subtitle = None
defaultPage = ""
postsPerPage = 10
@@ -344,6 +382,7 @@ module WebLog =
timeZone = ""
rss = RssOptions.empty
autoHtmx = false
uploads = Database
}
/// Get the host (including scheme) and extra path from the URL base
@@ -366,11 +405,6 @@ module WebLog =
TimeZoneInfo.ConvertTimeFromUtc
(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
[<CLIMutable; NoComparison; NoEquality>]

View File

@@ -556,6 +556,41 @@ type ThemeTemplate =
}
/// Where uploads should be placed
type UploadDestination =
| Database
| Disk
/// Functions to support upload destinations
module UploadDestination =
/// Convert an upload destination to its string representation
let toString = function Database -> "database" | Disk -> "disk"
/// Parse an upload destination from its string representation
let parse value =
match value with
| "database" -> Database
| "disk" -> Disk
| it -> invalidOp $"{it} is not a valid upload destination"
/// An identifier for an upload
type UploadId = UploadId of string
/// Functions to support upload IDs
module UploadId =
/// An empty upload ID
let empty = UploadId ""
/// Convert an upload ID to a string
let toString = function UploadId ui -> ui
/// Create a new upload ID
let create () = UploadId (newId ())
/// An identifier for a web log
type WebLogId = WebLogId of string

View File

@@ -12,6 +12,29 @@ module private Helpers =
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
[<NoComparison; NoEquality>]
type DisplayCategory =
@@ -124,27 +147,59 @@ type DisplayPage =
}
/// 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
/// Information about a revision used for display
[<CLIMutable; NoComparison; NoEquality>]
type DisplayRevision =
{ /// The as-of date/time for the revision
asOf : DateTime
/// The as-of date/time for the revision in the web log's local time zone
asOfLocal : DateTime
/// The format of the text of the revision
format : string
}
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
@@ -229,6 +284,18 @@ type EditCustomFeedModel =
/// The base URL for relative URL media files for this podcast (optional; defaults to web log base)
mediaBaseUrl : string
/// The URL for funding information for the podcast
fundingUrl : string
/// The text for the funding link
fundingText : string
/// A unique identifier to follow this podcast
guid : string
/// The medium for the content of this podcast
medium : string
}
/// An empty custom feed model
@@ -250,6 +317,10 @@ type EditCustomFeedModel =
explicit = "no"
defaultMediaType = "audio/mpeg"
mediaBaseUrl = ""
fundingUrl = ""
fundingText = ""
guid = ""
medium = ""
}
/// Create a model from a custom feed
@@ -277,6 +348,12 @@ type EditCustomFeedModel =
explicit = ExplicitRating.toString p.explicit
defaultMediaType = defaultArg p.defaultMediaType ""
mediaBaseUrl = defaultArg p.mediaBaseUrl ""
fundingUrl = defaultArg p.fundingUrl ""
fundingText = defaultArg p.fundingText ""
guid = p.guid
|> Option.map (fun it -> it.ToString().ToLowerInvariant ())
|> Option.defaultValue ""
medium = p.medium |> Option.map PodcastMedium.toString |> Option.defaultValue ""
}
| None -> rss
@@ -300,11 +377,10 @@ type EditCustomFeedModel =
explicit = ExplicitRating.parse this.explicit
defaultMediaType = noneIfBlank this.defaultMediaType
mediaBaseUrl = noneIfBlank this.mediaBaseUrl
// TODO: implement UI to update these
guid = None
fundingUrl = None
fundingText = None
medium = None
guid = noneIfBlank this.guid |> Option.map Guid.Parse
fundingUrl = noneIfBlank this.fundingUrl
fundingText = noneIfBlank this.fundingText
medium = noneIfBlank this.medium |> Option.map PodcastMedium.parse
}
else
None
@@ -712,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
[<NoComparison; NoEquality>]
type PostListItem =
@@ -802,6 +911,9 @@ type SettingsModel =
{ /// The name of the web log
name : string
/// The slug of the web log
slug : string
/// The subtitle of the web log
subtitle : string
@@ -819,32 +931,48 @@ type SettingsModel =
/// Whether to automatically load htmx
autoHtmx : bool
/// The default location for uploads
uploads : string
}
/// Create a settings model from a web log
static member fromWebLog (webLog : WebLog) =
{ name = webLog.name
slug = webLog.slug
subtitle = defaultArg webLog.subtitle ""
defaultPage = webLog.defaultPage
postsPerPage = webLog.postsPerPage
timeZone = webLog.timeZone
themePath = webLog.themePath
autoHtmx = webLog.autoHtmx
uploads = UploadDestination.toString webLog.uploads
}
/// Update a web log with settings from the form
member this.update (webLog : WebLog) =
{ webLog with
name = this.name
slug = this.slug
subtitle = if this.subtitle = "" then None else Some this.subtitle
defaultPage = this.defaultPage
postsPerPage = this.postsPerPage
timeZone = this.timeZone
themePath = this.themePath
autoHtmx = this.autoHtmx
uploads = UploadDestination.parse this.uploads
}
/// View model for uploading a file
[<CLIMutable; NoComparison; NoEquality>]
type UploadFileModel =
{ /// The upload destination
destination : string
}
/// A message displayed to the user
[<CLIMutable; NoComparison; NoEquality>]
type UserMessage =
{ /// The level of the message

View File

@@ -7,16 +7,45 @@ open MyWebLog.Data
[<AutoOpen>]
module Extensions =
open System.Security.Claims
open Microsoft.AspNetCore.Antiforgery
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection
/// Hold variable for the configured generator string
let mutable private generatorString : string option = None
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
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
/// <summary>

View File

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

View File

@@ -39,10 +39,10 @@ let dashboard : HttpHandler = fun next ctx -> task {
let listCategories : HttpHandler = fun next ctx -> task {
let! catListTemplate = TemplateCache.get "admin" "category-list-body" ctx.Data
let hash = Hash.FromAnonymousObject {|
page_title = "Categories"
csrf = ctx.CsrfTokenSet
web_log = ctx.WebLog
categories = CategoryCache.get ctx
page_title = "Categories"
csrf = csrfToken ctx
|}
hash.Add ("category_list", catListTemplate.Render hash)
return! viewForTheme "admin" "category-list" next ctx hash
@@ -53,7 +53,7 @@ let listCategoriesBare : HttpHandler = fun next ctx -> task {
return!
Hash.FromAnonymousObject {|
categories = CategoryCache.get ctx
csrf = csrfToken ctx
csrf = ctx.CsrfTokenSet
|}
|> bareForTheme "admin" "category-list-body" next ctx
}
@@ -73,9 +73,9 @@ let editCategory catId : HttpHandler = fun next ctx -> task {
| Some (title, cat) ->
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = EditCategoryModel.fromCategory cat
page_title = title
csrf = ctx.CsrfTokenSet
model = EditCategoryModel.fromCategory cat
categories = CategoryCache.get ctx
|}
|> bareForTheme "admin" "category-edit" next ctx
@@ -118,156 +118,16 @@ let deleteCategory catId : HttpHandler = fun next ctx -> task {
return! listCategoriesBare next ctx
}
// -- PAGES --
// 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
}
open Microsoft.AspNetCore.Http
// -- TAG MAPPINGS --
open Microsoft.AspNetCore.Http
/// Get the hash necessary to render the tag mapping list
let private tagMappingHash (ctx : HttpContext) = task {
let! mappings = ctx.Data.TagMap.findByWebLog ctx.WebLog.id
return Hash.FromAnonymousObject {|
csrf = ctx.CsrfTokenSet
web_log = ctx.WebLog
csrf = csrfToken ctx
mappings = mappings
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 ->
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = EditTagMapModel.fromMapping tm
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
| None -> return! Error.notFound next ctx
@@ -337,6 +197,7 @@ let deleteMapping tagMapId : HttpHandler = fun next ctx -> task {
// -- THEMES --
open System
open System.IO
open System.IO.Compression
open System.Text.RegularExpressions
@@ -346,8 +207,8 @@ open MyWebLog.Data
let themeUpdatePage : HttpHandler = fun next ctx -> task {
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
page_title = "Upload Theme"
csrf = ctx.CsrfTokenSet
|}
|> viewForTheme "admin" "upload-theme" next ctx
}
@@ -442,13 +303,13 @@ let updateTheme : HttpHandler = fun next ctx -> task {
do! ThemeAssetCache.refreshTheme (ThemeId themeName) data
TemplateCache.invalidateTheme themeName
do! addMessage ctx { UserMessage.success with message = "Theme updated successfully" }
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/dashboard")) next ctx
return! redirectToGet "admin/dashboard" next ctx
| Ok _ ->
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 ->
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
return! RequestErrors.BAD_REQUEST "Bad request" next ctx
}
@@ -465,23 +326,26 @@ let settings : HttpHandler = fun next ctx -> task {
let! themes = data.Theme.all ()
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = SettingsModel.fromWebLog webLog
pages =
seq {
KeyValuePair.Create ("posts", "- First Page of Posts -")
page_title = "Web Log Settings"
csrf = ctx.CsrfTokenSet
web_log = webLog
model = SettingsModel.fromWebLog webLog
pages = seq
{ KeyValuePair.Create ("posts", "- First Page of Posts -")
yield! allPages
|> List.sortBy (fun p -> p.title.ToLower ())
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.id, p.title))
}
|> Array.ofSeq
themes = themes
|> Seq.ofList
|> Seq.map (fun it ->
KeyValuePair.Create (ThemeId.toString it.id, $"{it.name} (v{it.version})"))
|> Array.ofSeq
web_log = webLog
page_title = "Web Log Settings"
themes =
themes
|> Seq.ofList
|> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.id, $"{it.name} (v{it.version})"))
|> Array.ofSeq
upload_values = [|
KeyValuePair.Create (UploadDestination.toString Database, "Database")
KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
|]
|}
|> viewForTheme "admin" "settings" next ctx
}
@@ -493,13 +357,20 @@ let saveSettings : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<SettingsModel> ()
match! data.WebLog.findById webLog.id with
| Some webLog ->
let webLog = model.update webLog
let oldSlug = webLog.slug
let webLog = model.update webLog
do! data.WebLog.updateSettings webLog
// Update cache
WebLogCache.set webLog
if oldSlug <> webLog.slug then
// Rename disk directory if it exists
let uploadRoot = Path.Combine ("wwwroot", "upload")
let oldDir = Path.Combine (uploadRoot, oldSlug)
if Directory.Exists oldDir then Directory.Move (oldDir, Path.Combine (uploadRoot, webLog.slug))
do! addMessage ctx { UserMessage.success with message = "Web log settings saved successfully" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings")) next ctx
return! redirectToGet "admin/settings" next ctx
| None -> return! Error.notFound next ctx
}

View File

@@ -2,21 +2,20 @@
module MyWebLog.Handlers.Error
open System.Net
open System.Threading.Tasks
open Giraffe
open Microsoft.AspNetCore.Http
open MyWebLog
/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
let notAuthorized : HttpHandler = fun next ctx -> task {
if ctx.Request.Method = "GET" then
let returnUrl = WebUtility.UrlEncode ctx.Request.Path
return!
redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink $"user/log-on?returnUrl={returnUrl}")) next ctx
else
return! (setStatusCode 401 >=> fun _ _ -> Task.FromResult<HttpContext option> None) next ctx
}
let notAuthorized : HttpHandler =
handleContext (fun ctx ->
if ctx.Request.Method = "GET" then
let returnUrl = WebUtility.UrlEncode ctx.Request.Path
redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink $"user/log-on?returnUrl={returnUrl}"))
earlyReturn 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
let notFound : HttpHandler =
setStatusCode 404 >=> text "Not found"
let notFound : HttpHandler = fun _ ->
(setStatusCode 404 >=> text "Not found") earlyReturn

View File

@@ -2,6 +2,7 @@
module MyWebLog.Handlers.Feed
open System
open System.Collections.Generic
open System.IO
open System.Net
open System.ServiceModel.Syndication
@@ -129,17 +130,19 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[
|> List.iter item.Categories.Add
item
/// Convert non-absolute URLs to an absolute URL for this web log
let toAbsolute webLog (link : string) =
if link.StartsWith "http" then link else WebLog.absoluteUrl webLog (Permalink link)
/// Add episode information to a podcast feed item
let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (post : Post) (item : SyndicationItem) =
// Convert non-absolute URLs to an absolute URL for this web log
let toAbsolute (link : string) = if link.StartsWith "http" then link else WebLog.absoluteUrl webLog (Permalink link)
let epMediaUrl =
match episode.media with
| link when link.StartsWith "http" -> link
| link when Option.isSome podcast.mediaBaseUrl -> $"{podcast.mediaBaseUrl.Value}{link}"
| link -> WebLog.absoluteUrl webLog (Permalink link)
let epMediaType = [ episode.mediaType; podcast.defaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
let epImageUrl = defaultArg episode.imageUrl (Permalink.toString podcast.imageUrl) |> toAbsolute
let epImageUrl = defaultArg episode.imageUrl (Permalink.toString podcast.imageUrl) |> toAbsolute webLog
let epExplicit = defaultArg episode.explicit podcast.explicit |> ExplicitRating.toString
let xmlDoc = XmlDocument ()
@@ -165,7 +168,7 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
match episode.chapterFile with
| Some chapters ->
let url = toAbsolute chapters
let url = toAbsolute webLog chapters
let typ =
match episode.chapterType with
| Some mime -> Some mime
@@ -179,7 +182,7 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
match episode.transcriptUrl with
| Some transcript ->
let url = toAbsolute 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)
@@ -301,6 +304,17 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
rssFeed.ElementExtensions.Add ("author", Namespace.iTunes, podcast.displayedAuthor)
rssFeed.ElementExtensions.Add ("explicit", Namespace.iTunes, ExplicitRating.toString podcast.explicit)
podcast.subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub))
podcast.fundingUrl
|> Option.iter (fun url ->
let funding = xmlDoc.CreateElement ("podcast", "funding", Namespace.podcast)
funding.SetAttribute ("url", toAbsolute webLog url)
funding.InnerText <- defaultArg podcast.fundingText "Support This Podcast"
rssFeed.ElementExtensions.Add funding)
podcast.guid
|> Option.iter (fun guid ->
rssFeed.ElementExtensions.Add ("guid", Namespace.podcast, guid.ToString().ToLowerInvariant ()))
podcast.medium
|> Option.iter (fun med -> rssFeed.ElementExtensions.Add ("medium", Namespace.podcast, PodcastMedium.toString med))
/// Get the feed's self reference and non-feed link
let private selfAndLink webLog feedType ctx =
@@ -368,7 +382,7 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
setTitleAndDescription feedType webLog cats feed
feed.LastUpdatedTime <- (List.head posts).updatedOn |> DateTimeOffset
feed.Generator <- generator ctx
feed.Generator <- ctx.Generator
feed.Items <- posts |> Seq.ofList |> Seq.map toItem
feed.Language <- "en"
feed.Id <- WebLog.absoluteUrl webLog link
@@ -402,23 +416,23 @@ let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> bac
open DotLiquid
// GET: /admin/rss/settings
// GET: /admin/settings/rss
let editSettings : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let feeds =
webLog.rss.customFeeds
|> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx))
|> Array.ofList
return! Hash.FromAnonymousObject
{| csrf = csrfToken ctx
return! Hash.FromAnonymousObject {|
page_title = "RSS Settings"
csrf = ctx.CsrfTokenSet
model = EditRssModel.fromRssOptions webLog.rss
custom_feeds = feeds
|}
|> viewForTheme "admin" "rss-settings" next ctx
}
// POST: /admin/rss/settings
// POST: /admin/settings/rss
let saveSettings : HttpHandler = fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditRssModel> ()
@@ -428,11 +442,11 @@ let saveSettings : HttpHandler = fun next ctx -> task {
do! data.WebLog.updateRssOptions webLog
WebLogCache.set webLog
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
}
// GET: /admin/rss/{id}/edit
// GET: /admin/settings/rss/{id}/edit
let editCustomFeed feedId : HttpHandler = fun next ctx -> task {
let customFeed =
match feedId with
@@ -440,17 +454,27 @@ let editCustomFeed feedId : HttpHandler = fun next ctx -> task {
| _ -> ctx.WebLog.rss.customFeeds |> List.tryFind (fun f -> f.id = CustomFeedId feedId)
match customFeed with
| Some f ->
return! Hash.FromAnonymousObject
{| csrf = csrfToken ctx
page_title = $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
model = EditCustomFeedModel.fromFeed f
categories = CategoryCache.get ctx
return! Hash.FromAnonymousObject {|
page_title = $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
csrf = ctx.CsrfTokenSet
model = EditCustomFeedModel.fromFeed f
categories = CategoryCache.get ctx
medium_values = [|
KeyValuePair.Create ("", "&ndash; Unspecified &ndash;")
KeyValuePair.Create (PodcastMedium.toString Podcast, "Podcast")
KeyValuePair.Create (PodcastMedium.toString Music, "Music")
KeyValuePair.Create (PodcastMedium.toString Video, "Video")
KeyValuePair.Create (PodcastMedium.toString Film, "Film")
KeyValuePair.Create (PodcastMedium.toString Audiobook, "Audiobook")
KeyValuePair.Create (PodcastMedium.toString Newsletter, "Newsletter")
KeyValuePair.Create (PodcastMedium.toString Blog, "Blog")
|]
|}
|> viewForTheme "admin" "custom-feed-edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST: /admin/rss/save
// POST: /admin/settings/rss/save
let saveCustomFeed : HttpHandler = fun next ctx -> task {
let data = ctx.Data
match! data.WebLog.findById ctx.WebLog.id with
@@ -470,13 +494,12 @@ let saveCustomFeed : HttpHandler = fun next ctx -> task {
UserMessage.success with
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 (WebLog.relativeUrl webLog (Permalink nextUrl)) next ctx
return! redirectToGet $"admin/settings/rss/{CustomFeedId.toString feed.id}/edit" 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 data = ctx.Data
match! data.WebLog.findById ctx.WebLog.id with
@@ -495,6 +518,6 @@ let deleteCustomFeed feedId : HttpHandler = fun next ctx -> task {
do! addMessage ctx { UserMessage.success with message = "Custom feed deleted successfully" }
else
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
}

View File

@@ -52,24 +52,6 @@ let messages (ctx : HttpContext) = task {
| 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 DotLiquid
@@ -94,14 +76,14 @@ let private populateHash hash ctx = task {
hash.Add ("page_list", PageListCache.get ctx)
hash.Add ("current_page", ctx.Request.Path.Value.Substring 1)
hash.Add ("messages", messages)
hash.Add ("generator", generator ctx)
hash.Add ("generator", ctx.Generator)
hash.Add ("htmx_script", htmxScript)
do! commitSession ctx
}
/// 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
// 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
let bareForTheme theme template next ctx = fun (hash : Hash) -> task {
let bareForTheme theme template next ctx (hash : Hash) = task {
do! populateHash hash ctx
// Bare templates are rendered with layout-bare
let! contentTemplate = TemplateCache.get theme template ctx.Data
hash.Add ("content", contentTemplate.Render hash)
if not (hash.ContainsKey "content") then
let! contentTemplate = TemplateCache.get theme template ctx.Data
hash.Add ("content", contentTemplate.Render hash)
// Bare templates are rendered with layout-bare
let! layoutTemplate = TemplateCache.get theme "layout-bare" ctx.Data
// 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}"
| None -> $"{m.level}|||{m.message}"
|> setHttpHeader "X-Message")
withHxNoPush
withHxNoPushUrl
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
let themedView template next ctx = fun (hash : Hash) -> task {
return! viewForTheme (deriveWebLogFromHash hash ctx).themePath template next ctx hash
}
let themedView 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
let redirectToGet url : HttpHandler = fun next ctx -> task {
let redirectToGet url : HttpHandler = fun _ ctx -> task {
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
let validateCsrf : HttpHandler = fun next ctx -> task {
match! (antiForgery ctx).IsRequestValidAsync ctx with
match! ctx.AntiForgery.IsRequestValidAsync ctx with
| 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
@@ -226,6 +194,14 @@ let getCategoryIds slug ctx =
|> Seq.map (fun c -> CategoryId c.id)
|> 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
/// 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

@@ -198,9 +198,9 @@ let home : HttpHandler = fun next ctx -> task {
| Some page ->
return!
Hash.FromAnonymousObject {|
page_title = page.title
page = DisplayPage.fromPage webLog page
categories = CategoryCache.get ctx
page_title = page.title
is_home = true
|}
|> themedView (defaultArg page.template "single-page") next ctx
@@ -215,7 +215,7 @@ let all pageNbr : HttpHandler = fun next ctx -> task {
let! posts = data.Post.findPageOfPosts webLog.id pageNbr 25
let! hash = preparePostList webLog posts AdminList "" pageNbr 25 ctx data
hash.Add ("page_title", "Posts")
hash.Add ("csrf", csrfToken ctx)
hash.Add ("csrf", ctx.CsrfTokenSet)
return! viewForTheme "admin" "post-list" next ctx hash
}
@@ -238,11 +238,11 @@ let edit postId : HttpHandler = fun next ctx -> task {
let model = EditPostModel.fromPost webLog post
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
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 |])
page_title = title
templates = templates
categories = cats
explicit_values = [|
@@ -256,15 +256,24 @@ let edit postId : HttpHandler = fun next ctx -> task {
| 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
let editPermalinks postId : HttpHandler = fun next ctx -> task {
match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with
| Some post ->
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
page_title = "Manage Prior Permalinks"
csrf = ctx.CsrfTokenSet
model = ManagePermalinksModel.fromPost post
page_title = $"Manage Prior Permalinks"
|}
|> viewForTheme "admin" "permalinks" next ctx
| None -> return! Error.notFound next ctx
@@ -278,17 +287,83 @@ let savePermalinks : HttpHandler = fun next ctx -> task {
match! ctx.Data.Post.updatePriorPermalinks (PostId model.id) webLog.id links with
| true ->
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
}
// 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 (WebLog.relativeUrl webLog (Permalink "admin/posts")) next ctx
// GET /admin/post/{id}/revisions
let editRevisions postId : HttpHandler = fun next ctx -> task {
match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with
| Some post ->
return!
Hash.FromAnonymousObject {|
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"
@@ -306,7 +381,7 @@ let save : HttpHandler = fun next ctx -> task {
{ Post.empty with
id = PostId.create ()
webLogId = webLog.id
authorId = userId ctx
authorId = ctx.UserId
}
| postId -> return! data.Post.findFullById (PostId postId) webLog.id
}
@@ -323,7 +398,7 @@ let save : HttpHandler = fun next ctx -> task {
let post =
match model.setPublished with
| true ->
let dt = WebLog.utcTime webLog model.pubOverride.Value
let dt = parseToUtc (model.pubOverride.Value.ToString "o")
match model.setUpdated with
| true ->
{ post with
@@ -342,7 +417,6 @@ let save : HttpHandler = fun next ctx -> task {
|> List.length = List.length pst.Value.categoryIds) then
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Post saved successfully" }
return!
redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{PostId.toString post.id}/edit")) next ctx
return! redirectToGet $"admin/post/{PostId.toString post.id}/edit" next ctx
| None -> return! Error.notFound next ctx
}

View File

@@ -29,7 +29,7 @@ module CatchAll =
// Current post
match data.Post.findByPermalink permalink webLog.id |> await with
| 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
model.Add ("page_title", post.title)
yield fun next ctx -> themedView (defaultArg post.template "single-post") next ctx model
@@ -37,12 +37,12 @@ module CatchAll =
// Current page
match data.Page.findByPermalink permalink webLog.id |> await with
| Some page ->
debug (fun () -> $"Found page by permalink")
debug (fun () -> "Found page by permalink")
yield fun next ctx ->
Hash.FromAnonymousObject {|
page_title = page.title
page = DisplayPage.fromPage webLog page
categories = CategoryCache.get ctx
page_title = page.title
is_page = true
|}
|> themedView (defaultArg page.template "single-page") next ctx
@@ -50,7 +50,7 @@ module CatchAll =
// RSS feed
match Feed.deriveFeedType ctx textLink with
| Some (feedType, postCount) ->
debug (fun () -> $"Found RSS feed")
debug (fun () -> "Found RSS feed")
yield Feed.generate feedType postCount
| None -> ()
// 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..]}/")
match data.Post.findByPermalink altLink webLog.id |> await with
| 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)
| None -> ()
// Page differing only by trailing slash
match data.Page.findByPermalink altLink webLog.id |> await with
| 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)
| None -> ()
// Prior post
match data.Post.findCurrentPermalink [ permalink; altLink ] webLog.id |> await with
| Some link ->
debug (fun () -> $"Found post by prior permalink")
debug (fun () -> "Found post by prior permalink")
yield redirectTo true (WebLog.relativeUrl webLog link)
| None -> ()
// Prior page
match data.Page.findCurrentPermalink [ permalink; altLink ] webLog.id |> await with
| Some link ->
debug (fun () -> $"Found page by prior permalink")
debug (fun () -> "Found page by prior permalink")
yield redirectTo true (WebLog.relativeUrl webLog link)
| None -> ()
debug (fun () -> $"No content found")
debug (fun () -> "No content found")
}
// GET {all-of-the-above}
@@ -93,55 +93,25 @@ module CatchAll =
/// Serve theme assets
module Asset =
open System
open Microsoft.AspNetCore.Http.Headers
open Microsoft.AspNetCore.StaticFiles
open Microsoft.Net.Http.Headers
/// Determine if the asset has been modified since the date/time specified by the If-Modified-Since header
let private checkModified asset (ctx : HttpContext) : HttpHandler option =
match ctx.Request.Headers.IfModifiedSince with
| it when it.Count < 1 -> None
| it ->
if asset.updatedOn > DateTime.Parse it[0] then
None
else
Some (setStatusCode 304 >=> setBodyFromString "Not Modified")
/// An instance of ASP.NET Core's file extension to MIME type converter
let private mimeMap = FileExtensionContentTypeProvider ()
// GET /theme/{theme}/{**path}
let serveAsset (urlParts : string seq) : HttpHandler = fun next ctx -> task {
let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
let path = urlParts |> Seq.skip 1 |> Seq.head
match! ctx.Data.ThemeAsset.findById (ThemeAssetId.ofString path) with
| Some asset ->
match checkModified asset ctx with
match Upload.checkModified asset.updatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx
| None ->
let mimeType =
match mimeMap.TryGetContentType path with
| true, typ -> typ
| false, _ -> "application/octet-stream"
let headers = ResponseHeaders ctx.Response.Headers
headers.LastModified <- Some (DateTimeOffset asset.updatedOn) |> Option.toNullable
headers.ContentType <- MediaTypeHeaderValue mimeType
headers.CacheControl <-
let hdr = CacheControlHeaderValue()
hdr.MaxAge <- Some (TimeSpan.FromDays 30) |> Option.toNullable
hdr
return! setBody asset.data next ctx
| None -> return! Upload.sendFile asset.updatedOn path asset.data next ctx
| None -> return! Error.notFound next ctx
}
/// The primary myWebLog router
let router : HttpHandler = choose [
GET >=> choose [
GET_HEAD >=> choose [
route "/" >=> Post.home
]
subRoute "/admin" (requireUser >=> choose [
GET >=> choose [
GET_HEAD >=> choose [
subRoute "/categor" (choose [
route "ies" >=> Admin.listCategories
route "ies/bare" >=> Admin.listCategoriesBare
@@ -149,16 +119,20 @@ let router : HttpHandler = choose [
])
route "/dashboard" >=> Admin.dashboard
subRoute "/page" (choose [
route "s" >=> Admin.listPages 1
routef "s/page/%i" Admin.listPages
routef "/%s/edit" Admin.editPage
routef "/%s/permalinks" Admin.editPagePermalinks
route "s" >=> Page.all 1
routef "s/page/%i" Page.all
routef "/%s/edit" Page.edit
routef "/%s/permalinks" Page.editPermalinks
routef "/%s/revision/%s/preview" Page.previewRevision
routef "/%s/revisions" Page.editRevisions
])
subRoute "/post" (choose [
route "s" >=> Post.all 1
routef "s/page/%i" Post.all
routef "/%s/edit" Post.edit
routef "/%s/permalinks" Post.editPermalinks
route "s" >=> Post.all 1
routef "s/page/%i" Post.all
routef "/%s/edit" Post.edit
routef "/%s/permalinks" Post.editPermalinks
routef "/%s/revision/%s/preview" Post.previewRevision
routef "/%s/revisions" Post.editRevisions
])
subRoute "/settings" (choose [
route "" >=> Admin.settings
@@ -173,6 +147,10 @@ let router : HttpHandler = choose [
])
])
route "/theme/update" >=> Admin.themeUpdatePage
subRoute "/upload" (choose [
route "s" >=> Upload.list
route "/new" >=> Upload.showNew
])
route "/user/edit" >=> User.edit
]
POST >=> validateCsrf >=> choose [
@@ -181,14 +159,20 @@ let router : HttpHandler = choose [
routef "/%s/delete" Admin.deleteCategory
])
subRoute "/page" (choose [
route "/save" >=> Admin.savePage
route "/permalinks" >=> Admin.savePagePermalinks
routef "/%s/delete" Admin.deletePage
route "/save" >=> Page.save
route "/permalinks" >=> Page.savePermalinks
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 [
route "/save" >=> Post.save
route "/permalinks" >=> Post.savePermalinks
routef "/%s/delete" Post.delete
route "/save" >=> Post.save
route "/permalinks" >=> Post.savePermalinks
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 [
route "" >=> Admin.saveSettings
@@ -203,6 +187,11 @@ let router : HttpHandler = choose [
])
])
route "/theme/update" >=> Admin.updateTheme
subRoute "/upload" (choose [
route "/save" >=> Upload.save
routexp "/delete/(.*)" Upload.deleteFromDisk
routef "/%s/delete" Upload.deleteFromDb
])
route "/user/save" >=> User.save
]
])
@@ -210,7 +199,8 @@ let router : HttpHandler = choose [
GET_HEAD >=> routef "/page/%i" Post.pageOfPosts
GET_HEAD >=> routef "/page/%i/" Post.redirectToPageOfPosts
GET_HEAD >=> routexp "/tag/(.*)" Post.pageOfTaggedPosts
GET_HEAD >=> routexp "/themes/(.*)" Asset.serveAsset
GET_HEAD >=> routexp "/themes/(.*)" Asset.serve
GET_HEAD >=> routexp "/upload/(.*)" Upload.serve
subRoute "/user" (choose [
GET_HEAD >=> choose [
route "/log-on" >=> User.logOn None

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 Giraffe
open MyWebLog
open MyWebLog.ViewModels
// GET /user/log-on
@@ -26,9 +27,9 @@ let logOn returnUrl : HttpHandler = fun next ctx -> task {
| false -> None
return!
Hash.FromAnonymousObject {|
model = { LogOnModel.empty with returnTo = returnTo }
page_title = "Log On"
csrf = csrfToken ctx
csrf = ctx.CsrfTokenSet
model = { LogOnModel.empty with returnTo = returnTo }
|}
|> viewForTheme "admin" "log-on" next ctx
}
@@ -36,13 +37,11 @@ let logOn returnUrl : HttpHandler = fun next ctx -> task {
open System.Security.Claims
open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies
open MyWebLog
// POST /user/log-on
let doLogOn : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel> ()
let webLog = ctx.WebLog
match! ctx.Data.WebLogUser.findByEmail model.emailAddress webLog.id with
let! model = ctx.BindFormAsync<LogOnModel> ()
match! ctx.Data.WebLogUser.findByEmail model.emailAddress ctx.WebLog.id with
| Some user when user.passwordHash = hashedPassword model.password user.userName user.salt ->
let claims = seq {
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,
AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow))
do! addMessage ctx
{ UserMessage.success with message = $"Logged on successfully | Welcome to {webLog.name}!" }
return! redirectToGet (defaultArg model.returnTo (WebLog.relativeUrl webLog (Permalink "admin/dashboard")))
next ctx
{ UserMessage.success with message = $"Logged on successfully | Welcome to {ctx.WebLog.name}!" }
return! redirectToGet (defaultArg (model.returnTo |> Option.map (fun it -> it[1..])) "admin/dashboard") next ctx
| _ ->
do! addMessage ctx { UserMessage.error with message = "Log on attempt unsuccessful" }
return! logOn model.returnTo next ctx
@@ -67,19 +65,19 @@ let doLogOn : HttpHandler = fun next ctx -> task {
let logOff : HttpHandler = fun next ctx -> task {
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
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
let private showEdit (hash : Hash) : HttpHandler = fun next ctx -> task {
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
}
// GET /admin/user/edit
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
| None -> return! Error.notFound next ctx
}
@@ -89,7 +87,7 @@ let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel> ()
if model.newPassword = model.newPasswordConfirm then
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 ->
let pw, salt =
if model.newPassword = "" then
@@ -108,7 +106,7 @@ let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
do! data.WebLogUser.update user
let pwMsg = if model.newPassword = "" then "" else " and updated your password"
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
else
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 userId = WebLogUserId.create ()
let homePageId = PageId.create ()
let slug = Handlers.Upload.makeSlug args[2]
do! data.WebLog.add
{ WebLog.empty with
id = webLogId
name = args[2]
slug = slug
urlBase = args[1]
defaultPage = PageId.toString homePageId
timeZone = timeZone
@@ -162,13 +164,48 @@ module Backup =
}
/// Create a theme asset from an encoded theme asset
static member fromAsset (asset : EncodedAsset) : ThemeAsset =
{ id = asset.id
updatedOn = asset.updatedOn
data = Convert.FromBase64String asset.data
static member fromEncoded (encoded : EncodedAsset) : ThemeAsset =
{ id = encoded.id
updatedOn = encoded.updatedOn
data = Convert.FromBase64String encoded.data
}
/// An uploaded file, with the data base-64 encoded
type EncodedUpload =
{ /// The ID of the upload
id : UploadId
/// The ID of the web log to which the upload belongs
webLogId : WebLogId
/// The path at which this upload is served
path : Permalink
/// The date/time this upload was last updated (file time)
updatedOn : DateTime
/// The data for the upload, base-64 encoded
data : string
}
/// Create an encoded uploaded file from the original uploaded file
static member fromUpload (upload : Upload) : EncodedUpload =
{ id = upload.id
webLogId = upload.webLogId
path = upload.path
updatedOn = upload.updatedOn
data = Convert.ToBase64String upload.data
}
/// Create an uploaded file from an encoded uploaded file
static member fromEncoded (encoded : EncodedUpload) : Upload =
{ id = encoded.id
webLogId = encoded.webLogId
path = encoded.path
updatedOn = encoded.updatedOn
data = Convert.FromBase64String encoded.data
}
/// A unified archive for a web log
type Archive =
{ /// The web log to which this archive belongs
@@ -194,6 +231,9 @@ module Backup =
/// The posts for this web log (containing only the most recent revision)
posts : Post list
/// The uploaded files for this web log
uploads : EncodedUpload list
}
/// Create a JSON serializer (uses RethinkDB data implementation's JSON converters)
@@ -212,19 +252,21 @@ module Backup =
let tagMapCount = List.length archive.tagMappings
let pageCount = List.length archive.pages
let postCount = List.length archive.posts
let uploadCount = List.length archive.uploads
// Create a pluralized output based on the count
let plural count ifOne ifMany =
if count = 1 then ifOne else ifMany
printfn ""
printfn $"""{msg.Replace ("{{NAME}}", webLog.name)}"""
printfn $"""{msg.Replace ("<>NAME<>", webLog.name)}"""
printfn $""" - The theme "{archive.theme.name}" with {assetCount} asset{plural assetCount "" "s"}"""
printfn $""" - {userCount} user{plural userCount "" "s"}"""
printfn $""" - {categoryCount} categor{plural categoryCount "y" "ies"}"""
printfn $""" - {tagMapCount} tag mapping{plural tagMapCount "" "s"}"""
printfn $""" - {pageCount} page{plural pageCount "" "s"}"""
printfn $""" - {postCount} post{plural postCount "" "s"}"""
printfn $""" - {uploadCount} uploaded file{plural uploadCount "" "s"}"""
/// Create a backup archive
let private createBackup webLog (fileName : string) prettyOutput (data : IData) = task {
@@ -248,6 +290,9 @@ module Backup =
printfn "- Exporting posts..."
let! posts = data.Post.findFullByWebLog webLog.id
printfn "- Exporting uploads..."
let! uploads = data.Upload.findByWebLogWithData webLog.id
printfn "- Writing archive..."
let archive = {
webLog = webLog
@@ -256,8 +301,9 @@ module Backup =
assets = assets |> List.map EncodedAsset.fromAsset
categories = categories
tagMappings = tagMaps
pages = pages |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
posts = posts |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
pages = pages |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
posts = posts |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
uploads = uploads |> List.map EncodedUpload.fromUpload
}
// Write the structure to the backup file
@@ -267,7 +313,7 @@ module Backup =
serializer.Serialize (writer, archive)
writer.Close ()
displayStats "{{NAME}} backup contains:" webLog archive
displayStats $"{fileName} (for <>NAME<>) contains:" webLog archive
}
let private doRestore archive newUrlBase (data : IData) = task {
@@ -284,6 +330,7 @@ module Backup =
let newPageIds = archive.pages |> List.map (fun page -> page.id, PageId.create ()) |> dict
let newPostIds = archive.posts |> List.map (fun post -> post.id, PostId.create ()) |> dict
let newUserIds = archive.users |> List.map (fun user -> user.id, WebLogUserId.create ()) |> dict
let newUpIds = archive.uploads |> List.map (fun up -> up.id, UploadId.create ()) |> dict
return
{ archive with
webLog = { archive.webLog with id = newWebLogId; urlBase = Option.get newUrlBase }
@@ -308,6 +355,8 @@ module Backup =
authorId = newUserIds[post.authorId]
categoryIds = post.categoryIds |> List.map (fun c -> newCatIds[c])
})
uploads = archive.uploads
|> List.map (fun u -> { u with id = newUpIds[u.id]; webLogId = newWebLogId })
}
| None ->
return
@@ -320,7 +369,7 @@ module Backup =
printfn ""
printfn "- Importing theme..."
do! data.Theme.save restore.theme
let! _ = restore.assets |> List.map (EncodedAsset.fromAsset >> data.ThemeAsset.save) |> Task.WhenAll
let! _ = restore.assets |> List.map (EncodedAsset.fromEncoded >> data.ThemeAsset.save) |> Task.WhenAll
// Restore web log data
@@ -342,7 +391,10 @@ module Backup =
// TODO: comments not yet implemented
displayStats "Restored for {{NAME}}:" restore.webLog restore
printfn "- Restoring uploads..."
do! data.Upload.restore (restore.uploads |> List.map EncodedUpload.fromEncoded)
displayStats "Restored for <>NAME<>:" restore.webLog restore
}
/// Decide whether to restore a backup
@@ -371,17 +423,26 @@ module Backup =
/// Generate a backup archive
let generateBackup (args : string[]) (sp : IServiceProvider) = task {
if args.Length = 3 || args.Length = 4 then
let showUsage () =
printfn """Usage: MyWebLog backup [url-base] [*backup-file-name] [**"pretty"]"""
printfn """ * optional - default is [web-log-slug].json"""
printfn """ ** optional - default is non-pretty JSON output"""
if args.Length > 1 && args.Length < 5 then
let data = sp.GetRequiredService<IData> ()
match! data.WebLog.findByHost args[1] with
| Some webLog ->
let fileName = if args[2].EndsWith ".json" then args[2] else $"{args[2]}.json"
let prettyOutput = args.Length = 4 && args[3] = "pretty"
let fileName =
if args.Length = 2 || (args.Length = 3 && args[2] = "pretty") then
$"{webLog.slug}.json"
elif args[2].EndsWith ".json" then
args[2]
else
$"{args[2]}.json"
let prettyOutput = (args.Length = 3 && args[2] = "pretty") || (args.Length = 4 && args[3] = "pretty")
do! createBackup webLog fileName prettyOutput data
| None -> printfn $"Error: no web log found for {args[1]}"
else
printfn """Usage: MyWebLog backup [url-base] [backup-file-name] [*"pretty"]"""
printfn """ * optional - default is non-pretty JSON output"""
showUsage ()
}
/// Restore a backup archive

View File

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

View File

@@ -41,13 +41,17 @@ module DataImplementation =
let get (sp : IServiceProvider) : IData =
let config = sp.GetRequiredService<IConfiguration> ()
if (config.GetConnectionString >> isNull >> not) "SQLite" then
let log = sp.GetRequiredService<ILogger<SQLiteData>> ()
let conn = new SqliteConnection (config.GetConnectionString "SQLite")
log.LogInformation $"Using SQL database {conn.DataSource}"
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
upcast SQLiteData (conn, sp.GetRequiredService<ILogger<SQLiteData>> ())
elif (config.GetSection "RethinkDB").Exists () then
let log = sp.GetRequiredService<ILogger<RethinkDbData>> ()
Json.all () |> Seq.iter Converter.Serializer.Converters.Add
let rethinkCfg = DataConfig.FromConfiguration (config.GetSection "RethinkDB")
let conn = rethinkCfg.CreateConnectionAsync () |> Async.AwaitTask |> Async.RunSynchronously
log.LogInformation $"Using RethinkDB database {rethinkCfg.Database}"
upcast RethinkDbData (conn, rethinkCfg, sp.GetRequiredService<ILogger<RethinkDbData>> ())
else
let log = sp.GetRequiredService<ILogger<SQLiteData>> ()

View File

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

View File

View File

@@ -12,6 +12,7 @@
{{ "admin/dashboard" | nav_link: "Dashboard" }}
{{ "admin/pages" | nav_link: "Pages" }}
{{ "admin/posts" | nav_link: "Posts" }}
{{ "admin/uploads" | nav_link: "Uploads" }}
{{ "admin/categories" | nav_link: "Categories" }}
{{ "admin/settings" | nav_link: "Settings" }}
</ul>
@@ -47,6 +48,8 @@
<div class="container-fluid">
<div class="row">
<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">
</div>
</div>

View File

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

View File

@@ -16,8 +16,15 @@
value="{{ model.permalink }}">
<label for="permalink">Permalink</label>
{%- if model.page_id != "new" %}
{%- capture perm_edit %}admin/page/{{ model.page_id }}/permalinks{% endcapture -%}
<span class="form-text"><a href="{{ perm_edit | relative_link }}">Manage Permalinks</a></span>
<span class="form-text">
<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 -%}
</div>
<div class="mb-2">

View File

@@ -16,8 +16,15 @@
value="{{ model.permalink }}">
<label for="permalink">Permalink</label>
{%- if model.post_id != "new" %}
{%- capture perm_edit %}admin/post/{{ model.post_id }}/permalinks{% endcapture -%}
<span class="form-text"><a href="{{ perm_edit | relative_link }}">Manage Permalinks</a></span>
<span class="form-text">
<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 -%}
</div>
<div class="mb-2">

View File

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

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

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
2.0.0-beta02
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);
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,
/** The next index for a permalink */
/**
* The next index for a permalink
* @type {number}
*/
nextPermalink : 0,
/**
* Set the next meta item index
* @param idx The index to set
* @param {number} idx The index to set
*/
setNextMetaIndex(idx) {
this.nextMetaIndex = idx
@@ -15,7 +24,7 @@
/**
* Set the next permalink index
* @param idx The index to set
* @param {number} idx The index to set
*/
setPermalinkIndex(idx) {
this.nextPermalink = idx
@@ -220,10 +229,22 @@
checkPodcast() {
document.getElementById("podcastFields").disabled = !document.getElementById("isPodcast").checked
},
/**
* Copy text to the clipboard
* @param {string} text The text to be copied
* @param {HTMLAnchorElement} elt The element on which the click was generated
* @return {boolean} False, to prevent navigation
*/
copyText(text, elt) {
navigator.clipboard.writeText(text)
elt.innerText = "Copied"
return false
},
/**
* Toggle the source of a custom RSS feed
* @param source The source that was selected
* @param {string} source The source that was selected
*/
customFeedBy(source) {
const categoryInput = document.getElementById("sourceValueCat")
@@ -241,7 +262,7 @@
/**
* Remove a metadata item
* @param idx The index of the metadata item to remove
* @param {number} idx The index of the metadata item to remove
*/
removeMetaItem(idx) {
document.getElementById(`meta_${idx}`).remove()
@@ -249,7 +270,7 @@
/**
* Remove a permalink
* @param idx The index of the permalink to remove
* @param {number} idx The index of the permalink to remove
*/
removePermalink(idx) {
document.getElementById(`link_${idx}`).remove()
@@ -264,7 +285,7 @@
/**
* Show messages that may have come with an htmx response
* @param messages The messages from the response
* @param {string} messages The messages from the response
*/
showMessage(messages) {
const msgs = messages.split(", ")