Compare commits
15 Commits
v2.0-beta0
...
v2.0-beta0
| Author | SHA1 | Date | |
|---|---|---|---|
| 07aff16c3a | |||
| d290e6e8a6 | |||
| 039d09aed5 | |||
| d667d09372 | |||
| 2906c20efa | |||
| 355ade8c87 | |||
| 1d096d696b | |||
| ce3816a8ae | |||
| 879710a0a3 | |||
| c957279162 | |||
| 9307ace24a | |||
| feada6f11f | |||
| 0567dff54a | |||
| c29bbc04ac | |||
| 46bd785a1f |
3
.gitignore
vendored
3
.gitignore
vendored
@@ -262,3 +262,6 @@ src/MyWebLog/wwwroot/img/bit-badger
|
||||
|
||||
.ionide
|
||||
src/MyWebLog/appsettings.Production.json
|
||||
|
||||
# SQLite database files
|
||||
src/MyWebLog/*.db*
|
||||
|
||||
13
build.fsx
13
build.fsx
@@ -33,7 +33,6 @@ let version =
|
||||
/// Zip a theme distributed with myWebLog
|
||||
let zipTheme (name : string) (_ : TargetParameter) =
|
||||
let path = $"src/{name}-theme"
|
||||
Trace.log $"Path = {path}"
|
||||
!! $"{path}/**/*"
|
||||
|> Zip.filesAsSpecs path //$"src/{name}-theme"
|
||||
|> Seq.filter (fun (_, name) -> not (name.EndsWith ".zip"))
|
||||
@@ -79,14 +78,16 @@ Target.create "PackageLinux" (packageFor "linux-x64")
|
||||
Target.create "RepackageLinux" (fun _ ->
|
||||
let workDir = $"{releasePath}/linux"
|
||||
let zipArchive = $"{releasePath}/myWebLog-{version}.linux-x64.zip"
|
||||
let sh command args =
|
||||
CreateProcess.fromRawCommand command args
|
||||
|> CreateProcess.redirectOutput
|
||||
|> Proc.run
|
||||
|> ignore
|
||||
Shell.mkdir workDir
|
||||
Zip.unzip workDir zipArchive
|
||||
Shell.cd workDir
|
||||
[ "cfj"; $"../myWebLog-{version}.linux-x64.tar.bz2"; "." ]
|
||||
|> CreateProcess.fromRawCommand "tar"
|
||||
|> CreateProcess.redirectOutput
|
||||
|> Proc.run
|
||||
|> ignore
|
||||
sh "chmod" [ "+x"; "app/MyWebLog" ]
|
||||
sh "tar" [ "cfj"; $"../myWebLog-{version}.linux-x64.tar.bz2"; "." ]
|
||||
Shell.cd "../.."
|
||||
Shell.rm zipArchive
|
||||
Shell.rm_rf workDir
|
||||
|
||||
@@ -99,7 +99,21 @@ module Json =
|
||||
writer.WriteValue (ThemeId.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> ThemeId) reader.Value
|
||||
|
||||
|
||||
type UploadDestinationConverter () =
|
||||
inherit JsonConverter<UploadDestination> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : UploadDestination, _ : JsonSerializer) =
|
||||
writer.WriteValue (UploadDestination.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadDestination, _ : bool, _ : JsonSerializer) =
|
||||
(string >> UploadDestination.parse) reader.Value
|
||||
|
||||
type UploadIdConverter () =
|
||||
inherit JsonConverter<UploadId> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : UploadId, _ : JsonSerializer) =
|
||||
writer.WriteValue (UploadId.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> UploadId) reader.Value
|
||||
|
||||
type WebLogIdConverter () =
|
||||
inherit JsonConverter<WebLogId> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : WebLogId, _ : JsonSerializer) =
|
||||
@@ -120,21 +134,23 @@ module Json =
|
||||
let all () : JsonConverter seq =
|
||||
seq {
|
||||
// Our converters
|
||||
CategoryIdConverter ()
|
||||
CommentIdConverter ()
|
||||
CustomFeedIdConverter ()
|
||||
CustomFeedSourceConverter ()
|
||||
ExplicitRatingConverter ()
|
||||
MarkupTextConverter ()
|
||||
PermalinkConverter ()
|
||||
PageIdConverter ()
|
||||
PodcastMediumConverter ()
|
||||
PostIdConverter ()
|
||||
TagMapIdConverter ()
|
||||
ThemeAssetIdConverter ()
|
||||
ThemeIdConverter ()
|
||||
WebLogIdConverter ()
|
||||
WebLogUserIdConverter ()
|
||||
CategoryIdConverter ()
|
||||
CommentIdConverter ()
|
||||
CustomFeedIdConverter ()
|
||||
CustomFeedSourceConverter ()
|
||||
ExplicitRatingConverter ()
|
||||
MarkupTextConverter ()
|
||||
PermalinkConverter ()
|
||||
PageIdConverter ()
|
||||
PodcastMediumConverter ()
|
||||
PostIdConverter ()
|
||||
TagMapIdConverter ()
|
||||
ThemeAssetIdConverter ()
|
||||
ThemeIdConverter ()
|
||||
UploadDestinationConverter ()
|
||||
UploadIdConverter ()
|
||||
WebLogIdConverter ()
|
||||
WebLogUserIdConverter ()
|
||||
// Handles DUs with no associated data, as well as option fields
|
||||
CompactUnionJsonConverter ()
|
||||
CompactUnionJsonConverter ()
|
||||
}
|
||||
|
||||
@@ -199,6 +199,28 @@ type IThemeAssetData =
|
||||
abstract member save : ThemeAsset -> Task<unit>
|
||||
|
||||
|
||||
/// Functions to manipulate uploaded files
|
||||
type IUploadData =
|
||||
|
||||
/// Add an uploaded file
|
||||
abstract member add : Upload -> Task<unit>
|
||||
|
||||
/// Delete an uploaded file
|
||||
abstract member delete : UploadId -> WebLogId -> Task<Result<string, string>>
|
||||
|
||||
/// Find an uploaded file by its path for the given web log
|
||||
abstract member findByPath : string -> WebLogId -> Task<Upload option>
|
||||
|
||||
/// Find all uploaded files for a web log (excludes data)
|
||||
abstract member findByWebLog : WebLogId -> Task<Upload list>
|
||||
|
||||
/// Find all uploaded files for a web log
|
||||
abstract member findByWebLogWithData : WebLogId -> Task<Upload list>
|
||||
|
||||
/// Restore uploaded files from a backup
|
||||
abstract member restore : Upload list -> Task<unit>
|
||||
|
||||
|
||||
/// Functions to manipulate web logs
|
||||
type IWebLogData =
|
||||
|
||||
@@ -270,6 +292,9 @@ type IData =
|
||||
/// Theme asset data functions
|
||||
abstract member ThemeAsset : IThemeAssetData
|
||||
|
||||
/// Uploaded file functions
|
||||
abstract member Upload : IUploadData
|
||||
|
||||
/// Web log data functions
|
||||
abstract member WebLog : IWebLogData
|
||||
|
||||
|
||||
@@ -11,7 +11,7 @@
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.6" />
|
||||
<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.7" />
|
||||
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" />
|
||||
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
|
||||
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
|
||||
@@ -31,6 +31,7 @@
|
||||
<Compile Include="SQLite\SQLitePostData.fs" />
|
||||
<Compile Include="SQLite\SQLiteTagMapData.fs" />
|
||||
<Compile Include="SQLite\SQLiteThemeData.fs" />
|
||||
<Compile Include="SQLite\SQLiteUploadData.fs" />
|
||||
<Compile Include="SQLite\SQLiteWebLogData.fs" />
|
||||
<Compile Include="SQLite\SQLiteWebLogUserData.fs" />
|
||||
<Compile Include="SQLiteData.fs" />
|
||||
|
||||
@@ -33,6 +33,9 @@ module private RethinkHelpers =
|
||||
/// The theme asset table
|
||||
let ThemeAsset = "ThemeAsset"
|
||||
|
||||
/// The uploaded file table
|
||||
let Upload = "Upload"
|
||||
|
||||
/// The web log table
|
||||
let WebLog = "WebLog"
|
||||
|
||||
@@ -40,7 +43,7 @@ module private RethinkHelpers =
|
||||
let WebLogUser = "WebLogUser"
|
||||
|
||||
/// A list of all tables
|
||||
let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; WebLog; WebLogUser ]
|
||||
let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ]
|
||||
|
||||
|
||||
/// Shorthand for the ReQL starting point
|
||||
@@ -125,6 +128,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|
||||
indexCreate "webLogAndUrl" (fun row -> r.Array (row["webLogId"], row["urlValue"]) :> obj)
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
// Uploaded files need an index by web log ID and path, as that is how they are retrieved
|
||||
if Table.Upload = table then
|
||||
if not (indexes |> List.contains "webLogAndPath") then
|
||||
log.LogInformation $"Creating index {table}.webLogAndPath..."
|
||||
do! rethink {
|
||||
withTable table
|
||||
indexCreate "webLogAndPath" (fun row -> r.Array (row["webLogId"], row["path"]) :> obj)
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
// Users log on with e-mail
|
||||
if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then
|
||||
log.LogInformation $"Creating index {table}.logOn..."
|
||||
@@ -725,6 +737,69 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|
||||
}
|
||||
}
|
||||
|
||||
member _.Upload = {
|
||||
new IUploadData with
|
||||
|
||||
member _.add upload = rethink {
|
||||
withTable Table.Upload
|
||||
insert upload
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
|
||||
member _.delete uploadId webLogId = backgroundTask {
|
||||
let! upload =
|
||||
rethink<Upload> {
|
||||
withTable Table.Upload
|
||||
get uploadId
|
||||
resultOption; withRetryOptionDefault
|
||||
}
|
||||
|> verifyWebLog<Upload> webLogId (fun u -> u.webLogId) <| conn
|
||||
match upload with
|
||||
| Some up ->
|
||||
do! rethink {
|
||||
withTable Table.Upload
|
||||
get uploadId
|
||||
delete
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
return Ok (Permalink.toString up.path)
|
||||
| None -> return Result.Error $"Upload ID {UploadId.toString uploadId} not found"
|
||||
}
|
||||
|
||||
member _.findByPath path webLogId =
|
||||
rethink<Upload> {
|
||||
withTable Table.Upload
|
||||
getAll [ r.Array (webLogId, path) ] "webLogAndPath"
|
||||
resultCursor; withRetryCursorDefault; toList
|
||||
}
|
||||
|> tryFirst <| conn
|
||||
|
||||
member _.findByWebLog webLogId = rethink<Upload> {
|
||||
withTable Table.Upload
|
||||
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
|
||||
[ Index "webLogAndPath" ]
|
||||
without [ "data" ]
|
||||
resultCursor; withRetryCursorDefault; toList conn
|
||||
}
|
||||
|
||||
member _.findByWebLogWithData webLogId = rethink<Upload> {
|
||||
withTable Table.Upload
|
||||
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
|
||||
[ Index "webLogAndPath" ]
|
||||
resultCursor; withRetryCursorDefault; toList conn
|
||||
}
|
||||
|
||||
member _.restore uploads = backgroundTask {
|
||||
// Files can be large; we'll do 5 at a time
|
||||
for batch in uploads |> List.chunkBySize 5 do
|
||||
do! rethink {
|
||||
withTable Table.TagMap
|
||||
insert batch
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
member _.WebLog = {
|
||||
new IWebLogData with
|
||||
|
||||
@@ -763,6 +838,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|
||||
delete
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
// Uploaded files do not have a straightforward webLogId index
|
||||
do! rethink {
|
||||
withTable Table.Upload
|
||||
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
|
||||
[ Index "webLogAndPath" ]
|
||||
delete
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
for table in [ Table.Post; Table.Category; Table.Page; Table.WebLogUser ] do
|
||||
do! rethink {
|
||||
withTable table
|
||||
@@ -805,12 +888,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|
||||
get webLog.id
|
||||
update [
|
||||
"name", webLog.name :> obj
|
||||
"slug", webLog.slug
|
||||
"subtitle", webLog.subtitle
|
||||
"defaultPage", webLog.defaultPage
|
||||
"postsPerPage", webLog.postsPerPage
|
||||
"timeZone", webLog.timeZone
|
||||
"themePath", webLog.themePath
|
||||
"autoHtmx", webLog.autoHtmx
|
||||
"uploads", webLog.uploads
|
||||
]
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
@@ -900,6 +985,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|
||||
do! ensureIndexes Table.Page [ "webLogId"; "authorId" ]
|
||||
do! ensureIndexes Table.Post [ "webLogId"; "authorId" ]
|
||||
do! ensureIndexes Table.TagMap []
|
||||
do! ensureIndexes Table.Upload []
|
||||
do! ensureIndexes Table.WebLog [ "urlBase" ]
|
||||
do! ensureIndexes Table.WebLogUser [ "webLogId" ]
|
||||
}
|
||||
|
||||
@@ -248,10 +248,28 @@ module Map =
|
||||
text = getString "template" rdr
|
||||
}
|
||||
|
||||
/// Create an uploaded file from the current row in the given data reader
|
||||
let toUpload includeData (rdr : SqliteDataReader) : Upload =
|
||||
let data =
|
||||
if includeData then
|
||||
use dataStream = new MemoryStream ()
|
||||
use blobStream = getStream "data" rdr
|
||||
blobStream.CopyTo dataStream
|
||||
dataStream.ToArray ()
|
||||
else
|
||||
[||]
|
||||
{ id = UploadId (getString "id" rdr)
|
||||
webLogId = WebLogId (getString "web_log_id" rdr)
|
||||
path = Permalink (getString "path" rdr)
|
||||
updatedOn = getDateTime "updated_on" rdr
|
||||
data = data
|
||||
}
|
||||
|
||||
/// Create a web log from the current row in the given data reader
|
||||
let toWebLog (rdr : SqliteDataReader) : WebLog =
|
||||
{ id = WebLogId (getString "id" rdr)
|
||||
name = getString "name" rdr
|
||||
slug = getString "slug" rdr
|
||||
subtitle = tryString "subtitle" rdr
|
||||
defaultPage = getString "default_page" rdr
|
||||
postsPerPage = getInt "posts_per_page" rdr
|
||||
@@ -259,6 +277,7 @@ module Map =
|
||||
urlBase = getString "url_base" rdr
|
||||
timeZone = getString "time_zone" rdr
|
||||
autoHtmx = getBoolean "auto_htmx" rdr
|
||||
uploads = UploadDestination.parse (getString "uploads" rdr)
|
||||
rss = {
|
||||
feedEnabled = getBoolean "feed_enabled" rdr
|
||||
feedName = getString "feed_name" rdr
|
||||
|
||||
@@ -21,12 +21,12 @@ type SQLiteCategoryData (conn : SqliteConnection) =
|
||||
/// Add a category
|
||||
let add cat = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO category (
|
||||
id, web_log_id, name, slug, description, parent_id
|
||||
) VALUES (
|
||||
@id, @webLogId, @name, @slug, @description, @parentId
|
||||
)"""
|
||||
cmd.CommandText <- """
|
||||
INSERT INTO category (
|
||||
id, web_log_id, name, slug, description, parent_id
|
||||
) VALUES (
|
||||
@id, @webLogId, @name, @slug, @description, @parentId
|
||||
)"""
|
||||
addCategoryParameters cmd cat
|
||||
let! _ = cmd.ExecuteNonQueryAsync ()
|
||||
()
|
||||
@@ -70,13 +70,13 @@ type SQLiteCategoryData (conn : SqliteConnection) =
|
||||
// Parent category post counts include posts in subcategories
|
||||
cmd.Parameters.Clear ()
|
||||
addWebLogId cmd webLogId
|
||||
cmd.CommandText <-
|
||||
"""SELECT COUNT(DISTINCT p.id)
|
||||
FROM post p
|
||||
INNER JOIN post_category pc ON pc.post_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = 'Published'
|
||||
AND pc.category_id IN ("""
|
||||
cmd.CommandText <- """
|
||||
SELECT COUNT(DISTINCT p.id)
|
||||
FROM post p
|
||||
INNER JOIN post_category pc ON pc.post_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = 'Published'
|
||||
AND pc.category_id IN ("""
|
||||
ordered
|
||||
|> Seq.filter (fun cat -> cat.parentNames |> Array.contains it.name)
|
||||
|> Seq.map (fun cat -> cat.id)
|
||||
@@ -125,10 +125,10 @@ type SQLiteCategoryData (conn : SqliteConnection) =
|
||||
| Some _ ->
|
||||
use cmd = conn.CreateCommand ()
|
||||
// Delete the category off all posts where it is assigned
|
||||
cmd.CommandText <-
|
||||
"""DELETE FROM post_category
|
||||
WHERE category_id = @id
|
||||
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)"""
|
||||
cmd.CommandText <- """
|
||||
DELETE FROM post_category
|
||||
WHERE category_id = @id
|
||||
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)"""
|
||||
let catIdParameter = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
|
||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
|
||||
do! write cmd
|
||||
@@ -150,14 +150,14 @@ type SQLiteCategoryData (conn : SqliteConnection) =
|
||||
/// Update a category
|
||||
let update cat = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""UPDATE category
|
||||
SET name = @name,
|
||||
slug = @slug,
|
||||
description = @description,
|
||||
parent_id = @parentId
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
cmd.CommandText <- """
|
||||
UPDATE category
|
||||
SET name = @name,
|
||||
slug = @slug,
|
||||
description = @description,
|
||||
parent_id = @parentId
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
addCategoryParameters cmd cat
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
@@ -139,14 +139,14 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||
let add page = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
// The page itself
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO page (
|
||||
id, web_log_id, author_id, title, permalink, published_on, updated_on, show_in_page_list,
|
||||
template, page_text
|
||||
) VALUES (
|
||||
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @showInPageList,
|
||||
@template, @text
|
||||
)"""
|
||||
cmd.CommandText <- """
|
||||
INSERT INTO page (
|
||||
id, web_log_id, author_id, title, permalink, published_on, updated_on, show_in_page_list, template,
|
||||
page_text
|
||||
) VALUES (
|
||||
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @showInPageList, @template,
|
||||
@text
|
||||
)"""
|
||||
addPageParameters cmd page
|
||||
do! write cmd
|
||||
do! updatePageMeta page.id [] page.metadata
|
||||
@@ -174,11 +174,11 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||
/// Count all pages shown in the page list for the given web log
|
||||
let countListed webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""SELECT COUNT(id)
|
||||
FROM page
|
||||
WHERE web_log_id = @webLogId
|
||||
AND show_in_page_list = @showInPageList"""
|
||||
cmd.CommandText <- """
|
||||
SELECT COUNT(id)
|
||||
FROM page
|
||||
WHERE web_log_id = @webLogId
|
||||
AND show_in_page_list = @showInPageList"""
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore
|
||||
return! count cmd
|
||||
@@ -211,11 +211,11 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||
| Some _ ->
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
|
||||
cmd.CommandText <-
|
||||
"""DELETE FROM page_revision WHERE page_id = @id;
|
||||
DELETE FROM page_permalink WHERE page_id = @id;
|
||||
DELETE FROM page_meta WHERE page_id = @id;
|
||||
DELETE FROM page WHERE id = @id"""
|
||||
cmd.CommandText <- """
|
||||
DELETE FROM page_revision WHERE page_id = @id;
|
||||
DELETE FROM page_permalink WHERE page_id = @id;
|
||||
DELETE FROM page_meta WHERE page_id = @id;
|
||||
DELETE FROM page WHERE id = @id"""
|
||||
do! write cmd
|
||||
return true
|
||||
| None -> return false
|
||||
@@ -238,12 +238,12 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||
/// Find the current permalink within a set of potential prior permalinks for the given web log
|
||||
let findCurrentPermalink permalinks webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""SELECT p.permalink
|
||||
FROM page p
|
||||
INNER JOIN page_permalink pp ON pp.page_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND pp.permalink IN ("""
|
||||
cmd.CommandText <- """
|
||||
SELECT p.permalink
|
||||
FROM page p
|
||||
INNER JOIN page_permalink pp ON pp.page_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND pp.permalink IN ("""
|
||||
permalinks
|
||||
|> List.iteri (fun idx link ->
|
||||
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
|
||||
@@ -274,12 +274,12 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||
/// Get all listed pages for the given web log (without revisions, prior permalinks, or text)
|
||||
let findListed webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""SELECT *
|
||||
FROM page
|
||||
WHERE web_log_id = @webLogId
|
||||
AND show_in_page_list = @showInPageList
|
||||
ORDER BY LOWER(title)"""
|
||||
cmd.CommandText <- """
|
||||
SELECT *
|
||||
FROM page
|
||||
WHERE web_log_id = @webLogId
|
||||
AND show_in_page_list = @showInPageList
|
||||
ORDER BY LOWER(title)"""
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
@@ -293,12 +293,12 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||
/// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata)
|
||||
let findPageOfPages webLogId pageNbr = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""SELECT *
|
||||
FROM page
|
||||
WHERE web_log_id = @webLogId
|
||||
ORDER BY LOWER(title)
|
||||
LIMIT @pageSize OFFSET @toSkip"""
|
||||
cmd.CommandText <- """
|
||||
SELECT *
|
||||
FROM page
|
||||
WHERE web_log_id = @webLogId
|
||||
ORDER BY LOWER(title)
|
||||
LIMIT @pageSize OFFSET @toSkip"""
|
||||
addWebLogId cmd webLogId
|
||||
[ cmd.Parameters.AddWithValue ("@pageSize", 26)
|
||||
cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25)
|
||||
@@ -318,18 +318,18 @@ type SQLitePageData (conn : SqliteConnection) =
|
||||
match! findFullById page.id page.webLogId with
|
||||
| Some oldPage ->
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""UPDATE page
|
||||
SET author_id = @authorId,
|
||||
title = @title,
|
||||
permalink = @permalink,
|
||||
published_on = @publishedOn,
|
||||
updated_on = @updatedOn,
|
||||
show_in_page_list = @showInPageList,
|
||||
template = @template,
|
||||
page_text = @text
|
||||
WHERE id = @pageId
|
||||
AND web_log_id = @webLogId"""
|
||||
cmd.CommandText <- """
|
||||
UPDATE page
|
||||
SET author_id = @authorId,
|
||||
title = @title,
|
||||
permalink = @permalink,
|
||||
published_on = @publishedOn,
|
||||
updated_on = @updatedOn,
|
||||
show_in_page_list = @showInPageList,
|
||||
template = @template,
|
||||
page_text = @text
|
||||
WHERE id = @pageId
|
||||
AND web_log_id = @webLogId"""
|
||||
addPageParameters cmd page
|
||||
do! write cmd
|
||||
do! updatePageMeta page.id oldPage.metadata page.metadata
|
||||
|
||||
@@ -146,26 +146,26 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||
if count = 1 then
|
||||
match post.episode with
|
||||
| Some ep ->
|
||||
cmd.CommandText <-
|
||||
"""UPDATE post_episode
|
||||
SET media = @media,
|
||||
length = @length,
|
||||
duration = @duration,
|
||||
media_type = @mediaType,
|
||||
image_url = @imageUrl,
|
||||
subtitle = @subtitle,
|
||||
explicit = @explicit,
|
||||
chapter_file = @chapterFile,
|
||||
chapter_type = @chapterType,
|
||||
transcript_url = @transcriptUrl,
|
||||
transcript_type = @transcriptType,
|
||||
transcript_lang = @transcriptLang,
|
||||
transcript_captions = @transcriptCaptions,
|
||||
season_number = @seasonNumber,
|
||||
season_description = @seasonDescription,
|
||||
episode_number = @episodeNumber,
|
||||
episode_description = @episodeDescription
|
||||
WHERE post_id = @postId"""
|
||||
cmd.CommandText <- """
|
||||
UPDATE post_episode
|
||||
SET media = @media,
|
||||
length = @length,
|
||||
duration = @duration,
|
||||
media_type = @mediaType,
|
||||
image_url = @imageUrl,
|
||||
subtitle = @subtitle,
|
||||
explicit = @explicit,
|
||||
chapter_file = @chapterFile,
|
||||
chapter_type = @chapterType,
|
||||
transcript_url = @transcriptUrl,
|
||||
transcript_type = @transcriptType,
|
||||
transcript_lang = @transcriptLang,
|
||||
transcript_captions = @transcriptCaptions,
|
||||
season_number = @seasonNumber,
|
||||
season_description = @seasonDescription,
|
||||
episode_number = @episodeNumber,
|
||||
episode_description = @episodeDescription
|
||||
WHERE post_id = @postId"""
|
||||
addEpisodeParameters cmd ep
|
||||
do! write cmd
|
||||
| None ->
|
||||
@@ -174,16 +174,16 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||
else
|
||||
match post.episode with
|
||||
| Some ep ->
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO post_episode (
|
||||
post_id, media, length, duration, media_type, image_url, subtitle, explicit,
|
||||
chapter_file, chapter_type, transcript_url, transcript_type, transcript_lang,
|
||||
transcript_captions, season_number, season_description, episode_number, episode_description
|
||||
) VALUES (
|
||||
@postId, @media, @length, @duration, @mediaType, @imageUrl, @subtitle, @explicit,
|
||||
@chapterFile, @chapterType, @transcriptUrl, @transcriptType, @transcriptLang,
|
||||
@transcriptCaptions, @seasonNumber, @seasonDescription, @episodeNumber, @episodeDescription
|
||||
)"""
|
||||
cmd.CommandText <- """
|
||||
INSERT INTO post_episode (
|
||||
post_id, media, length, duration, media_type, image_url, subtitle, explicit, chapter_file,
|
||||
chapter_type, transcript_url, transcript_type, transcript_lang, transcript_captions,
|
||||
season_number, season_description, episode_number, episode_description
|
||||
) VALUES (
|
||||
@postId, @media, @length, @duration, @mediaType, @imageUrl, @subtitle, @explicit, @chapterFile,
|
||||
@chapterType, @transcriptUrl, @transcriptType, @transcriptLang, @transcriptCaptions,
|
||||
@seasonNumber, @seasonDescription, @episodeNumber, @episodeDescription
|
||||
)"""
|
||||
addEpisodeParameters cmd ep
|
||||
do! write cmd
|
||||
| None -> ()
|
||||
@@ -278,14 +278,12 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||
/// Add a post
|
||||
let add post = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO post (
|
||||
id, web_log_id, author_id, status, title, permalink, published_on, updated_on,
|
||||
template, post_text
|
||||
) VALUES (
|
||||
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn,
|
||||
@template, @text
|
||||
)"""
|
||||
cmd.CommandText <- """
|
||||
INSERT INTO post (
|
||||
id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text
|
||||
) VALUES (
|
||||
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text
|
||||
)"""
|
||||
addPostParameters cmd post
|
||||
do! write cmd
|
||||
do! updatePostCategories post.id [] post.categoryIds
|
||||
@@ -340,14 +338,14 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||
| Some _ ->
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
|
||||
cmd.CommandText <-
|
||||
"""DELETE FROM post_revision WHERE post_id = @id;
|
||||
DELETE FROM post_permalink WHERE post_id = @id;
|
||||
DELETE FROM post_meta WHERE post_id = @id;
|
||||
DELETE FROM post_episode WHERE post_id = @id;
|
||||
DELETE FROM post_tag WHERE post_id = @id;
|
||||
DELETE FROM post_category WHERE post_id = @id;
|
||||
DELETE FROM post WHERE id = @id"""
|
||||
cmd.CommandText <- """
|
||||
DELETE FROM post_revision WHERE post_id = @id;
|
||||
DELETE FROM post_permalink WHERE post_id = @id;
|
||||
DELETE FROM post_meta WHERE post_id = @id;
|
||||
DELETE FROM post_episode WHERE post_id = @id;
|
||||
DELETE FROM post_tag WHERE post_id = @id;
|
||||
DELETE FROM post_category WHERE post_id = @id;
|
||||
DELETE FROM post WHERE id = @id"""
|
||||
do! write cmd
|
||||
return true
|
||||
| None -> return false
|
||||
@@ -356,12 +354,12 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||
/// Find the current permalink from a list of potential prior permalinks for the given web log
|
||||
let findCurrentPermalink permalinks webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""SELECT p.permalink
|
||||
FROM post p
|
||||
INNER JOIN post_permalink pp ON pp.post_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND pp.permalink IN ("""
|
||||
cmd.CommandText <- """
|
||||
SELECT p.permalink
|
||||
FROM post p
|
||||
INNER JOIN post_permalink pp ON pp.post_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND pp.permalink IN ("""
|
||||
permalinks
|
||||
|> List.iteri (fun idx link ->
|
||||
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
|
||||
@@ -392,12 +390,12 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||
/// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
|
||||
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
$"""{selectPost}
|
||||
INNER JOIN post_category pc ON pc.post_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
AND pc.category_id IN ("""
|
||||
cmd.CommandText <- $"""
|
||||
{selectPost}
|
||||
INNER JOIN post_category pc ON pc.post_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
AND pc.category_id IN ("""
|
||||
categoryIds
|
||||
|> List.iteri (fun idx catId ->
|
||||
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
|
||||
@@ -420,11 +418,11 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||
/// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks)
|
||||
let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
$"""{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
cmd.CommandText <- $"""
|
||||
{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! posts =
|
||||
@@ -437,12 +435,12 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||
/// Get a page of published posts for the given web log (excludes revisions and prior permalinks)
|
||||
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
$"""{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
ORDER BY p.published_on DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
cmd.CommandText <- $"""
|
||||
{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
ORDER BY p.published_on DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
@@ -456,14 +454,14 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
|
||||
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
$"""{selectPost}
|
||||
INNER JOIN post_tag pt ON pt.post_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
AND pt.tag = @tag
|
||||
ORDER BY p.published_on DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
cmd.CommandText <- $"""
|
||||
{selectPost}
|
||||
INNER JOIN post_tag pt ON pt.post_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
AND pt.tag = @tag
|
||||
ORDER BY p.published_on DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
addWebLogId cmd webLogId
|
||||
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
|
||||
cmd.Parameters.AddWithValue ("@tag", tag)
|
||||
@@ -479,13 +477,13 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||
/// Find the next newest and oldest post from a publish date for the given web log
|
||||
let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
$"""{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
AND p.published_on < @publishedOn
|
||||
ORDER BY p.published_on DESC
|
||||
LIMIT 1"""
|
||||
cmd.CommandText <- $"""
|
||||
{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
AND p.published_on < @publishedOn
|
||||
ORDER BY p.published_on DESC
|
||||
LIMIT 1"""
|
||||
addWebLogId cmd webLogId
|
||||
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
|
||||
cmd.Parameters.AddWithValue ("@publishedOn", publishedOn)
|
||||
@@ -499,13 +497,13 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||
return None
|
||||
}
|
||||
do! rdr.CloseAsync ()
|
||||
cmd.CommandText <-
|
||||
$"""{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
AND p.published_on > @publishedOn
|
||||
ORDER BY p.published_on
|
||||
LIMIT 1"""
|
||||
cmd.CommandText <- $"""
|
||||
{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
AND p.published_on > @publishedOn
|
||||
ORDER BY p.published_on
|
||||
LIMIT 1"""
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! newer = backgroundTask {
|
||||
if rdr.Read () then
|
||||
@@ -528,18 +526,18 @@ type SQLitePostData (conn : SqliteConnection) =
|
||||
match! findFullById post.id post.webLogId with
|
||||
| Some oldPost ->
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""UPDATE post
|
||||
SET author_id = @authorId,
|
||||
status = @status,
|
||||
title = @title,
|
||||
permalink = @permalink,
|
||||
published_on = @publishedOn,
|
||||
updated_on = @updatedOn,
|
||||
template = @template,
|
||||
post_text = @text
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
cmd.CommandText <- """
|
||||
UPDATE post
|
||||
SET author_id = @authorId,
|
||||
status = @status,
|
||||
title = @title,
|
||||
permalink = @permalink,
|
||||
published_on = @publishedOn,
|
||||
updated_on = @updatedOn,
|
||||
template = @template,
|
||||
post_text = @text
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
addPostParameters cmd post
|
||||
do! write cmd
|
||||
do! updatePostCategories post.id oldPost.categoryIds post.categoryIds
|
||||
|
||||
@@ -50,11 +50,11 @@ type SQLiteTagMapData (conn : SqliteConnection) =
|
||||
/// Find any tag mappings in a list of tags for the given web log
|
||||
let findMappingForTags (tags : string list) webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""SELECT *
|
||||
FROM tag_map
|
||||
WHERE web_log_id = @webLogId
|
||||
AND tag IN ("""
|
||||
cmd.CommandText <- """
|
||||
SELECT *
|
||||
FROM tag_map
|
||||
WHERE web_log_id = @webLogId
|
||||
AND tag IN ("""
|
||||
tags
|
||||
|> List.iteri (fun idx tag ->
|
||||
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
|
||||
@@ -71,19 +71,19 @@ type SQLiteTagMapData (conn : SqliteConnection) =
|
||||
use cmd = conn.CreateCommand ()
|
||||
match! findById tagMap.id tagMap.webLogId with
|
||||
| Some _ ->
|
||||
cmd.CommandText <-
|
||||
"""UPDATE tag_map
|
||||
SET tag = @tag,
|
||||
url_value = @urlValue
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
cmd.CommandText <- """
|
||||
UPDATE tag_map
|
||||
SET tag = @tag,
|
||||
url_value = @urlValue
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
| None ->
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO tag_map (
|
||||
id, web_log_id, tag, url_value
|
||||
) VALUES (
|
||||
@id, @webLogId, @tag, @urlValue
|
||||
)"""
|
||||
cmd.CommandText <- """
|
||||
INSERT INTO tag_map (
|
||||
id, web_log_id, tag, url_value
|
||||
) VALUES (
|
||||
@id, @webLogId, @tag, @urlValue
|
||||
)"""
|
||||
addWebLogId cmd tagMap.webLogId
|
||||
[ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.id)
|
||||
cmd.Parameters.AddWithValue ("@tag", tagMap.tag)
|
||||
|
||||
101
src/MyWebLog.Data/SQLite/SQLiteUploadData.fs
Normal file
101
src/MyWebLog.Data/SQLite/SQLiteUploadData.fs
Normal 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
|
||||
|
||||
@@ -27,6 +27,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||
let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) =
|
||||
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.id)
|
||||
cmd.Parameters.AddWithValue ("@name", webLog.name)
|
||||
cmd.Parameters.AddWithValue ("@slug", webLog.slug)
|
||||
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.subtitle)
|
||||
cmd.Parameters.AddWithValue ("@defaultPage", webLog.defaultPage)
|
||||
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.postsPerPage)
|
||||
@@ -34,6 +35,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||
cmd.Parameters.AddWithValue ("@urlBase", webLog.urlBase)
|
||||
cmd.Parameters.AddWithValue ("@timeZone", webLog.timeZone)
|
||||
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.autoHtmx)
|
||||
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.uploads)
|
||||
] |> ignore
|
||||
addWebLogRssParameters cmd webLog
|
||||
|
||||
@@ -69,11 +71,11 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||
/// Get the current custom feeds for a web log
|
||||
let getCustomFeeds (webLog : WebLog) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""SELECT f.*, p.*
|
||||
FROM web_log_feed f
|
||||
LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id
|
||||
WHERE f.web_log_id = @webLogId"""
|
||||
cmd.CommandText <- """
|
||||
SELECT f.*, p.*
|
||||
FROM web_log_feed f
|
||||
LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id
|
||||
WHERE f.web_log_id = @webLogId"""
|
||||
addWebLogId cmd webLog.id
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList Map.toCustomFeed rdr
|
||||
@@ -88,16 +90,16 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||
/// Add a podcast to a custom feed
|
||||
let addPodcast feedId (podcast : PodcastOptions) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO web_log_feed_podcast (
|
||||
feed_id, title, subtitle, items_in_feed, summary, displayed_author, email,
|
||||
image_url, itunes_category, itunes_subcategory, explicit, default_media_type,
|
||||
media_base_url, guid, funding_url, funding_text, medium
|
||||
) VALUES (
|
||||
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email,
|
||||
@imageUrl, @iTunesCategory, @iTunesSubcategory, @explicit, @defaultMediaType,
|
||||
@mediaBaseUrl, @guid, @fundingUrl, @fundingText, @medium
|
||||
)"""
|
||||
cmd.CommandText <- """
|
||||
INSERT INTO web_log_feed_podcast (
|
||||
feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url,
|
||||
itunes_category, itunes_subcategory, explicit, default_media_type, media_base_url, guid, funding_url,
|
||||
funding_text, medium
|
||||
) VALUES (
|
||||
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl,
|
||||
@iTunesCategory, @iTunesSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @guid, @fundingUrl,
|
||||
@fundingText, @medium
|
||||
)"""
|
||||
addPodcastParameters cmd feedId podcast
|
||||
do! write cmd
|
||||
}
|
||||
@@ -115,9 +117,9 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
|
||||
toDelete
|
||||
|> List.map (fun it -> backgroundTask {
|
||||
cmd.CommandText <-
|
||||
"""DELETE FROM web_log_feed_podcast WHERE feed_id = @id;
|
||||
DELETE FROM web_log_feed WHERE id = @id"""
|
||||
cmd.CommandText <- """
|
||||
DELETE FROM web_log_feed_podcast WHERE feed_id = @id;
|
||||
DELETE FROM web_log_feed WHERE id = @id"""
|
||||
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.id
|
||||
do! write cmd
|
||||
})
|
||||
@@ -126,12 +128,12 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||
cmd.Parameters.Clear ()
|
||||
toAdd
|
||||
|> List.map (fun it -> backgroundTask {
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO web_log_feed (
|
||||
id, web_log_id, source, path
|
||||
) VALUES (
|
||||
@id, @webLogId, @source, @path
|
||||
)"""
|
||||
cmd.CommandText <- """
|
||||
INSERT INTO web_log_feed (
|
||||
id, web_log_id, source, path
|
||||
) VALUES (
|
||||
@id, @webLogId, @source, @path
|
||||
)"""
|
||||
cmd.Parameters.Clear ()
|
||||
addCustomFeedParameters cmd webLog.id it
|
||||
do! write cmd
|
||||
@@ -143,12 +145,12 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||
|> ignore
|
||||
toUpdate
|
||||
|> List.map (fun it -> backgroundTask {
|
||||
cmd.CommandText <-
|
||||
"""UPDATE web_log_feed
|
||||
SET source = @source,
|
||||
path = @path
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
cmd.CommandText <- """
|
||||
UPDATE web_log_feed
|
||||
SET source = @source,
|
||||
path = @path
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
cmd.Parameters.Clear ()
|
||||
addCustomFeedParameters cmd webLog.id it
|
||||
do! write cmd
|
||||
@@ -156,25 +158,25 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||
match it.podcast with
|
||||
| Some podcast ->
|
||||
if hadPodcast then
|
||||
cmd.CommandText <-
|
||||
"""UPDATE web_log_feed_podcast
|
||||
SET title = @title,
|
||||
subtitle = @subtitle,
|
||||
items_in_feed = @itemsInFeed,
|
||||
summary = @summary,
|
||||
displayed_author = @displayedAuthor,
|
||||
email = @email,
|
||||
image_url = @imageUrl,
|
||||
itunes_category = @iTunesCategory,
|
||||
itunes_subcategory = @iTunesSubcategory,
|
||||
explicit = @explicit,
|
||||
default_media_type = @defaultMediaType,
|
||||
media_base_url = @mediaBaseUrl,
|
||||
guid = @guid,
|
||||
funding_url = @fundingUrl,
|
||||
funding_text = @fundingText,
|
||||
medium = @medium
|
||||
WHERE feed_id = @feedId"""
|
||||
cmd.CommandText <- """
|
||||
UPDATE web_log_feed_podcast
|
||||
SET title = @title,
|
||||
subtitle = @subtitle,
|
||||
items_in_feed = @itemsInFeed,
|
||||
summary = @summary,
|
||||
displayed_author = @displayedAuthor,
|
||||
email = @email,
|
||||
image_url = @imageUrl,
|
||||
itunes_category = @iTunesCategory,
|
||||
itunes_subcategory = @iTunesSubcategory,
|
||||
explicit = @explicit,
|
||||
default_media_type = @defaultMediaType,
|
||||
media_base_url = @mediaBaseUrl,
|
||||
guid = @guid,
|
||||
funding_url = @fundingUrl,
|
||||
funding_text = @fundingText,
|
||||
medium = @medium
|
||||
WHERE feed_id = @feedId"""
|
||||
cmd.Parameters.Clear ()
|
||||
addPodcastParameters cmd it.id podcast
|
||||
do! write cmd
|
||||
@@ -198,16 +200,14 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||
/// Add a web log
|
||||
let add webLog = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO web_log (
|
||||
id, name, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone,
|
||||
auto_htmx, feed_enabled, feed_name, items_in_feed, category_enabled, tag_enabled,
|
||||
copyright
|
||||
) VALUES (
|
||||
@id, @name, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone,
|
||||
@autoHtmx, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled,
|
||||
@copyright
|
||||
)"""
|
||||
cmd.CommandText <- """
|
||||
INSERT INTO web_log (
|
||||
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
|
||||
uploads, feed_enabled, feed_name, items_in_feed, category_enabled, tag_enabled, copyright
|
||||
) VALUES (
|
||||
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
|
||||
@uploads, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled, @copyright
|
||||
)"""
|
||||
addWebLogParameters cmd webLog
|
||||
do! write cmd
|
||||
do! updateCustomFeeds webLog
|
||||
@@ -232,25 +232,26 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
|
||||
let postSubQuery = subQuery "post"
|
||||
let pageSubQuery = subQuery "page"
|
||||
cmd.CommandText <-
|
||||
$"""DELETE FROM post_comment WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_revision WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_permalink WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_episode WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_tag WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_category WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_meta WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post WHERE web_log_id = @webLogId;
|
||||
DELETE FROM page_revision WHERE page_id IN {pageSubQuery};
|
||||
DELETE FROM page_permalink WHERE page_id IN {pageSubQuery};
|
||||
DELETE FROM page_meta WHERE page_id IN {pageSubQuery};
|
||||
DELETE FROM page WHERE web_log_id = @webLogId;
|
||||
DELETE FROM category WHERE web_log_id = @webLogId;
|
||||
DELETE FROM tag_map WHERE web_log_id = @webLogId;
|
||||
DELETE FROM web_log_user WHERE web_log_id = @webLogId;
|
||||
DELETE FROM web_log_feed_podcast WHERE feed_id IN {subQuery "web_log_feed"};
|
||||
DELETE FROM web_log_feed WHERE web_log_id = @webLogId;
|
||||
DELETE FROM web_log WHERE id = @webLogId"""
|
||||
cmd.CommandText <- $"""
|
||||
DELETE FROM post_comment WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_revision WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_permalink WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_episode WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_tag WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_category WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_meta WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post WHERE web_log_id = @webLogId;
|
||||
DELETE FROM page_revision WHERE page_id IN {pageSubQuery};
|
||||
DELETE FROM page_permalink WHERE page_id IN {pageSubQuery};
|
||||
DELETE FROM page_meta WHERE page_id IN {pageSubQuery};
|
||||
DELETE FROM page WHERE web_log_id = @webLogId;
|
||||
DELETE FROM category WHERE web_log_id = @webLogId;
|
||||
DELETE FROM tag_map WHERE web_log_id = @webLogId;
|
||||
DELETE FROM upload WHERE web_log_id = @webLogId;
|
||||
DELETE FROM web_log_user WHERE web_log_id = @webLogId;
|
||||
DELETE FROM web_log_feed_podcast WHERE feed_id IN {subQuery "web_log_feed"};
|
||||
DELETE FROM web_log_feed WHERE web_log_id = @webLogId;
|
||||
DELETE FROM web_log WHERE id = @webLogId"""
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
@@ -283,23 +284,25 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||
/// Update settings for a web log
|
||||
let updateSettings webLog = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""UPDATE web_log
|
||||
SET name = @name,
|
||||
subtitle = @subtitle,
|
||||
default_page = @defaultPage,
|
||||
posts_per_page = @postsPerPage,
|
||||
theme_id = @themeId,
|
||||
url_base = @urlBase,
|
||||
time_zone = @timeZone,
|
||||
auto_htmx = @autoHtmx,
|
||||
feed_enabled = @feedEnabled,
|
||||
feed_name = @feedName,
|
||||
items_in_feed = @itemsInFeed,
|
||||
category_enabled = @categoryEnabled,
|
||||
tag_enabled = @tagEnabled,
|
||||
copyright = @copyright
|
||||
WHERE id = @id"""
|
||||
cmd.CommandText <- """
|
||||
UPDATE web_log
|
||||
SET name = @name,
|
||||
slug = @slug,
|
||||
subtitle = @subtitle,
|
||||
default_page = @defaultPage,
|
||||
posts_per_page = @postsPerPage,
|
||||
theme_id = @themeId,
|
||||
url_base = @urlBase,
|
||||
time_zone = @timeZone,
|
||||
auto_htmx = @autoHtmx,
|
||||
uploads = @uploads,
|
||||
feed_enabled = @feedEnabled,
|
||||
feed_name = @feedName,
|
||||
items_in_feed = @itemsInFeed,
|
||||
category_enabled = @categoryEnabled,
|
||||
tag_enabled = @tagEnabled,
|
||||
copyright = @copyright
|
||||
WHERE id = @id"""
|
||||
addWebLogParameters cmd webLog
|
||||
do! write cmd
|
||||
}
|
||||
@@ -307,15 +310,15 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|
||||
/// Update RSS options for a web log
|
||||
let updateRssOptions webLog = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""UPDATE web_log
|
||||
SET feed_enabled = @feedEnabled,
|
||||
feed_name = @feedName,
|
||||
items_in_feed = @itemsInFeed,
|
||||
category_enabled = @categoryEnabled,
|
||||
tag_enabled = @tagEnabled,
|
||||
copyright = @copyright
|
||||
WHERE id = @id"""
|
||||
cmd.CommandText <- """
|
||||
UPDATE web_log
|
||||
SET feed_enabled = @feedEnabled,
|
||||
feed_name = @feedName,
|
||||
items_in_feed = @itemsInFeed,
|
||||
category_enabled = @categoryEnabled,
|
||||
tag_enabled = @tagEnabled,
|
||||
copyright = @copyright
|
||||
WHERE id = @id"""
|
||||
addWebLogRssParameters cmd webLog
|
||||
do! write cmd
|
||||
do! updateCustomFeeds webLog
|
||||
|
||||
@@ -28,14 +28,14 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
|
||||
/// Add a user
|
||||
let add user = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO web_log_user (
|
||||
id, web_log_id, user_name, first_name, last_name, preferred_name, password_hash, salt,
|
||||
url, authorization_level
|
||||
) VALUES (
|
||||
@id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash, @salt,
|
||||
@url, @authorizationLevel
|
||||
)"""
|
||||
cmd.CommandText <- """
|
||||
INSERT INTO web_log_user (
|
||||
id, web_log_id, user_name, first_name, last_name, preferred_name, password_hash, salt, url,
|
||||
authorization_level
|
||||
) VALUES (
|
||||
@id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url,
|
||||
@authorizationLevel
|
||||
)"""
|
||||
addWebLogUserParameters cmd user
|
||||
do! write cmd
|
||||
}
|
||||
@@ -43,8 +43,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
|
||||
/// Find a user by their e-mail address for the given web log
|
||||
let findByEmail (email : string) webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND user_name = @userName"
|
||||
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND user_name = @userName"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@userName", email) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
@@ -95,18 +94,18 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
|
||||
/// Update a user
|
||||
let update user = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""UPDATE web_log_user
|
||||
SET user_name = @userName,
|
||||
first_name = @firstName,
|
||||
last_name = @lastName,
|
||||
preferred_name = @preferredName,
|
||||
password_hash = @passwordHash,
|
||||
salt = @salt,
|
||||
url = @url,
|
||||
authorization_level = @authorizationLevel
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
cmd.CommandText <- """
|
||||
UPDATE web_log_user
|
||||
SET user_name = @userName,
|
||||
first_name = @firstName,
|
||||
last_name = @lastName,
|
||||
preferred_name = @preferredName,
|
||||
password_hash = @passwordHash,
|
||||
salt = @salt,
|
||||
url = @url,
|
||||
authorization_level = @authorizationLevel
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
addWebLogUserParameters cmd user
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
@@ -36,6 +36,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
member _.TagMap = SQLiteTagMapData conn
|
||||
member _.Theme = SQLiteThemeData conn
|
||||
member _.ThemeAsset = SQLiteThemeAssetData conn
|
||||
member _.Upload = SQLiteUploadData conn
|
||||
member _.WebLog = SQLiteWebLogData conn
|
||||
member _.WebLogUser = SQLiteWebLogUserData conn
|
||||
|
||||
@@ -48,8 +49,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating theme table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE theme (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE theme (
|
||||
id TEXT PRIMARY KEY,
|
||||
name TEXT NOT NULL,
|
||||
version TEXT NOT NULL)"""
|
||||
@@ -58,8 +59,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating theme_template table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE theme_template (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE theme_template (
|
||||
theme_id TEXT NOT NULL REFERENCES theme (id),
|
||||
name TEXT NOT NULL,
|
||||
template TEXT NOT NULL,
|
||||
@@ -69,8 +70,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating theme_asset table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE theme_asset (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE theme_asset (
|
||||
theme_id TEXT NOT NULL REFERENCES theme (id),
|
||||
path TEXT NOT NULL,
|
||||
updated_on TEXT NOT NULL,
|
||||
@@ -83,10 +84,11 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating web_log table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE web_log (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE web_log (
|
||||
id TEXT PRIMARY KEY,
|
||||
name TEXT NOT NULL,
|
||||
slug TEXT NOT NULL,
|
||||
subtitle TEXT,
|
||||
default_page TEXT NOT NULL,
|
||||
posts_per_page INTEGER NOT NULL,
|
||||
@@ -94,30 +96,33 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
url_base TEXT NOT NULL,
|
||||
time_zone TEXT NOT NULL,
|
||||
auto_htmx INTEGER NOT NULL DEFAULT 0,
|
||||
uploads TEXT NOT NULL,
|
||||
feed_enabled INTEGER NOT NULL DEFAULT 0,
|
||||
feed_name TEXT NOT NULL,
|
||||
items_in_feed INTEGER,
|
||||
category_enabled INTEGER NOT NULL DEFAULT 0,
|
||||
tag_enabled INTEGER NOT NULL DEFAULT 0,
|
||||
copyright TEXT)"""
|
||||
copyright TEXT);
|
||||
CREATE INDEX web_log_theme_idx ON web_log (theme_id)"""
|
||||
do! write cmd
|
||||
match! tableExists "web_log_feed" with
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating web_log_feed table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE web_log_feed (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE web_log_feed (
|
||||
id TEXT PRIMARY KEY,
|
||||
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||
source TEXT NOT NULL,
|
||||
path TEXT NOT NULL)"""
|
||||
path TEXT NOT NULL);
|
||||
CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"""
|
||||
do! write cmd
|
||||
match! tableExists "web_log_feed_podcast" with
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating web_log_feed_podcast table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE web_log_feed_podcast (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE web_log_feed_podcast (
|
||||
feed_id TEXT PRIMARY KEY REFERENCES web_log_feed (id),
|
||||
title TEXT NOT NULL,
|
||||
subtitle TEXT,
|
||||
@@ -142,14 +147,15 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating category table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE category (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE category (
|
||||
id TEXT PRIMARY KEY,
|
||||
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||
name TEXT NOT NULL,
|
||||
slug TEXT NOT NULL,
|
||||
description TEXT,
|
||||
parent_id TEXT)"""
|
||||
parent_id TEXT);
|
||||
CREATE INDEX category_web_log_idx ON category (web_log_id)"""
|
||||
do! write cmd
|
||||
|
||||
// Web log user table
|
||||
@@ -157,8 +163,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating web_log_user table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE web_log_user (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE web_log_user (
|
||||
id TEXT PRIMARY KEY,
|
||||
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||
user_name TEXT NOT NULL,
|
||||
@@ -168,7 +174,9 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
password_hash TEXT NOT NULL,
|
||||
salt TEXT NOT NULL,
|
||||
url TEXT,
|
||||
authorization_level TEXT NOT NULL)"""
|
||||
authorization_level TEXT NOT NULL);
|
||||
CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id);
|
||||
CREATE INDEX web_log_user_user_name_idx ON web_log_user (web_log_id, user_name)"""
|
||||
do! write cmd
|
||||
|
||||
// Page tables
|
||||
@@ -176,8 +184,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating page table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE page (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE page (
|
||||
id TEXT PRIMARY KEY,
|
||||
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||
author_id TEXT NOT NULL REFERENCES web_log_user (id),
|
||||
@@ -187,14 +195,17 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
updated_on TEXT NOT NULL,
|
||||
show_in_page_list INTEGER NOT NULL DEFAULT 0,
|
||||
template TEXT,
|
||||
page_text TEXT NOT NULL)"""
|
||||
page_text TEXT NOT NULL);
|
||||
CREATE INDEX page_web_log_idx ON page (web_log_id);
|
||||
CREATE INDEX page_author_idx ON page (author_id);
|
||||
CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)"""
|
||||
do! write cmd
|
||||
match! tableExists "page_meta" with
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating page_meta table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE page_meta (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE page_meta (
|
||||
page_id TEXT NOT NULL REFERENCES page (id),
|
||||
name TEXT NOT NULL,
|
||||
value TEXT NOT NULL,
|
||||
@@ -204,8 +215,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating page_permalink table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE page_permalink (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE page_permalink (
|
||||
page_id TEXT NOT NULL REFERENCES page (id),
|
||||
permalink TEXT NOT NULL,
|
||||
PRIMARY KEY (page_id, permalink))"""
|
||||
@@ -214,8 +225,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating page_revision table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE page_revision (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE page_revision (
|
||||
page_id TEXT NOT NULL REFERENCES page (id),
|
||||
as_of TEXT NOT NULL,
|
||||
revision_text TEXT NOT NULL,
|
||||
@@ -227,8 +238,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating post table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE post (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE post (
|
||||
id TEXT PRIMARY KEY,
|
||||
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||
author_id TEXT NOT NULL REFERENCES web_log_user (id),
|
||||
@@ -238,24 +249,29 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
published_on TEXT,
|
||||
updated_on TEXT NOT NULL,
|
||||
template TEXT,
|
||||
post_text TEXT NOT NULL)"""
|
||||
post_text TEXT NOT NULL);
|
||||
CREATE INDEX post_web_log_idx ON post (web_log_id);
|
||||
CREATE INDEX post_author_idx ON post (author_id);
|
||||
CREATE INDEX post_status_idx ON post (web_log_id, status, updated_on);
|
||||
CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)"""
|
||||
do! write cmd
|
||||
match! tableExists "post_category" with
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating post_category table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE post_category (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE post_category (
|
||||
post_id TEXT NOT NULL REFERENCES post (id),
|
||||
category_id TEXT NOT NULL REFERENCES category (id),
|
||||
PRIMARY KEY (post_id, category_id))"""
|
||||
PRIMARY KEY (post_id, category_id));
|
||||
CREATE INDEX post_category_category_idx ON post_category (category_id)"""
|
||||
do! write cmd
|
||||
match! tableExists "post_episode" with
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating post_episode table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE post_episode (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE post_episode (
|
||||
post_id TEXT PRIMARY KEY REFERENCES post(id),
|
||||
media TEXT NOT NULL,
|
||||
length INTEGER NOT NULL,
|
||||
@@ -279,8 +295,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating post_tag table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE post_tag (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE post_tag (
|
||||
post_id TEXT NOT NULL REFERENCES post (id),
|
||||
tag TEXT NOT NULL,
|
||||
PRIMARY KEY (post_id, tag))"""
|
||||
@@ -289,8 +305,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating post_meta table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE post_meta (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE post_meta (
|
||||
post_id TEXT NOT NULL REFERENCES post (id),
|
||||
name TEXT NOT NULL,
|
||||
value TEXT NOT NULL,
|
||||
@@ -300,8 +316,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating post_permalink table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE post_permalink (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE post_permalink (
|
||||
post_id TEXT NOT NULL REFERENCES post (id),
|
||||
permalink TEXT NOT NULL,
|
||||
PRIMARY KEY (post_id, permalink))"""
|
||||
@@ -310,8 +326,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating post_revision table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE post_revision (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE post_revision (
|
||||
post_id TEXT NOT NULL REFERENCES post (id),
|
||||
as_of TEXT NOT NULL,
|
||||
revision_text TEXT NOT NULL,
|
||||
@@ -321,8 +337,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating post_comment table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE post_comment (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE post_comment (
|
||||
id TEXT PRIMARY KEY,
|
||||
post_id TEXT NOT NULL REFERENCES post(id),
|
||||
in_reply_to_id TEXT,
|
||||
@@ -331,7 +347,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
url TEXT,
|
||||
status TEXT NOT NULL,
|
||||
posted_on TEXT NOT NULL,
|
||||
comment_text TEXT NOT NULL)"""
|
||||
comment_text TEXT NOT NULL);
|
||||
CREATE INDEX post_comment_post_idx ON post_comment (post_id)"""
|
||||
do! write cmd
|
||||
|
||||
// Tag map table
|
||||
@@ -339,11 +356,28 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating tag_map table..."
|
||||
cmd.CommandText <-
|
||||
"""CREATE TABLE tag_map (
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE tag_map (
|
||||
id TEXT PRIMARY KEY,
|
||||
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||
tag TEXT NOT NULL,
|
||||
url_value TEXT NOT NULL)"""
|
||||
url_value TEXT NOT NULL);
|
||||
CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)"""
|
||||
do! write cmd
|
||||
|
||||
// Uploaded file table
|
||||
match! tableExists "upload" with
|
||||
| true -> ()
|
||||
| false ->
|
||||
log.LogInformation "Creating upload table..."
|
||||
cmd.CommandText <- """
|
||||
CREATE TABLE upload (
|
||||
id TEXT PRIMARY KEY,
|
||||
web_log_id TEXT NOT NULL REFERENCES web_log (id),
|
||||
path TEXT NOT NULL,
|
||||
updated_on TEXT NOT NULL,
|
||||
data BLOB NOT NULL);
|
||||
CREATE INDEX upload_web_log_idx ON upload (web_log_id);
|
||||
CREATE INDEX upload_path_idx ON upload (web_log_id, path)"""
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
@@ -295,6 +295,37 @@ type ThemeAsset =
|
||||
}
|
||||
|
||||
|
||||
/// An uploaded file
|
||||
type Upload =
|
||||
{ /// The ID of the upload
|
||||
id : UploadId
|
||||
|
||||
/// The ID of the web log to which this upload belongs
|
||||
webLogId : WebLogId
|
||||
|
||||
/// The link at which this upload is served
|
||||
path : Permalink
|
||||
|
||||
/// The updated date/time for this upload
|
||||
updatedOn : DateTime
|
||||
|
||||
/// The data for the upload
|
||||
data : byte[]
|
||||
}
|
||||
|
||||
/// Functions to support uploaded files
|
||||
module Upload =
|
||||
|
||||
/// An empty upload
|
||||
let empty = {
|
||||
id = UploadId.empty
|
||||
webLogId = WebLogId.empty
|
||||
path = Permalink.empty
|
||||
updatedOn = DateTime.MinValue
|
||||
data = [||]
|
||||
}
|
||||
|
||||
|
||||
/// A web log
|
||||
[<CLIMutable; NoComparison; NoEquality>]
|
||||
type WebLog =
|
||||
@@ -304,6 +335,9 @@ type WebLog =
|
||||
/// The name of the web log
|
||||
name : string
|
||||
|
||||
/// The slug of the web log
|
||||
slug : string
|
||||
|
||||
/// A subtitle for the web log
|
||||
subtitle : string option
|
||||
|
||||
@@ -327,6 +361,9 @@ type WebLog =
|
||||
|
||||
/// Whether to automatically load htmx
|
||||
autoHtmx : bool
|
||||
|
||||
/// Where uploads are placed
|
||||
uploads : UploadDestination
|
||||
}
|
||||
|
||||
/// Functions to support web logs
|
||||
@@ -336,6 +373,7 @@ module WebLog =
|
||||
let empty =
|
||||
{ id = WebLogId.empty
|
||||
name = ""
|
||||
slug = ""
|
||||
subtitle = None
|
||||
defaultPage = ""
|
||||
postsPerPage = 10
|
||||
@@ -344,6 +382,7 @@ module WebLog =
|
||||
timeZone = ""
|
||||
rss = RssOptions.empty
|
||||
autoHtmx = false
|
||||
uploads = Database
|
||||
}
|
||||
|
||||
/// Get the host (including scheme) and extra path from the URL base
|
||||
@@ -366,11 +405,6 @@ module WebLog =
|
||||
TimeZoneInfo.ConvertTimeFromUtc
|
||||
(DateTime (date.Ticks, DateTimeKind.Utc), TimeZoneInfo.FindSystemTimeZoneById webLog.timeZone)
|
||||
|
||||
/// Convert a date/time in the web log's local date/time to UTC
|
||||
let utcTime webLog (date : DateTime) =
|
||||
TimeZoneInfo.ConvertTimeToUtc
|
||||
(DateTime (date.Ticks, DateTimeKind.Unspecified), TimeZoneInfo.FindSystemTimeZoneById webLog.timeZone)
|
||||
|
||||
|
||||
/// A user of the web log
|
||||
[<CLIMutable; NoComparison; NoEquality>]
|
||||
|
||||
@@ -556,6 +556,41 @@ type ThemeTemplate =
|
||||
}
|
||||
|
||||
|
||||
/// Where uploads should be placed
|
||||
type UploadDestination =
|
||||
| Database
|
||||
| Disk
|
||||
|
||||
/// Functions to support upload destinations
|
||||
module UploadDestination =
|
||||
|
||||
/// Convert an upload destination to its string representation
|
||||
let toString = function Database -> "database" | Disk -> "disk"
|
||||
|
||||
/// Parse an upload destination from its string representation
|
||||
let parse value =
|
||||
match value with
|
||||
| "database" -> Database
|
||||
| "disk" -> Disk
|
||||
| it -> invalidOp $"{it} is not a valid upload destination"
|
||||
|
||||
|
||||
/// An identifier for an upload
|
||||
type UploadId = UploadId of string
|
||||
|
||||
/// Functions to support upload IDs
|
||||
module UploadId =
|
||||
|
||||
/// An empty upload ID
|
||||
let empty = UploadId ""
|
||||
|
||||
/// Convert an upload ID to a string
|
||||
let toString = function UploadId ui -> ui
|
||||
|
||||
/// Create a new upload ID
|
||||
let create () = UploadId (newId ())
|
||||
|
||||
|
||||
/// An identifier for a web log
|
||||
type WebLogId = WebLogId of string
|
||||
|
||||
|
||||
@@ -12,6 +12,29 @@ module private Helpers =
|
||||
match (defaultArg (Option.ofObj it) "").Trim () with "" -> None | trimmed -> Some trimmed
|
||||
|
||||
|
||||
/// The model used to display the admin dashboard
|
||||
[<NoComparison; NoEquality>]
|
||||
type DashboardModel =
|
||||
{ /// The number of published posts
|
||||
posts : int
|
||||
|
||||
/// The number of post drafts
|
||||
drafts : int
|
||||
|
||||
/// The number of pages
|
||||
pages : int
|
||||
|
||||
/// The number of pages in the page list
|
||||
listedPages : int
|
||||
|
||||
/// The number of categories
|
||||
categories : int
|
||||
|
||||
/// The top-level categories
|
||||
topLevelCategories : int
|
||||
}
|
||||
|
||||
|
||||
/// Details about a category, used to display category lists
|
||||
[<NoComparison; NoEquality>]
|
||||
type DisplayCategory =
|
||||
@@ -124,27 +147,59 @@ type DisplayPage =
|
||||
}
|
||||
|
||||
|
||||
/// The model used to display the admin dashboard
|
||||
[<NoComparison; NoEquality>]
|
||||
type DashboardModel =
|
||||
{ /// The number of published posts
|
||||
posts : int
|
||||
|
||||
/// The number of post drafts
|
||||
drafts : int
|
||||
|
||||
/// The number of pages
|
||||
pages : int
|
||||
|
||||
/// The number of pages in the page list
|
||||
listedPages : int
|
||||
|
||||
/// The number of categories
|
||||
categories : int
|
||||
|
||||
/// The top-level categories
|
||||
topLevelCategories : int
|
||||
/// Information about a revision used for display
|
||||
[<CLIMutable; NoComparison; NoEquality>]
|
||||
type DisplayRevision =
|
||||
{ /// The as-of date/time for the revision
|
||||
asOf : DateTime
|
||||
|
||||
/// The as-of date/time for the revision in the web log's local time zone
|
||||
asOfLocal : DateTime
|
||||
|
||||
/// The format of the text of the revision
|
||||
format : string
|
||||
}
|
||||
with
|
||||
|
||||
/// Create a display revision from an actual revision
|
||||
static member fromRevision webLog (rev : Revision) =
|
||||
{ asOf = rev.asOf
|
||||
asOfLocal = WebLog.localTime webLog rev.asOf
|
||||
format = MarkupText.sourceType rev.text
|
||||
}
|
||||
|
||||
|
||||
open System.IO
|
||||
|
||||
/// Information about an uploaded file used for display
|
||||
[<NoComparison; NoEquality>]
|
||||
type DisplayUpload =
|
||||
{ /// The ID of the uploaded file
|
||||
id : string
|
||||
|
||||
/// The name of the uploaded file
|
||||
name : string
|
||||
|
||||
/// The path at which the file is served
|
||||
path : string
|
||||
|
||||
/// The date/time the file was updated
|
||||
updatedOn : DateTime option
|
||||
|
||||
/// The source for this file (created from UploadDestination DU)
|
||||
source : string
|
||||
}
|
||||
|
||||
/// Create a display uploaded file
|
||||
static member fromUpload webLog source (upload : Upload) =
|
||||
let path = Permalink.toString upload.path
|
||||
let name = Path.GetFileName path
|
||||
{ id = UploadId.toString upload.id
|
||||
name = name
|
||||
path = path.Replace (name, "")
|
||||
updatedOn = Some (WebLog.localTime webLog upload.updatedOn)
|
||||
source = UploadDestination.toString source
|
||||
}
|
||||
|
||||
|
||||
/// View model for editing categories
|
||||
@@ -229,6 +284,18 @@ type EditCustomFeedModel =
|
||||
|
||||
/// The base URL for relative URL media files for this podcast (optional; defaults to web log base)
|
||||
mediaBaseUrl : string
|
||||
|
||||
/// The URL for funding information for the podcast
|
||||
fundingUrl : string
|
||||
|
||||
/// The text for the funding link
|
||||
fundingText : string
|
||||
|
||||
/// A unique identifier to follow this podcast
|
||||
guid : string
|
||||
|
||||
/// The medium for the content of this podcast
|
||||
medium : string
|
||||
}
|
||||
|
||||
/// An empty custom feed model
|
||||
@@ -250,6 +317,10 @@ type EditCustomFeedModel =
|
||||
explicit = "no"
|
||||
defaultMediaType = "audio/mpeg"
|
||||
mediaBaseUrl = ""
|
||||
fundingUrl = ""
|
||||
fundingText = ""
|
||||
guid = ""
|
||||
medium = ""
|
||||
}
|
||||
|
||||
/// Create a model from a custom feed
|
||||
@@ -277,6 +348,12 @@ type EditCustomFeedModel =
|
||||
explicit = ExplicitRating.toString p.explicit
|
||||
defaultMediaType = defaultArg p.defaultMediaType ""
|
||||
mediaBaseUrl = defaultArg p.mediaBaseUrl ""
|
||||
fundingUrl = defaultArg p.fundingUrl ""
|
||||
fundingText = defaultArg p.fundingText ""
|
||||
guid = p.guid
|
||||
|> Option.map (fun it -> it.ToString().ToLowerInvariant ())
|
||||
|> Option.defaultValue ""
|
||||
medium = p.medium |> Option.map PodcastMedium.toString |> Option.defaultValue ""
|
||||
}
|
||||
| None -> rss
|
||||
|
||||
@@ -300,11 +377,10 @@ type EditCustomFeedModel =
|
||||
explicit = ExplicitRating.parse this.explicit
|
||||
defaultMediaType = noneIfBlank this.defaultMediaType
|
||||
mediaBaseUrl = noneIfBlank this.mediaBaseUrl
|
||||
// TODO: implement UI to update these
|
||||
guid = None
|
||||
fundingUrl = None
|
||||
fundingText = None
|
||||
medium = None
|
||||
guid = noneIfBlank this.guid |> Option.map Guid.Parse
|
||||
fundingUrl = noneIfBlank this.fundingUrl
|
||||
fundingText = noneIfBlank this.fundingText
|
||||
medium = noneIfBlank this.medium |> Option.map PodcastMedium.parse
|
||||
}
|
||||
else
|
||||
None
|
||||
@@ -712,6 +788,39 @@ type ManagePermalinksModel =
|
||||
}
|
||||
|
||||
|
||||
/// View model to manage revisions
|
||||
[<CLIMutable; NoComparison; NoEquality>]
|
||||
type ManageRevisionsModel =
|
||||
{ /// The ID for the entity being edited
|
||||
id : string
|
||||
|
||||
/// The type of entity being edited ("page" or "post")
|
||||
entity : string
|
||||
|
||||
/// The current title of the page or post
|
||||
currentTitle : string
|
||||
|
||||
/// The revisions for the page or post
|
||||
revisions : DisplayRevision[]
|
||||
}
|
||||
|
||||
/// Create a revision model from a page
|
||||
static member fromPage webLog (pg : Page) =
|
||||
{ id = PageId.toString pg.id
|
||||
entity = "page"
|
||||
currentTitle = pg.title
|
||||
revisions = pg.revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
|
||||
}
|
||||
|
||||
/// Create a revision model from a post
|
||||
static member fromPost webLog (post : Post) =
|
||||
{ id = PostId.toString post.id
|
||||
entity = "post"
|
||||
currentTitle = post.title
|
||||
revisions = post.revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
|
||||
}
|
||||
|
||||
|
||||
/// View model for posts in a list
|
||||
[<NoComparison; NoEquality>]
|
||||
type PostListItem =
|
||||
@@ -802,6 +911,9 @@ type SettingsModel =
|
||||
{ /// The name of the web log
|
||||
name : string
|
||||
|
||||
/// The slug of the web log
|
||||
slug : string
|
||||
|
||||
/// The subtitle of the web log
|
||||
subtitle : string
|
||||
|
||||
@@ -819,32 +931,48 @@ type SettingsModel =
|
||||
|
||||
/// Whether to automatically load htmx
|
||||
autoHtmx : bool
|
||||
|
||||
/// The default location for uploads
|
||||
uploads : string
|
||||
}
|
||||
|
||||
/// Create a settings model from a web log
|
||||
static member fromWebLog (webLog : WebLog) =
|
||||
{ name = webLog.name
|
||||
slug = webLog.slug
|
||||
subtitle = defaultArg webLog.subtitle ""
|
||||
defaultPage = webLog.defaultPage
|
||||
postsPerPage = webLog.postsPerPage
|
||||
timeZone = webLog.timeZone
|
||||
themePath = webLog.themePath
|
||||
autoHtmx = webLog.autoHtmx
|
||||
uploads = UploadDestination.toString webLog.uploads
|
||||
}
|
||||
|
||||
/// Update a web log with settings from the form
|
||||
member this.update (webLog : WebLog) =
|
||||
{ webLog with
|
||||
name = this.name
|
||||
slug = this.slug
|
||||
subtitle = if this.subtitle = "" then None else Some this.subtitle
|
||||
defaultPage = this.defaultPage
|
||||
postsPerPage = this.postsPerPage
|
||||
timeZone = this.timeZone
|
||||
themePath = this.themePath
|
||||
autoHtmx = this.autoHtmx
|
||||
uploads = UploadDestination.parse this.uploads
|
||||
}
|
||||
|
||||
|
||||
/// View model for uploading a file
|
||||
[<CLIMutable; NoComparison; NoEquality>]
|
||||
type UploadFileModel =
|
||||
{ /// The upload destination
|
||||
destination : string
|
||||
}
|
||||
|
||||
|
||||
/// A message displayed to the user
|
||||
[<CLIMutable; NoComparison; NoEquality>]
|
||||
type UserMessage =
|
||||
{ /// The level of the message
|
||||
|
||||
@@ -7,16 +7,45 @@ open MyWebLog.Data
|
||||
[<AutoOpen>]
|
||||
module Extensions =
|
||||
|
||||
open System.Security.Claims
|
||||
open Microsoft.AspNetCore.Antiforgery
|
||||
open Microsoft.Extensions.Configuration
|
||||
open Microsoft.Extensions.DependencyInjection
|
||||
|
||||
/// Hold variable for the configured generator string
|
||||
let mutable private generatorString : string option = None
|
||||
|
||||
type HttpContext with
|
||||
/// The web log for the current request
|
||||
member this.WebLog = this.Items["webLog"] :?> WebLog
|
||||
|
||||
/// The anti-CSRF service
|
||||
member this.AntiForgery = this.RequestServices.GetRequiredService<IAntiforgery> ()
|
||||
|
||||
/// The cross-site request forgery token set for this request
|
||||
member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this
|
||||
|
||||
/// The data implementation
|
||||
member this.Data = this.RequestServices.GetRequiredService<IData> ()
|
||||
|
||||
|
||||
/// The generator string
|
||||
member this.Generator =
|
||||
match generatorString with
|
||||
| Some gen -> gen
|
||||
| None ->
|
||||
let cfg = this.RequestServices.GetRequiredService<IConfiguration> ()
|
||||
generatorString <-
|
||||
match Option.ofObj cfg["Generator"] with
|
||||
| Some gen -> Some gen
|
||||
| None -> Some "generator not configured"
|
||||
generatorString.Value
|
||||
|
||||
/// The user ID for the current request
|
||||
member this.UserId =
|
||||
WebLogUserId (this.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value
|
||||
|
||||
/// The web log for the current request
|
||||
member this.WebLog = this.Items["webLog"] :?> WebLog
|
||||
|
||||
|
||||
open System.Collections.Concurrent
|
||||
|
||||
/// <summary>
|
||||
|
||||
@@ -222,17 +222,17 @@ let register () =
|
||||
Template.RegisterTag<PageFootTag> "page_foot"
|
||||
Template.RegisterTag<UserLinksTag> "user_links"
|
||||
|
||||
[ // Domain types
|
||||
typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>; typeof<MetaItem>; typeof<Page>; typeof<RssOptions>
|
||||
typeof<TagMap>; typeof<WebLog>
|
||||
// View models
|
||||
typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayCustomFeed>; typeof<DisplayPage>
|
||||
typeof<EditCategoryModel>; typeof<EditCustomFeedModel>; typeof<EditPageModel>; typeof<EditPostModel>
|
||||
typeof<EditRssModel>; typeof<EditTagMapModel>; typeof<EditUserModel>; typeof<LogOnModel>
|
||||
typeof<ManagePermalinksModel>; typeof<PostDisplay>; typeof<PostListItem>; typeof<SettingsModel>
|
||||
typeof<UserMessage>
|
||||
// Framework types
|
||||
typeof<AntiforgeryTokenSet>; typeof<int option>; typeof<KeyValuePair>; typeof<MetaItem list>
|
||||
typeof<string list>; typeof<string option>; typeof<TagMap list>
|
||||
[ // Domain types
|
||||
typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>; typeof<MetaItem>; typeof<Page>
|
||||
typeof<RssOptions>; typeof<TagMap>; typeof<UploadDestination>; typeof<WebLog>
|
||||
// View models
|
||||
typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayCustomFeed>; typeof<DisplayPage>
|
||||
typeof<DisplayRevision>; typeof<DisplayUpload>; typeof<EditCategoryModel>; typeof<EditCustomFeedModel>
|
||||
typeof<EditPageModel>; typeof<EditPostModel>; typeof<EditRssModel>; typeof<EditTagMapModel>
|
||||
typeof<EditUserModel>; typeof<LogOnModel>; typeof<ManagePermalinksModel>; typeof<ManageRevisionsModel>
|
||||
typeof<PostDisplay>; typeof<PostListItem>; typeof<SettingsModel>; typeof<UserMessage>
|
||||
// Framework types
|
||||
typeof<AntiforgeryTokenSet>; typeof<DateTime option>; typeof<int option>; typeof<KeyValuePair>
|
||||
typeof<MetaItem list>; typeof<string list>; typeof<string option>; typeof<TagMap list>
|
||||
]
|
||||
|> List.iter (fun it -> Template.RegisterSafeType (it, [| "*" |]))
|
||||
|
||||
@@ -39,10 +39,10 @@ let dashboard : HttpHandler = fun next ctx -> task {
|
||||
let listCategories : HttpHandler = fun next ctx -> task {
|
||||
let! catListTemplate = TemplateCache.get "admin" "category-list-body" ctx.Data
|
||||
let hash = Hash.FromAnonymousObject {|
|
||||
page_title = "Categories"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
web_log = ctx.WebLog
|
||||
categories = CategoryCache.get ctx
|
||||
page_title = "Categories"
|
||||
csrf = csrfToken ctx
|
||||
|}
|
||||
hash.Add ("category_list", catListTemplate.Render hash)
|
||||
return! viewForTheme "admin" "category-list" next ctx hash
|
||||
@@ -53,7 +53,7 @@ let listCategoriesBare : HttpHandler = fun next ctx -> task {
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
categories = CategoryCache.get ctx
|
||||
csrf = csrfToken ctx
|
||||
csrf = ctx.CsrfTokenSet
|
||||
|}
|
||||
|> bareForTheme "admin" "category-list-body" next ctx
|
||||
}
|
||||
@@ -73,9 +73,9 @@ let editCategory catId : HttpHandler = fun next ctx -> task {
|
||||
| Some (title, cat) ->
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
csrf = csrfToken ctx
|
||||
model = EditCategoryModel.fromCategory cat
|
||||
page_title = title
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = EditCategoryModel.fromCategory cat
|
||||
categories = CategoryCache.get ctx
|
||||
|}
|
||||
|> bareForTheme "admin" "category-edit" next ctx
|
||||
@@ -118,156 +118,16 @@ let deleteCategory catId : HttpHandler = fun next ctx -> task {
|
||||
return! listCategoriesBare next ctx
|
||||
}
|
||||
|
||||
// -- PAGES --
|
||||
|
||||
// GET /admin/pages
|
||||
// GET /admin/pages/page/{pageNbr}
|
||||
let listPages pageNbr : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
let! pages = ctx.Data.Page.findPageOfPages webLog.id pageNbr
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
csrf = csrfToken ctx
|
||||
pages = pages |> List.map (DisplayPage.fromPageMinimal webLog)
|
||||
page_title = "Pages"
|
||||
page_nbr = pageNbr
|
||||
prev_page = if pageNbr = 2 then "" else $"/page/{pageNbr - 1}"
|
||||
next_page = $"/page/{pageNbr + 1}"
|
||||
|}
|
||||
|> viewForTheme "admin" "page-list" next ctx
|
||||
}
|
||||
|
||||
// GET /admin/page/{id}/edit
|
||||
let editPage pgId : HttpHandler = fun next ctx -> task {
|
||||
let! result = task {
|
||||
match pgId with
|
||||
| "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new" })
|
||||
| _ ->
|
||||
match! ctx.Data.Page.findFullById (PageId pgId) ctx.WebLog.id with
|
||||
| Some page -> return Some ("Edit Page", page)
|
||||
| None -> return None
|
||||
}
|
||||
match result with
|
||||
| Some (title, page) ->
|
||||
let model = EditPageModel.fromPage page
|
||||
let! templates = templatesForTheme ctx "page"
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
csrf = csrfToken ctx
|
||||
model = model
|
||||
metadata = Array.zip model.metaNames model.metaValues
|
||||
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
|
||||
page_title = title
|
||||
templates = templates
|
||||
|}
|
||||
|> viewForTheme "admin" "page-edit" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// GET /admin/page/{id}/permalinks
|
||||
let editPagePermalinks pgId : HttpHandler = fun next ctx -> task {
|
||||
match! ctx.Data.Page.findFullById (PageId pgId) ctx.WebLog.id with
|
||||
| Some pg ->
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
csrf = csrfToken ctx
|
||||
model = ManagePermalinksModel.fromPage pg
|
||||
page_title = $"Manage Prior Permalinks"
|
||||
|}
|
||||
|> viewForTheme "admin" "permalinks" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// POST /admin/page/permalinks
|
||||
let savePagePermalinks : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
|
||||
let links = model.prior |> Array.map Permalink |> List.ofArray
|
||||
match! ctx.Data.Page.updatePriorPermalinks (PageId model.id) webLog.id links with
|
||||
| true ->
|
||||
do! addMessage ctx { UserMessage.success with message = "Page permalinks saved successfully" }
|
||||
return! redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/page/{model.id}/permalinks")) next ctx
|
||||
| false -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// POST /admin/page/{id}/delete
|
||||
let deletePage pgId : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
match! ctx.Data.Page.delete (PageId pgId) webLog.id with
|
||||
| true ->
|
||||
do! PageListCache.update ctx
|
||||
do! addMessage ctx { UserMessage.success with message = "Page deleted successfully" }
|
||||
| false -> do! addMessage ctx { UserMessage.error with message = "Page not found; nothing deleted" }
|
||||
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/pages")) next ctx
|
||||
}
|
||||
|
||||
open System
|
||||
|
||||
#nowarn "3511"
|
||||
|
||||
// POST /admin/page/save
|
||||
let savePage : HttpHandler = fun next ctx -> task {
|
||||
let! model = ctx.BindFormAsync<EditPageModel> ()
|
||||
let webLog = ctx.WebLog
|
||||
let data = ctx.Data
|
||||
let now = DateTime.UtcNow
|
||||
let! pg = task {
|
||||
match model.pageId with
|
||||
| "new" ->
|
||||
return Some
|
||||
{ Page.empty with
|
||||
id = PageId.create ()
|
||||
webLogId = webLog.id
|
||||
authorId = userId ctx
|
||||
publishedOn = now
|
||||
}
|
||||
| pgId -> return! data.Page.findFullById (PageId pgId) webLog.id
|
||||
}
|
||||
match pg with
|
||||
| Some page ->
|
||||
let updateList = page.showInPageList <> model.isShownInPageList
|
||||
let revision = { asOf = now; text = MarkupText.parse $"{model.source}: {model.text}" }
|
||||
// Detect a permalink change, and add the prior one to the prior list
|
||||
let page =
|
||||
match Permalink.toString page.permalink with
|
||||
| "" -> page
|
||||
| link when link = model.permalink -> page
|
||||
| _ -> { page with priorPermalinks = page.permalink :: page.priorPermalinks }
|
||||
let page =
|
||||
{ page with
|
||||
title = model.title
|
||||
permalink = Permalink model.permalink
|
||||
updatedOn = now
|
||||
showInPageList = model.isShownInPageList
|
||||
template = match model.template with "" -> None | tmpl -> Some tmpl
|
||||
text = MarkupText.toHtml revision.text
|
||||
metadata = Seq.zip model.metaNames model.metaValues
|
||||
|> Seq.filter (fun it -> fst it > "")
|
||||
|> Seq.map (fun it -> { name = fst it; value = snd it })
|
||||
|> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}")
|
||||
|> List.ofSeq
|
||||
revisions = match page.revisions |> List.tryHead with
|
||||
| Some r when r.text = revision.text -> page.revisions
|
||||
| _ -> revision :: page.revisions
|
||||
}
|
||||
do! (if model.pageId = "new" then data.Page.add else data.Page.update) page
|
||||
if updateList then do! PageListCache.update ctx
|
||||
do! addMessage ctx { UserMessage.success with message = "Page saved successfully" }
|
||||
return!
|
||||
redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/page/{PageId.toString page.id}/edit")) next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
open Microsoft.AspNetCore.Http
|
||||
|
||||
// -- TAG MAPPINGS --
|
||||
|
||||
open Microsoft.AspNetCore.Http
|
||||
|
||||
/// Get the hash necessary to render the tag mapping list
|
||||
let private tagMappingHash (ctx : HttpContext) = task {
|
||||
let! mappings = ctx.Data.TagMap.findByWebLog ctx.WebLog.id
|
||||
return Hash.FromAnonymousObject {|
|
||||
csrf = ctx.CsrfTokenSet
|
||||
web_log = ctx.WebLog
|
||||
csrf = csrfToken ctx
|
||||
mappings = mappings
|
||||
mapping_ids = mappings |> List.map (fun it -> { name = it.tag; value = TagMapId.toString it.id })
|
||||
|}
|
||||
@@ -302,9 +162,9 @@ let editMapping tagMapId : HttpHandler = fun next ctx -> task {
|
||||
| Some tm ->
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
csrf = csrfToken ctx
|
||||
model = EditTagMapModel.fromMapping tm
|
||||
page_title = if isNew then "Add Tag Mapping" else $"Mapping for {tm.tag} Tag"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = EditTagMapModel.fromMapping tm
|
||||
|}
|
||||
|> bareForTheme "admin" "tag-mapping-edit" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
@@ -337,6 +197,7 @@ let deleteMapping tagMapId : HttpHandler = fun next ctx -> task {
|
||||
|
||||
// -- THEMES --
|
||||
|
||||
open System
|
||||
open System.IO
|
||||
open System.IO.Compression
|
||||
open System.Text.RegularExpressions
|
||||
@@ -346,8 +207,8 @@ open MyWebLog.Data
|
||||
let themeUpdatePage : HttpHandler = fun next ctx -> task {
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
csrf = csrfToken ctx
|
||||
page_title = "Upload Theme"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
|}
|
||||
|> viewForTheme "admin" "upload-theme" next ctx
|
||||
}
|
||||
@@ -442,13 +303,13 @@ let updateTheme : HttpHandler = fun next ctx -> task {
|
||||
do! ThemeAssetCache.refreshTheme (ThemeId themeName) data
|
||||
TemplateCache.invalidateTheme themeName
|
||||
do! addMessage ctx { UserMessage.success with message = "Theme updated successfully" }
|
||||
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/dashboard")) next ctx
|
||||
return! redirectToGet "admin/dashboard" next ctx
|
||||
| Ok _ ->
|
||||
do! addMessage ctx { UserMessage.error with message = "You may not replace the admin theme" }
|
||||
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/theme/update")) next ctx
|
||||
return! redirectToGet "admin/theme/update" next ctx
|
||||
| Error message ->
|
||||
do! addMessage ctx { UserMessage.error with message = message }
|
||||
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/theme/update")) next ctx
|
||||
return! redirectToGet "admin/theme/update" next ctx
|
||||
else
|
||||
return! RequestErrors.BAD_REQUEST "Bad request" next ctx
|
||||
}
|
||||
@@ -465,23 +326,26 @@ let settings : HttpHandler = fun next ctx -> task {
|
||||
let! themes = data.Theme.all ()
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
csrf = csrfToken ctx
|
||||
model = SettingsModel.fromWebLog webLog
|
||||
pages =
|
||||
seq {
|
||||
KeyValuePair.Create ("posts", "- First Page of Posts -")
|
||||
page_title = "Web Log Settings"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
web_log = webLog
|
||||
model = SettingsModel.fromWebLog webLog
|
||||
pages = seq
|
||||
{ KeyValuePair.Create ("posts", "- First Page of Posts -")
|
||||
yield! allPages
|
||||
|> List.sortBy (fun p -> p.title.ToLower ())
|
||||
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.id, p.title))
|
||||
}
|
||||
|> Array.ofSeq
|
||||
themes = themes
|
||||
|> Seq.ofList
|
||||
|> Seq.map (fun it ->
|
||||
KeyValuePair.Create (ThemeId.toString it.id, $"{it.name} (v{it.version})"))
|
||||
|> Array.ofSeq
|
||||
web_log = webLog
|
||||
page_title = "Web Log Settings"
|
||||
themes =
|
||||
themes
|
||||
|> Seq.ofList
|
||||
|> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.id, $"{it.name} (v{it.version})"))
|
||||
|> Array.ofSeq
|
||||
upload_values = [|
|
||||
KeyValuePair.Create (UploadDestination.toString Database, "Database")
|
||||
KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
|
||||
|]
|
||||
|}
|
||||
|> viewForTheme "admin" "settings" next ctx
|
||||
}
|
||||
@@ -493,13 +357,20 @@ let saveSettings : HttpHandler = fun next ctx -> task {
|
||||
let! model = ctx.BindFormAsync<SettingsModel> ()
|
||||
match! data.WebLog.findById webLog.id with
|
||||
| Some webLog ->
|
||||
let webLog = model.update webLog
|
||||
let oldSlug = webLog.slug
|
||||
let webLog = model.update webLog
|
||||
do! data.WebLog.updateSettings webLog
|
||||
|
||||
// Update cache
|
||||
WebLogCache.set webLog
|
||||
|
||||
if oldSlug <> webLog.slug then
|
||||
// Rename disk directory if it exists
|
||||
let uploadRoot = Path.Combine ("wwwroot", "upload")
|
||||
let oldDir = Path.Combine (uploadRoot, oldSlug)
|
||||
if Directory.Exists oldDir then Directory.Move (oldDir, Path.Combine (uploadRoot, webLog.slug))
|
||||
|
||||
do! addMessage ctx { UserMessage.success with message = "Web log settings saved successfully" }
|
||||
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings")) next ctx
|
||||
return! redirectToGet "admin/settings" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
@@ -2,21 +2,20 @@
|
||||
module MyWebLog.Handlers.Error
|
||||
|
||||
open System.Net
|
||||
open System.Threading.Tasks
|
||||
open Giraffe
|
||||
open Microsoft.AspNetCore.Http
|
||||
open MyWebLog
|
||||
|
||||
/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
|
||||
let notAuthorized : HttpHandler = fun next ctx -> task {
|
||||
if ctx.Request.Method = "GET" then
|
||||
let returnUrl = WebUtility.UrlEncode ctx.Request.Path
|
||||
return!
|
||||
redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink $"user/log-on?returnUrl={returnUrl}")) next ctx
|
||||
else
|
||||
return! (setStatusCode 401 >=> fun _ _ -> Task.FromResult<HttpContext option> None) next ctx
|
||||
}
|
||||
let notAuthorized : HttpHandler =
|
||||
handleContext (fun ctx ->
|
||||
if ctx.Request.Method = "GET" then
|
||||
let returnUrl = WebUtility.UrlEncode ctx.Request.Path
|
||||
redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink $"user/log-on?returnUrl={returnUrl}"))
|
||||
earlyReturn ctx
|
||||
else
|
||||
setStatusCode 401 earlyReturn ctx)
|
||||
|
||||
|
||||
/// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there
|
||||
let notFound : HttpHandler =
|
||||
setStatusCode 404 >=> text "Not found"
|
||||
let notFound : HttpHandler = fun _ ->
|
||||
(setStatusCode 404 >=> text "Not found") earlyReturn
|
||||
|
||||
@@ -2,6 +2,7 @@
|
||||
module MyWebLog.Handlers.Feed
|
||||
|
||||
open System
|
||||
open System.Collections.Generic
|
||||
open System.IO
|
||||
open System.Net
|
||||
open System.ServiceModel.Syndication
|
||||
@@ -129,17 +130,19 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[
|
||||
|> List.iter item.Categories.Add
|
||||
item
|
||||
|
||||
/// Convert non-absolute URLs to an absolute URL for this web log
|
||||
let toAbsolute webLog (link : string) =
|
||||
if link.StartsWith "http" then link else WebLog.absoluteUrl webLog (Permalink link)
|
||||
|
||||
/// Add episode information to a podcast feed item
|
||||
let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (post : Post) (item : SyndicationItem) =
|
||||
// Convert non-absolute URLs to an absolute URL for this web log
|
||||
let toAbsolute (link : string) = if link.StartsWith "http" then link else WebLog.absoluteUrl webLog (Permalink link)
|
||||
let epMediaUrl =
|
||||
match episode.media with
|
||||
| link when link.StartsWith "http" -> link
|
||||
| link when Option.isSome podcast.mediaBaseUrl -> $"{podcast.mediaBaseUrl.Value}{link}"
|
||||
| link -> WebLog.absoluteUrl webLog (Permalink link)
|
||||
let epMediaType = [ episode.mediaType; podcast.defaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
|
||||
let epImageUrl = defaultArg episode.imageUrl (Permalink.toString podcast.imageUrl) |> toAbsolute
|
||||
let epImageUrl = defaultArg episode.imageUrl (Permalink.toString podcast.imageUrl) |> toAbsolute webLog
|
||||
let epExplicit = defaultArg episode.explicit podcast.explicit |> ExplicitRating.toString
|
||||
|
||||
let xmlDoc = XmlDocument ()
|
||||
@@ -165,7 +168,7 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
|
||||
|
||||
match episode.chapterFile with
|
||||
| Some chapters ->
|
||||
let url = toAbsolute chapters
|
||||
let url = toAbsolute webLog chapters
|
||||
let typ =
|
||||
match episode.chapterType with
|
||||
| Some mime -> Some mime
|
||||
@@ -179,7 +182,7 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
|
||||
|
||||
match episode.transcriptUrl with
|
||||
| Some transcript ->
|
||||
let url = toAbsolute transcript
|
||||
let url = toAbsolute webLog transcript
|
||||
let elt = xmlDoc.CreateElement ("podcast", "transcript", Namespace.podcast)
|
||||
elt.SetAttribute ("url", url)
|
||||
elt.SetAttribute ("type", Option.get episode.transcriptType)
|
||||
@@ -301,6 +304,17 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
|
||||
rssFeed.ElementExtensions.Add ("author", Namespace.iTunes, podcast.displayedAuthor)
|
||||
rssFeed.ElementExtensions.Add ("explicit", Namespace.iTunes, ExplicitRating.toString podcast.explicit)
|
||||
podcast.subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub))
|
||||
podcast.fundingUrl
|
||||
|> Option.iter (fun url ->
|
||||
let funding = xmlDoc.CreateElement ("podcast", "funding", Namespace.podcast)
|
||||
funding.SetAttribute ("url", toAbsolute webLog url)
|
||||
funding.InnerText <- defaultArg podcast.fundingText "Support This Podcast"
|
||||
rssFeed.ElementExtensions.Add funding)
|
||||
podcast.guid
|
||||
|> Option.iter (fun guid ->
|
||||
rssFeed.ElementExtensions.Add ("guid", Namespace.podcast, guid.ToString().ToLowerInvariant ()))
|
||||
podcast.medium
|
||||
|> Option.iter (fun med -> rssFeed.ElementExtensions.Add ("medium", Namespace.podcast, PodcastMedium.toString med))
|
||||
|
||||
/// Get the feed's self reference and non-feed link
|
||||
let private selfAndLink webLog feedType ctx =
|
||||
@@ -368,7 +382,7 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
|
||||
setTitleAndDescription feedType webLog cats feed
|
||||
|
||||
feed.LastUpdatedTime <- (List.head posts).updatedOn |> DateTimeOffset
|
||||
feed.Generator <- generator ctx
|
||||
feed.Generator <- ctx.Generator
|
||||
feed.Items <- posts |> Seq.ofList |> Seq.map toItem
|
||||
feed.Language <- "en"
|
||||
feed.Id <- WebLog.absoluteUrl webLog link
|
||||
@@ -402,23 +416,23 @@ let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> bac
|
||||
|
||||
open DotLiquid
|
||||
|
||||
// GET: /admin/rss/settings
|
||||
// GET: /admin/settings/rss
|
||||
let editSettings : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
let feeds =
|
||||
webLog.rss.customFeeds
|
||||
|> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx))
|
||||
|> Array.ofList
|
||||
return! Hash.FromAnonymousObject
|
||||
{| csrf = csrfToken ctx
|
||||
return! Hash.FromAnonymousObject {|
|
||||
page_title = "RSS Settings"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = EditRssModel.fromRssOptions webLog.rss
|
||||
custom_feeds = feeds
|
||||
|}
|
||||
|> viewForTheme "admin" "rss-settings" next ctx
|
||||
}
|
||||
|
||||
// POST: /admin/rss/settings
|
||||
// POST: /admin/settings/rss
|
||||
let saveSettings : HttpHandler = fun next ctx -> task {
|
||||
let data = ctx.Data
|
||||
let! model = ctx.BindFormAsync<EditRssModel> ()
|
||||
@@ -428,11 +442,11 @@ let saveSettings : HttpHandler = fun next ctx -> task {
|
||||
do! data.WebLog.updateRssOptions webLog
|
||||
WebLogCache.set webLog
|
||||
do! addMessage ctx { UserMessage.success with message = "RSS settings updated successfully" }
|
||||
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings/rss")) next ctx
|
||||
return! redirectToGet "admin/settings/rss" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// GET: /admin/rss/{id}/edit
|
||||
// GET: /admin/settings/rss/{id}/edit
|
||||
let editCustomFeed feedId : HttpHandler = fun next ctx -> task {
|
||||
let customFeed =
|
||||
match feedId with
|
||||
@@ -440,17 +454,27 @@ let editCustomFeed feedId : HttpHandler = fun next ctx -> task {
|
||||
| _ -> ctx.WebLog.rss.customFeeds |> List.tryFind (fun f -> f.id = CustomFeedId feedId)
|
||||
match customFeed with
|
||||
| Some f ->
|
||||
return! Hash.FromAnonymousObject
|
||||
{| csrf = csrfToken ctx
|
||||
page_title = $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
|
||||
model = EditCustomFeedModel.fromFeed f
|
||||
categories = CategoryCache.get ctx
|
||||
return! Hash.FromAnonymousObject {|
|
||||
page_title = $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = EditCustomFeedModel.fromFeed f
|
||||
categories = CategoryCache.get ctx
|
||||
medium_values = [|
|
||||
KeyValuePair.Create ("", "– Unspecified –")
|
||||
KeyValuePair.Create (PodcastMedium.toString Podcast, "Podcast")
|
||||
KeyValuePair.Create (PodcastMedium.toString Music, "Music")
|
||||
KeyValuePair.Create (PodcastMedium.toString Video, "Video")
|
||||
KeyValuePair.Create (PodcastMedium.toString Film, "Film")
|
||||
KeyValuePair.Create (PodcastMedium.toString Audiobook, "Audiobook")
|
||||
KeyValuePair.Create (PodcastMedium.toString Newsletter, "Newsletter")
|
||||
KeyValuePair.Create (PodcastMedium.toString Blog, "Blog")
|
||||
|]
|
||||
|}
|
||||
|> viewForTheme "admin" "custom-feed-edit" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// POST: /admin/rss/save
|
||||
// POST: /admin/settings/rss/save
|
||||
let saveCustomFeed : HttpHandler = fun next ctx -> task {
|
||||
let data = ctx.Data
|
||||
match! data.WebLog.findById ctx.WebLog.id with
|
||||
@@ -470,13 +494,12 @@ let saveCustomFeed : HttpHandler = fun next ctx -> task {
|
||||
UserMessage.success with
|
||||
message = $"""Successfully {if model.id = "new" then "add" else "sav"}ed custom feed"""
|
||||
}
|
||||
let nextUrl = $"admin/settings/rss/{CustomFeedId.toString feed.id}/edit"
|
||||
return! redirectToGet (WebLog.relativeUrl webLog (Permalink nextUrl)) next ctx
|
||||
return! redirectToGet $"admin/settings/rss/{CustomFeedId.toString feed.id}/edit" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// POST /admin/rss/{id}/delete
|
||||
// POST /admin/settings/rss/{id}/delete
|
||||
let deleteCustomFeed feedId : HttpHandler = fun next ctx -> task {
|
||||
let data = ctx.Data
|
||||
match! data.WebLog.findById ctx.WebLog.id with
|
||||
@@ -495,6 +518,6 @@ let deleteCustomFeed feedId : HttpHandler = fun next ctx -> task {
|
||||
do! addMessage ctx { UserMessage.success with message = "Custom feed deleted successfully" }
|
||||
else
|
||||
do! addMessage ctx { UserMessage.warning with message = "Custom feed not found; no action taken" }
|
||||
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings/rss")) next ctx
|
||||
return! redirectToGet "admin/settings/rss" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
@@ -52,24 +52,6 @@ let messages (ctx : HttpContext) = task {
|
||||
| None -> return [||]
|
||||
}
|
||||
|
||||
/// Hold variable for the configured generator string
|
||||
let mutable private generatorString : string option = None
|
||||
|
||||
open Microsoft.Extensions.Configuration
|
||||
open Microsoft.Extensions.DependencyInjection
|
||||
|
||||
/// Get the generator string
|
||||
let generator (ctx : HttpContext) =
|
||||
match generatorString with
|
||||
| Some gen -> gen
|
||||
| None ->
|
||||
let cfg = ctx.RequestServices.GetRequiredService<IConfiguration> ()
|
||||
generatorString <-
|
||||
match Option.ofObj cfg["Generator"] with
|
||||
| Some gen -> Some gen
|
||||
| None -> Some "generator not configured"
|
||||
generatorString.Value
|
||||
|
||||
open MyWebLog
|
||||
open DotLiquid
|
||||
|
||||
@@ -94,14 +76,14 @@ let private populateHash hash ctx = task {
|
||||
hash.Add ("page_list", PageListCache.get ctx)
|
||||
hash.Add ("current_page", ctx.Request.Path.Value.Substring 1)
|
||||
hash.Add ("messages", messages)
|
||||
hash.Add ("generator", generator ctx)
|
||||
hash.Add ("generator", ctx.Generator)
|
||||
hash.Add ("htmx_script", htmxScript)
|
||||
|
||||
do! commitSession ctx
|
||||
}
|
||||
|
||||
/// Render a view for the specified theme, using the specified template, layout, and hash
|
||||
let viewForTheme theme template next ctx = fun (hash : Hash) -> task {
|
||||
let viewForTheme theme template next ctx (hash : Hash) = task {
|
||||
do! populateHash hash ctx
|
||||
|
||||
// NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render;
|
||||
@@ -119,13 +101,14 @@ let viewForTheme theme template next ctx = fun (hash : Hash) -> task {
|
||||
}
|
||||
|
||||
/// Render a bare view for the specified theme, using the specified template and hash
|
||||
let bareForTheme theme template next ctx = fun (hash : Hash) -> task {
|
||||
let bareForTheme theme template next ctx (hash : Hash) = task {
|
||||
do! populateHash hash ctx
|
||||
|
||||
// Bare templates are rendered with layout-bare
|
||||
let! contentTemplate = TemplateCache.get theme template ctx.Data
|
||||
hash.Add ("content", contentTemplate.Render hash)
|
||||
if not (hash.ContainsKey "content") then
|
||||
let! contentTemplate = TemplateCache.get theme template ctx.Data
|
||||
hash.Add ("content", contentTemplate.Render hash)
|
||||
|
||||
// Bare templates are rendered with layout-bare
|
||||
let! layoutTemplate = TemplateCache.get theme "layout-bare" ctx.Data
|
||||
|
||||
// add messages as HTTP headers
|
||||
@@ -138,7 +121,7 @@ let bareForTheme theme template next ctx = fun (hash : Hash) -> task {
|
||||
| Some detail -> $"{m.level}|||{m.message}|||{detail}"
|
||||
| None -> $"{m.level}|||{m.message}"
|
||||
|> setHttpHeader "X-Message")
|
||||
withHxNoPush
|
||||
withHxNoPushUrl
|
||||
htmlString (layoutTemplate.Render hash)
|
||||
}
|
||||
|
||||
@@ -146,36 +129,21 @@ let bareForTheme theme template next ctx = fun (hash : Hash) -> task {
|
||||
}
|
||||
|
||||
/// Return a view for the web log's default theme
|
||||
let themedView template next ctx = fun (hash : Hash) -> task {
|
||||
return! viewForTheme (deriveWebLogFromHash hash ctx).themePath template next ctx hash
|
||||
}
|
||||
let themedView template next ctx hash =
|
||||
viewForTheme (deriveWebLogFromHash hash ctx).themePath template next ctx hash
|
||||
|
||||
|
||||
/// Redirect after doing some action; commits session and issues a temporary redirect
|
||||
let redirectToGet url : HttpHandler = fun next ctx -> task {
|
||||
let redirectToGet url : HttpHandler = fun _ ctx -> task {
|
||||
do! commitSession ctx
|
||||
return! redirectTo false url next ctx
|
||||
return! redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink url)) earlyReturn ctx
|
||||
}
|
||||
|
||||
open System.Security.Claims
|
||||
|
||||
/// Get the user ID for the current request
|
||||
let userId (ctx : HttpContext) =
|
||||
WebLogUserId (ctx.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value
|
||||
|
||||
open Microsoft.AspNetCore.Antiforgery
|
||||
|
||||
/// Get the Anti-CSRF service
|
||||
let private antiForgery (ctx : HttpContext) = ctx.RequestServices.GetRequiredService<IAntiforgery> ()
|
||||
|
||||
/// Get the cross-site request forgery token set
|
||||
let csrfToken (ctx : HttpContext) =
|
||||
(antiForgery ctx).GetAndStoreTokens ctx
|
||||
|
||||
/// Validate the cross-site request forgery token in the current request
|
||||
let validateCsrf : HttpHandler = fun next ctx -> task {
|
||||
match! (antiForgery ctx).IsRequestValidAsync ctx with
|
||||
match! ctx.AntiForgery.IsRequestValidAsync ctx with
|
||||
| true -> return! next ctx
|
||||
| false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" next ctx
|
||||
| false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" earlyReturn ctx
|
||||
}
|
||||
|
||||
/// Require a user to be logged on
|
||||
@@ -226,6 +194,14 @@ let getCategoryIds slug ctx =
|
||||
|> Seq.map (fun c -> CategoryId c.id)
|
||||
|> List.ofSeq
|
||||
|
||||
open System
|
||||
open System.Globalization
|
||||
|
||||
/// Parse a date/time to UTC
|
||||
let parseToUtc (date : string) =
|
||||
DateTime.Parse (date, null, DateTimeStyles.AdjustToUniversal)
|
||||
|
||||
open Microsoft.Extensions.DependencyInjection
|
||||
open Microsoft.Extensions.Logging
|
||||
|
||||
/// Log level for debugging
|
||||
|
||||
221
src/MyWebLog/Handlers/Page.fs
Normal file
221
src/MyWebLog/Handlers/Page.fs
Normal 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
|
||||
}
|
||||
@@ -198,9 +198,9 @@ let home : HttpHandler = fun next ctx -> task {
|
||||
| Some page ->
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
page_title = page.title
|
||||
page = DisplayPage.fromPage webLog page
|
||||
categories = CategoryCache.get ctx
|
||||
page_title = page.title
|
||||
is_home = true
|
||||
|}
|
||||
|> themedView (defaultArg page.template "single-page") next ctx
|
||||
@@ -215,7 +215,7 @@ let all pageNbr : HttpHandler = fun next ctx -> task {
|
||||
let! posts = data.Post.findPageOfPosts webLog.id pageNbr 25
|
||||
let! hash = preparePostList webLog posts AdminList "" pageNbr 25 ctx data
|
||||
hash.Add ("page_title", "Posts")
|
||||
hash.Add ("csrf", csrfToken ctx)
|
||||
hash.Add ("csrf", ctx.CsrfTokenSet)
|
||||
return! viewForTheme "admin" "post-list" next ctx hash
|
||||
}
|
||||
|
||||
@@ -238,11 +238,11 @@ let edit postId : HttpHandler = fun next ctx -> task {
|
||||
let model = EditPostModel.fromPost webLog post
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
csrf = csrfToken ctx
|
||||
page_title = title
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = model
|
||||
metadata = Array.zip model.metaNames model.metaValues
|
||||
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
|
||||
page_title = title
|
||||
templates = templates
|
||||
categories = cats
|
||||
explicit_values = [|
|
||||
@@ -256,15 +256,24 @@ let edit postId : HttpHandler = fun next ctx -> task {
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// POST /admin/post/{id}/delete
|
||||
let delete postId : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
match! ctx.Data.Post.delete (PostId postId) webLog.id with
|
||||
| true -> do! addMessage ctx { UserMessage.success with message = "Post deleted successfully" }
|
||||
| false -> do! addMessage ctx { UserMessage.error with message = "Post not found; nothing deleted" }
|
||||
return! redirectToGet "admin/posts" next ctx
|
||||
}
|
||||
|
||||
// GET /admin/post/{id}/permalinks
|
||||
let editPermalinks postId : HttpHandler = fun next ctx -> task {
|
||||
match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with
|
||||
| Some post ->
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
csrf = csrfToken ctx
|
||||
page_title = "Manage Prior Permalinks"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = ManagePermalinksModel.fromPost post
|
||||
page_title = $"Manage Prior Permalinks"
|
||||
|}
|
||||
|> viewForTheme "admin" "permalinks" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
@@ -278,17 +287,83 @@ let savePermalinks : HttpHandler = fun next ctx -> task {
|
||||
match! ctx.Data.Post.updatePriorPermalinks (PostId model.id) webLog.id links with
|
||||
| true ->
|
||||
do! addMessage ctx { UserMessage.success with message = "Post permalinks saved successfully" }
|
||||
return! redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{model.id}/permalinks")) next ctx
|
||||
return! redirectToGet $"admin/post/{model.id}/permalinks" next ctx
|
||||
| false -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// POST /admin/post/{id}/delete
|
||||
let delete postId : HttpHandler = fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
match! ctx.Data.Post.delete (PostId postId) webLog.id with
|
||||
| true -> do! addMessage ctx { UserMessage.success with message = "Post deleted successfully" }
|
||||
| false -> do! addMessage ctx { UserMessage.error with message = "Post not found; nothing deleted" }
|
||||
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/posts")) next ctx
|
||||
// GET /admin/post/{id}/revisions
|
||||
let editRevisions postId : HttpHandler = fun next ctx -> task {
|
||||
match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with
|
||||
| Some post ->
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
page_title = "Manage Post Revisions"
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = ManageRevisionsModel.fromPost ctx.WebLog post
|
||||
|}
|
||||
|> viewForTheme "admin" "revisions" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// GET /admin/post/{id}/revisions/purge
|
||||
let purgeRevisions postId : HttpHandler = fun next ctx -> task {
|
||||
let data = ctx.Data
|
||||
match! data.Post.findFullById (PostId postId) ctx.WebLog.id with
|
||||
| Some post ->
|
||||
do! data.Post.update { post with revisions = [ List.head post.revisions ] }
|
||||
do! addMessage ctx { UserMessage.success with message = "Prior revisions purged successfully" }
|
||||
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
open Microsoft.AspNetCore.Http
|
||||
|
||||
/// Find the post and the requested revision
|
||||
let private findPostRevision postId revDate (ctx : HttpContext) = task {
|
||||
match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with
|
||||
| Some post ->
|
||||
let asOf = parseToUtc revDate
|
||||
return Some post, post.revisions |> List.tryFind (fun r -> r.asOf = asOf)
|
||||
| None -> return None, None
|
||||
}
|
||||
|
||||
// GET /admin/post/{id}/revision/{revision-date}/preview
|
||||
let previewRevision (postId, revDate) : HttpHandler = fun next ctx -> task {
|
||||
match! findPostRevision postId revDate ctx with
|
||||
| Some _, Some rev ->
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.text}</div>"""
|
||||
|}
|
||||
|> bareForTheme "admin" "" next ctx
|
||||
| None, _
|
||||
| _, None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// POST /admin/post/{id}/revision/{revision-date}/restore
|
||||
let restoreRevision (postId, revDate) : HttpHandler = fun next ctx -> task {
|
||||
match! findPostRevision postId revDate ctx with
|
||||
| Some post, Some rev ->
|
||||
do! ctx.Data.Post.update
|
||||
{ post with
|
||||
revisions = { rev with asOf = DateTime.UtcNow }
|
||||
:: (post.revisions |> List.filter (fun r -> r.asOf <> rev.asOf))
|
||||
}
|
||||
do! addMessage ctx { UserMessage.success with message = "Revision restored successfully" }
|
||||
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
|
||||
| None, _
|
||||
| _, None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// POST /admin/post/{id}/revision/{revision-date}/delete
|
||||
let deleteRevision (postId, revDate) : HttpHandler = fun next ctx -> task {
|
||||
match! findPostRevision postId revDate ctx with
|
||||
| Some post, Some rev ->
|
||||
do! ctx.Data.Post.update { post with revisions = post.revisions |> List.filter (fun r -> r.asOf <> rev.asOf) }
|
||||
do! addMessage ctx { UserMessage.success with message = "Revision deleted successfully" }
|
||||
return! bareForTheme "admin" "" next ctx (Hash.FromAnonymousObject {| content = "" |})
|
||||
| None, _
|
||||
| _, None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
#nowarn "3511"
|
||||
@@ -306,7 +381,7 @@ let save : HttpHandler = fun next ctx -> task {
|
||||
{ Post.empty with
|
||||
id = PostId.create ()
|
||||
webLogId = webLog.id
|
||||
authorId = userId ctx
|
||||
authorId = ctx.UserId
|
||||
}
|
||||
| postId -> return! data.Post.findFullById (PostId postId) webLog.id
|
||||
}
|
||||
@@ -323,7 +398,7 @@ let save : HttpHandler = fun next ctx -> task {
|
||||
let post =
|
||||
match model.setPublished with
|
||||
| true ->
|
||||
let dt = WebLog.utcTime webLog model.pubOverride.Value
|
||||
let dt = parseToUtc (model.pubOverride.Value.ToString "o")
|
||||
match model.setUpdated with
|
||||
| true ->
|
||||
{ post with
|
||||
@@ -342,7 +417,6 @@ let save : HttpHandler = fun next ctx -> task {
|
||||
|> List.length = List.length pst.Value.categoryIds) then
|
||||
do! CategoryCache.update ctx
|
||||
do! addMessage ctx { UserMessage.success with message = "Post saved successfully" }
|
||||
return!
|
||||
redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{PostId.toString post.id}/edit")) next ctx
|
||||
return! redirectToGet $"admin/post/{PostId.toString post.id}/edit" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
@@ -29,7 +29,7 @@ module CatchAll =
|
||||
// Current post
|
||||
match data.Post.findByPermalink permalink webLog.id |> await with
|
||||
| Some post ->
|
||||
debug (fun () -> $"Found post by permalink")
|
||||
debug (fun () -> "Found post by permalink")
|
||||
let model = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 ctx data |> await
|
||||
model.Add ("page_title", post.title)
|
||||
yield fun next ctx -> themedView (defaultArg post.template "single-post") next ctx model
|
||||
@@ -37,12 +37,12 @@ module CatchAll =
|
||||
// Current page
|
||||
match data.Page.findByPermalink permalink webLog.id |> await with
|
||||
| Some page ->
|
||||
debug (fun () -> $"Found page by permalink")
|
||||
debug (fun () -> "Found page by permalink")
|
||||
yield fun next ctx ->
|
||||
Hash.FromAnonymousObject {|
|
||||
page_title = page.title
|
||||
page = DisplayPage.fromPage webLog page
|
||||
categories = CategoryCache.get ctx
|
||||
page_title = page.title
|
||||
is_page = true
|
||||
|}
|
||||
|> themedView (defaultArg page.template "single-page") next ctx
|
||||
@@ -50,7 +50,7 @@ module CatchAll =
|
||||
// RSS feed
|
||||
match Feed.deriveFeedType ctx textLink with
|
||||
| Some (feedType, postCount) ->
|
||||
debug (fun () -> $"Found RSS feed")
|
||||
debug (fun () -> "Found RSS feed")
|
||||
yield Feed.generate feedType postCount
|
||||
| None -> ()
|
||||
// Post differing only by trailing slash
|
||||
@@ -58,28 +58,28 @@ module CatchAll =
|
||||
Permalink (if textLink.EndsWith "/" then textLink[1..textLink.Length - 2] else $"{textLink[1..]}/")
|
||||
match data.Post.findByPermalink altLink webLog.id |> await with
|
||||
| Some post ->
|
||||
debug (fun () -> $"Found post by trailing-slash-agnostic permalink")
|
||||
debug (fun () -> "Found post by trailing-slash-agnostic permalink")
|
||||
yield redirectTo true (WebLog.relativeUrl webLog post.permalink)
|
||||
| None -> ()
|
||||
// Page differing only by trailing slash
|
||||
match data.Page.findByPermalink altLink webLog.id |> await with
|
||||
| Some page ->
|
||||
debug (fun () -> $"Found page by trailing-slash-agnostic permalink")
|
||||
debug (fun () -> "Found page by trailing-slash-agnostic permalink")
|
||||
yield redirectTo true (WebLog.relativeUrl webLog page.permalink)
|
||||
| None -> ()
|
||||
// Prior post
|
||||
match data.Post.findCurrentPermalink [ permalink; altLink ] webLog.id |> await with
|
||||
| Some link ->
|
||||
debug (fun () -> $"Found post by prior permalink")
|
||||
debug (fun () -> "Found post by prior permalink")
|
||||
yield redirectTo true (WebLog.relativeUrl webLog link)
|
||||
| None -> ()
|
||||
// Prior page
|
||||
match data.Page.findCurrentPermalink [ permalink; altLink ] webLog.id |> await with
|
||||
| Some link ->
|
||||
debug (fun () -> $"Found page by prior permalink")
|
||||
debug (fun () -> "Found page by prior permalink")
|
||||
yield redirectTo true (WebLog.relativeUrl webLog link)
|
||||
| None -> ()
|
||||
debug (fun () -> $"No content found")
|
||||
debug (fun () -> "No content found")
|
||||
}
|
||||
|
||||
// GET {all-of-the-above}
|
||||
@@ -93,55 +93,25 @@ module CatchAll =
|
||||
/// Serve theme assets
|
||||
module Asset =
|
||||
|
||||
open System
|
||||
open Microsoft.AspNetCore.Http.Headers
|
||||
open Microsoft.AspNetCore.StaticFiles
|
||||
open Microsoft.Net.Http.Headers
|
||||
|
||||
/// Determine if the asset has been modified since the date/time specified by the If-Modified-Since header
|
||||
let private checkModified asset (ctx : HttpContext) : HttpHandler option =
|
||||
match ctx.Request.Headers.IfModifiedSince with
|
||||
| it when it.Count < 1 -> None
|
||||
| it ->
|
||||
if asset.updatedOn > DateTime.Parse it[0] then
|
||||
None
|
||||
else
|
||||
Some (setStatusCode 304 >=> setBodyFromString "Not Modified")
|
||||
|
||||
/// An instance of ASP.NET Core's file extension to MIME type converter
|
||||
let private mimeMap = FileExtensionContentTypeProvider ()
|
||||
|
||||
// GET /theme/{theme}/{**path}
|
||||
let serveAsset (urlParts : string seq) : HttpHandler = fun next ctx -> task {
|
||||
let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
|
||||
let path = urlParts |> Seq.skip 1 |> Seq.head
|
||||
match! ctx.Data.ThemeAsset.findById (ThemeAssetId.ofString path) with
|
||||
| Some asset ->
|
||||
match checkModified asset ctx with
|
||||
match Upload.checkModified asset.updatedOn ctx with
|
||||
| Some threeOhFour -> return! threeOhFour next ctx
|
||||
| None ->
|
||||
let mimeType =
|
||||
match mimeMap.TryGetContentType path with
|
||||
| true, typ -> typ
|
||||
| false, _ -> "application/octet-stream"
|
||||
let headers = ResponseHeaders ctx.Response.Headers
|
||||
headers.LastModified <- Some (DateTimeOffset asset.updatedOn) |> Option.toNullable
|
||||
headers.ContentType <- MediaTypeHeaderValue mimeType
|
||||
headers.CacheControl <-
|
||||
let hdr = CacheControlHeaderValue()
|
||||
hdr.MaxAge <- Some (TimeSpan.FromDays 30) |> Option.toNullable
|
||||
hdr
|
||||
return! setBody asset.data next ctx
|
||||
| None -> return! Upload.sendFile asset.updatedOn path asset.data next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
|
||||
/// The primary myWebLog router
|
||||
let router : HttpHandler = choose [
|
||||
GET >=> choose [
|
||||
GET_HEAD >=> choose [
|
||||
route "/" >=> Post.home
|
||||
]
|
||||
subRoute "/admin" (requireUser >=> choose [
|
||||
GET >=> choose [
|
||||
GET_HEAD >=> choose [
|
||||
subRoute "/categor" (choose [
|
||||
route "ies" >=> Admin.listCategories
|
||||
route "ies/bare" >=> Admin.listCategoriesBare
|
||||
@@ -149,16 +119,20 @@ let router : HttpHandler = choose [
|
||||
])
|
||||
route "/dashboard" >=> Admin.dashboard
|
||||
subRoute "/page" (choose [
|
||||
route "s" >=> Admin.listPages 1
|
||||
routef "s/page/%i" Admin.listPages
|
||||
routef "/%s/edit" Admin.editPage
|
||||
routef "/%s/permalinks" Admin.editPagePermalinks
|
||||
route "s" >=> Page.all 1
|
||||
routef "s/page/%i" Page.all
|
||||
routef "/%s/edit" Page.edit
|
||||
routef "/%s/permalinks" Page.editPermalinks
|
||||
routef "/%s/revision/%s/preview" Page.previewRevision
|
||||
routef "/%s/revisions" Page.editRevisions
|
||||
])
|
||||
subRoute "/post" (choose [
|
||||
route "s" >=> Post.all 1
|
||||
routef "s/page/%i" Post.all
|
||||
routef "/%s/edit" Post.edit
|
||||
routef "/%s/permalinks" Post.editPermalinks
|
||||
route "s" >=> Post.all 1
|
||||
routef "s/page/%i" Post.all
|
||||
routef "/%s/edit" Post.edit
|
||||
routef "/%s/permalinks" Post.editPermalinks
|
||||
routef "/%s/revision/%s/preview" Post.previewRevision
|
||||
routef "/%s/revisions" Post.editRevisions
|
||||
])
|
||||
subRoute "/settings" (choose [
|
||||
route "" >=> Admin.settings
|
||||
@@ -173,6 +147,10 @@ let router : HttpHandler = choose [
|
||||
])
|
||||
])
|
||||
route "/theme/update" >=> Admin.themeUpdatePage
|
||||
subRoute "/upload" (choose [
|
||||
route "s" >=> Upload.list
|
||||
route "/new" >=> Upload.showNew
|
||||
])
|
||||
route "/user/edit" >=> User.edit
|
||||
]
|
||||
POST >=> validateCsrf >=> choose [
|
||||
@@ -181,14 +159,20 @@ let router : HttpHandler = choose [
|
||||
routef "/%s/delete" Admin.deleteCategory
|
||||
])
|
||||
subRoute "/page" (choose [
|
||||
route "/save" >=> Admin.savePage
|
||||
route "/permalinks" >=> Admin.savePagePermalinks
|
||||
routef "/%s/delete" Admin.deletePage
|
||||
route "/save" >=> Page.save
|
||||
route "/permalinks" >=> Page.savePermalinks
|
||||
routef "/%s/delete" Page.delete
|
||||
routef "/%s/revision/%s/delete" Page.deleteRevision
|
||||
routef "/%s/revision/%s/restore" Page.restoreRevision
|
||||
routef "/%s/revisions/purge" Page.purgeRevisions
|
||||
])
|
||||
subRoute "/post" (choose [
|
||||
route "/save" >=> Post.save
|
||||
route "/permalinks" >=> Post.savePermalinks
|
||||
routef "/%s/delete" Post.delete
|
||||
route "/save" >=> Post.save
|
||||
route "/permalinks" >=> Post.savePermalinks
|
||||
routef "/%s/delete" Post.delete
|
||||
routef "/%s/revision/%s/delete" Post.deleteRevision
|
||||
routef "/%s/revision/%s/restore" Post.restoreRevision
|
||||
routef "/%s/revisions/purge" Post.purgeRevisions
|
||||
])
|
||||
subRoute "/settings" (choose [
|
||||
route "" >=> Admin.saveSettings
|
||||
@@ -203,6 +187,11 @@ let router : HttpHandler = choose [
|
||||
])
|
||||
])
|
||||
route "/theme/update" >=> Admin.updateTheme
|
||||
subRoute "/upload" (choose [
|
||||
route "/save" >=> Upload.save
|
||||
routexp "/delete/(.*)" Upload.deleteFromDisk
|
||||
routef "/%s/delete" Upload.deleteFromDb
|
||||
])
|
||||
route "/user/save" >=> User.save
|
||||
]
|
||||
])
|
||||
@@ -210,7 +199,8 @@ let router : HttpHandler = choose [
|
||||
GET_HEAD >=> routef "/page/%i" Post.pageOfPosts
|
||||
GET_HEAD >=> routef "/page/%i/" Post.redirectToPageOfPosts
|
||||
GET_HEAD >=> routexp "/tag/(.*)" Post.pageOfTaggedPosts
|
||||
GET_HEAD >=> routexp "/themes/(.*)" Asset.serveAsset
|
||||
GET_HEAD >=> routexp "/themes/(.*)" Asset.serve
|
||||
GET_HEAD >=> routexp "/upload/(.*)" Upload.serve
|
||||
subRoute "/user" (choose [
|
||||
GET_HEAD >=> choose [
|
||||
route "/log-on" >=> User.logOn None
|
||||
|
||||
214
src/MyWebLog/Handlers/Upload.fs
Normal file
214
src/MyWebLog/Handlers/Upload.fs
Normal 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
|
||||
}
|
||||
@@ -13,6 +13,7 @@ let hashedPassword (plainText : string) (email : string) (salt : Guid) =
|
||||
|
||||
open DotLiquid
|
||||
open Giraffe
|
||||
open MyWebLog
|
||||
open MyWebLog.ViewModels
|
||||
|
||||
// GET /user/log-on
|
||||
@@ -26,9 +27,9 @@ let logOn returnUrl : HttpHandler = fun next ctx -> task {
|
||||
| false -> None
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
model = { LogOnModel.empty with returnTo = returnTo }
|
||||
page_title = "Log On"
|
||||
csrf = csrfToken ctx
|
||||
csrf = ctx.CsrfTokenSet
|
||||
model = { LogOnModel.empty with returnTo = returnTo }
|
||||
|}
|
||||
|> viewForTheme "admin" "log-on" next ctx
|
||||
}
|
||||
@@ -36,13 +37,11 @@ let logOn returnUrl : HttpHandler = fun next ctx -> task {
|
||||
open System.Security.Claims
|
||||
open Microsoft.AspNetCore.Authentication
|
||||
open Microsoft.AspNetCore.Authentication.Cookies
|
||||
open MyWebLog
|
||||
|
||||
// POST /user/log-on
|
||||
let doLogOn : HttpHandler = fun next ctx -> task {
|
||||
let! model = ctx.BindFormAsync<LogOnModel> ()
|
||||
let webLog = ctx.WebLog
|
||||
match! ctx.Data.WebLogUser.findByEmail model.emailAddress webLog.id with
|
||||
let! model = ctx.BindFormAsync<LogOnModel> ()
|
||||
match! ctx.Data.WebLogUser.findByEmail model.emailAddress ctx.WebLog.id with
|
||||
| Some user when user.passwordHash = hashedPassword model.password user.userName user.salt ->
|
||||
let claims = seq {
|
||||
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.id)
|
||||
@@ -55,9 +54,8 @@ let doLogOn : HttpHandler = fun next ctx -> task {
|
||||
do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity,
|
||||
AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow))
|
||||
do! addMessage ctx
|
||||
{ UserMessage.success with message = $"Logged on successfully | Welcome to {webLog.name}!" }
|
||||
return! redirectToGet (defaultArg model.returnTo (WebLog.relativeUrl webLog (Permalink "admin/dashboard")))
|
||||
next ctx
|
||||
{ UserMessage.success with message = $"Logged on successfully | Welcome to {ctx.WebLog.name}!" }
|
||||
return! redirectToGet (defaultArg (model.returnTo |> Option.map (fun it -> it[1..])) "admin/dashboard") next ctx
|
||||
| _ ->
|
||||
do! addMessage ctx { UserMessage.error with message = "Log on attempt unsuccessful" }
|
||||
return! logOn model.returnTo next ctx
|
||||
@@ -67,19 +65,19 @@ let doLogOn : HttpHandler = fun next ctx -> task {
|
||||
let logOff : HttpHandler = fun next ctx -> task {
|
||||
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
|
||||
do! addMessage ctx { UserMessage.info with message = "Log off successful" }
|
||||
return! redirectToGet (WebLog.relativeUrl ctx.WebLog Permalink.empty) next ctx
|
||||
return! redirectToGet "" next ctx
|
||||
}
|
||||
|
||||
/// Display the user edit page, with information possibly filled in
|
||||
let private showEdit (hash : Hash) : HttpHandler = fun next ctx -> task {
|
||||
hash.Add ("page_title", "Edit Your Information")
|
||||
hash.Add ("csrf", csrfToken ctx)
|
||||
hash.Add ("csrf", ctx.CsrfTokenSet)
|
||||
return! viewForTheme "admin" "user-edit" next ctx hash
|
||||
}
|
||||
|
||||
// GET /admin/user/edit
|
||||
let edit : HttpHandler = fun next ctx -> task {
|
||||
match! ctx.Data.WebLogUser.findById (userId ctx) ctx.WebLog.id with
|
||||
match! ctx.Data.WebLogUser.findById ctx.UserId ctx.WebLog.id with
|
||||
| Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
@@ -89,7 +87,7 @@ let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|
||||
let! model = ctx.BindFormAsync<EditUserModel> ()
|
||||
if model.newPassword = model.newPasswordConfirm then
|
||||
let data = ctx.Data
|
||||
match! data.WebLogUser.findById (userId ctx) ctx.WebLog.id with
|
||||
match! data.WebLogUser.findById ctx.UserId ctx.WebLog.id with
|
||||
| Some user ->
|
||||
let pw, salt =
|
||||
if model.newPassword = "" then
|
||||
@@ -108,7 +106,7 @@ let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
|
||||
do! data.WebLogUser.update user
|
||||
let pwMsg = if model.newPassword = "" then "" else " and updated your password"
|
||||
do! addMessage ctx { UserMessage.success with message = $"Saved your information{pwMsg} successfully" }
|
||||
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/user/edit")) next ctx
|
||||
return! redirectToGet "admin/user/edit" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
else
|
||||
do! addMessage ctx { UserMessage.error with message = "Passwords did not match; no updates made" }
|
||||
|
||||
@@ -23,11 +23,13 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
|
||||
let webLogId = WebLogId.create ()
|
||||
let userId = WebLogUserId.create ()
|
||||
let homePageId = PageId.create ()
|
||||
let slug = Handlers.Upload.makeSlug args[2]
|
||||
|
||||
do! data.WebLog.add
|
||||
{ WebLog.empty with
|
||||
id = webLogId
|
||||
name = args[2]
|
||||
slug = slug
|
||||
urlBase = args[1]
|
||||
defaultPage = PageId.toString homePageId
|
||||
timeZone = timeZone
|
||||
@@ -162,13 +164,48 @@ module Backup =
|
||||
}
|
||||
|
||||
/// Create a theme asset from an encoded theme asset
|
||||
static member fromAsset (asset : EncodedAsset) : ThemeAsset =
|
||||
{ id = asset.id
|
||||
updatedOn = asset.updatedOn
|
||||
data = Convert.FromBase64String asset.data
|
||||
static member fromEncoded (encoded : EncodedAsset) : ThemeAsset =
|
||||
{ id = encoded.id
|
||||
updatedOn = encoded.updatedOn
|
||||
data = Convert.FromBase64String encoded.data
|
||||
}
|
||||
|
||||
/// An uploaded file, with the data base-64 encoded
|
||||
type EncodedUpload =
|
||||
{ /// The ID of the upload
|
||||
id : UploadId
|
||||
|
||||
/// The ID of the web log to which the upload belongs
|
||||
webLogId : WebLogId
|
||||
|
||||
/// The path at which this upload is served
|
||||
path : Permalink
|
||||
|
||||
/// The date/time this upload was last updated (file time)
|
||||
updatedOn : DateTime
|
||||
|
||||
/// The data for the upload, base-64 encoded
|
||||
data : string
|
||||
}
|
||||
|
||||
/// Create an encoded uploaded file from the original uploaded file
|
||||
static member fromUpload (upload : Upload) : EncodedUpload =
|
||||
{ id = upload.id
|
||||
webLogId = upload.webLogId
|
||||
path = upload.path
|
||||
updatedOn = upload.updatedOn
|
||||
data = Convert.ToBase64String upload.data
|
||||
}
|
||||
|
||||
/// Create an uploaded file from an encoded uploaded file
|
||||
static member fromEncoded (encoded : EncodedUpload) : Upload =
|
||||
{ id = encoded.id
|
||||
webLogId = encoded.webLogId
|
||||
path = encoded.path
|
||||
updatedOn = encoded.updatedOn
|
||||
data = Convert.FromBase64String encoded.data
|
||||
}
|
||||
|
||||
/// A unified archive for a web log
|
||||
type Archive =
|
||||
{ /// The web log to which this archive belongs
|
||||
@@ -194,6 +231,9 @@ module Backup =
|
||||
|
||||
/// The posts for this web log (containing only the most recent revision)
|
||||
posts : Post list
|
||||
|
||||
/// The uploaded files for this web log
|
||||
uploads : EncodedUpload list
|
||||
}
|
||||
|
||||
/// Create a JSON serializer (uses RethinkDB data implementation's JSON converters)
|
||||
@@ -212,19 +252,21 @@ module Backup =
|
||||
let tagMapCount = List.length archive.tagMappings
|
||||
let pageCount = List.length archive.pages
|
||||
let postCount = List.length archive.posts
|
||||
let uploadCount = List.length archive.uploads
|
||||
|
||||
// Create a pluralized output based on the count
|
||||
let plural count ifOne ifMany =
|
||||
if count = 1 then ifOne else ifMany
|
||||
|
||||
printfn ""
|
||||
printfn $"""{msg.Replace ("{{NAME}}", webLog.name)}"""
|
||||
printfn $"""{msg.Replace ("<>NAME<>", webLog.name)}"""
|
||||
printfn $""" - The theme "{archive.theme.name}" with {assetCount} asset{plural assetCount "" "s"}"""
|
||||
printfn $""" - {userCount} user{plural userCount "" "s"}"""
|
||||
printfn $""" - {categoryCount} categor{plural categoryCount "y" "ies"}"""
|
||||
printfn $""" - {tagMapCount} tag mapping{plural tagMapCount "" "s"}"""
|
||||
printfn $""" - {pageCount} page{plural pageCount "" "s"}"""
|
||||
printfn $""" - {postCount} post{plural postCount "" "s"}"""
|
||||
printfn $""" - {uploadCount} uploaded file{plural uploadCount "" "s"}"""
|
||||
|
||||
/// Create a backup archive
|
||||
let private createBackup webLog (fileName : string) prettyOutput (data : IData) = task {
|
||||
@@ -248,6 +290,9 @@ module Backup =
|
||||
printfn "- Exporting posts..."
|
||||
let! posts = data.Post.findFullByWebLog webLog.id
|
||||
|
||||
printfn "- Exporting uploads..."
|
||||
let! uploads = data.Upload.findByWebLogWithData webLog.id
|
||||
|
||||
printfn "- Writing archive..."
|
||||
let archive = {
|
||||
webLog = webLog
|
||||
@@ -256,8 +301,9 @@ module Backup =
|
||||
assets = assets |> List.map EncodedAsset.fromAsset
|
||||
categories = categories
|
||||
tagMappings = tagMaps
|
||||
pages = pages |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
|
||||
posts = posts |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
|
||||
pages = pages |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
|
||||
posts = posts |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
|
||||
uploads = uploads |> List.map EncodedUpload.fromUpload
|
||||
}
|
||||
|
||||
// Write the structure to the backup file
|
||||
@@ -267,7 +313,7 @@ module Backup =
|
||||
serializer.Serialize (writer, archive)
|
||||
writer.Close ()
|
||||
|
||||
displayStats "{{NAME}} backup contains:" webLog archive
|
||||
displayStats $"{fileName} (for <>NAME<>) contains:" webLog archive
|
||||
}
|
||||
|
||||
let private doRestore archive newUrlBase (data : IData) = task {
|
||||
@@ -284,6 +330,7 @@ module Backup =
|
||||
let newPageIds = archive.pages |> List.map (fun page -> page.id, PageId.create ()) |> dict
|
||||
let newPostIds = archive.posts |> List.map (fun post -> post.id, PostId.create ()) |> dict
|
||||
let newUserIds = archive.users |> List.map (fun user -> user.id, WebLogUserId.create ()) |> dict
|
||||
let newUpIds = archive.uploads |> List.map (fun up -> up.id, UploadId.create ()) |> dict
|
||||
return
|
||||
{ archive with
|
||||
webLog = { archive.webLog with id = newWebLogId; urlBase = Option.get newUrlBase }
|
||||
@@ -308,6 +355,8 @@ module Backup =
|
||||
authorId = newUserIds[post.authorId]
|
||||
categoryIds = post.categoryIds |> List.map (fun c -> newCatIds[c])
|
||||
})
|
||||
uploads = archive.uploads
|
||||
|> List.map (fun u -> { u with id = newUpIds[u.id]; webLogId = newWebLogId })
|
||||
}
|
||||
| None ->
|
||||
return
|
||||
@@ -320,7 +369,7 @@ module Backup =
|
||||
printfn ""
|
||||
printfn "- Importing theme..."
|
||||
do! data.Theme.save restore.theme
|
||||
let! _ = restore.assets |> List.map (EncodedAsset.fromAsset >> data.ThemeAsset.save) |> Task.WhenAll
|
||||
let! _ = restore.assets |> List.map (EncodedAsset.fromEncoded >> data.ThemeAsset.save) |> Task.WhenAll
|
||||
|
||||
// Restore web log data
|
||||
|
||||
@@ -342,7 +391,10 @@ module Backup =
|
||||
|
||||
// TODO: comments not yet implemented
|
||||
|
||||
displayStats "Restored for {{NAME}}:" restore.webLog restore
|
||||
printfn "- Restoring uploads..."
|
||||
do! data.Upload.restore (restore.uploads |> List.map EncodedUpload.fromEncoded)
|
||||
|
||||
displayStats "Restored for <>NAME<>:" restore.webLog restore
|
||||
}
|
||||
|
||||
/// Decide whether to restore a backup
|
||||
@@ -371,17 +423,26 @@ module Backup =
|
||||
|
||||
/// Generate a backup archive
|
||||
let generateBackup (args : string[]) (sp : IServiceProvider) = task {
|
||||
if args.Length = 3 || args.Length = 4 then
|
||||
let showUsage () =
|
||||
printfn """Usage: MyWebLog backup [url-base] [*backup-file-name] [**"pretty"]"""
|
||||
printfn """ * optional - default is [web-log-slug].json"""
|
||||
printfn """ ** optional - default is non-pretty JSON output"""
|
||||
if args.Length > 1 && args.Length < 5 then
|
||||
let data = sp.GetRequiredService<IData> ()
|
||||
match! data.WebLog.findByHost args[1] with
|
||||
| Some webLog ->
|
||||
let fileName = if args[2].EndsWith ".json" then args[2] else $"{args[2]}.json"
|
||||
let prettyOutput = args.Length = 4 && args[3] = "pretty"
|
||||
let fileName =
|
||||
if args.Length = 2 || (args.Length = 3 && args[2] = "pretty") then
|
||||
$"{webLog.slug}.json"
|
||||
elif args[2].EndsWith ".json" then
|
||||
args[2]
|
||||
else
|
||||
$"{args[2]}.json"
|
||||
let prettyOutput = (args.Length = 3 && args[2] = "pretty") || (args.Length = 4 && args[3] = "pretty")
|
||||
do! createBackup webLog fileName prettyOutput data
|
||||
| None -> printfn $"Error: no web log found for {args[1]}"
|
||||
else
|
||||
printfn """Usage: MyWebLog backup [url-base] [backup-file-name] [*"pretty"]"""
|
||||
printfn """ * optional - default is non-pretty JSON output"""
|
||||
showUsage ()
|
||||
}
|
||||
|
||||
/// Restore a backup archive
|
||||
|
||||
@@ -16,8 +16,10 @@
|
||||
<Compile Include="Handlers\Helpers.fs" />
|
||||
<Compile Include="Handlers\Admin.fs" />
|
||||
<Compile Include="Handlers\Feed.fs" />
|
||||
<Compile Include="Handlers\Page.fs" />
|
||||
<Compile Include="Handlers\Post.fs" />
|
||||
<Compile Include="Handlers\User.fs" />
|
||||
<Compile Include="Handlers\Upload.fs" />
|
||||
<Compile Include="Handlers\Routes.fs" />
|
||||
<Compile Include="DotLiquidBespoke.fs" />
|
||||
<Compile Include="Maintenance.fs" />
|
||||
@@ -27,8 +29,8 @@
|
||||
<ItemGroup>
|
||||
<PackageReference Include="DotLiquid" Version="2.2.656" />
|
||||
<PackageReference Include="Giraffe" Version="6.0.0" />
|
||||
<PackageReference Include="Giraffe.Htmx" Version="1.7.0" />
|
||||
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.7.0" />
|
||||
<PackageReference Include="Giraffe.Htmx" Version="1.8.0" />
|
||||
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.0" />
|
||||
<PackageReference Include="NeoSmart.Caching.Sqlite" Version="6.0.1" />
|
||||
<PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" />
|
||||
<PackageReference Update="FSharp.Core" Version="6.0.5" />
|
||||
@@ -41,7 +43,7 @@
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<None Include=".\wwwroot\img\*.png" CopyToOutputDirectory="Always" />
|
||||
<None Include=".\wwwroot\upload\*" CopyToOutputDirectory="Always" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
|
||||
@@ -41,13 +41,17 @@ module DataImplementation =
|
||||
let get (sp : IServiceProvider) : IData =
|
||||
let config = sp.GetRequiredService<IConfiguration> ()
|
||||
if (config.GetConnectionString >> isNull >> not) "SQLite" then
|
||||
let log = sp.GetRequiredService<ILogger<SQLiteData>> ()
|
||||
let conn = new SqliteConnection (config.GetConnectionString "SQLite")
|
||||
log.LogInformation $"Using SQL database {conn.DataSource}"
|
||||
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
|
||||
upcast SQLiteData (conn, sp.GetRequiredService<ILogger<SQLiteData>> ())
|
||||
elif (config.GetSection "RethinkDB").Exists () then
|
||||
let log = sp.GetRequiredService<ILogger<RethinkDbData>> ()
|
||||
Json.all () |> Seq.iter Converter.Serializer.Converters.Add
|
||||
let rethinkCfg = DataConfig.FromConfiguration (config.GetSection "RethinkDB")
|
||||
let conn = rethinkCfg.CreateConnectionAsync () |> Async.AwaitTask |> Async.RunSynchronously
|
||||
log.LogInformation $"Using RethinkDB database {rethinkCfg.Database}"
|
||||
upcast RethinkDbData (conn, rethinkCfg, sp.GetRequiredService<ILogger<RethinkDbData>> ())
|
||||
else
|
||||
let log = sp.GetRequiredService<ILogger<SQLiteData>> ()
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
{
|
||||
"Generator": "myWebLog 2.0-beta02",
|
||||
"Generator": "myWebLog 2.0-beta04",
|
||||
"Logging": {
|
||||
"LogLevel": {
|
||||
"MyWebLog.Handlers": "Information"
|
||||
|
||||
0
src/MyWebLog/wwwroot/upload/.gitkeep
Normal file
0
src/MyWebLog/wwwroot/upload/.gitkeep
Normal file
@@ -12,6 +12,7 @@
|
||||
{{ "admin/dashboard" | nav_link: "Dashboard" }}
|
||||
{{ "admin/pages" | nav_link: "Pages" }}
|
||||
{{ "admin/posts" | nav_link: "Posts" }}
|
||||
{{ "admin/uploads" | nav_link: "Uploads" }}
|
||||
{{ "admin/categories" | nav_link: "Categories" }}
|
||||
{{ "admin/settings" | nav_link: "Settings" }}
|
||||
</ul>
|
||||
@@ -47,6 +48,8 @@
|
||||
<div class="container-fluid">
|
||||
<div class="row">
|
||||
<div class="col-xs-12 text-end">
|
||||
{%- assign version = generator | split: " " -%}
|
||||
<small class="me-1 align-baseline">v{{ version[1] }}</small>
|
||||
<img src="{{ "themes/admin/logo-light.png" | relative_link }}" alt="myWebLog" width="120" height="34">
|
||||
</div>
|
||||
</div>
|
||||
|
||||
@@ -185,7 +185,7 @@
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row">
|
||||
<div class="row pb-3">
|
||||
<div class="col-12 col-lg-10 offset-lg-1">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="mediaBaseUrl" id="mediaBaseUrl" class="form-control"
|
||||
@@ -195,6 +195,57 @@
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row">
|
||||
<div class="col-12 col-lg-5 offset-lg-1 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="fundingUrl" id="fundingUrl" class="form-control" placeholder="Funding URL"
|
||||
value="{{ model.funding_url }}">
|
||||
<label for="fundingUrl">Funding URL</label>
|
||||
<span class="form-text fst-italic">
|
||||
Optional; URL describing donation options for this podcast, relative URL supported
|
||||
</span>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-12 col-lg-5 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="fundingText" id="fundingText" class="form-control" maxlength="128"
|
||||
placeholder="Funding Text" value="{{ model.funding_text }}">
|
||||
<label for="fundingText">Funding Text</label>
|
||||
<span class="form-text fst-italic">Optional; text for the funding link</span>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row pb-3">
|
||||
<div class="col-8 col-lg-5 offset-lg-1 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="guid" id="guid" class="form-control" placeholder="GUID"
|
||||
value="{{ model.guid }}">
|
||||
<label for="guid">Podcast GUID</label>
|
||||
<span class="form-text fst-italic">
|
||||
Optional; v5 UUID uniquely identifying this podcast; once entered, do not change this value
|
||||
(<a href="https://github.com/Podcastindex-org/podcast-namespace/blob/main/docs/1.0.md#guid"
|
||||
target="_blank">documentation</a>)
|
||||
</span>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-4 col-lg-3 offset-lg-2 pb-3">
|
||||
<div class="form-floating">
|
||||
<select name="medium" id="medium" class="form-control">
|
||||
{% for med in medium_values -%}
|
||||
<option value="{{ med[0] }}"{% if model.medium == med[0] %} selected{% endif %}>
|
||||
{{ med[1] }}
|
||||
</option>
|
||||
{%- endfor %}
|
||||
</select>
|
||||
<label for="medium">Medium</label>
|
||||
<span class="form-text fst-italic">
|
||||
Optional; medium of the podcast content
|
||||
(<a href="https://github.com/Podcastindex-org/podcast-namespace/blob/main/docs/1.0.md#medium"
|
||||
target="_blank">documentation</a>)
|
||||
</span>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
</fieldset>
|
||||
</div>
|
||||
</div>
|
||||
|
||||
@@ -16,8 +16,15 @@
|
||||
value="{{ model.permalink }}">
|
||||
<label for="permalink">Permalink</label>
|
||||
{%- if model.page_id != "new" %}
|
||||
{%- capture perm_edit %}admin/page/{{ model.page_id }}/permalinks{% endcapture -%}
|
||||
<span class="form-text"><a href="{{ perm_edit | relative_link }}">Manage Permalinks</a></span>
|
||||
<span class="form-text">
|
||||
<a href="{{ "admin/page/" | append: model.page_id | append: "/permalinks" | relative_link }}">
|
||||
Manage Permalinks
|
||||
</a>
|
||||
<span class="text-muted"> • </span>
|
||||
<a href="{{ "admin/page/" | append: model.page_id | append: "/revisions" | relative_link }}">
|
||||
Manage Revisions
|
||||
</a>
|
||||
</span>
|
||||
{% endif -%}
|
||||
</div>
|
||||
<div class="mb-2">
|
||||
|
||||
@@ -16,8 +16,15 @@
|
||||
value="{{ model.permalink }}">
|
||||
<label for="permalink">Permalink</label>
|
||||
{%- if model.post_id != "new" %}
|
||||
{%- capture perm_edit %}admin/post/{{ model.post_id }}/permalinks{% endcapture -%}
|
||||
<span class="form-text"><a href="{{ perm_edit | relative_link }}">Manage Permalinks</a></span>
|
||||
<span class="form-text">
|
||||
<a href="{{ "admin/post/" | append: model.post_id | append: "/permalinks" | relative_link }}">
|
||||
Manage Permalinks
|
||||
</a>
|
||||
<span class="text-muted"> • </span>
|
||||
<a href="{{ "admin/post/" | append: model.post_id | append: "/revisions" | relative_link }}">
|
||||
Manage Revisions
|
||||
</a>
|
||||
</span>
|
||||
{% endif -%}
|
||||
</div>
|
||||
<div class="mb-2">
|
||||
|
||||
@@ -42,7 +42,7 @@
|
||||
</span>
|
||||
</div>
|
||||
<div class="{{ title_col }}">
|
||||
{%- if post.episode %}<span class="badge bg-success float-end text-uppercase">Episode</span>{% endif -%}
|
||||
{%- if post.episode %}<span class="badge bg-success float-end text-uppercase mt-1">Episode</span>{% endif -%}
|
||||
{{ post.title }}<br>
|
||||
<small>
|
||||
<a href="{{ post | relative_link }}" target="_blank">View Post</a>
|
||||
|
||||
68
src/admin-theme/revisions.liquid
Normal file
68
src/admin-theme/revisions.liquid
Normal 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 }}">
|
||||
« 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"> • </span>
|
||||
<a href="{{ rev_restore }}" hx-post="{{ rev_restore }}">Restore as Current</a>
|
||||
<span class="text-muted"> • </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>
|
||||
@@ -8,26 +8,33 @@
|
||||
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
|
||||
<div class="container">
|
||||
<div class="row">
|
||||
<div class="col-12 col-md-6 col-xl-4 offset-xl-1 pb-3">
|
||||
<div class="col-12 col-md-6 col-xl-4 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="name" id="name" class="form-control" value="{{ model.name }}" required autofocus>
|
||||
<input type="text" name="name" id="name" class="form-control" placeholder="Name" required autofocus
|
||||
value="{{ model.name }}">
|
||||
<label for="name">Name</label>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-12 col-md-6 col-xl-4 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="subtitle" id="subtitle" class="form-control" value="{{ model.subtitle }}">
|
||||
<input type="text" name="slug" id="slug" class="form-control" placeholder="Slug" required
|
||||
value="{{ model.slug }}">
|
||||
<label for="slug">Slug</label>
|
||||
<span class="form-text">
|
||||
<span class="badge rounded-pill bg-warning text-dark">WARNING</span> changing this value may break links
|
||||
(<a href="https://bitbadger.solutions/open-source/myweblog/configuring.html#blog-settings"
|
||||
target="_blank">more</a>)
|
||||
</span>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-12 col-md-6 col-xl-4 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="subtitle" id="subtitle" class="form-control" placeholder="Subtitle"
|
||||
value="{{ model.subtitle }}">
|
||||
<label for="subtitle">Subtitle</label>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-12 col-md-4 col-xl-2 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="number" name="postsPerPage" id="postsPerPage" class="form-control" min="0" max="50" required
|
||||
value="{{ model.posts_per_page }}">
|
||||
<label for="postsPerPage">Posts per Page</label>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-12 col-md-4 col-xl-3 pb-3">
|
||||
<div class="col-12 col-md-6 col-xl-4 offset-xl-1 pb-3">
|
||||
<div class="form-floating">
|
||||
<select name="themePath" id="themePath" class="form-control" required>
|
||||
{% for theme in themes -%}
|
||||
@@ -39,19 +46,12 @@
|
||||
<label for="themePath">Theme</label>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-12 col-md-4 col-xl-3 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="timeZone" id="timeZone" class="form-control" required
|
||||
value="{{ model.time_zone }}">
|
||||
<label for="timeZone">Time Zone</label>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-12 col-md-4 pb-3">
|
||||
<div class="col-12 col-md-6 offset-md-1 col-xl-4 offset-xl-0 pb-3">
|
||||
<div class="form-floating">
|
||||
<select name="defaultPage" id="defaultPage" class="form-control" required>
|
||||
{% for pg in pages -%}
|
||||
<option value="{{ pg[0] }}"
|
||||
{%- if pg[0] == model.default_page %} selected="selected"{% endif %}>
|
||||
{%- if pg[0] == model.default_page %} selected="selected"{% endif %}>
|
||||
{{ pg[1] }}
|
||||
</option>
|
||||
{%- endfor %}
|
||||
@@ -59,6 +59,22 @@
|
||||
<label for="defaultPage">Default Page</label>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-12 col-md-4 col-xl-2 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="number" name="postsPerPage" id="postsPerPage" class="form-control" min="0" max="50" required
|
||||
value="{{ model.posts_per_page }}">
|
||||
<label for="postsPerPage">Posts per Page</label>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row">
|
||||
<div class="col-12 col-md-4 col-xl-3 offset-xl-2 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="timeZone" id="timeZone" class="form-control" placeholder="Time Zone" required
|
||||
value="{{ model.time_zone }}">
|
||||
<label for="timeZone">Time Zone</label>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-12 col-md-4 col-xl-2">
|
||||
<div class="form-check form-switch">
|
||||
<input type="checkbox" name="autoHtmx" id="autoHtmx" class="form-check-input" value="true"
|
||||
@@ -69,6 +85,16 @@
|
||||
<a href="https://htmx.org" target="_blank" rel="noopener">What is this?</a>
|
||||
</span>
|
||||
</div>
|
||||
<div class="col-12 col-md-4 col-xl-3 pb-3">
|
||||
<div class="form-floating">
|
||||
<select name="uploads" id="uploads" class="form-control">
|
||||
{%- for it in upload_values %}
|
||||
<option value="{{ it[0] }}"{% if model.uploads == it[0] %} selected{% endif %}>{{ it[1] }}</option>
|
||||
{%- endfor %}
|
||||
</select>
|
||||
<label for="uploads">Default Upload Destination</label>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row pb-3">
|
||||
<div class="col text-center">
|
||||
|
||||
73
src/admin-theme/upload-list.liquid
Normal file
73
src/admin-theme/upload-list.liquid
Normal 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"> • 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 • </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>
|
||||
31
src/admin-theme/upload-new.liquid
Normal file
31
src/admin-theme/upload-new.liquid
Normal 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>
|
||||
@@ -1,2 +1,2 @@
|
||||
myWebLog Admin
|
||||
2.0.0-beta02
|
||||
2.0.0-beta03
|
||||
@@ -85,3 +85,10 @@ a.text-danger:link:hover, a.text-danger:visited:hover {
|
||||
background-color: var(--light-accent);
|
||||
color: var(--dark-gray);
|
||||
}
|
||||
.mwl-revision-preview {
|
||||
max-height: 90vh;
|
||||
overflow: auto;
|
||||
border: solid 1px black;
|
||||
border-radius: .5rem;
|
||||
padding: .5rem;
|
||||
}
|
||||
|
||||
@@ -1,13 +1,22 @@
|
||||
const Admin = {
|
||||
/** The next index for a metadata item */
|
||||
/**
|
||||
* Support functions for the administrative UI
|
||||
*/
|
||||
this.Admin = {
|
||||
/**
|
||||
* The next index for a metadata item
|
||||
* @type {number}
|
||||
*/
|
||||
nextMetaIndex : 0,
|
||||
|
||||
/** The next index for a permalink */
|
||||
/**
|
||||
* The next index for a permalink
|
||||
* @type {number}
|
||||
*/
|
||||
nextPermalink : 0,
|
||||
|
||||
/**
|
||||
* Set the next meta item index
|
||||
* @param idx The index to set
|
||||
* @param {number} idx The index to set
|
||||
*/
|
||||
setNextMetaIndex(idx) {
|
||||
this.nextMetaIndex = idx
|
||||
@@ -15,7 +24,7 @@
|
||||
|
||||
/**
|
||||
* Set the next permalink index
|
||||
* @param idx The index to set
|
||||
* @param {number} idx The index to set
|
||||
*/
|
||||
setPermalinkIndex(idx) {
|
||||
this.nextPermalink = idx
|
||||
@@ -220,10 +229,22 @@
|
||||
checkPodcast() {
|
||||
document.getElementById("podcastFields").disabled = !document.getElementById("isPodcast").checked
|
||||
},
|
||||
|
||||
/**
|
||||
* Copy text to the clipboard
|
||||
* @param {string} text The text to be copied
|
||||
* @param {HTMLAnchorElement} elt The element on which the click was generated
|
||||
* @return {boolean} False, to prevent navigation
|
||||
*/
|
||||
copyText(text, elt) {
|
||||
navigator.clipboard.writeText(text)
|
||||
elt.innerText = "Copied"
|
||||
return false
|
||||
},
|
||||
|
||||
/**
|
||||
* Toggle the source of a custom RSS feed
|
||||
* @param source The source that was selected
|
||||
* @param {string} source The source that was selected
|
||||
*/
|
||||
customFeedBy(source) {
|
||||
const categoryInput = document.getElementById("sourceValueCat")
|
||||
@@ -241,7 +262,7 @@
|
||||
|
||||
/**
|
||||
* Remove a metadata item
|
||||
* @param idx The index of the metadata item to remove
|
||||
* @param {number} idx The index of the metadata item to remove
|
||||
*/
|
||||
removeMetaItem(idx) {
|
||||
document.getElementById(`meta_${idx}`).remove()
|
||||
@@ -249,7 +270,7 @@
|
||||
|
||||
/**
|
||||
* Remove a permalink
|
||||
* @param idx The index of the permalink to remove
|
||||
* @param {number} idx The index of the permalink to remove
|
||||
*/
|
||||
removePermalink(idx) {
|
||||
document.getElementById(`link_${idx}`).remove()
|
||||
@@ -264,7 +285,7 @@
|
||||
|
||||
/**
|
||||
* Show messages that may have come with an htmx response
|
||||
* @param messages The messages from the response
|
||||
* @param {string} messages The messages from the response
|
||||
*/
|
||||
showMessage(messages) {
|
||||
const msgs = messages.split(", ")
|
||||
|
||||
Reference in New Issue
Block a user