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 .ionide
src/MyWebLog/appsettings.Production.json src/MyWebLog/appsettings.Production.json
# SQLite database files
src/MyWebLog/*.db*

View File

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

View File

@@ -100,6 +100,20 @@ module Json =
override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) = override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) =
(string >> ThemeId) reader.Value (string >> ThemeId) reader.Value
type UploadDestinationConverter () =
inherit JsonConverter<UploadDestination> ()
override _.WriteJson (writer : JsonWriter, value : UploadDestination, _ : JsonSerializer) =
writer.WriteValue (UploadDestination.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadDestination, _ : bool, _ : JsonSerializer) =
(string >> UploadDestination.parse) reader.Value
type UploadIdConverter () =
inherit JsonConverter<UploadId> ()
override _.WriteJson (writer : JsonWriter, value : UploadId, _ : JsonSerializer) =
writer.WriteValue (UploadId.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadId, _ : bool, _ : JsonSerializer) =
(string >> UploadId) reader.Value
type WebLogIdConverter () = type WebLogIdConverter () =
inherit JsonConverter<WebLogId> () inherit JsonConverter<WebLogId> ()
override _.WriteJson (writer : JsonWriter, value : WebLogId, _ : JsonSerializer) = override _.WriteJson (writer : JsonWriter, value : WebLogId, _ : JsonSerializer) =
@@ -133,6 +147,8 @@ module Json =
TagMapIdConverter () TagMapIdConverter ()
ThemeAssetIdConverter () ThemeAssetIdConverter ()
ThemeIdConverter () ThemeIdConverter ()
UploadDestinationConverter ()
UploadIdConverter ()
WebLogIdConverter () WebLogIdConverter ()
WebLogUserIdConverter () WebLogUserIdConverter ()
// Handles DUs with no associated data, as well as option fields // Handles DUs with no associated data, as well as option fields

View File

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

View File

@@ -11,7 +11,7 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.6" /> <PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.7" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" /> <PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" />
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" /> <PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" /> <PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
@@ -31,6 +31,7 @@
<Compile Include="SQLite\SQLitePostData.fs" /> <Compile Include="SQLite\SQLitePostData.fs" />
<Compile Include="SQLite\SQLiteTagMapData.fs" /> <Compile Include="SQLite\SQLiteTagMapData.fs" />
<Compile Include="SQLite\SQLiteThemeData.fs" /> <Compile Include="SQLite\SQLiteThemeData.fs" />
<Compile Include="SQLite\SQLiteUploadData.fs" />
<Compile Include="SQLite\SQLiteWebLogData.fs" /> <Compile Include="SQLite\SQLiteWebLogData.fs" />
<Compile Include="SQLite\SQLiteWebLogUserData.fs" /> <Compile Include="SQLite\SQLiteWebLogUserData.fs" />
<Compile Include="SQLiteData.fs" /> <Compile Include="SQLiteData.fs" />

View File

@@ -33,6 +33,9 @@ module private RethinkHelpers =
/// The theme asset table /// The theme asset table
let ThemeAsset = "ThemeAsset" let ThemeAsset = "ThemeAsset"
/// The uploaded file table
let Upload = "Upload"
/// The web log table /// The web log table
let WebLog = "WebLog" let WebLog = "WebLog"
@@ -40,7 +43,7 @@ module private RethinkHelpers =
let WebLogUser = "WebLogUser" let WebLogUser = "WebLogUser"
/// A list of all tables /// A list of all tables
let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; WebLog; WebLogUser ] let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ]
/// Shorthand for the ReQL starting point /// 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) indexCreate "webLogAndUrl" (fun row -> r.Array (row["webLogId"], row["urlValue"]) :> obj)
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
// Uploaded files need an index by web log ID and path, as that is how they are retrieved
if Table.Upload = table then
if not (indexes |> List.contains "webLogAndPath") then
log.LogInformation $"Creating index {table}.webLogAndPath..."
do! rethink {
withTable table
indexCreate "webLogAndPath" (fun row -> r.Array (row["webLogId"], row["path"]) :> obj)
write; withRetryOnce; ignoreResult conn
}
// Users log on with e-mail // Users log on with e-mail
if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then
log.LogInformation $"Creating index {table}.logOn..." log.LogInformation $"Creating index {table}.logOn..."
@@ -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 = { member _.WebLog = {
new IWebLogData with new IWebLogData with
@@ -763,6 +838,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
delete delete
write; withRetryOnce; ignoreResult conn 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 for table in [ Table.Post; Table.Category; Table.Page; Table.WebLogUser ] do
do! rethink { do! rethink {
withTable table withTable table
@@ -805,12 +888,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
get webLog.id get webLog.id
update [ update [
"name", webLog.name :> obj "name", webLog.name :> obj
"slug", webLog.slug
"subtitle", webLog.subtitle "subtitle", webLog.subtitle
"defaultPage", webLog.defaultPage "defaultPage", webLog.defaultPage
"postsPerPage", webLog.postsPerPage "postsPerPage", webLog.postsPerPage
"timeZone", webLog.timeZone "timeZone", webLog.timeZone
"themePath", webLog.themePath "themePath", webLog.themePath
"autoHtmx", webLog.autoHtmx "autoHtmx", webLog.autoHtmx
"uploads", webLog.uploads
] ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
@@ -900,6 +985,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! ensureIndexes Table.Page [ "webLogId"; "authorId" ] do! ensureIndexes Table.Page [ "webLogId"; "authorId" ]
do! ensureIndexes Table.Post [ "webLogId"; "authorId" ] do! ensureIndexes Table.Post [ "webLogId"; "authorId" ]
do! ensureIndexes Table.TagMap [] do! ensureIndexes Table.TagMap []
do! ensureIndexes Table.Upload []
do! ensureIndexes Table.WebLog [ "urlBase" ] do! ensureIndexes Table.WebLog [ "urlBase" ]
do! ensureIndexes Table.WebLogUser [ "webLogId" ] do! ensureIndexes Table.WebLogUser [ "webLogId" ]
} }

View File

@@ -248,10 +248,28 @@ module Map =
text = getString "template" rdr text = getString "template" rdr
} }
/// Create an uploaded file from the current row in the given data reader
let toUpload includeData (rdr : SqliteDataReader) : Upload =
let data =
if includeData then
use dataStream = new MemoryStream ()
use blobStream = getStream "data" rdr
blobStream.CopyTo dataStream
dataStream.ToArray ()
else
[||]
{ id = UploadId (getString "id" rdr)
webLogId = WebLogId (getString "web_log_id" rdr)
path = Permalink (getString "path" rdr)
updatedOn = getDateTime "updated_on" rdr
data = data
}
/// Create a web log from the current row in the given data reader /// Create a web log from the current row in the given data reader
let toWebLog (rdr : SqliteDataReader) : WebLog = let toWebLog (rdr : SqliteDataReader) : WebLog =
{ id = WebLogId (getString "id" rdr) { id = WebLogId (getString "id" rdr)
name = getString "name" rdr name = getString "name" rdr
slug = getString "slug" rdr
subtitle = tryString "subtitle" rdr subtitle = tryString "subtitle" rdr
defaultPage = getString "default_page" rdr defaultPage = getString "default_page" rdr
postsPerPage = getInt "posts_per_page" rdr postsPerPage = getInt "posts_per_page" rdr
@@ -259,6 +277,7 @@ module Map =
urlBase = getString "url_base" rdr urlBase = getString "url_base" rdr
timeZone = getString "time_zone" rdr timeZone = getString "time_zone" rdr
autoHtmx = getBoolean "auto_htmx" rdr autoHtmx = getBoolean "auto_htmx" rdr
uploads = UploadDestination.parse (getString "uploads" rdr)
rss = { rss = {
feedEnabled = getBoolean "feed_enabled" rdr feedEnabled = getBoolean "feed_enabled" rdr
feedName = getString "feed_name" rdr feedName = getString "feed_name" rdr

View File

@@ -21,8 +21,8 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Add a category /// Add a category
let add cat = backgroundTask { let add cat = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""INSERT INTO category ( INSERT INTO category (
id, web_log_id, name, slug, description, parent_id id, web_log_id, name, slug, description, parent_id
) VALUES ( ) VALUES (
@id, @webLogId, @name, @slug, @description, @parentId @id, @webLogId, @name, @slug, @description, @parentId
@@ -70,8 +70,8 @@ type SQLiteCategoryData (conn : SqliteConnection) =
// Parent category post counts include posts in subcategories // Parent category post counts include posts in subcategories
cmd.Parameters.Clear () cmd.Parameters.Clear ()
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.CommandText <- cmd.CommandText <- """
"""SELECT COUNT(DISTINCT p.id) SELECT COUNT(DISTINCT p.id)
FROM post p FROM post p
INNER JOIN post_category pc ON pc.post_id = p.id INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
@@ -125,8 +125,8 @@ type SQLiteCategoryData (conn : SqliteConnection) =
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
// Delete the category off all posts where it is assigned // Delete the category off all posts where it is assigned
cmd.CommandText <- cmd.CommandText <- """
"""DELETE FROM post_category DELETE FROM post_category
WHERE category_id = @id WHERE category_id = @id
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)""" AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)"""
let catIdParameter = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) let catIdParameter = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
@@ -150,8 +150,8 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Update a category /// Update a category
let update cat = backgroundTask { let update cat = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""UPDATE category UPDATE category
SET name = @name, SET name = @name,
slug = @slug, slug = @slug,
description = @description, description = @description,

View File

@@ -139,13 +139,13 @@ type SQLitePageData (conn : SqliteConnection) =
let add page = backgroundTask { let add page = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
// The page itself // The page itself
cmd.CommandText <- cmd.CommandText <- """
"""INSERT INTO page ( INSERT INTO page (
id, web_log_id, author_id, title, permalink, published_on, updated_on, show_in_page_list, id, web_log_id, author_id, title, permalink, published_on, updated_on, show_in_page_list, template,
template, page_text page_text
) VALUES ( ) VALUES (
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @showInPageList, @id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @showInPageList, @template,
@template, @text @text
)""" )"""
addPageParameters cmd page addPageParameters cmd page
do! write cmd do! write cmd
@@ -174,8 +174,8 @@ type SQLitePageData (conn : SqliteConnection) =
/// Count all pages shown in the page list for the given web log /// Count all pages shown in the page list for the given web log
let countListed webLogId = backgroundTask { let countListed webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""SELECT COUNT(id) SELECT COUNT(id)
FROM page FROM page
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList""" AND show_in_page_list = @showInPageList"""
@@ -211,8 +211,8 @@ type SQLitePageData (conn : SqliteConnection) =
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
cmd.CommandText <- cmd.CommandText <- """
"""DELETE FROM page_revision WHERE page_id = @id; DELETE FROM page_revision WHERE page_id = @id;
DELETE FROM page_permalink WHERE page_id = @id; DELETE FROM page_permalink WHERE page_id = @id;
DELETE FROM page_meta WHERE page_id = @id; DELETE FROM page_meta WHERE page_id = @id;
DELETE FROM page WHERE id = @id""" DELETE FROM page WHERE id = @id"""
@@ -238,8 +238,8 @@ type SQLitePageData (conn : SqliteConnection) =
/// Find the current permalink within a set of potential prior permalinks for the given web log /// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask { let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""SELECT p.permalink SELECT p.permalink
FROM page p FROM page p
INNER JOIN page_permalink pp ON pp.page_id = p.id INNER JOIN page_permalink pp ON pp.page_id = p.id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
@@ -274,8 +274,8 @@ type SQLitePageData (conn : SqliteConnection) =
/// Get all listed pages for the given web log (without revisions, prior permalinks, or text) /// Get all listed pages for the given web log (without revisions, prior permalinks, or text)
let findListed webLogId = backgroundTask { let findListed webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""SELECT * SELECT *
FROM page FROM page
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList AND show_in_page_list = @showInPageList
@@ -293,8 +293,8 @@ type SQLitePageData (conn : SqliteConnection) =
/// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata) /// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata)
let findPageOfPages webLogId pageNbr = backgroundTask { let findPageOfPages webLogId pageNbr = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""SELECT * SELECT *
FROM page FROM page
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
ORDER BY LOWER(title) ORDER BY LOWER(title)
@@ -318,8 +318,8 @@ type SQLitePageData (conn : SqliteConnection) =
match! findFullById page.id page.webLogId with match! findFullById page.id page.webLogId with
| Some oldPage -> | Some oldPage ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""UPDATE page UPDATE page
SET author_id = @authorId, SET author_id = @authorId,
title = @title, title = @title,
permalink = @permalink, permalink = @permalink,

View File

@@ -146,8 +146,8 @@ type SQLitePostData (conn : SqliteConnection) =
if count = 1 then if count = 1 then
match post.episode with match post.episode with
| Some ep -> | Some ep ->
cmd.CommandText <- cmd.CommandText <- """
"""UPDATE post_episode UPDATE post_episode
SET media = @media, SET media = @media,
length = @length, length = @length,
duration = @duration, duration = @duration,
@@ -174,15 +174,15 @@ type SQLitePostData (conn : SqliteConnection) =
else else
match post.episode with match post.episode with
| Some ep -> | Some ep ->
cmd.CommandText <- cmd.CommandText <- """
"""INSERT INTO post_episode ( INSERT INTO post_episode (
post_id, media, length, duration, media_type, image_url, subtitle, explicit, post_id, media, length, duration, media_type, image_url, subtitle, explicit, chapter_file,
chapter_file, chapter_type, transcript_url, transcript_type, transcript_lang, chapter_type, transcript_url, transcript_type, transcript_lang, transcript_captions,
transcript_captions, season_number, season_description, episode_number, episode_description season_number, season_description, episode_number, episode_description
) VALUES ( ) VALUES (
@postId, @media, @length, @duration, @mediaType, @imageUrl, @subtitle, @explicit, @postId, @media, @length, @duration, @mediaType, @imageUrl, @subtitle, @explicit, @chapterFile,
@chapterFile, @chapterType, @transcriptUrl, @transcriptType, @transcriptLang, @chapterType, @transcriptUrl, @transcriptType, @transcriptLang, @transcriptCaptions,
@transcriptCaptions, @seasonNumber, @seasonDescription, @episodeNumber, @episodeDescription @seasonNumber, @seasonDescription, @episodeNumber, @episodeDescription
)""" )"""
addEpisodeParameters cmd ep addEpisodeParameters cmd ep
do! write cmd do! write cmd
@@ -278,13 +278,11 @@ type SQLitePostData (conn : SqliteConnection) =
/// Add a post /// Add a post
let add post = backgroundTask { let add post = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""INSERT INTO post ( INSERT INTO post (
id, web_log_id, author_id, status, title, permalink, published_on, updated_on, id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text
template, post_text
) VALUES ( ) VALUES (
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text
@template, @text
)""" )"""
addPostParameters cmd post addPostParameters cmd post
do! write cmd do! write cmd
@@ -340,8 +338,8 @@ type SQLitePostData (conn : SqliteConnection) =
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
cmd.CommandText <- cmd.CommandText <- """
"""DELETE FROM post_revision WHERE post_id = @id; DELETE FROM post_revision WHERE post_id = @id;
DELETE FROM post_permalink WHERE post_id = @id; DELETE FROM post_permalink WHERE post_id = @id;
DELETE FROM post_meta WHERE post_id = @id; DELETE FROM post_meta WHERE post_id = @id;
DELETE FROM post_episode WHERE post_id = @id; DELETE FROM post_episode WHERE post_id = @id;
@@ -356,8 +354,8 @@ type SQLitePostData (conn : SqliteConnection) =
/// Find the current permalink from a list of potential prior permalinks for the given web log /// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask { let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""SELECT p.permalink SELECT p.permalink
FROM post p FROM post p
INNER JOIN post_permalink pp ON pp.post_id = p.id INNER JOIN post_permalink pp ON pp.post_id = p.id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
@@ -392,8 +390,8 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks) /// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask { let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- $"""
$"""{selectPost} {selectPost}
INNER JOIN post_category pc ON pc.post_id = p.id INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = @status AND p.status = @status
@@ -420,8 +418,8 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks) /// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks)
let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask { let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- $"""
$"""{selectPost} {selectPost}
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
ORDER BY p.published_on DESC NULLS FIRST, p.updated_on ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}""" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
@@ -437,8 +435,8 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of published posts for the given web log (excludes revisions and prior permalinks) /// Get a page of published posts for the given web log (excludes revisions and prior permalinks)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask { let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- $"""
$"""{selectPost} {selectPost}
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = @status AND p.status = @status
ORDER BY p.published_on DESC ORDER BY p.published_on DESC
@@ -456,8 +454,8 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks) /// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask { let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- $"""
$"""{selectPost} {selectPost}
INNER JOIN post_tag pt ON pt.post_id = p.id INNER JOIN post_tag pt ON pt.post_id = p.id
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = @status AND p.status = @status
@@ -479,8 +477,8 @@ type SQLitePostData (conn : SqliteConnection) =
/// Find the next newest and oldest post from a publish date for the given web log /// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask { let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- $"""
$"""{selectPost} {selectPost}
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = @status AND p.status = @status
AND p.published_on < @publishedOn AND p.published_on < @publishedOn
@@ -499,8 +497,8 @@ type SQLitePostData (conn : SqliteConnection) =
return None return None
} }
do! rdr.CloseAsync () do! rdr.CloseAsync ()
cmd.CommandText <- cmd.CommandText <- $"""
$"""{selectPost} {selectPost}
WHERE p.web_log_id = @webLogId WHERE p.web_log_id = @webLogId
AND p.status = @status AND p.status = @status
AND p.published_on > @publishedOn AND p.published_on > @publishedOn
@@ -528,8 +526,8 @@ type SQLitePostData (conn : SqliteConnection) =
match! findFullById post.id post.webLogId with match! findFullById post.id post.webLogId with
| Some oldPost -> | Some oldPost ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""UPDATE post UPDATE post
SET author_id = @authorId, SET author_id = @authorId,
status = @status, status = @status,
title = @title, title = @title,

View File

@@ -50,8 +50,8 @@ type SQLiteTagMapData (conn : SqliteConnection) =
/// Find any tag mappings in a list of tags for the given web log /// Find any tag mappings in a list of tags for the given web log
let findMappingForTags (tags : string list) webLogId = backgroundTask { let findMappingForTags (tags : string list) webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""SELECT * SELECT *
FROM tag_map FROM tag_map
WHERE web_log_id = @webLogId WHERE web_log_id = @webLogId
AND tag IN (""" AND tag IN ("""
@@ -71,15 +71,15 @@ type SQLiteTagMapData (conn : SqliteConnection) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
match! findById tagMap.id tagMap.webLogId with match! findById tagMap.id tagMap.webLogId with
| Some _ -> | Some _ ->
cmd.CommandText <- cmd.CommandText <- """
"""UPDATE tag_map UPDATE tag_map
SET tag = @tag, SET tag = @tag,
url_value = @urlValue url_value = @urlValue
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId""" AND web_log_id = @webLogId"""
| None -> | None ->
cmd.CommandText <- cmd.CommandText <- """
"""INSERT INTO tag_map ( INSERT INTO tag_map (
id, web_log_id, tag, url_value id, web_log_id, tag, url_value
) VALUES ( ) VALUES (
@id, @webLogId, @tag, @urlValue @id, @webLogId, @tag, @urlValue

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) = let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.id) [ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.id)
cmd.Parameters.AddWithValue ("@name", webLog.name) cmd.Parameters.AddWithValue ("@name", webLog.name)
cmd.Parameters.AddWithValue ("@slug", webLog.slug)
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.subtitle) cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.subtitle)
cmd.Parameters.AddWithValue ("@defaultPage", webLog.defaultPage) cmd.Parameters.AddWithValue ("@defaultPage", webLog.defaultPage)
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.postsPerPage) cmd.Parameters.AddWithValue ("@postsPerPage", webLog.postsPerPage)
@@ -34,6 +35,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.Parameters.AddWithValue ("@urlBase", webLog.urlBase) cmd.Parameters.AddWithValue ("@urlBase", webLog.urlBase)
cmd.Parameters.AddWithValue ("@timeZone", webLog.timeZone) cmd.Parameters.AddWithValue ("@timeZone", webLog.timeZone)
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.autoHtmx) cmd.Parameters.AddWithValue ("@autoHtmx", webLog.autoHtmx)
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.uploads)
] |> ignore ] |> ignore
addWebLogRssParameters cmd webLog addWebLogRssParameters cmd webLog
@@ -69,8 +71,8 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Get the current custom feeds for a web log /// Get the current custom feeds for a web log
let getCustomFeeds (webLog : WebLog) = backgroundTask { let getCustomFeeds (webLog : WebLog) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""SELECT f.*, p.* SELECT f.*, p.*
FROM web_log_feed f FROM web_log_feed f
LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id
WHERE f.web_log_id = @webLogId""" WHERE f.web_log_id = @webLogId"""
@@ -88,15 +90,15 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Add a podcast to a custom feed /// Add a podcast to a custom feed
let addPodcast feedId (podcast : PodcastOptions) = backgroundTask { let addPodcast feedId (podcast : PodcastOptions) = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""INSERT INTO web_log_feed_podcast ( INSERT INTO web_log_feed_podcast (
feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url,
image_url, itunes_category, itunes_subcategory, explicit, default_media_type, itunes_category, itunes_subcategory, explicit, default_media_type, media_base_url, guid, funding_url,
media_base_url, guid, funding_url, funding_text, medium funding_text, medium
) VALUES ( ) VALUES (
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl,
@imageUrl, @iTunesCategory, @iTunesSubcategory, @explicit, @defaultMediaType, @iTunesCategory, @iTunesSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @guid, @fundingUrl,
@mediaBaseUrl, @guid, @fundingUrl, @fundingText, @medium @fundingText, @medium
)""" )"""
addPodcastParameters cmd feedId podcast addPodcastParameters cmd feedId podcast
do! write cmd do! write cmd
@@ -115,8 +117,8 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
toDelete toDelete
|> List.map (fun it -> backgroundTask { |> List.map (fun it -> backgroundTask {
cmd.CommandText <- cmd.CommandText <- """
"""DELETE FROM web_log_feed_podcast WHERE feed_id = @id; DELETE FROM web_log_feed_podcast WHERE feed_id = @id;
DELETE FROM web_log_feed WHERE id = @id""" DELETE FROM web_log_feed WHERE id = @id"""
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.id cmd.Parameters["@id"].Value <- CustomFeedId.toString it.id
do! write cmd do! write cmd
@@ -126,8 +128,8 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.Parameters.Clear () cmd.Parameters.Clear ()
toAdd toAdd
|> List.map (fun it -> backgroundTask { |> List.map (fun it -> backgroundTask {
cmd.CommandText <- cmd.CommandText <- """
"""INSERT INTO web_log_feed ( INSERT INTO web_log_feed (
id, web_log_id, source, path id, web_log_id, source, path
) VALUES ( ) VALUES (
@id, @webLogId, @source, @path @id, @webLogId, @source, @path
@@ -143,8 +145,8 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|> ignore |> ignore
toUpdate toUpdate
|> List.map (fun it -> backgroundTask { |> List.map (fun it -> backgroundTask {
cmd.CommandText <- cmd.CommandText <- """
"""UPDATE web_log_feed UPDATE web_log_feed
SET source = @source, SET source = @source,
path = @path path = @path
WHERE id = @id WHERE id = @id
@@ -156,8 +158,8 @@ type SQLiteWebLogData (conn : SqliteConnection) =
match it.podcast with match it.podcast with
| Some podcast -> | Some podcast ->
if hadPodcast then if hadPodcast then
cmd.CommandText <- cmd.CommandText <- """
"""UPDATE web_log_feed_podcast UPDATE web_log_feed_podcast
SET title = @title, SET title = @title,
subtitle = @subtitle, subtitle = @subtitle,
items_in_feed = @itemsInFeed, items_in_feed = @itemsInFeed,
@@ -198,15 +200,13 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Add a web log /// Add a web log
let add webLog = backgroundTask { let add webLog = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""INSERT INTO web_log ( INSERT INTO web_log (
id, name, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
auto_htmx, feed_enabled, feed_name, items_in_feed, category_enabled, tag_enabled, uploads, feed_enabled, feed_name, items_in_feed, category_enabled, tag_enabled, copyright
copyright
) VALUES ( ) VALUES (
@id, @name, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
@autoHtmx, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled, @uploads, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled, @copyright
@copyright
)""" )"""
addWebLogParameters cmd webLog addWebLogParameters cmd webLog
do! write cmd do! write cmd
@@ -232,8 +232,8 @@ type SQLiteWebLogData (conn : SqliteConnection) =
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)" let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
let postSubQuery = subQuery "post" let postSubQuery = subQuery "post"
let pageSubQuery = subQuery "page" let pageSubQuery = subQuery "page"
cmd.CommandText <- cmd.CommandText <- $"""
$"""DELETE FROM post_comment WHERE post_id IN {postSubQuery}; DELETE FROM post_comment WHERE post_id IN {postSubQuery};
DELETE FROM post_revision WHERE post_id IN {postSubQuery}; DELETE FROM post_revision WHERE post_id IN {postSubQuery};
DELETE FROM post_permalink WHERE post_id IN {postSubQuery}; DELETE FROM post_permalink WHERE post_id IN {postSubQuery};
DELETE FROM post_episode WHERE post_id IN {postSubQuery}; DELETE FROM post_episode WHERE post_id IN {postSubQuery};
@@ -247,6 +247,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
DELETE FROM page WHERE web_log_id = @webLogId; DELETE FROM page WHERE web_log_id = @webLogId;
DELETE FROM category WHERE web_log_id = @webLogId; DELETE FROM category WHERE web_log_id = @webLogId;
DELETE FROM tag_map 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_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_podcast WHERE feed_id IN {subQuery "web_log_feed"};
DELETE FROM web_log_feed WHERE web_log_id = @webLogId; DELETE FROM web_log_feed WHERE web_log_id = @webLogId;
@@ -283,9 +284,10 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Update settings for a web log /// Update settings for a web log
let updateSettings webLog = backgroundTask { let updateSettings webLog = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""UPDATE web_log UPDATE web_log
SET name = @name, SET name = @name,
slug = @slug,
subtitle = @subtitle, subtitle = @subtitle,
default_page = @defaultPage, default_page = @defaultPage,
posts_per_page = @postsPerPage, posts_per_page = @postsPerPage,
@@ -293,6 +295,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
url_base = @urlBase, url_base = @urlBase,
time_zone = @timeZone, time_zone = @timeZone,
auto_htmx = @autoHtmx, auto_htmx = @autoHtmx,
uploads = @uploads,
feed_enabled = @feedEnabled, feed_enabled = @feedEnabled,
feed_name = @feedName, feed_name = @feedName,
items_in_feed = @itemsInFeed, items_in_feed = @itemsInFeed,
@@ -307,8 +310,8 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Update RSS options for a web log /// Update RSS options for a web log
let updateRssOptions webLog = backgroundTask { let updateRssOptions webLog = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""UPDATE web_log UPDATE web_log
SET feed_enabled = @feedEnabled, SET feed_enabled = @feedEnabled,
feed_name = @feedName, feed_name = @feedName,
items_in_feed = @itemsInFeed, items_in_feed = @itemsInFeed,

View File

@@ -28,13 +28,13 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Add a user /// Add a user
let add user = backgroundTask { let add user = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""INSERT INTO web_log_user ( INSERT INTO web_log_user (
id, web_log_id, user_name, first_name, last_name, preferred_name, password_hash, salt, id, web_log_id, user_name, first_name, last_name, preferred_name, password_hash, salt, url,
url, authorization_level authorization_level
) VALUES ( ) VALUES (
@id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash, @salt, @id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url,
@url, @authorizationLevel @authorizationLevel
)""" )"""
addWebLogUserParameters cmd user addWebLogUserParameters cmd user
do! write cmd do! write cmd
@@ -43,8 +43,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Find a user by their e-mail address for the given web log /// Find a user by their e-mail address for the given web log
let findByEmail (email : string) webLogId = backgroundTask { let findByEmail (email : string) webLogId = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND user_name = @userName"
"SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND user_name = @userName"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@userName", email) |> ignore cmd.Parameters.AddWithValue ("@userName", email) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
@@ -95,8 +94,8 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Update a user /// Update a user
let update user = backgroundTask { let update user = backgroundTask {
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <- """
"""UPDATE web_log_user UPDATE web_log_user
SET user_name = @userName, SET user_name = @userName,
first_name = @firstName, first_name = @firstName,
last_name = @lastName, last_name = @lastName,

View File

@@ -36,6 +36,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
member _.TagMap = SQLiteTagMapData conn member _.TagMap = SQLiteTagMapData conn
member _.Theme = SQLiteThemeData conn member _.Theme = SQLiteThemeData conn
member _.ThemeAsset = SQLiteThemeAssetData conn member _.ThemeAsset = SQLiteThemeAssetData conn
member _.Upload = SQLiteUploadData conn
member _.WebLog = SQLiteWebLogData conn member _.WebLog = SQLiteWebLogData conn
member _.WebLogUser = SQLiteWebLogUserData conn member _.WebLogUser = SQLiteWebLogUserData conn
@@ -48,8 +49,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating theme table..." log.LogInformation "Creating theme table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE theme ( CREATE TABLE theme (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
name TEXT NOT NULL, name TEXT NOT NULL,
version TEXT NOT NULL)""" version TEXT NOT NULL)"""
@@ -58,8 +59,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating theme_template table..." log.LogInformation "Creating theme_template table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE theme_template ( CREATE TABLE theme_template (
theme_id TEXT NOT NULL REFERENCES theme (id), theme_id TEXT NOT NULL REFERENCES theme (id),
name TEXT NOT NULL, name TEXT NOT NULL,
template TEXT NOT NULL, template TEXT NOT NULL,
@@ -69,8 +70,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating theme_asset table..." log.LogInformation "Creating theme_asset table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE theme_asset ( CREATE TABLE theme_asset (
theme_id TEXT NOT NULL REFERENCES theme (id), theme_id TEXT NOT NULL REFERENCES theme (id),
path TEXT NOT NULL, path TEXT NOT NULL,
updated_on TEXT NOT NULL, updated_on TEXT NOT NULL,
@@ -83,10 +84,11 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating web_log table..." log.LogInformation "Creating web_log table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE web_log ( CREATE TABLE web_log (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
name TEXT NOT NULL, name TEXT NOT NULL,
slug TEXT NOT NULL,
subtitle TEXT, subtitle TEXT,
default_page TEXT NOT NULL, default_page TEXT NOT NULL,
posts_per_page INTEGER NOT NULL, posts_per_page INTEGER NOT NULL,
@@ -94,30 +96,33 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
url_base TEXT NOT NULL, url_base TEXT NOT NULL,
time_zone TEXT NOT NULL, time_zone TEXT NOT NULL,
auto_htmx INTEGER NOT NULL DEFAULT 0, auto_htmx INTEGER NOT NULL DEFAULT 0,
uploads TEXT NOT NULL,
feed_enabled INTEGER NOT NULL DEFAULT 0, feed_enabled INTEGER NOT NULL DEFAULT 0,
feed_name TEXT NOT NULL, feed_name TEXT NOT NULL,
items_in_feed INTEGER, items_in_feed INTEGER,
category_enabled INTEGER NOT NULL DEFAULT 0, category_enabled INTEGER NOT NULL DEFAULT 0,
tag_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 do! write cmd
match! tableExists "web_log_feed" with match! tableExists "web_log_feed" with
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating web_log_feed table..." log.LogInformation "Creating web_log_feed table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE web_log_feed ( CREATE TABLE web_log_feed (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
source TEXT NOT NULL, 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 do! write cmd
match! tableExists "web_log_feed_podcast" with match! tableExists "web_log_feed_podcast" with
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating web_log_feed_podcast table..." log.LogInformation "Creating web_log_feed_podcast table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE web_log_feed_podcast ( CREATE TABLE web_log_feed_podcast (
feed_id TEXT PRIMARY KEY REFERENCES web_log_feed (id), feed_id TEXT PRIMARY KEY REFERENCES web_log_feed (id),
title TEXT NOT NULL, title TEXT NOT NULL,
subtitle TEXT, subtitle TEXT,
@@ -142,14 +147,15 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating category table..." log.LogInformation "Creating category table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE category ( CREATE TABLE category (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
name TEXT NOT NULL, name TEXT NOT NULL,
slug TEXT NOT NULL, slug TEXT NOT NULL,
description TEXT, description TEXT,
parent_id TEXT)""" parent_id TEXT);
CREATE INDEX category_web_log_idx ON category (web_log_id)"""
do! write cmd do! write cmd
// Web log user table // Web log user table
@@ -157,8 +163,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating web_log_user table..." log.LogInformation "Creating web_log_user table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE web_log_user ( CREATE TABLE web_log_user (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
user_name TEXT NOT NULL, user_name TEXT NOT NULL,
@@ -168,7 +174,9 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
password_hash TEXT NOT NULL, password_hash TEXT NOT NULL,
salt TEXT NOT NULL, salt TEXT NOT NULL,
url TEXT, 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 do! write cmd
// Page tables // Page tables
@@ -176,8 +184,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating page table..." log.LogInformation "Creating page table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE page ( CREATE TABLE page (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (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, updated_on TEXT NOT NULL,
show_in_page_list INTEGER NOT NULL DEFAULT 0, show_in_page_list INTEGER NOT NULL DEFAULT 0,
template TEXT, 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 do! write cmd
match! tableExists "page_meta" with match! tableExists "page_meta" with
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating page_meta table..." log.LogInformation "Creating page_meta table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE page_meta ( CREATE TABLE page_meta (
page_id TEXT NOT NULL REFERENCES page (id), page_id TEXT NOT NULL REFERENCES page (id),
name TEXT NOT NULL, name TEXT NOT NULL,
value TEXT NOT NULL, value TEXT NOT NULL,
@@ -204,8 +215,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating page_permalink table..." log.LogInformation "Creating page_permalink table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE page_permalink ( CREATE TABLE page_permalink (
page_id TEXT NOT NULL REFERENCES page (id), page_id TEXT NOT NULL REFERENCES page (id),
permalink TEXT NOT NULL, permalink TEXT NOT NULL,
PRIMARY KEY (page_id, permalink))""" PRIMARY KEY (page_id, permalink))"""
@@ -214,8 +225,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating page_revision table..." log.LogInformation "Creating page_revision table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE page_revision ( CREATE TABLE page_revision (
page_id TEXT NOT NULL REFERENCES page (id), page_id TEXT NOT NULL REFERENCES page (id),
as_of TEXT NOT NULL, as_of TEXT NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
@@ -227,8 +238,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating post table..." log.LogInformation "Creating post table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE post ( CREATE TABLE post (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (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, published_on TEXT,
updated_on TEXT NOT NULL, updated_on TEXT NOT NULL,
template TEXT, 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 do! write cmd
match! tableExists "post_category" with match! tableExists "post_category" with
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating post_category table..." log.LogInformation "Creating post_category table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE post_category ( CREATE TABLE post_category (
post_id TEXT NOT NULL REFERENCES post (id), post_id TEXT NOT NULL REFERENCES post (id),
category_id TEXT NOT NULL REFERENCES category (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 do! write cmd
match! tableExists "post_episode" with match! tableExists "post_episode" with
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating post_episode table..." log.LogInformation "Creating post_episode table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE post_episode ( CREATE TABLE post_episode (
post_id TEXT PRIMARY KEY REFERENCES post(id), post_id TEXT PRIMARY KEY REFERENCES post(id),
media TEXT NOT NULL, media TEXT NOT NULL,
length INTEGER NOT NULL, length INTEGER NOT NULL,
@@ -279,8 +295,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating post_tag table..." log.LogInformation "Creating post_tag table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE post_tag ( CREATE TABLE post_tag (
post_id TEXT NOT NULL REFERENCES post (id), post_id TEXT NOT NULL REFERENCES post (id),
tag TEXT NOT NULL, tag TEXT NOT NULL,
PRIMARY KEY (post_id, tag))""" PRIMARY KEY (post_id, tag))"""
@@ -289,8 +305,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating post_meta table..." log.LogInformation "Creating post_meta table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE post_meta ( CREATE TABLE post_meta (
post_id TEXT NOT NULL REFERENCES post (id), post_id TEXT NOT NULL REFERENCES post (id),
name TEXT NOT NULL, name TEXT NOT NULL,
value TEXT NOT NULL, value TEXT NOT NULL,
@@ -300,8 +316,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating post_permalink table..." log.LogInformation "Creating post_permalink table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE post_permalink ( CREATE TABLE post_permalink (
post_id TEXT NOT NULL REFERENCES post (id), post_id TEXT NOT NULL REFERENCES post (id),
permalink TEXT NOT NULL, permalink TEXT NOT NULL,
PRIMARY KEY (post_id, permalink))""" PRIMARY KEY (post_id, permalink))"""
@@ -310,8 +326,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating post_revision table..." log.LogInformation "Creating post_revision table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE post_revision ( CREATE TABLE post_revision (
post_id TEXT NOT NULL REFERENCES post (id), post_id TEXT NOT NULL REFERENCES post (id),
as_of TEXT NOT NULL, as_of TEXT NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
@@ -321,8 +337,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating post_comment table..." log.LogInformation "Creating post_comment table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE post_comment ( CREATE TABLE post_comment (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
post_id TEXT NOT NULL REFERENCES post(id), post_id TEXT NOT NULL REFERENCES post(id),
in_reply_to_id TEXT, in_reply_to_id TEXT,
@@ -331,7 +347,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
url TEXT, url TEXT,
status TEXT NOT NULL, status TEXT NOT NULL,
posted_on 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 do! write cmd
// Tag map table // Tag map table
@@ -339,11 +356,28 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> () | true -> ()
| false -> | false ->
log.LogInformation "Creating tag_map table..." log.LogInformation "Creating tag_map table..."
cmd.CommandText <- cmd.CommandText <- """
"""CREATE TABLE tag_map ( CREATE TABLE tag_map (
id TEXT PRIMARY KEY, id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES web_log (id),
tag TEXT NOT NULL, 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 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 /// A web log
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type WebLog = type WebLog =
@@ -304,6 +335,9 @@ type WebLog =
/// The name of the web log /// The name of the web log
name : string name : string
/// The slug of the web log
slug : string
/// A subtitle for the web log /// A subtitle for the web log
subtitle : string option subtitle : string option
@@ -327,6 +361,9 @@ type WebLog =
/// Whether to automatically load htmx /// Whether to automatically load htmx
autoHtmx : bool autoHtmx : bool
/// Where uploads are placed
uploads : UploadDestination
} }
/// Functions to support web logs /// Functions to support web logs
@@ -336,6 +373,7 @@ module WebLog =
let empty = let empty =
{ id = WebLogId.empty { id = WebLogId.empty
name = "" name = ""
slug = ""
subtitle = None subtitle = None
defaultPage = "" defaultPage = ""
postsPerPage = 10 postsPerPage = 10
@@ -344,6 +382,7 @@ module WebLog =
timeZone = "" timeZone = ""
rss = RssOptions.empty rss = RssOptions.empty
autoHtmx = false autoHtmx = false
uploads = Database
} }
/// Get the host (including scheme) and extra path from the URL base /// Get the host (including scheme) and extra path from the URL base
@@ -366,11 +405,6 @@ module WebLog =
TimeZoneInfo.ConvertTimeFromUtc TimeZoneInfo.ConvertTimeFromUtc
(DateTime (date.Ticks, DateTimeKind.Utc), TimeZoneInfo.FindSystemTimeZoneById webLog.timeZone) (DateTime (date.Ticks, DateTimeKind.Utc), TimeZoneInfo.FindSystemTimeZoneById webLog.timeZone)
/// Convert a date/time in the web log's local date/time to UTC
let utcTime webLog (date : DateTime) =
TimeZoneInfo.ConvertTimeToUtc
(DateTime (date.Ticks, DateTimeKind.Unspecified), TimeZoneInfo.FindSystemTimeZoneById webLog.timeZone)
/// A user of the web log /// A user of the web log
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]

View File

@@ -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 /// An identifier for a web log
type WebLogId = WebLogId of string 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 match (defaultArg (Option.ofObj it) "").Trim () with "" -> None | trimmed -> Some trimmed
/// The model used to display the admin dashboard
[<NoComparison; NoEquality>]
type DashboardModel =
{ /// The number of published posts
posts : int
/// The number of post drafts
drafts : int
/// The number of pages
pages : int
/// The number of pages in the page list
listedPages : int
/// The number of categories
categories : int
/// The top-level categories
topLevelCategories : int
}
/// Details about a category, used to display category lists /// Details about a category, used to display category lists
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type DisplayCategory = type DisplayCategory =
@@ -124,26 +147,58 @@ type DisplayPage =
} }
/// The model used to display the admin dashboard /// 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>] [<NoComparison; NoEquality>]
type DashboardModel = type DisplayUpload =
{ /// The number of published posts { /// The ID of the uploaded file
posts : int id : string
/// The number of post drafts /// The name of the uploaded file
drafts : int name : string
/// The number of pages /// The path at which the file is served
pages : int path : string
/// The number of pages in the page list /// The date/time the file was updated
listedPages : int updatedOn : DateTime option
/// The number of categories /// The source for this file (created from UploadDestination DU)
categories : int source : string
}
/// The top-level categories /// Create a display uploaded file
topLevelCategories : int 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
} }
@@ -229,6 +284,18 @@ type EditCustomFeedModel =
/// The base URL for relative URL media files for this podcast (optional; defaults to web log base) /// The base URL for relative URL media files for this podcast (optional; defaults to web log base)
mediaBaseUrl : string mediaBaseUrl : string
/// The URL for funding information for the podcast
fundingUrl : string
/// The text for the funding link
fundingText : string
/// A unique identifier to follow this podcast
guid : string
/// The medium for the content of this podcast
medium : string
} }
/// An empty custom feed model /// An empty custom feed model
@@ -250,6 +317,10 @@ type EditCustomFeedModel =
explicit = "no" explicit = "no"
defaultMediaType = "audio/mpeg" defaultMediaType = "audio/mpeg"
mediaBaseUrl = "" mediaBaseUrl = ""
fundingUrl = ""
fundingText = ""
guid = ""
medium = ""
} }
/// Create a model from a custom feed /// Create a model from a custom feed
@@ -277,6 +348,12 @@ type EditCustomFeedModel =
explicit = ExplicitRating.toString p.explicit explicit = ExplicitRating.toString p.explicit
defaultMediaType = defaultArg p.defaultMediaType "" defaultMediaType = defaultArg p.defaultMediaType ""
mediaBaseUrl = defaultArg p.mediaBaseUrl "" mediaBaseUrl = defaultArg p.mediaBaseUrl ""
fundingUrl = defaultArg p.fundingUrl ""
fundingText = defaultArg p.fundingText ""
guid = p.guid
|> Option.map (fun it -> it.ToString().ToLowerInvariant ())
|> Option.defaultValue ""
medium = p.medium |> Option.map PodcastMedium.toString |> Option.defaultValue ""
} }
| None -> rss | None -> rss
@@ -300,11 +377,10 @@ type EditCustomFeedModel =
explicit = ExplicitRating.parse this.explicit explicit = ExplicitRating.parse this.explicit
defaultMediaType = noneIfBlank this.defaultMediaType defaultMediaType = noneIfBlank this.defaultMediaType
mediaBaseUrl = noneIfBlank this.mediaBaseUrl mediaBaseUrl = noneIfBlank this.mediaBaseUrl
// TODO: implement UI to update these guid = noneIfBlank this.guid |> Option.map Guid.Parse
guid = None fundingUrl = noneIfBlank this.fundingUrl
fundingUrl = None fundingText = noneIfBlank this.fundingText
fundingText = None medium = noneIfBlank this.medium |> Option.map PodcastMedium.parse
medium = None
} }
else else
None 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 /// View model for posts in a list
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type PostListItem = type PostListItem =
@@ -802,6 +911,9 @@ type SettingsModel =
{ /// The name of the web log { /// The name of the web log
name : string name : string
/// The slug of the web log
slug : string
/// The subtitle of the web log /// The subtitle of the web log
subtitle : string subtitle : string
@@ -819,32 +931,48 @@ type SettingsModel =
/// Whether to automatically load htmx /// Whether to automatically load htmx
autoHtmx : bool autoHtmx : bool
/// The default location for uploads
uploads : string
} }
/// Create a settings model from a web log /// Create a settings model from a web log
static member fromWebLog (webLog : WebLog) = static member fromWebLog (webLog : WebLog) =
{ name = webLog.name { name = webLog.name
slug = webLog.slug
subtitle = defaultArg webLog.subtitle "" subtitle = defaultArg webLog.subtitle ""
defaultPage = webLog.defaultPage defaultPage = webLog.defaultPage
postsPerPage = webLog.postsPerPage postsPerPage = webLog.postsPerPage
timeZone = webLog.timeZone timeZone = webLog.timeZone
themePath = webLog.themePath themePath = webLog.themePath
autoHtmx = webLog.autoHtmx autoHtmx = webLog.autoHtmx
uploads = UploadDestination.toString webLog.uploads
} }
/// Update a web log with settings from the form /// Update a web log with settings from the form
member this.update (webLog : WebLog) = member this.update (webLog : WebLog) =
{ webLog with { webLog with
name = this.name name = this.name
slug = this.slug
subtitle = if this.subtitle = "" then None else Some this.subtitle subtitle = if this.subtitle = "" then None else Some this.subtitle
defaultPage = this.defaultPage defaultPage = this.defaultPage
postsPerPage = this.postsPerPage postsPerPage = this.postsPerPage
timeZone = this.timeZone timeZone = this.timeZone
themePath = this.themePath themePath = this.themePath
autoHtmx = this.autoHtmx autoHtmx = this.autoHtmx
uploads = UploadDestination.parse this.uploads
} }
/// View model for uploading a file
[<CLIMutable; NoComparison; NoEquality>]
type UploadFileModel =
{ /// The upload destination
destination : string
}
/// A message displayed to the user
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type UserMessage = type UserMessage =
{ /// The level of the message { /// The level of the message

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -198,9 +198,9 @@ let home : HttpHandler = fun next ctx -> task {
| Some page -> | Some page ->
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
page_title = page.title
page = DisplayPage.fromPage webLog page page = DisplayPage.fromPage webLog page
categories = CategoryCache.get ctx categories = CategoryCache.get ctx
page_title = page.title
is_home = true is_home = true
|} |}
|> themedView (defaultArg page.template "single-page") next ctx |> themedView (defaultArg page.template "single-page") next ctx
@@ -215,7 +215,7 @@ let all pageNbr : HttpHandler = fun next ctx -> task {
let! posts = data.Post.findPageOfPosts webLog.id pageNbr 25 let! posts = data.Post.findPageOfPosts webLog.id pageNbr 25
let! hash = preparePostList webLog posts AdminList "" pageNbr 25 ctx data let! hash = preparePostList webLog posts AdminList "" pageNbr 25 ctx data
hash.Add ("page_title", "Posts") hash.Add ("page_title", "Posts")
hash.Add ("csrf", csrfToken ctx) hash.Add ("csrf", ctx.CsrfTokenSet)
return! viewForTheme "admin" "post-list" next ctx hash return! viewForTheme "admin" "post-list" next ctx hash
} }
@@ -238,11 +238,11 @@ let edit postId : HttpHandler = fun next ctx -> task {
let model = EditPostModel.fromPost webLog post let model = EditPostModel.fromPost webLog post
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
csrf = csrfToken ctx page_title = title
csrf = ctx.CsrfTokenSet
model = model model = model
metadata = Array.zip model.metaNames model.metaValues metadata = Array.zip model.metaNames model.metaValues
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]) |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
page_title = title
templates = templates templates = templates
categories = cats categories = cats
explicit_values = [| explicit_values = [|
@@ -256,15 +256,24 @@ let edit postId : HttpHandler = fun next ctx -> task {
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// POST /admin/post/{id}/delete
let delete postId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
match! ctx.Data.Post.delete (PostId postId) webLog.id with
| true -> do! addMessage ctx { UserMessage.success with message = "Post deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with message = "Post not found; nothing deleted" }
return! redirectToGet "admin/posts" next ctx
}
// GET /admin/post/{id}/permalinks // GET /admin/post/{id}/permalinks
let editPermalinks postId : HttpHandler = fun next ctx -> task { let editPermalinks postId : HttpHandler = fun next ctx -> task {
match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with
| Some post -> | Some post ->
return! return!
Hash.FromAnonymousObject {| Hash.FromAnonymousObject {|
csrf = csrfToken ctx page_title = "Manage Prior Permalinks"
csrf = ctx.CsrfTokenSet
model = ManagePermalinksModel.fromPost post model = ManagePermalinksModel.fromPost post
page_title = $"Manage Prior Permalinks"
|} |}
|> viewForTheme "admin" "permalinks" next ctx |> viewForTheme "admin" "permalinks" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@@ -278,17 +287,83 @@ let savePermalinks : HttpHandler = fun next ctx -> task {
match! ctx.Data.Post.updatePriorPermalinks (PostId model.id) webLog.id links with match! ctx.Data.Post.updatePriorPermalinks (PostId model.id) webLog.id links with
| true -> | true ->
do! addMessage ctx { UserMessage.success with message = "Post permalinks saved successfully" } do! addMessage ctx { UserMessage.success with message = "Post permalinks saved successfully" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{model.id}/permalinks")) next ctx return! redirectToGet $"admin/post/{model.id}/permalinks" next ctx
| false -> return! Error.notFound next ctx | false -> return! Error.notFound next ctx
} }
// POST /admin/post/{id}/delete // GET /admin/post/{id}/revisions
let delete postId : HttpHandler = fun next ctx -> task { let editRevisions postId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with
match! ctx.Data.Post.delete (PostId postId) webLog.id with | Some post ->
| true -> do! addMessage ctx { UserMessage.success with message = "Post deleted successfully" } return!
| false -> do! addMessage ctx { UserMessage.error with message = "Post not found; nothing deleted" } Hash.FromAnonymousObject {|
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/posts")) next ctx page_title = "Manage Post Revisions"
csrf = ctx.CsrfTokenSet
model = ManageRevisionsModel.fromPost ctx.WebLog post
|}
|> viewForTheme "admin" "revisions" next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/post/{id}/revisions/purge
let purgeRevisions postId : HttpHandler = fun next ctx -> task {
let data = ctx.Data
match! data.Post.findFullById (PostId postId) ctx.WebLog.id with
| Some post ->
do! data.Post.update { post with revisions = [ List.head post.revisions ] }
do! addMessage ctx { UserMessage.success with message = "Prior revisions purged successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| None -> return! Error.notFound next ctx
}
open Microsoft.AspNetCore.Http
/// Find the post and the requested revision
let private findPostRevision postId revDate (ctx : HttpContext) = task {
match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with
| Some post ->
let asOf = parseToUtc revDate
return Some post, post.revisions |> List.tryFind (fun r -> r.asOf = asOf)
| None -> return None, None
}
// GET /admin/post/{id}/revision/{revision-date}/preview
let previewRevision (postId, revDate) : HttpHandler = fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some _, Some rev ->
return!
Hash.FromAnonymousObject {|
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.text}</div>"""
|}
|> bareForTheme "admin" "" next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/revision/{revision-date}/restore
let restoreRevision (postId, revDate) : HttpHandler = fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev ->
do! ctx.Data.Post.update
{ post with
revisions = { rev with asOf = DateTime.UtcNow }
:: (post.revisions |> List.filter (fun r -> r.asOf <> rev.asOf))
}
do! addMessage ctx { UserMessage.success with message = "Revision restored successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/revision/{revision-date}/delete
let deleteRevision (postId, revDate) : HttpHandler = fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev ->
do! ctx.Data.Post.update { post with revisions = post.revisions |> List.filter (fun r -> r.asOf <> rev.asOf) }
do! addMessage ctx { UserMessage.success with message = "Revision deleted successfully" }
return! bareForTheme "admin" "" next ctx (Hash.FromAnonymousObject {| content = "" |})
| None, _
| _, None -> return! Error.notFound next ctx
} }
#nowarn "3511" #nowarn "3511"
@@ -306,7 +381,7 @@ let save : HttpHandler = fun next ctx -> task {
{ Post.empty with { Post.empty with
id = PostId.create () id = PostId.create ()
webLogId = webLog.id webLogId = webLog.id
authorId = userId ctx authorId = ctx.UserId
} }
| postId -> return! data.Post.findFullById (PostId postId) webLog.id | postId -> return! data.Post.findFullById (PostId postId) webLog.id
} }
@@ -323,7 +398,7 @@ let save : HttpHandler = fun next ctx -> task {
let post = let post =
match model.setPublished with match model.setPublished with
| true -> | true ->
let dt = WebLog.utcTime webLog model.pubOverride.Value let dt = parseToUtc (model.pubOverride.Value.ToString "o")
match model.setUpdated with match model.setUpdated with
| true -> | true ->
{ post with { post with
@@ -342,7 +417,6 @@ let save : HttpHandler = fun next ctx -> task {
|> List.length = List.length pst.Value.categoryIds) then |> List.length = List.length pst.Value.categoryIds) then
do! CategoryCache.update ctx do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Post saved successfully" } do! addMessage ctx { UserMessage.success with message = "Post saved successfully" }
return! return! redirectToGet $"admin/post/{PostId.toString post.id}/edit" next ctx
redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{PostId.toString post.id}/edit")) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

View File

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

View File

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

View File

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

View File

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

View File

@@ -42,7 +42,7 @@
</span> </span>
</div> </div>
<div class="{{ title_col }}"> <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> {{ post.title }}<br>
<small> <small>
<a href="{{ post | relative_link }}" target="_blank">View Post</a> <a href="{{ post | relative_link }}" target="_blank">View Post</a>

View File

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

View File

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

View File

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

View File

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

View File

@@ -1,2 +1,2 @@
myWebLog Admin myWebLog Admin
2.0.0-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); background-color: var(--light-accent);
color: var(--dark-gray); color: var(--dark-gray);
} }
.mwl-revision-preview {
max-height: 90vh;
overflow: auto;
border: solid 1px black;
border-radius: .5rem;
padding: .5rem;
}

View File

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