46 Commits

Author SHA1 Message Date
7b325dc19e v2 (#36)
* Use PostgreSQL JSON-based data implementation
* Fix back link on RSS settings page (#34)
* Show theme upload messages (#28)
* Fix admin page list paging (#35)
* Add db migrations for all stores
* Support both .NET 6 and 7
2023-02-26 13:01:21 -05:00
5f3daa1de9 v2 RC2 (#33)
* Add PostgreSQL back end (#30)
* Upgrade password storage (#32)
* Change podcast/episode storage for SQLite (#29)
* Move date/time handling to NodaTime (#31)
2022-08-21 18:56:18 -04:00
1ec664ad24 Fix casing on CLI usage examples 2022-08-01 07:46:53 -04:00
33698bd182 Reassign child cats when deleting parent cat (#27)
- Create common page/post edit field template (#25)
- Fix relative URL adjustment throughout
- Fix upload name sanitization regex
- Create modules within Admin handler module
- Enable/disable podcast episode fields on page load
- Fix upload destination casing in templates
- Tweak default theme to show no posts found on index template
- Update Bootstrap to 5.1.3 in default theme
2022-07-28 20:36:02 -04:00
6b49793fbb Change alerts to toasts (#25)
- Upgrade to Bootstrap 5.1.3
- Move RSS settings and tag mappings to web log settings (#25)
- Fix parameters in 2 SQLite queries
2022-07-27 21:38:46 -04:00
a8386d6c97 Add loading indicator for admin theme (#25) 2022-07-26 22:34:19 -04:00
b1ca48c2c5 Add docs link to admin header (#25)
- Change executable name in release packages
2022-07-26 20:37:18 -04:00
3189681021 Tweak admin UI templates (#25)
- Move user management under web log settings
- Move user self-update to my-info
- Return meaningful error if a template does not exist
- Tweak margins/paddings throughout
- Do not show headings on list pages if lists are empty
- Fix pagination styles for page/post list pages
2022-07-26 16:28:14 -04:00
ff9c08842b First cut at cache management (#23) 2022-07-24 23:55:00 -04:00
e103738d39 Prevent deletion if theme is in use (#20) 2022-07-24 19:26:36 -04:00
d854178255 Upload / delete themes (#20)
- Moved themes to section of installation admin page (will also implement #23 there)
2022-07-24 19:18:20 -04:00
0a32181e65 WIP on theme upload (#20) 2022-07-24 16:32:37 -04:00
81fe03b8f3 WIP on theme admin page (#20) 2022-07-22 21:19:19 -04:00
4514c4864d Load themes at startup (#20)
- Adjust release packaging (#20)
- Fix default theme for beta-5 changes (#24)
- Remove RethinkDB case fix (cleanup from #21)
- Bump versions for next release
2022-07-22 10:33:11 -04:00
99ccdebcc7 Delete user / admin clean-up (#19)
- Add CLI help (#22)
- Add constants for common view items
- Construct hashes with piped functions
2022-07-21 21:42:38 -04:00
59f385122b Add user add/edit (#19)
- Add makeHash function to simplify code around DotLiquid hashes
- Add context extension to determine if a user has an access level
- Add someTask function to simply Task.FromResult (Some x)
2022-07-20 23:13:16 -04:00
41ae1d8dad First cut of user admin page (#19) 2022-07-19 22:51:51 -04:00
1e987fdf72 Eliminate compiler warnings
- Change RethinkDB to use connection-string style settings
2022-07-19 20:59:53 -04:00
7eaad4a076 Clean up database names (#21)
- Moved user edit to "my info" (#19)
2022-07-18 20:05:10 -04:00
5fb3a73dcf Add user created and last seen on (#19)
- Updated view models / interfaces per F# naming guidelines
2022-07-17 23:10:30 -04:00
e0a03bfca9 Add upgrade-user CLI option (#19) 2022-07-17 15:50:33 -04:00
d30312c23f Add access restrictions to UI (#19)
- Vary default user access for new web logs (#19)
- Add htmx detection to not auth/404 handlers
- Bump version
2022-07-16 22:17:57 -04:00
eae1509d81 Add access restrictions to server routes (#19) 2022-07-16 17:32:18 -04:00
425223a3a8 Add access levels (#19)
- Remove authorization level
2022-07-16 15:51:58 -04:00
07aff16c3a Version bump 2022-07-16 13:38:44 -04:00
d290e6e8a6 Complete page / post revision maint (#13)
- Fix log on redirection
- Move page handlers to its own file
- Add version to admin area footer
- Move generator to HttpContext extension property
2022-07-16 12:33:34 -04:00
039d09aed5 WIP on page revisions (#13)
- Simplify redirectToGet usage
- Move a few functions to HttpContext extension properties
- Modify bare response to allow content not from a template
- Fix uploaded date/time handling
2022-07-15 22:51:51 -04:00
d667d09372 WIP on revision mgt template (#13) 2022-07-14 23:25:29 -04:00
2906c20efa Upgrade htmx to v1.8.0 (#18) 2022-07-14 18:55:52 -04:00
355ade8c87 Add slug and upload dest to settings (#2) 2022-07-07 12:42:37 -04:00
1d096d696b Add types to admin functions
- Change how functions are registered
2022-07-06 10:30:30 -04:00
ce3816a8ae Use web log slug for backup file name (#16) 2022-07-04 19:06:32 -04:00
879710a0a3 Add funding (#7)/GUID (#4)/medium (#3) to podcast
- Add info log for non-default DB connections
2022-07-04 18:40:32 -04:00
c957279162 Add and delete uploaded files (#2) 2022-07-04 13:19:16 -04:00
9307ace24a WIP on saving uploads (#2) 2022-07-01 20:59:21 -04:00
feada6f11f Add copy links to upload list (#2) 2022-06-30 18:56:24 -04:00
0567dff54a WIP on upload admin (#2) 2022-06-28 22:18:56 -04:00
c29bbc04ac WIP on uploads (#2)
- Add data types and fields
- Implement in both RethinkDB and SQLite
- Add uploads to backup/restore
- Add empty upload folder to project
- Add indexes to SQLite tables (#15)
2022-06-28 17:34:18 -04:00
46bd785a1f Make program executable (#14)
- Bump versions for next release
2022-06-28 08:39:43 -04:00
3203f1b2ee Bump versions 2022-06-28 06:33:38 -04:00
7203fa5a38 Invalidate cache when theme uploaded (#12)
- Add episode to display page (leftover from #9)
- Show episode label based on structure (also #9)
2022-06-27 22:16:53 -04:00
16603bbcaf Render feed from episode (#9)
- Render chapter if present (#5)
- Render transcript if present (#8)
- Require transcript type if URL entered (#8)
2022-06-27 20:34:30 -04:00
80c65bcad6 Add episode fields to UI (#9)
- Add chapter fields (#5)
- Add transcript fields (#8)
2022-06-27 17:47:00 -04:00
9fbb1bb14d Add episode fields to post view model
Parts of #9 / #5 / #8
2022-06-27 07:36:29 -04:00
707b67c630 Reorganize SQLite data files
- Add episode data structure (#9)
- Add fields for chapters (#6) and transcripts (#8)
- Add fields for medium (#3), funding (#7), and GUID (#4)
- Fix RethinkDB restore problems (#10)
- Save custom feeds in SQLite (#11)
2022-06-24 21:56:07 -04:00
dfb0ff3b9c Fix RethinkDB restore (#10)
- Also fixed replacement base URL issue
2022-06-24 08:47:22 -04:00
94 changed files with 10976 additions and 5531 deletions

View File

@@ -1,12 +0,0 @@
{
"version": 1,
"isRoot": true,
"tools": {
"fake-cli": {
"version": "5.22.0",
"commands": [
"fake"
]
}
}
}

6
.gitignore vendored
View File

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

166
build.fs Normal file
View File

@@ -0,0 +1,166 @@
open System.IO
open Fake.Core
open Fake.DotNet
open Fake.IO
open Fake.IO.Globbing.Operators
let execContext = Context.FakeExecutionContext.Create false "build.fsx" []
Context.setExecutionContext (Context.RuntimeContext.Fake execContext)
/// The output directory for release ZIPs
let releasePath = "releases"
/// The path to the main project
let projectPath = "src/MyWebLog"
/// The path and name of the main project
let projName = $"{projectPath}/MyWebLog.fsproj"
/// The version being packaged (extracted from appsettings.json)
let version =
let settings = File.ReadAllText $"{projectPath}/appsettings.json"
let generator = settings.Substring (settings.IndexOf "\"Generator\":")
let appVersion = generator.Replace("\"Generator\": \"", "")
let appVersion = appVersion.Substring (0, appVersion.IndexOf "\"")
appVersion.Split ' ' |> Array.last
/// Zip a theme distributed with myWebLog
let zipTheme (name : string) (_ : TargetParameter) =
let path = $"src/{name}-theme"
!! $"{path}/**/*"
|> Zip.filesAsSpecs path
|> Seq.filter (fun (_, name) -> not (name.EndsWith ".zip"))
|> Zip.zipSpec $"{releasePath}/{name}-theme.zip"
/// Frameworks supported by this build
let frameworks = [ "net6.0"; "net7.0" ]
/// Publish the project for the given runtime ID
let publishFor rid (_ : TargetParameter) =
frameworks
|> List.iter (fun fwk ->
DotNet.publish
(fun opts ->
{ opts with Runtime = Some rid; SelfContained = Some false; NoLogo = true; Framework = Some fwk })
projName)
/// Package published output for the given runtime ID
let packageFor rid (_ : TargetParameter) =
frameworks
|> List.iter (fun fwk ->
let path = $"{projectPath}/bin/Release/{fwk}/%s{rid}/publish"
let prodSettings = $"{path}/appsettings.Production.json"
if File.exists prodSettings then File.delete prodSettings
[ !! $"{path}/**/*"
|> Zip.filesAsSpecs path
|> Seq.map (fun (orig, dest) ->
orig, if dest.StartsWith "MyWebLog" then dest.Replace ("MyWebLog", "myWebLog") else dest)
Seq.singleton ($"{releasePath}/admin-theme.zip", "admin-theme.zip")
Seq.singleton ($"{releasePath}/default-theme.zip", "default-theme.zip")
]
|> Seq.concat
|> Zip.zipSpec $"{releasePath}/myWebLog-{version}.{fwk}.{rid}.zip")
Target.create "Clean" (fun _ ->
!! "src/**/bin"
++ "src/**/obj"
|> Shell.cleanDirs
Shell.cleanDir releasePath
)
Target.create "Build" (fun _ ->
DotNet.build (fun opts -> { opts with NoLogo = true }) projName
)
Target.create "ZipAdminTheme" (zipTheme "admin")
Target.create "ZipDefaultTheme" (zipTheme "default")
Target.create "PublishWindows" (publishFor "win-x64")
Target.create "PackageWindows" (packageFor "win-x64")
Target.create "PublishLinux" (publishFor "linux-x64")
Target.create "PackageLinux" (packageFor "linux-x64")
Target.create "RepackageLinux" (fun _ ->
let workDir = $"{releasePath}/linux"
frameworks
|> List.iter (fun fwk ->
let zipArchive = $"{releasePath}/myWebLog-{version}.{fwk}.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
sh "chmod" [ "+x"; "./myWebLog" ]
sh "tar" [ "cfj"; $"../myWebLog-{version}.{fwk}.linux-x64.tar.bz2"; "." ]
Shell.cd "../.."
Shell.rm zipArchive)
Shell.rm_rf workDir
)
Target.create "All" ignore
Target.create "RemoveThemeArchives" (fun _ ->
Shell.rm $"{releasePath}/admin-theme.zip"
Shell.rm $"{releasePath}/default-theme.zip"
)
Target.create "CI" ignore
open Fake.Core.TargetOperators
let dependencies = [
"Clean"
==> "All"
"Clean"
?=> "Build"
==> "All"
"Clean"
?=> "ZipDefaultTheme"
==> "All"
"Clean"
?=> "ZipAdminTheme"
==> "All"
"Build"
==> "PublishWindows"
==> "All"
"Build"
==> "PublishLinux"
==> "All"
"PublishWindows"
==> "PackageWindows"
==> "All"
"PublishLinux"
==> "PackageLinux"
==> "All"
"PackageLinux"
==> "RepackageLinux"
==> "All"
"All"
==> "RemoveThemeArchives"
==> "CI"
]
[<EntryPoint>]
let main args =
try
match args with
| [| target |] -> Target.runOrDefault target
| _ -> Target.runOrDefault "All"
0
with e ->
printfn "%A" e
1

20
build.fsproj Normal file
View File

@@ -0,0 +1,20 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net7.0</TargetFramework>
</PropertyGroup>
<ItemGroup>
<Compile Include="build.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="Fake.Core.Target" Version="5.23.1" />
<PackageReference Include="Fake.DotNet.Cli" Version="5.23.1" />
<PackageReference Include="Fake.IO.FileSystem" Version="5.23.1" />
<PackageReference Include="Fake.IO.Zip" Version="5.23.1" />
<PackageReference Include="MSBuild.StructuredLogger" Version="2.1.768" />
</ItemGroup>
</Project>

143
build.fsx
View File

@@ -1,143 +0,0 @@
#r "paket:
nuget Fake.DotNet.Cli
nuget Fake.IO.FileSystem
nuget Fake.IO.Zip
nuget Fake.Core.Target //"
#load ".fake/build.fsx/intellisense.fsx"
open System.IO
open Fake.Core
open Fake.DotNet
open Fake.IO
open Fake.IO.Globbing.Operators
open Fake.Core.TargetOperators
Target.initEnvironment ()
/// The output directory for release ZIPs
let releasePath = "releases"
/// The path to the main project
let projectPath = "src/MyWebLog"
/// The path and name of the main project
let projName = $"{projectPath}/MyWebLog.fsproj"
/// The version being packaged (extracted from appsettings.json)
let version =
let settings = File.ReadAllText $"{projectPath}/appsettings.json"
let generator = settings.Substring (settings.IndexOf "\"Generator\":")
let appVersion = generator.Replace("\"Generator\": \"", "")
let appVersion = appVersion.Substring (0, appVersion.IndexOf "\"")
appVersion.Split ' ' |> Array.last
/// 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"))
|> Zip.zipSpec $"{releasePath}/{name}.zip"
/// Publish the project for the given runtime ID
let publishFor rid (_ : TargetParameter) =
DotNet.publish (fun opts -> { opts with Runtime = Some rid; SelfContained = Some false; NoLogo = true }) projName
/// Package published output for the given runtime ID
let packageFor (rid : string) (_ : TargetParameter) =
let path = $"{projectPath}/bin/Release/net6.0/{rid}/publish"
[ !! $"{path}/**/*"
|> Zip.filesAsSpecs path
|> Zip.moveToFolder "app"
Seq.singleton ($"{releasePath}/admin.zip", "admin.zip")
Seq.singleton ($"{releasePath}/default.zip", "default.zip")
]
|> Seq.concat
|> Zip.zipSpec $"{releasePath}/myWebLog-{version}.{rid}.zip"
Target.create "Clean" (fun _ ->
!! "src/**/bin"
++ "src/**/obj"
|> Shell.cleanDirs
Shell.cleanDir releasePath
)
Target.create "Build" (fun _ ->
DotNet.build (fun opts -> { opts with NoLogo = true }) projName
)
Target.create "ZipAdminTheme" (zipTheme "admin")
Target.create "ZipDefaultTheme" (zipTheme "default")
Target.create "PublishWindows" (publishFor "win-x64")
Target.create "PackageWindows" (packageFor "win-x64")
Target.create "PublishLinux" (publishFor "linux-x64")
Target.create "PackageLinux" (packageFor "linux-x64")
Target.create "RepackageLinux" (fun _ ->
let workDir = $"{releasePath}/linux"
let zipArchive = $"{releasePath}/myWebLog-{version}.linux-x64.zip"
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
Shell.cd "../.."
Shell.rm zipArchive
Shell.rm_rf workDir
)
Target.create "All" ignore
Target.create "RemoveThemeArchives" (fun _ ->
Shell.rm $"{releasePath}/admin.zip"
Shell.rm $"{releasePath}/default.zip"
)
Target.create "CI" ignore
"Clean"
==> "All"
"Clean"
?=> "Build"
==> "All"
"Clean"
?=> "ZipDefaultTheme"
==> "All"
"Clean"
?=> "ZipAdminTheme"
==> "All"
"Build"
==> "PublishWindows"
==> "All"
"Build"
==> "PublishLinux"
==> "All"
"PublishWindows"
==> "PackageWindows"
==> "All"
"PublishLinux"
==> "PackageLinux"
==> "All"
"PackageLinux"
==> "RepackageLinux"
==> "All"
"All"
==> "RemoveThemeArchives"
==> "CI"
Target.runOrDefault "All"

View File

@@ -1,227 +0,0 @@
STORAGE: NONE
RESTRICTION: || (== net6.0) (== netstandard2.0)
NUGET
remote: https://api.nuget.org/v3/index.json
BlackFox.VsWhere (1.1)
FSharp.Core (>= 4.2.3)
Microsoft.Win32.Registry (>= 4.7)
Fake.Core.CommandLineParsing (5.22)
FParsec (>= 1.1.1)
FSharp.Core (>= 6.0)
Fake.Core.Context (5.22)
FSharp.Core (>= 6.0)
Fake.Core.Environment (5.22)
FSharp.Core (>= 6.0)
Fake.Core.FakeVar (5.22)
Fake.Core.Context (>= 5.22)
FSharp.Core (>= 6.0)
Fake.Core.Process (5.22)
Fake.Core.Environment (>= 5.22)
Fake.Core.FakeVar (>= 5.22)
Fake.Core.String (>= 5.22)
Fake.Core.Trace (>= 5.22)
Fake.IO.FileSystem (>= 5.22)
FSharp.Core (>= 6.0)
System.Collections.Immutable (>= 5.0)
Fake.Core.SemVer (5.22)
FSharp.Core (>= 6.0)
Fake.Core.String (5.22)
FSharp.Core (>= 6.0)
Fake.Core.Target (5.22)
Fake.Core.CommandLineParsing (>= 5.22)
Fake.Core.Context (>= 5.22)
Fake.Core.Environment (>= 5.22)
Fake.Core.FakeVar (>= 5.22)
Fake.Core.Process (>= 5.22)
Fake.Core.String (>= 5.22)
Fake.Core.Trace (>= 5.22)
FSharp.Control.Reactive (>= 5.0.2)
FSharp.Core (>= 6.0)
Fake.Core.Tasks (5.22)
Fake.Core.Trace (>= 5.22)
FSharp.Core (>= 6.0)
Fake.Core.Trace (5.22)
Fake.Core.Environment (>= 5.22)
Fake.Core.FakeVar (>= 5.22)
FSharp.Core (>= 6.0)
Fake.Core.Xml (5.22)
Fake.Core.String (>= 5.22)
FSharp.Core (>= 6.0)
Fake.DotNet.Cli (5.22)
Fake.Core.Environment (>= 5.22)
Fake.Core.Process (>= 5.22)
Fake.Core.String (>= 5.22)
Fake.Core.Trace (>= 5.22)
Fake.DotNet.MSBuild (>= 5.22)
Fake.DotNet.NuGet (>= 5.22)
Fake.IO.FileSystem (>= 5.22)
FSharp.Core (>= 6.0)
Mono.Posix.NETStandard (>= 1.0)
Newtonsoft.Json (>= 13.0.1)
Fake.DotNet.MSBuild (5.22)
BlackFox.VsWhere (>= 1.1)
Fake.Core.Environment (>= 5.22)
Fake.Core.Process (>= 5.22)
Fake.Core.String (>= 5.22)
Fake.Core.Trace (>= 5.22)
Fake.IO.FileSystem (>= 5.22)
FSharp.Core (>= 6.0)
MSBuild.StructuredLogger (>= 2.1.545)
Fake.DotNet.NuGet (5.22)
Fake.Core.Environment (>= 5.22)
Fake.Core.Process (>= 5.22)
Fake.Core.SemVer (>= 5.22)
Fake.Core.String (>= 5.22)
Fake.Core.Tasks (>= 5.22)
Fake.Core.Trace (>= 5.22)
Fake.Core.Xml (>= 5.22)
Fake.IO.FileSystem (>= 5.22)
Fake.Net.Http (>= 5.22)
FSharp.Core (>= 6.0)
Newtonsoft.Json (>= 13.0.1)
NuGet.Protocol (>= 5.11)
Fake.IO.FileSystem (5.22)
Fake.Core.String (>= 5.22)
FSharp.Core (>= 6.0)
Fake.IO.Zip (5.22)
Fake.Core.String (>= 5.22)
Fake.IO.FileSystem (>= 5.22)
FSharp.Core (>= 6.0)
Fake.Net.Http (5.22)
Fake.Core.Trace (>= 5.22)
FSharp.Core (>= 6.0)
FParsec (1.1.1)
FSharp.Core (>= 4.3.4)
FSharp.Control.Reactive (5.0.5)
FSharp.Core (>= 4.7.2)
System.Reactive (>= 5.0 < 6.0)
FSharp.Core (6.0.5)
Microsoft.Build (17.2)
Microsoft.Build.Framework (>= 17.2) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
Microsoft.NET.StringTools (>= 1.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
Microsoft.Win32.Registry (>= 4.3) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net6.0))
System.Collections.Immutable (>= 5.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
System.Configuration.ConfigurationManager (>= 4.7) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
System.Reflection.Metadata (>= 1.6) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net6.0))
System.Security.Principal.Windows (>= 4.7) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net6.0))
System.Text.Encoding.CodePages (>= 4.0.1) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net6.0))
System.Text.Json (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
System.Threading.Tasks.Dataflow (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
Microsoft.Build.Framework (17.2)
Microsoft.Win32.Registry (>= 4.3)
System.Security.Permissions (>= 4.7)
Microsoft.Build.Tasks.Core (17.2)
Microsoft.Build.Framework (>= 17.2)
Microsoft.Build.Utilities.Core (>= 17.2)
Microsoft.NET.StringTools (>= 1.0)
Microsoft.Win32.Registry (>= 4.3)
System.CodeDom (>= 4.4)
System.Collections.Immutable (>= 5.0)
System.Reflection.Metadata (>= 1.6)
System.Resources.Extensions (>= 4.6)
System.Security.Cryptography.Pkcs (>= 4.7)
System.Security.Cryptography.Xml (>= 4.7)
System.Security.Permissions (>= 4.7)
System.Threading.Tasks.Dataflow (>= 6.0)
Microsoft.Build.Utilities.Core (17.2)
Microsoft.Build.Framework (>= 17.2)
Microsoft.NET.StringTools (>= 1.0)
Microsoft.Win32.Registry (>= 4.3)
System.Collections.Immutable (>= 5.0)
System.Configuration.ConfigurationManager (>= 4.7)
System.Security.Permissions (>= 4.7) - restriction: == netstandard2.0
System.Text.Encoding.CodePages (>= 4.0.1) - restriction: == netstandard2.0
Microsoft.NET.StringTools (1.0)
System.Memory (>= 4.5.4)
System.Runtime.CompilerServices.Unsafe (>= 5.0)
Microsoft.NETCore.Platforms (6.0.4) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard1.2)) (&& (== net6.0) (< netstandard1.3)) (&& (== net6.0) (< netstandard1.5)) (== netstandard2.0)
Microsoft.NETCore.Targets (5.0) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard1.2)) (&& (== net6.0) (< netstandard1.3)) (&& (== net6.0) (< netstandard1.5)) (== netstandard2.0)
Microsoft.Win32.Registry (5.0)
System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (>= monoandroid) (< netstandard1.3)) (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0)
System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (< netcoreapp2.1)) (&& (== net6.0) (>= uap10.1)) (== netstandard2.0)
System.Security.AccessControl (>= 5.0)
System.Security.Principal.Windows (>= 5.0)
Microsoft.Win32.SystemEvents (6.0.1) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
Mono.Posix.NETStandard (1.0)
MSBuild.StructuredLogger (2.1.669)
Microsoft.Build (>= 16.10)
Microsoft.Build.Framework (>= 16.10)
Microsoft.Build.Tasks.Core (>= 16.10)
Microsoft.Build.Utilities.Core (>= 16.10)
Newtonsoft.Json (13.0.1)
NuGet.Common (6.2.1)
NuGet.Frameworks (>= 6.2.1)
NuGet.Configuration (6.2.1)
NuGet.Common (>= 6.2.1)
System.Security.Cryptography.ProtectedData (>= 4.4)
NuGet.Frameworks (6.2.1)
NuGet.Packaging (6.2.1)
Newtonsoft.Json (>= 13.0.1)
NuGet.Configuration (>= 6.2.1)
NuGet.Versioning (>= 6.2.1)
System.Security.Cryptography.Cng (>= 5.0)
System.Security.Cryptography.Pkcs (>= 5.0)
NuGet.Protocol (6.2.1)
NuGet.Packaging (>= 6.2.1)
NuGet.Versioning (6.2.1)
System.Buffers (4.5.1) - restriction: || (&& (== net6.0) (>= monoandroid) (< netstandard1.3)) (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0)
System.CodeDom (6.0)
System.Collections.Immutable (6.0)
System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
System.Runtime.CompilerServices.Unsafe (>= 6.0)
System.Configuration.ConfigurationManager (6.0)
System.Security.Cryptography.ProtectedData (>= 6.0)
System.Security.Permissions (>= 6.0)
System.Drawing.Common (6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
Microsoft.Win32.SystemEvents (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
System.Formats.Asn1 (6.0)
System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
System.Memory (4.5.5)
System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (>= net461)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (< netstandard1.1)) (&& (== net6.0) (< netstandard2.0)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0)
System.Numerics.Vectors (>= 4.4) - restriction: || (&& (== net6.0) (< netcoreapp2.0)) (== netstandard2.0)
System.Runtime.CompilerServices.Unsafe (>= 4.5.3) - restriction: || (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (>= net461)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (< netcoreapp2.1)) (&& (== net6.0) (< netstandard1.1)) (&& (== net6.0) (< netstandard2.0)) (&& (== net6.0) (>= uap10.1)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0)
System.Numerics.Vectors (4.5) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
System.Reactive (5.0)
System.Runtime.InteropServices.WindowsRuntime (>= 4.3) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (== netstandard2.0)
System.Threading.Tasks.Extensions (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net472)) (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (>= uap10.1)) (== netstandard2.0)
System.Reflection.Metadata (6.0.1)
System.Collections.Immutable (>= 6.0)
System.Resources.Extensions (6.0)
System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
System.Runtime (4.3.1) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (== netstandard2.0)
Microsoft.NETCore.Platforms (>= 1.1.1)
Microsoft.NETCore.Targets (>= 1.1.3)
System.Runtime.CompilerServices.Unsafe (6.0)
System.Runtime.InteropServices.WindowsRuntime (4.3) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (== netstandard2.0)
System.Runtime (>= 4.3)
System.Security.AccessControl (6.0)
System.Security.Principal.Windows (>= 5.0) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
System.Security.Cryptography.Cng (5.0)
System.Formats.Asn1 (>= 5.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.0))
System.Security.Cryptography.Pkcs (6.0.1)
System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0)
System.Formats.Asn1 (>= 6.0)
System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0)
System.Security.Cryptography.Cng (>= 5.0) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0)
System.Security.Cryptography.ProtectedData (6.0)
System.Security.Cryptography.Xml (6.0)
System.Memory (>= 4.5.4) - restriction: == netstandard2.0
System.Security.AccessControl (>= 6.0)
System.Security.Cryptography.Pkcs (>= 6.0)
System.Security.Permissions (6.0)
System.Security.AccessControl (>= 6.0)
System.Windows.Extensions (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
System.Security.Principal.Windows (5.0)
System.Text.Encoding.CodePages (6.0)
System.Runtime.CompilerServices.Unsafe (>= 6.0)
System.Text.Encodings.Web (6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
System.Runtime.CompilerServices.Unsafe (>= 6.0)
System.Text.Json (6.0.5) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
System.Runtime.CompilerServices.Unsafe (>= 6.0)
System.Text.Encodings.Web (>= 6.0)
System.Threading.Tasks.Dataflow (6.0)
System.Threading.Tasks.Extensions (4.5.4) - restriction: || (&& (== net6.0) (>= net472)) (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (>= uap10.1)) (== netstandard2.0)
System.Runtime.CompilerServices.Unsafe (>= 4.5.3) - restriction: || (&& (== net6.0) (>= net461)) (&& (== net6.0) (< netcoreapp2.1)) (&& (== net6.0) (< netstandard1.0)) (&& (== net6.0) (< netstandard2.0)) (&& (== net6.0) (>= wp8)) (== netstandard2.0)
System.Windows.Extensions (6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
System.Drawing.Common (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))

View File

@@ -1,2 +0,0 @@
dotnet tool restore
dotnet fake %*

View File

@@ -1,7 +0,0 @@
#!/usr/bin/env bash
set -eu
set -o pipefail
dotnet tool restore
dotnet fake "$@"

View File

@@ -0,0 +1,9 @@
<Project>
<PropertyGroup>
<TargetFrameworks>net6.0;net7.0</TargetFrameworks>
<DebugType>embedded</DebugType>
<AssemblyVersion>2.0.0.0</AssemblyVersion>
<FileVersion>2.0.0.0</FileVersion>
<Version>2.0.0</Version>
</PropertyGroup>
</Project>

View File

@@ -65,6 +65,13 @@ module Json =
override _.ReadJson (reader : JsonReader, _ : Type, _ : PageId, _ : bool, _ : JsonSerializer) =
(string >> PageId) reader.Value
type PodcastMediumConverter () =
inherit JsonConverter<PodcastMedium> ()
override _.WriteJson (writer : JsonWriter, value : PodcastMedium, _ : JsonSerializer) =
writer.WriteValue (PodcastMedium.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : PodcastMedium, _ : bool, _ : JsonSerializer) =
(string >> PodcastMedium.parse) reader.Value
type PostIdConverter () =
inherit JsonConverter<PostId> ()
override _.WriteJson (writer : JsonWriter, value : PostId, _ : JsonSerializer) =
@@ -92,7 +99,14 @@ module Json =
writer.WriteValue (ThemeId.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) =
(string >> ThemeId) 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) =
@@ -108,12 +122,13 @@ module Json =
(string >> WebLogUserId) reader.Value
open Microsoft.FSharpLu.Json
/// All converters to use for data conversion
let all () : JsonConverter seq =
seq {
// Our converters
CategoryIdConverter ()
open NodaTime
open NodaTime.Serialization.JsonNet
/// Configure a serializer to use these converters
let configure (ser : JsonSerializer) =
// Our converters
[ CategoryIdConverter () :> JsonConverter
CommentIdConverter ()
CustomFeedIdConverter ()
CustomFeedSourceConverter ()
@@ -121,12 +136,44 @@ module Json =
MarkupTextConverter ()
PermalinkConverter ()
PageIdConverter ()
PodcastMediumConverter ()
PostIdConverter ()
TagMapIdConverter ()
ThemeAssetIdConverter ()
ThemeIdConverter ()
UploadIdConverter ()
WebLogIdConverter ()
WebLogUserIdConverter ()
// Handles DUs with no associated data, as well as option fields
CompactUnionJsonConverter ()
}
] |> List.iter ser.Converters.Add
// NodaTime
let _ = ser.ConfigureForNodaTime DateTimeZoneProviders.Tzdb
// Handles DUs with no associated data, as well as option fields
ser.Converters.Add (CompactUnionJsonConverter ())
ser.NullValueHandling <- NullValueHandling.Ignore
ser.MissingMemberHandling <- MissingMemberHandling.Ignore
ser
/// Serializer settings extracted from a JsonSerializer (a property sure would be nice...)
let mutable private serializerSettings : JsonSerializerSettings option = None
/// Extract settings from the serializer to be used in JsonConvert calls
let settings (ser : JsonSerializer) =
if Option.isNone serializerSettings then
serializerSettings <- JsonSerializerSettings (
ConstructorHandling = ser.ConstructorHandling,
ContractResolver = ser.ContractResolver,
Converters = ser.Converters,
DefaultValueHandling = ser.DefaultValueHandling,
DateFormatHandling = ser.DateFormatHandling,
DateParseHandling = ser.DateParseHandling,
MetadataPropertyHandling = ser.MetadataPropertyHandling,
MissingMemberHandling = ser.MissingMemberHandling,
NullValueHandling = ser.NullValueHandling,
ObjectCreationHandling = ser.ObjectCreationHandling,
ReferenceLoopHandling = ser.ReferenceLoopHandling,
SerializationBinder = ser.SerializationBinder,
TraceWriter = ser.TraceWriter,
TypeNameAssemblyFormatHandling = ser.TypeNameAssemblyFormatHandling,
TypeNameHandling = ser.TypeNameHandling)
|> Some
serializerSettings.Value

View File

@@ -1,252 +1,300 @@
namespace MyWebLog.Data
open System
open System.Threading.Tasks
open MyWebLog
open MyWebLog.ViewModels
open Newtonsoft.Json
open NodaTime
/// The result of a category deletion attempt
type CategoryDeleteResult =
/// The category was deleted successfully
| CategoryDeleted
/// The category was deleted successfully, and its children were reassigned to its parent
| ReassignedChildCategories
/// The category was not found, so no effort was made to delete it
| CategoryNotFound
/// Data functions to support manipulating categories
type ICategoryData =
/// Add a category
abstract member add : Category -> Task<unit>
abstract member Add : Category -> Task<unit>
/// Count all categories for the given web log
abstract member countAll : WebLogId -> Task<int>
abstract member CountAll : WebLogId -> Task<int>
/// Count all top-level categories for the given web log
abstract member countTopLevel : WebLogId -> Task<int>
abstract member CountTopLevel : WebLogId -> Task<int>
/// Delete a category (also removes it from posts)
abstract member delete : CategoryId -> WebLogId -> Task<bool>
abstract member Delete : CategoryId -> WebLogId -> Task<CategoryDeleteResult>
/// Find all categories for a web log, sorted alphabetically and grouped by hierarchy
abstract member findAllForView : WebLogId -> Task<DisplayCategory[]>
abstract member FindAllForView : WebLogId -> Task<DisplayCategory[]>
/// Find a category by its ID
abstract member findById : CategoryId -> WebLogId -> Task<Category option>
abstract member FindById : CategoryId -> WebLogId -> Task<Category option>
/// Find all categories for the given web log
abstract member findByWebLog : WebLogId -> Task<Category list>
abstract member FindByWebLog : WebLogId -> Task<Category list>
/// Restore categories from a backup
abstract member restore : Category list -> Task<unit>
abstract member Restore : Category list -> Task<unit>
/// Update a category (slug, name, description, and parent ID)
abstract member update : Category -> Task<unit>
abstract member Update : Category -> Task<unit>
/// Data functions to support manipulating pages
type IPageData =
/// Add a page
abstract member add : Page -> Task<unit>
abstract member Add : Page -> Task<unit>
/// Get all pages for the web log (excluding meta items, text, revisions, and prior permalinks)
abstract member all : WebLogId -> Task<Page list>
abstract member All : WebLogId -> Task<Page list>
/// Count all pages for the given web log
abstract member countAll : WebLogId -> Task<int>
abstract member CountAll : WebLogId -> Task<int>
/// Count pages marked as "show in page list" for the given web log
abstract member countListed : WebLogId -> Task<int>
abstract member CountListed : WebLogId -> Task<int>
/// Delete a page
abstract member delete : PageId -> WebLogId -> Task<bool>
abstract member Delete : PageId -> WebLogId -> Task<bool>
/// Find a page by its ID (excluding revisions and prior permalinks)
abstract member findById : PageId -> WebLogId -> Task<Page option>
abstract member FindById : PageId -> WebLogId -> Task<Page option>
/// Find a page by its permalink (excluding revisions and prior permalinks)
abstract member findByPermalink : Permalink -> WebLogId -> Task<Page option>
abstract member FindByPermalink : Permalink -> WebLogId -> Task<Page option>
/// Find the current permalink for a page from a list of prior permalinks
abstract member findCurrentPermalink : Permalink list -> WebLogId -> Task<Permalink option>
abstract member FindCurrentPermalink : Permalink list -> WebLogId -> Task<Permalink option>
/// Find a page by its ID (including revisions and prior permalinks)
abstract member findFullById : PageId -> WebLogId -> Task<Page option>
abstract member FindFullById : PageId -> WebLogId -> Task<Page option>
/// Find all pages for the given web log (including revisions and prior permalinks)
abstract member findFullByWebLog : WebLogId -> Task<Page list>
abstract member FindFullByWebLog : WebLogId -> Task<Page list>
/// Find pages marked as "show in page list" for the given web log (excluding text, revisions, and prior permalinks)
abstract member findListed : WebLogId -> Task<Page list>
abstract member FindListed : WebLogId -> Task<Page list>
/// Find a page of pages (displayed in admin section) (excluding meta items, revisions and prior permalinks)
abstract member findPageOfPages : WebLogId -> pageNbr : int -> Task<Page list>
abstract member FindPageOfPages : WebLogId -> pageNbr : int -> Task<Page list>
/// Restore pages from a backup
abstract member restore : Page list -> Task<unit>
abstract member Restore : Page list -> Task<unit>
/// Update a page
abstract member update : Page -> Task<unit>
abstract member Update : Page -> Task<unit>
/// Update the prior permalinks for the given page
abstract member updatePriorPermalinks : PageId -> WebLogId -> Permalink list -> Task<bool>
abstract member UpdatePriorPermalinks : PageId -> WebLogId -> Permalink list -> Task<bool>
/// Data functions to support manipulating posts
type IPostData =
/// Add a post
abstract member add : Post -> Task<unit>
abstract member Add : Post -> Task<unit>
/// Count posts by their status
abstract member countByStatus : PostStatus -> WebLogId -> Task<int>
abstract member CountByStatus : PostStatus -> WebLogId -> Task<int>
/// Delete a post
abstract member delete : PostId -> WebLogId -> Task<bool>
abstract member Delete : PostId -> WebLogId -> Task<bool>
/// Find a post by its ID (excluding revisions and prior permalinks)
abstract member FindById : PostId -> WebLogId -> Task<Post option>
/// Find a post by its permalink (excluding revisions and prior permalinks)
abstract member findByPermalink : Permalink -> WebLogId -> Task<Post option>
abstract member FindByPermalink : Permalink -> WebLogId -> Task<Post option>
/// Find the current permalink for a post from a list of prior permalinks
abstract member findCurrentPermalink : Permalink list -> WebLogId -> Task<Permalink option>
abstract member FindCurrentPermalink : Permalink list -> WebLogId -> Task<Permalink option>
/// Find a post by its ID (including revisions and prior permalinks)
abstract member findFullById : PostId -> WebLogId -> Task<Post option>
abstract member FindFullById : PostId -> WebLogId -> Task<Post option>
/// Find all posts for the given web log (including revisions and prior permalinks)
abstract member findFullByWebLog : WebLogId -> Task<Post list>
abstract member FindFullByWebLog : WebLogId -> Task<Post list>
/// Find posts to be displayed on a category list page (excluding revisions and prior permalinks)
abstract member findPageOfCategorizedPosts :
abstract member FindPageOfCategorizedPosts :
WebLogId -> CategoryId list -> pageNbr : int -> postsPerPage : int -> Task<Post list>
/// Find posts to be displayed on an admin page (excluding revisions and prior permalinks)
abstract member findPageOfPosts : WebLogId -> pageNbr : int -> postsPerPage : int -> Task<Post list>
abstract member FindPageOfPosts : WebLogId -> pageNbr : int -> postsPerPage : int -> Task<Post list>
/// Find posts to be displayed on a page (excluding revisions and prior permalinks)
abstract member findPageOfPublishedPosts : WebLogId -> pageNbr : int -> postsPerPage : int -> Task<Post list>
abstract member FindPageOfPublishedPosts : WebLogId -> pageNbr : int -> postsPerPage : int -> Task<Post list>
/// Find posts to be displayed on a tag list page (excluding revisions and prior permalinks)
abstract member findPageOfTaggedPosts :
abstract member FindPageOfTaggedPosts :
WebLogId -> tag : string -> pageNbr : int -> postsPerPage : int -> Task<Post list>
/// Find the next older and newer post for the given published date/time (excluding revisions and prior permalinks)
abstract member findSurroundingPosts : WebLogId -> publishedOn : DateTime -> Task<Post option * Post option>
abstract member FindSurroundingPosts : WebLogId -> publishedOn : Instant -> Task<Post option * Post option>
/// Restore posts from a backup
abstract member restore : Post list -> Task<unit>
abstract member Restore : Post list -> Task<unit>
/// Update a post
abstract member update : Post -> Task<unit>
abstract member Update : Post -> Task<unit>
/// Update the prior permalinks for a post
abstract member updatePriorPermalinks : PostId -> WebLogId -> Permalink list -> Task<bool>
abstract member UpdatePriorPermalinks : PostId -> WebLogId -> Permalink list -> Task<bool>
/// Functions to manipulate tag mappings
type ITagMapData =
/// Delete a tag mapping
abstract member delete : TagMapId -> WebLogId -> Task<bool>
abstract member Delete : TagMapId -> WebLogId -> Task<bool>
/// Find a tag mapping by its ID
abstract member findById : TagMapId -> WebLogId -> Task<TagMap option>
abstract member FindById : TagMapId -> WebLogId -> Task<TagMap option>
/// Find a tag mapping by its URL value
abstract member findByUrlValue : string -> WebLogId -> Task<TagMap option>
abstract member FindByUrlValue : string -> WebLogId -> Task<TagMap option>
/// Retrieve all tag mappings for the given web log
abstract member findByWebLog : WebLogId -> Task<TagMap list>
abstract member FindByWebLog : WebLogId -> Task<TagMap list>
/// Find tag mappings for the given tags
abstract member findMappingForTags : tags : string list -> WebLogId -> Task<TagMap list>
abstract member FindMappingForTags : tags : string list -> WebLogId -> Task<TagMap list>
/// Restore tag mappings from a backup
abstract member restore : TagMap list -> Task<unit>
abstract member Restore : TagMap list -> Task<unit>
/// Save a tag mapping (insert or update)
abstract member save : TagMap -> Task<unit>
abstract member Save : TagMap -> Task<unit>
/// Functions to manipulate themes
type IThemeData =
/// Retrieve all themes (except "admin")
abstract member all : unit -> Task<Theme list>
/// Retrieve all themes (except "admin") (excluding the text of templates)
abstract member All : unit -> Task<Theme list>
/// Delete a theme
abstract member Delete : ThemeId -> Task<bool>
/// Determine if a theme exists
abstract member Exists : ThemeId -> Task<bool>
/// Find a theme by its ID
abstract member findById : ThemeId -> Task<Theme option>
abstract member FindById : ThemeId -> Task<Theme option>
/// Find a theme by its ID (excluding the text of its templates)
abstract member findByIdWithoutText : ThemeId -> Task<Theme option>
abstract member FindByIdWithoutText : ThemeId -> Task<Theme option>
/// Save a theme (insert or update)
abstract member save : Theme -> Task<unit>
abstract member Save : Theme -> Task<unit>
/// Functions to manipulate theme assets
type IThemeAssetData =
/// Retrieve all theme assets (excluding data)
abstract member all : unit -> Task<ThemeAsset list>
abstract member All : unit -> Task<ThemeAsset list>
/// Delete all theme assets for the given theme
abstract member deleteByTheme : ThemeId -> Task<unit>
abstract member DeleteByTheme : ThemeId -> Task<unit>
/// Find a theme asset by its ID
abstract member findById : ThemeAssetId -> Task<ThemeAsset option>
abstract member FindById : ThemeAssetId -> Task<ThemeAsset option>
/// Find all assets for the given theme (excludes data)
abstract member findByTheme : ThemeId -> Task<ThemeAsset list>
abstract member FindByTheme : ThemeId -> Task<ThemeAsset list>
/// Find all assets for the given theme (includes data)
abstract member findByThemeWithData : ThemeId -> Task<ThemeAsset list>
abstract member FindByThemeWithData : ThemeId -> Task<ThemeAsset list>
/// Save a theme asset (insert or update)
abstract member save : ThemeAsset -> Task<unit>
abstract member Save : ThemeAsset -> Task<unit>
/// Functions to manipulate uploaded files
type IUploadData =
/// Add an uploaded file
abstract member Add : Upload -> Task<unit>
/// Delete an uploaded file
abstract member Delete : UploadId -> WebLogId -> Task<Result<string, string>>
/// Find an uploaded file by its path for the given web log
abstract member FindByPath : string -> WebLogId -> Task<Upload option>
/// Find all uploaded files for a web log (excludes data)
abstract member FindByWebLog : WebLogId -> Task<Upload list>
/// Find all uploaded files for a web log
abstract member FindByWebLogWithData : WebLogId -> Task<Upload list>
/// Restore uploaded files from a backup
abstract member Restore : Upload list -> Task<unit>
/// Functions to manipulate web logs
type IWebLogData =
/// Add a web log
abstract member add : WebLog -> Task<unit>
abstract member Add : WebLog -> Task<unit>
/// Retrieve all web logs
abstract member all : unit -> Task<WebLog list>
abstract member All : unit -> Task<WebLog list>
/// Delete a web log, including categories, tag mappings, posts/comments, and pages
abstract member delete : WebLogId -> Task<unit>
abstract member Delete : WebLogId -> Task<unit>
/// Find a web log by its host (URL base)
abstract member findByHost : string -> Task<WebLog option>
abstract member FindByHost : string -> Task<WebLog option>
/// Find a web log by its ID
abstract member findById : WebLogId -> Task<WebLog option>
abstract member FindById : WebLogId -> Task<WebLog option>
/// Update RSS options for a web log
abstract member updateRssOptions : WebLog -> Task<unit>
abstract member UpdateRssOptions : WebLog -> Task<unit>
/// Update web log settings (from the settings page)
abstract member updateSettings : WebLog -> Task<unit>
abstract member UpdateSettings : WebLog -> Task<unit>
/// Functions to manipulate web log users
type IWebLogUserData =
/// Add a web log user
abstract member add : WebLogUser -> Task<unit>
abstract member Add : WebLogUser -> Task<unit>
/// Delete a web log user
abstract member Delete : WebLogUserId -> WebLogId -> Task<Result<bool, string>>
/// Find a web log user by their e-mail address
abstract member findByEmail : email : string -> WebLogId -> Task<WebLogUser option>
abstract member FindByEmail : email : string -> WebLogId -> Task<WebLogUser option>
/// Find a web log user by their ID
abstract member findById : WebLogUserId -> WebLogId -> Task<WebLogUser option>
abstract member FindById : WebLogUserId -> WebLogId -> Task<WebLogUser option>
/// Find all web log users for the given web log
abstract member findByWebLog : WebLogId -> Task<WebLogUser list>
abstract member FindByWebLog : WebLogId -> Task<WebLogUser list>
/// Get a user ID -> name dictionary for the given user IDs
abstract member findNames : WebLogId -> WebLogUserId list -> Task<MetaItem list>
abstract member FindNames : WebLogId -> WebLogUserId list -> Task<MetaItem list>
/// Restore users from a backup
abstract member restore : WebLogUser list -> Task<unit>
abstract member Restore : WebLogUser list -> Task<unit>
/// Set a user's last seen date/time to now
abstract member SetLastSeen : WebLogUserId -> WebLogId -> Task<unit>
/// Update a web log user
abstract member update : WebLogUser -> Task<unit>
abstract member Update : WebLogUser -> Task<unit>
/// Data interface required for a myWebLog data implementation
@@ -270,12 +318,18 @@ 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
/// Web log user data functions
abstract member WebLogUser : IWebLogUserData
/// A JSON serializer for use in persistence
abstract member Serializer : JsonSerializer
/// Do any required start up data checks
abstract member startUp : unit -> Task<unit>
abstract member StartUp : unit -> Task<unit>

View File

@@ -1,23 +1,20 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net6.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<DebugType>embedded</DebugType>
</PropertyGroup>
<ItemGroup>
<ProjectReference Include="..\MyWebLog.Domain\MyWebLog.Domain.fsproj" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.6" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" />
<PackageReference Include="BitBadger.Npgsql.FSharp.Documents" Version="1.0.0-beta2" />
<PackageReference Include="Microsoft.Data.Sqlite" Version="7.0.3" />
<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="7.0.0" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="7.0.0" />
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.2" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.1" />
<PackageReference Include="Npgsql.NodaTime" Version="7.0.2" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-05" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
</ItemGroup>
<ItemGroup>
@@ -25,7 +22,27 @@
<Compile Include="Interfaces.fs" />
<Compile Include="Utils.fs" />
<Compile Include="RethinkDbData.fs" />
<Compile Include="SQLite\Helpers.fs" />
<Compile Include="SQLite\SQLiteCategoryData.fs" />
<Compile Include="SQLite\SQLitePageData.fs" />
<Compile Include="SQLite\SQLitePostData.fs" />
<Compile Include="SQLite\SQLiteTagMapData.fs" />
<Compile Include="SQLite\SQLiteThemeData.fs" />
<Compile Include="SQLite\SQLiteUploadData.fs" />
<Compile Include="SQLite\SQLiteWebLogData.fs" />
<Compile Include="SQLite\SQLiteWebLogUserData.fs" />
<Compile Include="SQLiteData.fs" />
<Compile Include="Postgres\PostgresHelpers.fs" />
<Compile Include="Postgres\PostgresCache.fs" />
<Compile Include="Postgres\PostgresCategoryData.fs" />
<Compile Include="Postgres\PostgresPageData.fs" />
<Compile Include="Postgres\PostgresPostData.fs" />
<Compile Include="Postgres\PostgresTagMapData.fs" />
<Compile Include="Postgres\PostgresThemeData.fs" />
<Compile Include="Postgres\PostgresUploadData.fs" />
<Compile Include="Postgres\PostgresWebLogData.fs" />
<Compile Include="Postgres\PostgresWebLogUserData.fs" />
<Compile Include="PostgresData.fs" />
</ItemGroup>
</Project>

View File

@@ -0,0 +1,183 @@
namespace MyWebLog.Data.Postgres
open System.Threading
open System.Threading.Tasks
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Caching.Distributed
open NodaTime
open Npgsql.FSharp
/// Helper types and functions for the cache
[<AutoOpen>]
module private Helpers =
/// The cache entry
type Entry =
{ /// The ID of the cache entry
Id : string
/// The value to be cached
Payload : byte[]
/// When this entry will expire
ExpireAt : Instant
/// The duration by which the expiration should be pushed out when being refreshed
SlidingExpiration : Duration option
/// The must-expire-by date/time for the cache entry
AbsoluteExpiration : Instant option
}
/// Run a task synchronously
let sync<'T> (it : Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously)
/// Get the current instant
let getNow () = SystemClock.Instance.GetCurrentInstant ()
/// Create a parameter for the expire-at time
let expireParam =
typedParam "expireAt"
/// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog
type DistributedCache () =
// ~~~ INITIALIZATION ~~~
do
task {
let! exists =
Custom.scalar
$"SELECT EXISTS
(SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session')
AS {existsName}" [] Map.toExists
if not exists then
do! Custom.nonQuery
"CREATE TABLE session (
id TEXT NOT NULL PRIMARY KEY,
payload BYTEA NOT NULL,
expire_at TIMESTAMPTZ NOT NULL,
sliding_expiration INTERVAL,
absolute_expiration TIMESTAMPTZ);
CREATE INDEX idx_session_expiration ON session (expire_at)" []
} |> sync
// ~~~ SUPPORT FUNCTIONS ~~~
/// Get an entry, updating it for sliding expiration
let getEntry key = backgroundTask {
let idParam = "@id", Sql.string key
let! tryEntry =
Custom.single "SELECT * FROM session WHERE id = @id" [ idParam ]
(fun row ->
{ Id = row.string "id"
Payload = row.bytea "payload"
ExpireAt = row.fieldValue<Instant> "expire_at"
SlidingExpiration = row.fieldValueOrNone<Duration> "sliding_expiration"
AbsoluteExpiration = row.fieldValueOrNone<Instant> "absolute_expiration" })
match tryEntry with
| Some entry ->
let now = getNow ()
let slideExp = defaultArg entry.SlidingExpiration Duration.MinValue
let absExp = defaultArg entry.AbsoluteExpiration Instant.MinValue
let needsRefresh, item =
if entry.ExpireAt = absExp then false, entry
elif slideExp = Duration.MinValue && absExp = Instant.MinValue then false, entry
elif absExp > Instant.MinValue && entry.ExpireAt.Plus slideExp > absExp then
true, { entry with ExpireAt = absExp }
else true, { entry with ExpireAt = now.Plus slideExp }
if needsRefresh then
do! Custom.nonQuery "UPDATE session SET expire_at = @expireAt WHERE id = @id"
[ expireParam item.ExpireAt; idParam ]
()
return if item.ExpireAt > now then Some entry else None
| None -> return None
}
/// The last time expired entries were purged (runs every 30 minutes)
let mutable lastPurge = Instant.MinValue
/// Purge expired entries every 30 minutes
let purge () = backgroundTask {
let now = getNow ()
if lastPurge.Plus (Duration.FromMinutes 30L) < now then
do! Custom.nonQuery "DELETE FROM session WHERE expire_at < @expireAt" [ expireParam now ]
lastPurge <- now
}
/// Remove a cache entry
let removeEntry key =
Delete.byId "session" key
/// Save an entry
let saveEntry (opts : DistributedCacheEntryOptions) key payload =
let now = getNow ()
let expireAt, slideExp, absExp =
if opts.SlidingExpiration.HasValue then
let slide = Duration.FromTimeSpan opts.SlidingExpiration.Value
now.Plus slide, Some slide, None
elif opts.AbsoluteExpiration.HasValue then
let exp = Instant.FromDateTimeOffset opts.AbsoluteExpiration.Value
exp, None, Some exp
elif opts.AbsoluteExpirationRelativeToNow.HasValue then
let exp = now.Plus (Duration.FromTimeSpan opts.AbsoluteExpirationRelativeToNow.Value)
exp, None, Some exp
else
// Default to 1 hour sliding expiration
let slide = Duration.FromHours 1
now.Plus slide, Some slide, None
Custom.nonQuery
"INSERT INTO session (
id, payload, expire_at, sliding_expiration, absolute_expiration
) VALUES (
@id, @payload, @expireAt, @slideExp, @absExp
) ON CONFLICT (id) DO UPDATE
SET payload = EXCLUDED.payload,
expire_at = EXCLUDED.expire_at,
sliding_expiration = EXCLUDED.sliding_expiration,
absolute_expiration = EXCLUDED.absolute_expiration"
[ "@id", Sql.string key
"@payload", Sql.bytea payload
expireParam expireAt
optParam "slideExp" slideExp
optParam "absExp" absExp ]
// ~~~ IMPLEMENTATION FUNCTIONS ~~~
/// Retrieve the data for a cache entry
let get key (_ : CancellationToken) = backgroundTask {
match! getEntry key with
| Some entry ->
do! purge ()
return entry.Payload
| None -> return null
}
/// Refresh an entry
let refresh key (cancelToken : CancellationToken) = backgroundTask {
let! _ = get key cancelToken
()
}
/// Remove an entry
let remove key (_ : CancellationToken) = backgroundTask {
do! removeEntry key
do! purge ()
}
/// Set an entry
let set key value options (_ : CancellationToken) = backgroundTask {
do! saveEntry options key value
do! purge ()
}
interface IDistributedCache with
member _.Get key = get key CancellationToken.None |> sync
member _.GetAsync (key, token) = get key token
member _.Refresh key = refresh key CancellationToken.None |> sync
member _.RefreshAsync (key, token) = refresh key token
member _.Remove key = remove key CancellationToken.None |> sync
member _.RemoveAsync (key, token) = remove key token
member _.Set (key, value, options) = set key value options CancellationToken.None |> sync
member _.SetAsync (key, value, options, token) = set key value options token

View File

@@ -0,0 +1,149 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Npgsql.FSharp
/// PostgreSQL myWebLog category data implementation
type PostgresCategoryData (log : ILogger) =
/// Count all categories for the given web log
let countAll webLogId =
log.LogTrace "Category.countAll"
Count.byContains Table.Category (webLogDoc webLogId)
/// Count all top-level categories for the given web log
let countTopLevel webLogId =
log.LogTrace "Category.countTopLevel"
Count.byContains Table.Category {| webLogDoc webLogId with ParentId = None |}
/// Retrieve all categories for the given web log in a DotLiquid-friendly format
let findAllForView webLogId = backgroundTask {
log.LogTrace "Category.findAllForView"
let! cats =
Custom.list $"{selectWithCriteria Table.Category} ORDER BY LOWER(data ->> '{nameof Category.empty.Name}')"
[ webLogContains webLogId ] fromData<Category>
let ordered = Utils.orderByHierarchy cats None None []
let counts =
ordered
|> Seq.map (fun it ->
// Parent category post counts include posts in subcategories
let catIdSql, catIdParams =
ordered
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|> Seq.map (fun cat -> cat.Id)
|> Seq.append (Seq.singleton it.Id)
|> List.ofSeq
|> arrayContains (nameof Post.empty.CategoryIds) id
let postCount =
Custom.scalar
$"""SELECT COUNT(DISTINCT id) AS {countName}
FROM {Table.Post}
WHERE {Query.whereDataContains "@criteria"}
AND {catIdSql}"""
[ "@criteria",
Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
catIdParams
] Map.toCount
|> Async.AwaitTask
|> Async.RunSynchronously
it.Id, postCount)
|> List.ofSeq
return
ordered
|> Seq.map (fun cat ->
{ cat with
PostCount = counts
|> List.tryFind (fun c -> fst c = cat.Id)
|> Option.map snd
|> Option.defaultValue 0
})
|> Array.ofSeq
}
/// Find a category by its ID for the given web log
let findById catId webLogId =
log.LogTrace "Category.findById"
Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId CategoryId.toString webLogId
/// Find all categories for the given web log
let findByWebLog webLogId =
log.LogTrace "Category.findByWebLog"
Document.findByWebLog<Category> Table.Category webLogId
/// Create parameters for a category insert / update
let catParameters (cat : Category) =
Query.docParameters (CategoryId.toString cat.Id) cat
/// Delete a category
let delete catId webLogId = backgroundTask {
log.LogTrace "Category.delete"
match! findById catId webLogId with
| Some cat ->
// Reassign any children to the category's parent category
let! children = Find.byContains<Category> Table.Category {| ParentId = CategoryId.toString catId |}
let hasChildren = not (List.isEmpty children)
if hasChildren then
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.Update.partialById Table.Category,
children |> List.map (fun child -> [
"@id", Sql.string (CategoryId.toString child.Id)
"@data", Query.jsonbDocParam {| ParentId = cat.ParentId |}
])
]
()
// Delete the category off all posts where it is assigned
let! posts =
Custom.list $"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.empty.CategoryIds}' @> @id"
[ "@id", Query.jsonbDocParam [| CategoryId.toString catId |] ] fromData<Post>
if not (List.isEmpty posts) then
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.Update.partialById Table.Post,
posts |> List.map (fun post -> [
"@id", Sql.string (PostId.toString post.Id)
"@data", Query.jsonbDocParam
{| CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId) |}
])
]
()
// Delete the category itself
do! Delete.byId Table.Category (CategoryId.toString catId)
return if hasChildren then ReassignedChildCategories else CategoryDeleted
| None -> return CategoryNotFound
}
/// Save a category
let save (cat : Category) = backgroundTask {
log.LogTrace "Category.save"
do! save Table.Category (CategoryId.toString cat.Id) cat
}
/// Restore categories from a backup
let restore cats = backgroundTask {
log.LogTrace "Category.restore"
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.insert Table.Category, cats |> List.map catParameters
]
()
}
interface ICategoryData with
member _.Add cat = save cat
member _.CountAll webLogId = countAll webLogId
member _.CountTopLevel webLogId = countTopLevel webLogId
member _.FindAllForView webLogId = findAllForView webLogId
member _.FindById catId webLogId = findById catId webLogId
member _.FindByWebLog webLogId = findByWebLog webLogId
member _.Delete catId webLogId = delete catId webLogId
member _.Restore cats = restore cats
member _.Update cat = save cat

View File

@@ -0,0 +1,236 @@
/// Helper functions for the PostgreSQL data implementation
[<AutoOpen>]
module MyWebLog.Data.Postgres.PostgresHelpers
/// The table names used in the PostgreSQL implementation
[<RequireQualifiedAccess>]
module Table =
/// Categories
[<Literal>]
let Category = "category"
/// Database Version
[<Literal>]
let DbVersion = "db_version"
/// Pages
[<Literal>]
let Page = "page"
/// Page Revisions
[<Literal>]
let PageRevision = "page_revision"
/// Posts
[<Literal>]
let Post = "post"
/// Post Comments
[<Literal>]
let PostComment = "post_comment"
/// Post Revisions
[<Literal>]
let PostRevision = "post_revision"
/// Tag/URL Mappings
[<Literal>]
let TagMap = "tag_map"
/// Themes
[<Literal>]
let Theme = "theme"
/// Theme Assets
[<Literal>]
let ThemeAsset = "theme_asset"
/// Uploads
[<Literal>]
let Upload = "upload"
/// Web Logs
[<Literal>]
let WebLog = "web_log"
/// Users
[<Literal>]
let WebLogUser = "web_log_user"
open System
open System.Threading.Tasks
open BitBadger.Npgsql.FSharp.Documents
open MyWebLog
open MyWebLog.Data
open NodaTime
open Npgsql
open Npgsql.FSharp
/// Create a SQL parameter for the web log ID
let webLogIdParam webLogId =
"@webLogId", Sql.string (WebLogId.toString webLogId)
/// Create an anonymous record with the given web log ID
let webLogDoc (webLogId : WebLogId) =
{| WebLogId = webLogId |}
/// Create a parameter for a web log document-contains query
let webLogContains webLogId =
"@criteria", Query.jsonbDocParam (webLogDoc webLogId)
/// The name of the field to select to be able to use Map.toCount
let countName = "the_count"
/// The name of the field to select to be able to use Map.toExists
let existsName = "does_exist"
/// A SQL string to select data from a table with the given JSON document contains criteria
let selectWithCriteria tableName =
$"""{Query.selectFromTable tableName} WHERE {Query.whereDataContains "@criteria"}"""
/// Create the SQL and parameters for an IN clause
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) =
if List.isEmpty items then "", []
else
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS}, @%s{paramName}{idx}", ($"@%s{paramName}{idx}", Sql.string (valueFunc it)) :: itemP)
(Seq.ofList items
|> Seq.map (fun it ->
$"%s{colNameAndPrefix} IN (@%s{paramName}0", [ $"@%s{paramName}0", Sql.string (valueFunc it) ])
|> Seq.head)
|> function sql, ps -> $"{sql})", ps
/// Create the SQL and parameters for match-any array query
let arrayContains<'T> name (valueFunc : 'T -> string) (items : 'T list) =
$"data['{name}'] ?| @{name}Values",
($"@{name}Values", Sql.stringArray (items |> List.map valueFunc |> Array.ofList))
/// Get the first result of the given query
let tryHead<'T> (query : Task<'T list>) = backgroundTask {
let! results = query
return List.tryHead results
}
/// Create a parameter for a non-standard type
let typedParam<'T> name (it : 'T) =
$"@%s{name}", Sql.parameter (NpgsqlParameter ($"@{name}", it))
/// Create a parameter for a possibly-missing non-standard type
let optParam<'T> name (it : 'T option) =
let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value)
p.ParameterName, Sql.parameter p
/// Mapping functions for SQL queries
module Map =
/// Get a count from a row
let toCount (row : RowReader) =
row.int countName
/// Get a true/false value as to whether an item exists
let toExists (row : RowReader) =
row.bool existsName
/// Create a permalink from the current row
let toPermalink (row : RowReader) =
Permalink (row.string "permalink")
/// Create a revision from the current row
let toRevision (row : RowReader) : Revision =
{ AsOf = row.fieldValue<Instant> "as_of"
Text = row.string "revision_text" |> MarkupText.parse
}
/// Create a theme asset from the current row
let toThemeAsset includeData (row : RowReader) : ThemeAsset =
{ Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||]
}
/// Create an uploaded file from the current row
let toUpload includeData (row : RowReader) : Upload =
{ Id = row.string "id" |> UploadId
WebLogId = row.string "web_log_id" |> WebLogId
Path = row.string "path" |> Permalink
UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||]
}
/// Document manipulation functions
module Document =
/// Determine whether a document exists with the given key for the given web log
let existsByWebLog<'TKey> table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId =
Custom.scalar
$""" SELECT EXISTS (
SELECT 1 FROM %s{table} WHERE id = @id AND {Query.whereDataContains "@criteria"}
) AS {existsName}"""
[ "@id", Sql.string (keyFunc key); webLogContains webLogId ] Map.toExists
/// Find a document by its ID for the given web log
let findByIdAndWebLog<'TKey, 'TDoc> table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId =
Custom.single $"""{Query.selectFromTable table} WHERE id = @id AND {Query.whereDataContains "@criteria"}"""
[ "@id", Sql.string (keyFunc key); webLogContains webLogId ] fromData<'TDoc>
/// Find a document by its ID for the given web log
let findByWebLog<'TDoc> table webLogId : Task<'TDoc list> =
Find.byContains table (webLogDoc webLogId)
/// Functions to support revisions
module Revisions =
/// Find all revisions for the given entity
let findByEntityId<'TKey> revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) =
Custom.list $"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC"
[ "@id", Sql.string (keyFunc key) ] Map.toRevision
/// Find all revisions for all posts for the given web log
let findByWebLog<'TKey> revTable entityTable (keyFunc : string -> 'TKey) webLogId =
Custom.list
$"""SELECT pr.*
FROM %s{revTable} pr
INNER JOIN %s{entityTable} p ON p.id = pr.{entityTable}_id
WHERE p.{Query.whereDataContains "@criteria"}
ORDER BY as_of DESC"""
[ webLogContains webLogId ] (fun row -> keyFunc (row.string $"{entityTable}_id"), Map.toRevision row)
/// Parameters for a revision INSERT statement
let revParams<'TKey> (key : 'TKey) (keyFunc : 'TKey -> string) rev = [
typedParam "asOf" rev.AsOf
"@id", Sql.string (keyFunc key)
"@text", Sql.string (MarkupText.toString rev.Text)
]
/// The SQL statement to insert a revision
let insertSql table =
$"INSERT INTO %s{table} VALUES (@id, @asOf, @text)"
/// Update a page's revisions
let update<'TKey> revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
$"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf",
toDelete
|> List.map (fun it -> [
"@id", Sql.string (keyFunc key)
typedParam "asOf" it.AsOf
])
if not (List.isEmpty toAdd) then
insertSql revTable, toAdd |> List.map (revParams key keyFunc)
]
()
}

View File

@@ -0,0 +1,178 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Npgsql.FSharp
/// PostgreSQL myWebLog page data implementation
type PostgresPageData (log : ILogger) =
// SUPPORT FUNCTIONS
/// Append revisions to a page
let appendPageRevisions (page : Page) = backgroundTask {
log.LogTrace "Page.appendPageRevisions"
let! revisions = Revisions.findByEntityId Table.PageRevision Table.Page page.Id PageId.toString
return { page with Revisions = revisions }
}
/// Return a page with no text or revisions
let pageWithoutText (row : RowReader) =
{ fromData<Page> row with Text = "" }
/// Update a page's revisions
let updatePageRevisions pageId oldRevs newRevs =
log.LogTrace "Page.updatePageRevisions"
Revisions.update Table.PageRevision Table.Page pageId PageId.toString oldRevs newRevs
/// Does the given page exist?
let pageExists pageId webLogId =
log.LogTrace "Page.pageExists"
Document.existsByWebLog Table.Page pageId PageId.toString webLogId
// IMPLEMENTATION FUNCTIONS
/// Get all pages for a web log (without text or revisions)
let all webLogId =
log.LogTrace "Page.all"
Custom.list $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')"
[ webLogContains webLogId ] fromData<Page>
/// Count all pages for the given web log
let countAll webLogId =
log.LogTrace "Page.countAll"
Count.byContains Table.Page (webLogDoc webLogId)
/// Count all pages shown in the page list for the given web log
let countListed webLogId =
log.LogTrace "Page.countListed"
Count.byContains Table.Page {| webLogDoc webLogId with IsInPageList = true |}
/// Find a page by its ID (without revisions)
let findById pageId webLogId =
log.LogTrace "Page.findById"
Document.findByIdAndWebLog<PageId, Page> Table.Page pageId PageId.toString webLogId
/// Find a complete page by its ID
let findFullById pageId webLogId = backgroundTask {
log.LogTrace "Page.findFullById"
match! findById pageId webLogId with
| Some page ->
let! withMore = appendPageRevisions page
return Some withMore
| None -> return None
}
/// Delete a page by its ID
let delete pageId webLogId = backgroundTask {
log.LogTrace "Page.delete"
match! pageExists pageId webLogId with
| true ->
do! Delete.byId Table.Page (PageId.toString pageId)
return true
| false -> return false
}
/// Find a page by its permalink for the given web log
let findByPermalink permalink webLogId =
log.LogTrace "Page.findByPermalink"
Find.byContains<Page> Table.Page {| webLogDoc webLogId with Permalink = Permalink.toString permalink |}
|> tryHead
/// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
log.LogTrace "Page.findCurrentPermalink"
if List.isEmpty permalinks then return None
else
let linkSql, linkParam =
arrayContains (nameof Page.empty.PriorPermalinks) Permalink.toString permalinks
return!
Custom.single
$"""SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink
FROM page
WHERE {Query.whereDataContains "@criteria"}
AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink
}
/// Get all complete pages for the given web log
let findFullByWebLog webLogId = backgroundTask {
log.LogTrace "Page.findFullByWebLog"
let! pages = Document.findByWebLog<Page> Table.Page webLogId
let! revisions = Revisions.findByWebLog Table.PageRevision Table.Page PageId webLogId
return
pages
|> List.map (fun it ->
{ it with Revisions = revisions |> List.filter (fun r -> fst r = it.Id) |> List.map snd })
}
/// Get all listed pages for the given web log (without revisions or text)
let findListed webLogId =
log.LogTrace "Page.findListed"
Custom.list $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with IsInPageList = true |} ]
pageWithoutText
/// Get a page of pages for the given web log (without revisions)
let findPageOfPages webLogId pageNbr =
log.LogTrace "Page.findPageOfPages"
Custom.list
$"{selectWithCriteria Table.Page}
ORDER BY LOWER(data->>'{nameof Page.empty.Title}')
LIMIT @pageSize OFFSET @toSkip"
[ webLogContains webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
fromData<Page>
/// Restore pages from a backup
let restore (pages : Page list) = backgroundTask {
log.LogTrace "Page.restore"
let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.insert Table.Page,
pages
|> List.map (fun page -> Query.docParameters (PageId.toString page.Id) { page with Revisions = [] })
Revisions.insertSql Table.PageRevision,
revisions |> List.map (fun (pageId, rev) -> Revisions.revParams pageId PageId.toString rev)
]
()
}
/// Save a page
let save (page : Page) = backgroundTask {
log.LogTrace "Page.save"
let! oldPage = findFullById page.Id page.WebLogId
do! save Table.Page (PageId.toString page.Id) { page with Revisions = [] }
do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions
()
}
/// Update a page's prior permalinks
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
log.LogTrace "Page.updatePriorPermalinks"
match! pageExists pageId webLogId with
| true ->
do! Update.partialById Table.Page (PageId.toString pageId) {| PriorPermalinks = permalinks |}
return true
| false -> return false
}
interface IPageData with
member _.Add page = save page
member _.All webLogId = all webLogId
member _.CountAll webLogId = countAll webLogId
member _.CountListed webLogId = countListed webLogId
member _.Delete pageId webLogId = delete pageId webLogId
member _.FindById pageId webLogId = findById pageId webLogId
member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId
member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
member _.FindFullById pageId webLogId = findFullById pageId webLogId
member _.FindFullByWebLog webLogId = findFullByWebLog webLogId
member _.FindListed webLogId = findListed webLogId
member _.FindPageOfPages webLogId pageNbr = findPageOfPages webLogId pageNbr
member _.Restore pages = restore pages
member _.Update page = save page
member _.UpdatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks

View File

@@ -0,0 +1,228 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open NodaTime.Text
open Npgsql.FSharp
/// PostgreSQL myWebLog post data implementation
type PostgresPostData (log : ILogger) =
// SUPPORT FUNCTIONS
/// Append revisions to a post
let appendPostRevisions (post : Post) = backgroundTask {
log.LogTrace "Post.appendPostRevisions"
let! revisions = Revisions.findByEntityId Table.PostRevision Table.Post post.Id PostId.toString
return { post with Revisions = revisions }
}
/// Return a post with no revisions, prior permalinks, or text
let postWithoutText row =
{ fromData<Post> row with Text = "" }
/// Update a post's revisions
let updatePostRevisions postId oldRevs newRevs =
log.LogTrace "Post.updatePostRevisions"
Revisions.update Table.PostRevision Table.Post postId PostId.toString oldRevs newRevs
/// Does the given post exist?
let postExists postId webLogId =
log.LogTrace "Post.postExists"
Document.existsByWebLog Table.Post postId PostId.toString webLogId
// IMPLEMENTATION FUNCTIONS
/// Count posts in a status for the given web log
let countByStatus status webLogId =
log.LogTrace "Post.countByStatus"
Count.byContains Table.Post {| webLogDoc webLogId with Status = PostStatus.toString status |}
/// Find a post by its ID for the given web log (excluding revisions)
let findById postId webLogId =
log.LogTrace "Post.findById"
Document.findByIdAndWebLog<PostId, Post> Table.Post postId PostId.toString webLogId
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink permalink webLogId =
log.LogTrace "Post.findByPermalink"
Custom.single (selectWithCriteria Table.Post)
[ "@criteria",
Query.jsonbDocParam {| webLogDoc webLogId with Permalink = Permalink.toString permalink |}
] fromData<Post>
/// Find a complete post by its ID for the given web log
let findFullById postId webLogId = backgroundTask {
log.LogTrace "Post.findFullById"
match! findById postId webLogId with
| Some post ->
let! withRevisions = appendPostRevisions post
return Some withRevisions
| None -> return None
}
/// Delete a post by its ID for the given web log
let delete postId webLogId = backgroundTask {
log.LogTrace "Post.delete"
match! postExists postId webLogId with
| true ->
let theId = PostId.toString postId
do! Custom.nonQuery
$"""DELETE FROM {Table.PostComment} WHERE {Query.whereDataContains "@criteria"};
DELETE FROM {Table.Post} WHERE id = @id"""
[ "@id", Sql.string theId; "@criteria", Query.jsonbDocParam {| PostId = theId |} ]
return true
| false -> return false
}
/// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
log.LogTrace "Post.findCurrentPermalink"
if List.isEmpty permalinks then return None
else
let linkSql, linkParam =
arrayContains (nameof Post.empty.PriorPermalinks) Permalink.toString permalinks
return!
Custom.single
$"""SELECT data ->> '{nameof Post.empty.Permalink}' AS permalink
FROM {Table.Post}
WHERE {Query.whereDataContains "@criteria"}
AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink
}
/// Get all complete posts for the given web log
let findFullByWebLog webLogId = backgroundTask {
log.LogTrace "Post.findFullByWebLog"
let! posts = Document.findByWebLog<Post> Table.Post webLogId
let! revisions = Revisions.findByWebLog Table.PostRevision Table.Post PostId webLogId
return
posts
|> List.map (fun it ->
{ it with Revisions = revisions |> List.filter (fun r -> fst r = it.Id) |> List.map snd })
}
/// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
log.LogTrace "Post.findPageOfCategorizedPosts"
let catSql, catParam = arrayContains (nameof Post.empty.CategoryIds) CategoryId.toString categoryIds
Custom.list
$"{selectWithCriteria Table.Post}
AND {catSql}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
catParam
] fromData<Post>
/// Get a page of posts for the given web log (excludes text and revisions)
let findPageOfPosts webLogId pageNbr postsPerPage =
log.LogTrace "Post.findPageOfPosts"
Custom.list
$"{selectWithCriteria Table.Post}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC NULLS FIRST,
data ->> '{nameof Post.empty.UpdatedOn}'
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ webLogContains webLogId ] postWithoutText
/// Get a page of published posts for the given web log (excludes revisions)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
log.LogTrace "Post.findPageOfPublishedPosts"
Custom.list
$"{selectWithCriteria Table.Post}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |} ]
fromData<Post>
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage =
log.LogTrace "Post.findPageOfTaggedPosts"
Custom.list
$"{selectWithCriteria Table.Post}
AND data['{nameof Post.empty.Tags}'] @> @tag
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
"@tag", Query.jsonbDocParam [| tag |]
] fromData<Post>
/// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId publishedOn = backgroundTask {
log.LogTrace "Post.findSurroundingPosts"
let queryParams () = [
"@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
"@publishedOn", Sql.string ((InstantPattern.General.Format publishedOn).Substring (0, 19))
]
let pubField = nameof Post.empty.PublishedOn
let! older =
Custom.list
$"{selectWithCriteria Table.Post}
AND SUBSTR(data ->> '{pubField}', 1, 19) < @publishedOn
ORDER BY data ->> '{pubField}' DESC
LIMIT 1" (queryParams ()) fromData<Post>
let! newer =
Custom.list
$"{selectWithCriteria Table.Post}
AND SUBSTR(data ->> '{pubField}', 1, 19) > @publishedOn
ORDER BY data ->> '{pubField}'
LIMIT 1" (queryParams ()) fromData<Post>
return List.tryHead older, List.tryHead newer
}
/// Save a post
let save (post : Post) = backgroundTask {
log.LogTrace "Post.save"
let! oldPost = findFullById post.Id post.WebLogId
do! save Table.Post (PostId.toString post.Id) { post with Revisions = [] }
do! updatePostRevisions post.Id (match oldPost with Some p -> p.Revisions | None -> []) post.Revisions
}
/// Restore posts from a backup
let restore posts = backgroundTask {
log.LogTrace "Post.restore"
let revisions = posts |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.insert Table.Post,
posts
|> List.map (fun post -> Query.docParameters (PostId.toString post.Id) { post with Revisions = [] })
Revisions.insertSql Table.PostRevision,
revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId PostId.toString rev)
]
()
}
/// Update prior permalinks for a post
let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
log.LogTrace "Post.updatePriorPermalinks"
match! postExists postId webLogId with
| true ->
do! Update.partialById Table.Post (PostId.toString postId) {| PriorPermalinks = permalinks |}
return true
| false -> return false
}
interface IPostData with
member _.Add post = save post
member _.CountByStatus status webLogId = countByStatus status webLogId
member _.Delete postId webLogId = delete postId webLogId
member _.FindById postId webLogId = findById postId webLogId
member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId
member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
member _.FindFullById postId webLogId = findFullById postId webLogId
member _.FindFullByWebLog webLogId = findFullByWebLog webLogId
member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage
member _.FindPageOfPosts webLogId pageNbr postsPerPage = findPageOfPosts webLogId pageNbr postsPerPage
member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage =
findPageOfPublishedPosts webLogId pageNbr postsPerPage
member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage =
findPageOfTaggedPosts webLogId tag pageNbr postsPerPage
member _.FindSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn
member _.Restore posts = restore posts
member _.Update post = save post
member _.UpdatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks

View File

@@ -0,0 +1,70 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Npgsql.FSharp
/// PostgreSQL myWebLog tag mapping data implementation
type PostgresTagMapData (log : ILogger) =
/// Find a tag mapping by its ID for the given web log
let findById tagMapId webLogId =
log.LogTrace "TagMap.findById"
Document.findByIdAndWebLog<TagMapId, TagMap> Table.TagMap tagMapId TagMapId.toString webLogId
/// Delete a tag mapping for the given web log
let delete tagMapId webLogId = backgroundTask {
log.LogTrace "TagMap.delete"
let! exists = Document.existsByWebLog Table.TagMap tagMapId TagMapId.toString webLogId
if exists then
do! Delete.byId Table.TagMap (TagMapId.toString tagMapId)
return true
else return false
}
/// Find a tag mapping by its URL value for the given web log
let findByUrlValue (urlValue : string) webLogId =
log.LogTrace "TagMap.findByUrlValue"
Custom.single (selectWithCriteria Table.TagMap)
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with UrlValue = urlValue |} ]
fromData<TagMap>
/// Get all tag mappings for the given web log
let findByWebLog webLogId =
log.LogTrace "TagMap.findByWebLog"
Custom.list $"{selectWithCriteria Table.TagMap} ORDER BY data ->> 'tag'" [ webLogContains webLogId ]
fromData<TagMap>
/// Find any tag mappings in a list of tags for the given web log
let findMappingForTags tags webLogId =
log.LogTrace "TagMap.findMappingForTags"
let tagSql, tagParam = arrayContains (nameof TagMap.empty.Tag) id tags
Custom.list $"{selectWithCriteria Table.TagMap} AND {tagSql}" [ webLogContains webLogId; tagParam ]
fromData<TagMap>
/// Save a tag mapping
let save (tagMap : TagMap) =
save Table.TagMap (TagMapId.toString tagMap.Id) tagMap
/// Restore tag mappings from a backup
let restore (tagMaps : TagMap list) = backgroundTask {
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.insert Table.TagMap,
tagMaps |> List.map (fun tagMap -> Query.docParameters (TagMapId.toString tagMap.Id) tagMap)
]
()
}
interface ITagMapData with
member _.Delete tagMapId webLogId = delete tagMapId webLogId
member _.FindById tagMapId webLogId = findById tagMapId webLogId
member _.FindByUrlValue urlValue webLogId = findByUrlValue urlValue webLogId
member _.FindByWebLog webLogId = findByWebLog webLogId
member _.FindMappingForTags tags webLogId = findMappingForTags tags webLogId
member _.Save tagMap = save tagMap
member _.Restore tagMaps = restore tagMaps

View File

@@ -0,0 +1,117 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Npgsql.FSharp
/// PostreSQL myWebLog theme data implementation
type PostgresThemeData (log : ILogger) =
/// Clear out the template text from a theme
let withoutTemplateText row =
let theme = fromData<Theme> row
{ theme with Templates = theme.Templates |> List.map (fun template -> { template with Text = "" }) }
/// Retrieve all themes (except 'admin'; excludes template text)
let all () =
log.LogTrace "Theme.all"
Custom.list $"{Query.selectFromTable Table.Theme} WHERE id <> 'admin' ORDER BY id" [] withoutTemplateText
/// Does a given theme exist?
let exists themeId =
log.LogTrace "Theme.exists"
Exists.byId Table.Theme (ThemeId.toString themeId)
/// Find a theme by its ID
let findById themeId =
log.LogTrace "Theme.findById"
Find.byId<Theme> Table.Theme (ThemeId.toString themeId)
/// Find a theme by its ID (excludes the text of templates)
let findByIdWithoutText themeId =
log.LogTrace "Theme.findByIdWithoutText"
Custom.single (Query.Find.byId Table.Theme) [ "@id", Sql.string (ThemeId.toString themeId) ] withoutTemplateText
/// Delete a theme by its ID
let delete themeId = backgroundTask {
log.LogTrace "Theme.delete"
match! exists themeId with
| true ->
do! Delete.byId Table.Theme (ThemeId.toString themeId)
return true
| false -> return false
}
/// Save a theme
let save (theme : Theme) =
log.LogTrace "Theme.save"
save Table.Theme (ThemeId.toString theme.Id) theme
interface IThemeData with
member _.All () = all ()
member _.Delete themeId = delete themeId
member _.Exists themeId = exists themeId
member _.FindById themeId = findById themeId
member _.FindByIdWithoutText themeId = findByIdWithoutText themeId
member _.Save theme = save theme
/// PostreSQL myWebLog theme data implementation
type PostgresThemeAssetData (log : ILogger) =
/// Get all theme assets (excludes data)
let all () =
log.LogTrace "ThemeAsset.all"
Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}" [] (Map.toThemeAsset false)
/// Delete all assets for the given theme
let deleteByTheme themeId =
log.LogTrace "ThemeAsset.deleteByTheme"
Custom.nonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
[ "@themeId", Sql.string (ThemeId.toString themeId) ]
/// Find a theme asset by its ID
let findById assetId =
log.LogTrace "ThemeAsset.findById"
let (ThemeAssetId (ThemeId themeId, path)) = assetId
Custom.single $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path"
[ "@themeId", Sql.string themeId; "@path", Sql.string path ] (Map.toThemeAsset true)
/// Get theme assets for the given theme (excludes data)
let findByTheme themeId =
log.LogTrace "ThemeAsset.findByTheme"
Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
[ "@themeId", Sql.string (ThemeId.toString themeId) ] (Map.toThemeAsset false)
/// Get theme assets for the given theme
let findByThemeWithData themeId =
log.LogTrace "ThemeAsset.findByThemeWithData"
Custom.list $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
[ "@themeId", Sql.string (ThemeId.toString themeId) ] (Map.toThemeAsset true)
/// Save a theme asset
let save (asset : ThemeAsset) =
log.LogTrace "ThemeAsset.save"
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
Custom.nonQuery
$"INSERT INTO {Table.ThemeAsset} (
theme_id, path, updated_on, data
) VALUES (
@themeId, @path, @updatedOn, @data
) ON CONFLICT (theme_id, path) DO UPDATE
SET updated_on = EXCLUDED.updated_on,
data = EXCLUDED.data"
[ "@themeId", Sql.string themeId
"@path", Sql.string path
"@data", Sql.bytea asset.Data
typedParam "updatedOn" asset.UpdatedOn ]
interface IThemeAssetData with
member _.All () = all ()
member _.DeleteByTheme themeId = deleteByTheme themeId
member _.FindById assetId = findById assetId
member _.FindByTheme themeId = findByTheme themeId
member _.FindByThemeWithData themeId = findByThemeWithData themeId
member _.Save asset = save asset

View File

@@ -0,0 +1,83 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Npgsql.FSharp
/// PostgreSQL myWebLog uploaded file data implementation
type PostgresUploadData (log : ILogger) =
/// The INSERT statement for an uploaded file
let upInsert = $"
INSERT INTO {Table.Upload} (
id, web_log_id, path, updated_on, data
) VALUES (
@id, @webLogId, @path, @updatedOn, @data
)"
/// Parameters for adding an uploaded file
let upParams (upload : Upload) = [
webLogIdParam upload.WebLogId
typedParam "updatedOn" upload.UpdatedOn
"@id", Sql.string (UploadId.toString upload.Id)
"@path", Sql.string (Permalink.toString upload.Path)
"@data", Sql.bytea upload.Data
]
/// Save an uploaded file
let add upload =
log.LogTrace "Upload.add"
Custom.nonQuery upInsert (upParams upload)
/// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask {
log.LogTrace "Upload.delete"
let idParam = [ "@id", Sql.string (UploadId.toString uploadId) ]
let! path =
Custom.single $"SELECT path FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
(webLogIdParam webLogId :: idParam) (fun row -> row.string "path")
if Option.isSome path then
do! Custom.nonQuery (Query.Delete.byId Table.Upload) idParam
return Ok path.Value
else return Error $"""Upload ID {UploadId.toString uploadId} not found"""
}
/// Find an uploaded file by its path for the given web log
let findByPath path webLogId =
log.LogTrace "Upload.findByPath"
Custom.single $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path"
[ webLogIdParam webLogId; "@path", Sql.string path ] (Map.toUpload true)
/// Find all uploaded files for the given web log (excludes data)
let findByWebLog webLogId =
log.LogTrace "Upload.findByWebLog"
Custom.list $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId"
[ webLogIdParam webLogId ] (Map.toUpload false)
/// Find all uploaded files for the given web log
let findByWebLogWithData webLogId =
log.LogTrace "Upload.findByWebLogWithData"
Custom.list $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId" [ webLogIdParam webLogId ]
(Map.toUpload true)
/// Restore uploads from a backup
let restore uploads = backgroundTask {
log.LogTrace "Upload.restore"
for batch in uploads |> List.chunkBySize 5 do
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [ upInsert, batch |> List.map upParams ]
()
}
interface IUploadData with
member _.Add upload = add upload
member _.Delete uploadId webLogId = delete uploadId webLogId
member _.FindByPath path webLogId = findByPath path webLogId
member _.FindByWebLog webLogId = findByWebLog webLogId
member _.FindByWebLogWithData webLogId = findByWebLogWithData webLogId
member _.Restore uploads = restore uploads

View File

@@ -0,0 +1,68 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
/// PostgreSQL myWebLog web log data implementation
type PostgresWebLogData (log : ILogger) =
/// Add a web log
let add (webLog : WebLog) =
log.LogTrace "WebLog.add"
insert Table.WebLog (WebLogId.toString webLog.Id) webLog
/// Retrieve all web logs
let all () =
log.LogTrace "WebLog.all"
Find.all<WebLog> Table.WebLog
/// Delete a web log by its ID
let delete webLogId =
log.LogTrace "WebLog.delete"
Custom.nonQuery
$"""DELETE FROM {Table.PostComment}
WHERE data ->> '{nameof Comment.empty.PostId}' IN
(SELECT id FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"});
{Query.Delete.byContains Table.Post};
{Query.Delete.byContains Table.Page};
{Query.Delete.byContains Table.Category};
{Query.Delete.byContains Table.TagMap};
{Query.Delete.byContains Table.WebLogUser};
DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId;
DELETE FROM {Table.WebLog} WHERE id = @webLogId"""
[ webLogIdParam webLogId; webLogContains webLogId ]
/// Find a web log by its host (URL base)
let findByHost (url : string) =
log.LogTrace "WebLog.findByHost"
Custom.single (selectWithCriteria Table.WebLog) [ "@criteria", Query.jsonbDocParam {| UrlBase = url |} ]
fromData<WebLog>
/// Find a web log by its ID
let findById webLogId =
log.LogTrace "WebLog.findById"
Find.byId<WebLog> Table.WebLog (WebLogId.toString webLogId)
/// Update settings for a web log
let updateSettings (webLog : WebLog) =
log.LogTrace "WebLog.updateSettings"
Update.full Table.WebLog (WebLogId.toString webLog.Id) webLog
/// Update RSS options for a web log
let updateRssOptions (webLog : WebLog) = backgroundTask {
log.LogTrace "WebLog.updateRssOptions"
match! findById webLog.Id with
| Some _ -> do! Update.partialById Table.WebLog (WebLogId.toString webLog.Id) {| Rss = webLog.Rss |}
| None -> ()
}
interface IWebLogData with
member _.Add webLog = add webLog
member _.All () = all ()
member _.Delete webLogId = delete webLogId
member _.FindByHost url = findByHost url
member _.FindById webLogId = findById webLogId
member _.UpdateSettings webLog = updateSettings webLog
member _.UpdateRssOptions webLog = updateRssOptions webLog

View File

@@ -0,0 +1,100 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Npgsql.FSharp
/// PostgreSQL myWebLog user data implementation
type PostgresWebLogUserData (log : ILogger) =
/// Find a user by their ID for the given web log
let findById userId webLogId =
log.LogTrace "WebLogUser.findById"
Document.findByIdAndWebLog<WebLogUserId, WebLogUser> Table.WebLogUser userId WebLogUserId.toString webLogId
/// Delete a user if they have no posts or pages
let delete userId webLogId = backgroundTask {
log.LogTrace "WebLogUser.delete"
match! findById userId webLogId with
| Some _ ->
let criteria = Query.whereDataContains "@criteria"
let! isAuthor =
Custom.scalar
$" SELECT ( EXISTS (SELECT 1 FROM {Table.Page} WHERE {criteria}
OR EXISTS (SELECT 1 FROM {Table.Post} WHERE {criteria})
) AS {existsName}"
[ "@criteria", Query.jsonbDocParam {| AuthorId = userId |} ] Map.toExists
if isAuthor then
return Error "User has pages or posts; cannot delete"
else
do! Delete.byId Table.WebLogUser (WebLogUserId.toString userId)
return Ok true
| None -> return Error "User does not exist"
}
/// Find a user by their e-mail address for the given web log
let findByEmail (email : string) webLogId =
log.LogTrace "WebLogUser.findByEmail"
Custom.single (selectWithCriteria Table.WebLogUser)
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Email = email |} ]
fromData<WebLogUser>
/// Get all users for the given web log
let findByWebLog webLogId =
log.LogTrace "WebLogUser.findByWebLog"
Custom.list
$"{selectWithCriteria Table.WebLogUser} ORDER BY LOWER(data->>'{nameof WebLogUser.empty.PreferredName}')"
[ webLogContains webLogId ] fromData<WebLogUser>
/// Find the names of users by their IDs for the given web log
let findNames webLogId userIds = backgroundTask {
log.LogTrace "WebLogUser.findNames"
let idSql, idParams = inClause "AND id" "id" WebLogUserId.toString userIds
let! users =
Custom.list $"{selectWithCriteria Table.WebLogUser} {idSql}" (webLogContains webLogId :: idParams)
fromData<WebLogUser>
return
users
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
}
/// Restore users from a backup
let restore (users : WebLogUser list) = backgroundTask {
log.LogTrace "WebLogUser.restore"
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.insert Table.WebLogUser,
users |> List.map (fun user -> Query.docParameters (WebLogUserId.toString user.Id) user)
]
()
}
/// Set a user's last seen date/time to now
let setLastSeen userId webLogId = backgroundTask {
log.LogTrace "WebLogUser.setLastSeen"
match! Document.existsByWebLog Table.WebLogUser userId WebLogUserId.toString webLogId with
| true ->
do! Update.partialById Table.WebLogUser (WebLogUserId.toString userId) {| LastSeenOn = Some (Noda.now ()) |}
| false -> ()
}
/// Save a user
let save (user : WebLogUser) =
log.LogTrace "WebLogUser.save"
save Table.WebLogUser (WebLogUserId.toString user.Id) user
interface IWebLogUserData with
member _.Add user = save user
member _.Delete userId webLogId = delete userId webLogId
member _.FindByEmail email webLogId = findByEmail email webLogId
member _.FindById userId webLogId = findById userId webLogId
member _.FindByWebLog webLogId = findByWebLog webLogId
member _.FindNames webLogId userIds = findNames webLogId userIds
member _.Restore users = restore users
member _.SetLastSeen userId webLogId = setLastSeen userId webLogId
member _.Update user = save user

View File

@@ -0,0 +1,199 @@
namespace MyWebLog.Data
open BitBadger.Npgsql.Documents
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data.Postgres
open Newtonsoft.Json
open Npgsql
open Npgsql.FSharp
/// Data implementation for PostgreSQL
type PostgresData (source : NpgsqlDataSource, log : ILogger<PostgresData>, ser : JsonSerializer) =
/// Create any needed tables
let ensureTables () = backgroundTask {
// Set up the PostgreSQL document store
Configuration.useDataSource source
Configuration.useSerializer
{ new IDocumentSerializer with
member _.Serialize<'T> (it : 'T) : string = Utils.serialize ser it
member _.Deserialize<'T> (it : string) : 'T = Utils.deserialize ser it
}
let! tables =
Sql.fromDataSource source
|> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'"
|> Sql.executeAsync (fun row -> row.string "tablename")
let needsTable table = not (List.contains table tables)
// Create a document table
let mutable isNew = false
let sql = seq {
// Theme tables
if needsTable Table.Theme then
isNew <- true
Definition.createTable Table.Theme
if needsTable Table.ThemeAsset then
$"CREATE TABLE {Table.ThemeAsset} (
theme_id TEXT NOT NULL REFERENCES {Table.Theme} (id) ON DELETE CASCADE,
path TEXT NOT NULL,
updated_on TIMESTAMPTZ NOT NULL,
data BYTEA NOT NULL,
PRIMARY KEY (theme_id, path))"
// Web log table
if needsTable Table.WebLog then
Definition.createTable Table.WebLog
Definition.createIndex Table.WebLog Optimized
// Category table
if needsTable Table.Category then
Definition.createTable Table.Category
Definition.createIndex Table.Category Optimized
// Web log user table
if needsTable Table.WebLogUser then
Definition.createTable Table.WebLogUser
Definition.createIndex Table.WebLogUser Optimized
// Page tables
if needsTable Table.Page then
Definition.createTable Table.Page
$"CREATE INDEX page_web_log_idx ON {Table.Page} ((data ->> '{nameof Page.empty.WebLogId}'))"
$"CREATE INDEX page_author_idx ON {Table.Page} ((data ->> '{nameof Page.empty.AuthorId}'))"
$"CREATE INDEX page_permalink_idx ON {Table.Page}
((data ->> '{nameof Page.empty.WebLogId}'), (data ->> '{nameof Page.empty.Permalink}'))"
if needsTable Table.PageRevision then
$"CREATE TABLE {Table.PageRevision} (
page_id TEXT NOT NULL REFERENCES {Table.Page} (id) ON DELETE CASCADE,
as_of TIMESTAMPTZ NOT NULL,
revision_text TEXT NOT NULL,
PRIMARY KEY (page_id, as_of))"
// Post tables
if needsTable Table.Post then
Definition.createTable Table.Post
$"CREATE INDEX post_web_log_idx ON {Table.Post} ((data ->> '{nameof Post.empty.WebLogId}'))"
$"CREATE INDEX post_author_idx ON {Table.Post} ((data ->> '{nameof Post.empty.AuthorId}'))"
$"CREATE INDEX post_status_idx ON {Table.Post}
((data ->> '{nameof Post.empty.WebLogId}'), (data ->> '{nameof Post.empty.Status}'),
(data ->> '{nameof Post.empty.UpdatedOn}'))"
$"CREATE INDEX post_permalink_idx ON {Table.Post}
((data ->> '{nameof Post.empty.WebLogId}'), (data ->> '{nameof Post.empty.Permalink}'))"
$"CREATE INDEX post_category_idx ON {Table.Post} USING GIN ((data['{nameof Post.empty.CategoryIds}']))"
$"CREATE INDEX post_tag_idx ON {Table.Post} USING GIN ((data['{nameof Post.empty.Tags}']))"
if needsTable Table.PostRevision then
$"CREATE TABLE {Table.PostRevision} (
post_id TEXT NOT NULL REFERENCES {Table.Post} (id) ON DELETE CASCADE,
as_of TIMESTAMPTZ NOT NULL,
revision_text TEXT NOT NULL,
PRIMARY KEY (post_id, as_of))"
if needsTable Table.PostComment then
Definition.createTable Table.PostComment
$"CREATE INDEX post_comment_post_idx ON {Table.PostComment}
((data ->> '{nameof Comment.empty.PostId}'))"
// Tag map table
if needsTable Table.TagMap then
Definition.createTable Table.TagMap
Definition.createIndex Table.TagMap Optimized
// Uploaded file table
if needsTable Table.Upload then
$"CREATE TABLE {Table.Upload} (
id TEXT NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES {Table.WebLog} (id),
path TEXT NOT NULL,
updated_on TIMESTAMPTZ NOT NULL,
data BYTEA NOT NULL)"
$"CREATE INDEX upload_web_log_idx ON {Table.Upload} (web_log_id)"
$"CREATE INDEX upload_path_idx ON {Table.Upload} (web_log_id, path)"
// Database version table
if needsTable Table.DbVersion then
$"CREATE TABLE {Table.DbVersion} (id TEXT NOT NULL PRIMARY KEY)"
$"INSERT INTO {Table.DbVersion} VALUES ('{Utils.currentDbVersion}')"
}
Sql.fromDataSource source
|> Sql.executeTransactionAsync
(sql
|> Seq.map (fun s ->
let parts = s.Replace(" IF NOT EXISTS", "", System.StringComparison.OrdinalIgnoreCase).Split ' '
if parts[1].ToLowerInvariant () = "table" then
log.LogInformation $"Creating {parts[2]} table..."
s, [ [] ])
|> List.ofSeq)
|> Async.AwaitTask
|> Async.RunSynchronously
|> ignore
}
/// Set a specific database version
let setDbVersion version =
Custom.nonQuery $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')" []
/// Migrate from v2-rc2 to v2 (manual migration required)
let migrateV2Rc2ToV2 () = backgroundTask {
Utils.logMigrationStep log "v2-rc2 to v2" "Requires user action"
let! webLogs =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.query $"SELECT url_base, slug FROM {Table.WebLog}"
|> Sql.executeAsync (fun row -> row.string "url_base", row.string "slug")
[ "** MANUAL DATABASE UPGRADE REQUIRED **"; ""
"The data structure for PostgreSQL changed significantly between v2-rc2 and v2."
"To migrate your data:"
" - Use a v2-rc2 executable to back up each web log"
" - Drop all tables from the database"
" - Use this executable to restore each backup"; ""
"Commands to back up all web logs:"
yield! webLogs |> List.map (fun (url, slug) -> sprintf "./myWebLog backup %s v2-rc2.%s.json" url slug)
]
|> String.concat "\n"
|> log.LogWarning
log.LogCritical "myWebLog will now exit"
exit 1
}
/// Do required data migration between versions
let migrate version = backgroundTask {
match version with
| Some "v2" -> ()
| Some "v2-rc2" -> do! migrateV2Rc2ToV2 ()
// Future versions will be inserted here
| Some _
| None ->
log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
do! setDbVersion Utils.currentDbVersion
}
interface IData with
member _.Category = PostgresCategoryData log
member _.Page = PostgresPageData log
member _.Post = PostgresPostData log
member _.TagMap = PostgresTagMapData log
member _.Theme = PostgresThemeData log
member _.ThemeAsset = PostgresThemeAssetData log
member _.Upload = PostgresUploadData log
member _.WebLog = PostgresWebLogData log
member _.WebLogUser = PostgresWebLogUserData log
member _.Serializer = ser
member _.StartUp () = backgroundTask {
log.LogTrace "PostgresData.StartUp"
do! ensureTables ()
let! version = Custom.single "SELECT id FROM db_version" [] (fun row -> row.string "id")
match version with
| Some v when v = Utils.currentDbVersion -> ()
| Some _
| None -> do! migrate version
}

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,314 @@
/// Helper functions for the SQLite data implementation
[<AutoOpen>]
module MyWebLog.Data.SQLite.Helpers
open System
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
open NodaTime.Text
/// Run a command that returns a count
let count (cmd : SqliteCommand) = backgroundTask {
let! it = cmd.ExecuteScalarAsync ()
return int (it :?> int64)
}
/// Create a list of items from the given data reader
let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) =
seq { while rdr.Read () do it rdr }
|> List.ofSeq
/// Verify that the web log ID matches before returning an item
let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) =
if rdr.Read () then
let item = it rdr
if prop item = webLogId then Some item else None
else None
/// Execute a command that returns no data
let write (cmd : SqliteCommand) = backgroundTask {
let! _ = cmd.ExecuteNonQueryAsync ()
()
}
/// Add a possibly-missing parameter, substituting null for None
let maybe<'T> (it : 'T option) : obj = match it with Some x -> x :> obj | None -> DBNull.Value
/// Create a value for a Duration
let durationParam =
DurationPattern.Roundtrip.Format
/// Create a value for an Instant
let instantParam =
InstantPattern.General.Format
/// Create an optional value for a Duration
let maybeDuration =
Option.map durationParam >> maybe
/// Create an optional value for an Instant
let maybeInstant =
Option.map instantParam >> maybe
/// Create the SQL and parameters for an IN clause
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) =
if List.isEmpty items then "", []
else
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS}, @%s{paramName}{idx}", (SqliteParameter ($"@%s{paramName}{idx}", valueFunc it) :: itemP))
(Seq.ofList items
|> Seq.map (fun it ->
$"%s{colNameAndPrefix} IN (@%s{paramName}0", [ SqliteParameter ($"@%s{paramName}0", valueFunc it) ])
|> Seq.head)
|> function sql, ps -> $"{sql})", ps
/// Functions to map domain items from a data reader
module Map =
open System.IO
/// Get a boolean value from a data reader
let getBoolean col (rdr : SqliteDataReader) = rdr.GetBoolean (rdr.GetOrdinal col)
/// Get a date/time value from a data reader
let getDateTime col (rdr : SqliteDataReader) = rdr.GetDateTime (rdr.GetOrdinal col)
/// Get a Guid value from a data reader
let getGuid col (rdr : SqliteDataReader) = rdr.GetGuid (rdr.GetOrdinal col)
/// Get an int value from a data reader
let getInt col (rdr : SqliteDataReader) = rdr.GetInt32 (rdr.GetOrdinal col)
/// Get a long (64-bit int) value from a data reader
let getLong col (rdr : SqliteDataReader) = rdr.GetInt64 (rdr.GetOrdinal col)
/// Get a BLOB stream value from a data reader
let getStream col (rdr : SqliteDataReader) = rdr.GetStream (rdr.GetOrdinal col)
/// Get a string value from a data reader
let getString col (rdr : SqliteDataReader) = rdr.GetString (rdr.GetOrdinal col)
/// Parse a Duration from the given value
let parseDuration value =
match DurationPattern.Roundtrip.Parse value with
| it when it.Success -> it.Value
| it -> raise it.Exception
/// Get a Duration value from a data reader
let getDuration col rdr =
getString col rdr |> parseDuration
/// Parse an Instant from the given value
let parseInstant value =
match InstantPattern.General.Parse value with
| it when it.Success -> it.Value
| it -> raise it.Exception
/// Get an Instant value from a data reader
let getInstant col rdr =
getString col rdr |> parseInstant
/// Get a timespan value from a data reader
let getTimeSpan col (rdr : SqliteDataReader) = rdr.GetTimeSpan (rdr.GetOrdinal col)
/// Get a possibly null boolean value from a data reader
let tryBoolean col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getBoolean col rdr)
/// Get a possibly null date/time value from a data reader
let tryDateTime col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getDateTime col rdr)
/// Get a possibly null Guid value from a data reader
let tryGuid col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getGuid col rdr)
/// Get a possibly null int value from a data reader
let tryInt col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getInt col rdr)
/// Get a possibly null string value from a data reader
let tryString col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr)
/// Get a possibly null Duration value from a data reader
let tryDuration col rdr =
tryString col rdr |> Option.map parseDuration
/// Get a possibly null Instant value from a data reader
let tryInstant col rdr =
tryString col rdr |> Option.map parseInstant
/// Get a possibly null timespan value from a data reader
let tryTimeSpan col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
/// Map an id field to a category ID
let toCategoryId rdr = getString "id" rdr |> CategoryId
/// Create a category from the current row in the given data reader
let toCategory rdr : Category =
{ Id = toCategoryId rdr
WebLogId = getString "web_log_id" rdr |> WebLogId
Name = getString "name" rdr
Slug = getString "slug" rdr
Description = tryString "description" rdr
ParentId = tryString "parent_id" rdr |> Option.map CategoryId
}
/// Create a custom feed from the current row in the given data reader
let toCustomFeed ser rdr : CustomFeed =
{ Id = getString "id" rdr |> CustomFeedId
Source = getString "source" rdr |> CustomFeedSource.parse
Path = getString "path" rdr |> Permalink
Podcast = tryString "podcast" rdr |> Option.map (Utils.deserialize ser)
}
/// Create a permalink from the current row in the given data reader
let toPermalink rdr = getString "permalink" rdr |> Permalink
/// Create a page from the current row in the given data reader
let toPage ser rdr : Page =
{ Page.empty with
Id = getString "id" rdr |> PageId
WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId
Title = getString "title" rdr
Permalink = toPermalink rdr
PublishedOn = getInstant "published_on" rdr
UpdatedOn = getInstant "updated_on" rdr
IsInPageList = getBoolean "is_in_page_list" rdr
Template = tryString "template" rdr
Text = getString "page_text" rdr
Metadata = tryString "meta_items" rdr
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
}
/// Create a post from the current row in the given data reader
let toPost ser rdr : Post =
{ Post.empty with
Id = getString "id" rdr |> PostId
WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId
Status = getString "status" rdr |> PostStatus.parse
Title = getString "title" rdr
Permalink = toPermalink rdr
PublishedOn = tryInstant "published_on" rdr
UpdatedOn = getInstant "updated_on" rdr
Template = tryString "template" rdr
Text = getString "post_text" rdr
Episode = tryString "episode" rdr |> Option.map (Utils.deserialize ser)
Metadata = tryString "meta_items" rdr
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
}
/// Create a revision from the current row in the given data reader
let toRevision rdr : Revision =
{ AsOf = getInstant "as_of" rdr
Text = getString "revision_text" rdr |> MarkupText.parse
}
/// Create a tag mapping from the current row in the given data reader
let toTagMap rdr : TagMap =
{ Id = getString "id" rdr |> TagMapId
WebLogId = getString "web_log_id" rdr |> WebLogId
Tag = getString "tag" rdr
UrlValue = getString "url_value" rdr
}
/// Create a theme from the current row in the given data reader (excludes templates)
let toTheme rdr : Theme =
{ Theme.empty with
Id = getString "id" rdr |> ThemeId
Name = getString "name" rdr
Version = getString "version" rdr
}
/// Create a theme asset from the current row in the given data reader
let toThemeAsset includeData rdr : ThemeAsset =
let assetData =
if includeData then
use dataStream = new MemoryStream ()
use blobStream = getStream "data" rdr
blobStream.CopyTo dataStream
dataStream.ToArray ()
else
[||]
{ Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
UpdatedOn = getInstant "updated_on" rdr
Data = assetData
}
/// Create a theme template from the current row in the given data reader
let toThemeTemplate includeText rdr : ThemeTemplate =
{ Name = getString "name" rdr
Text = if includeText then getString "template" rdr else ""
}
/// Create an uploaded file from the current row in the given data reader
let toUpload includeData rdr : Upload =
let data =
if includeData then
use dataStream = new MemoryStream ()
use blobStream = getStream "data" rdr
blobStream.CopyTo dataStream
dataStream.ToArray ()
else
[||]
{ Id = getString "id" rdr |> UploadId
WebLogId = getString "web_log_id" rdr |> WebLogId
Path = getString "path" rdr |> Permalink
UpdatedOn = getInstant "updated_on" rdr
Data = data
}
/// Create a web log from the current row in the given data reader
let toWebLog rdr : WebLog =
{ Id = getString "id" rdr |> WebLogId
Name = getString "name" rdr
Slug = getString "slug" rdr
Subtitle = tryString "subtitle" rdr
DefaultPage = getString "default_page" rdr
PostsPerPage = getInt "posts_per_page" rdr
ThemeId = getString "theme_id" rdr |> ThemeId
UrlBase = getString "url_base" rdr
TimeZone = getString "time_zone" rdr
AutoHtmx = getBoolean "auto_htmx" rdr
Uploads = getString "uploads" rdr |> UploadDestination.parse
Rss = {
IsFeedEnabled = getBoolean "is_feed_enabled" rdr
FeedName = getString "feed_name" rdr
ItemsInFeed = tryInt "items_in_feed" rdr
IsCategoryEnabled = getBoolean "is_category_enabled" rdr
IsTagEnabled = getBoolean "is_tag_enabled" rdr
Copyright = tryString "copyright" rdr
CustomFeeds = []
}
}
/// Create a web log user from the current row in the given data reader
let toWebLogUser rdr : WebLogUser =
{ Id = getString "id" rdr |> WebLogUserId
WebLogId = getString "web_log_id" rdr |> WebLogId
Email = getString "email" rdr
FirstName = getString "first_name" rdr
LastName = getString "last_name" rdr
PreferredName = getString "preferred_name" rdr
PasswordHash = getString "password_hash" rdr
Url = tryString "url" rdr
AccessLevel = getString "access_level" rdr |> AccessLevel.parse
CreatedOn = getInstant "created_on" rdr
LastSeenOn = tryInstant "last_seen_on" rdr
}
/// Add a web log ID parameter
let addWebLogId (cmd : SqliteCommand) webLogId =
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore

View File

@@ -0,0 +1,179 @@
namespace MyWebLog.Data.SQLite
open System.Threading.Tasks
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
/// SQLite myWebLog category data implementation
type SQLiteCategoryData (conn : SqliteConnection) =
/// Add parameters for category INSERT or UPDATE statements
let addCategoryParameters (cmd : SqliteCommand) (cat : Category) =
[ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId)
cmd.Parameters.AddWithValue ("@name", cat.Name)
cmd.Parameters.AddWithValue ("@slug", cat.Slug)
cmd.Parameters.AddWithValue ("@description", maybe cat.Description)
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
] |> ignore
/// Add a category
let add cat = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"INSERT INTO category (
id, web_log_id, name, slug, description, parent_id
) VALUES (
@id, @webLogId, @name, @slug, @description, @parentId
)"
addCategoryParameters cmd cat
let! _ = cmd.ExecuteNonQueryAsync ()
()
}
/// Count all categories for the given web log
let countAll webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE web_log_id = @webLogId"
addWebLogId cmd webLogId
return! count cmd
}
/// Count all top-level categories for the given web log
let countTopLevel webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"SELECT COUNT(id) FROM category WHERE web_log_id = @webLogId AND parent_id IS NULL"
addWebLogId cmd webLogId
return! count cmd
}
/// Retrieve all categories for the given web log in a DotLiquid-friendly format
let findAllForView webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM category WHERE web_log_id = @webLogId"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
let cats =
seq {
while rdr.Read () do
Map.toCategory rdr
}
|> Seq.sortBy (fun cat -> cat.Name.ToLowerInvariant ())
|> List.ofSeq
do! rdr.CloseAsync ()
let ordered = Utils.orderByHierarchy cats None None []
let! counts =
ordered
|> Seq.map (fun it -> backgroundTask {
// Parent category post counts include posts in subcategories
let catSql, catParams =
ordered
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|> Seq.map (fun cat -> cat.Id)
|> Seq.append (Seq.singleton it.Id)
|> List.ofSeq
|> inClause "AND pc.category_id" "catId" id
cmd.Parameters.Clear ()
addWebLogId cmd webLogId
cmd.Parameters.AddRange catParams
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'
{catSql}"
let! postCount = count cmd
return it.Id, postCount
})
|> Task.WhenAll
return
ordered
|> Seq.map (fun cat ->
{ cat with
PostCount = counts
|> Array.tryFind (fun c -> fst c = cat.Id)
|> Option.map snd
|> Option.defaultValue 0
})
|> Array.ofSeq
}
/// Find a category by its ID for the given web log
let findById catId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM category WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<Category> webLogId (fun c -> c.WebLogId) Map.toCategory rdr
}
/// Find all categories for the given web log
let findByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM category WHERE web_log_id = @webLogId"
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toCategory rdr
}
/// Delete a category
let delete catId webLogId = backgroundTask {
match! findById catId webLogId with
| Some cat ->
use cmd = conn.CreateCommand ()
// Reassign any children to the category's parent category
cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE parent_id = @parentId"
cmd.Parameters.AddWithValue ("@parentId", CategoryId.toString catId) |> ignore
let! children = count cmd
if children > 0 then
cmd.CommandText <- "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId"
cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
|> ignore
do! write cmd
// Delete the category off all posts where it is assigned, and the category itself
cmd.CommandText <-
"DELETE FROM post_category
WHERE category_id = @id
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId);
DELETE FROM category WHERE id = @id"
cmd.Parameters.Clear ()
let _ = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
addWebLogId cmd webLogId
do! write cmd
return if children = 0 then CategoryDeleted else ReassignedChildCategories
| None -> return CategoryNotFound
}
/// Restore categories from a backup
let restore cats = backgroundTask {
for cat in cats do
do! add cat
}
/// Update a category
let update cat = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"UPDATE category
SET name = @name,
slug = @slug,
description = @description,
parent_id = @parentId
WHERE id = @id
AND web_log_id = @webLogId"
addCategoryParameters cmd cat
do! write cmd
}
interface ICategoryData with
member _.Add cat = add cat
member _.CountAll webLogId = countAll webLogId
member _.CountTopLevel webLogId = countTopLevel webLogId
member _.FindAllForView webLogId = findAllForView webLogId
member _.FindById catId webLogId = findById catId webLogId
member _.FindByWebLog webLogId = findByWebLog webLogId
member _.Delete catId webLogId = delete catId webLogId
member _.Restore cats = restore cats
member _.Update cat = update cat

View File

@@ -0,0 +1,315 @@
namespace MyWebLog.Data.SQLite
open System.Threading.Tasks
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
/// SQLite myWebLog page data implementation
type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS
/// Add parameters for page INSERT or UPDATE statements
let addPageParameters (cmd : SqliteCommand) (page : Page) =
[ cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId)
cmd.Parameters.AddWithValue ("@title", page.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", instantParam page.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam page.UpdatedOn)
cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
cmd.Parameters.AddWithValue ("@template", maybe page.Template)
cmd.Parameters.AddWithValue ("@text", page.Text)
cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty page.Metadata then None
else Some (Utils.serialize ser page.Metadata)))
] |> ignore
/// Append revisions and permalinks to a page
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.Id) |> ignore
cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId"
use! rdr = cmd.ExecuteReaderAsync ()
let page = { page with PriorPermalinks = toList Map.toPermalink rdr }
do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC"
use! rdr = cmd.ExecuteReaderAsync ()
return { page with Revisions = toList Map.toRevision rdr }
}
/// Shorthand for mapping a data reader to a page
let toPage =
Map.toPage ser
/// Return a page with no text (or prior permalinks or revisions)
let pageWithoutText rdr =
{ toPage rdr with Text = "" }
/// Update a page's prior permalinks
let updatePagePermalinks pageId oldLinks newLinks = backgroundTask {
let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore
let runCmd link = backgroundTask {
cmd.Parameters["@link"].Value <- Permalink.toString link
do! write cmd
}
cmd.CommandText <- "DELETE FROM page_permalink WHERE page_id = @pageId AND permalink = @link"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO page_permalink VALUES (@pageId, @link)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a page's revisions
let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf"
toDelete
|> List.map (runCmd false)
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)"
toAdd
|> List.map (runCmd true)
|> Task.WhenAll
|> ignore
}
// IMPLEMENTATION FUNCTIONS
/// Add a page
let add page = backgroundTask {
use cmd = conn.CreateCommand ()
// The page itself
cmd.CommandText <-
"INSERT INTO page (
id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template,
page_text, meta_items
) VALUES (
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template,
@text, @metaItems
)"
addPageParameters cmd page
do! write cmd
do! updatePagePermalinks page.Id [] page.PriorPermalinks
do! updatePageRevisions page.Id [] page.Revisions
}
/// Get all pages for a web log (without text, revisions, prior permalinks, or metadata)
let all webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
return toList pageWithoutText rdr
}
/// Count all pages for the given web log
let countAll webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE web_log_id = @webLogId"
addWebLogId cmd webLogId
return! count cmd
}
/// Count all pages shown in the page list for the given web log
let countListed webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"SELECT COUNT(id)
FROM page
WHERE web_log_id = @webLogId
AND is_in_page_list = @isInPageList"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
return! count cmd
}
/// Find a page by its ID (without revisions and prior permalinks)
let findById pageId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<Page> webLogId (fun it -> it.WebLogId) (Map.toPage ser) rdr
}
/// Find a complete page by its ID
let findFullById pageId webLogId = backgroundTask {
match! findById pageId webLogId with
| Some page ->
let! page = appendPageRevisionsAndPermalinks page
return Some page
| None -> return None
}
let delete pageId webLogId = backgroundTask {
match! findById pageId webLogId with
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
cmd.CommandText <-
"DELETE FROM page_revision WHERE page_id = @id;
DELETE FROM page_permalink WHERE page_id = @id;
DELETE FROM page WHERE id = @id"
do! write cmd
return true
| None -> return false
}
/// Find a page by its permalink for the given web log
let findByPermalink permalink webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (toPage rdr) else None
}
/// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
let linkSql, linkParams = inClause "AND pp.permalink" "link" Permalink.toString permalinks
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
{linkSql}"
addWebLogId cmd webLogId
cmd.Parameters.AddRange linkParams
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toPermalink rdr) else None
}
/// Get all complete pages for the given web log
let findFullByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
let! pages =
toList toPage rdr
|> List.map (fun page -> backgroundTask { return! appendPageRevisionsAndPermalinks page })
|> Task.WhenAll
return List.ofArray pages
}
/// Get all listed pages for the given web log (without revisions, prior permalinks, or text)
let findListed webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"SELECT *
FROM page
WHERE web_log_id = @webLogId
AND is_in_page_list = @isInPageList
ORDER BY LOWER(title)"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return toList pageWithoutText rdr
}
/// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata)
let findPageOfPages webLogId pageNbr = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"SELECT *
FROM page
WHERE web_log_id = @webLogId
ORDER BY LOWER(title)
LIMIT @pageSize OFFSET @toSkip"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@pageSize", 26)
cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return toList toPage rdr
}
/// Restore pages from a backup
let restore pages = backgroundTask {
for page in pages do
do! add page
}
/// Update a page
let update (page : Page) = backgroundTask {
match! findFullById page.Id page.WebLogId with
| Some oldPage ->
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"UPDATE page
SET author_id = @authorId,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
is_in_page_list = @isInPageList,
template = @template,
page_text = @text,
meta_items = @metaItems
WHERE id = @id
AND web_log_id = @webLogId"
addPageParameters cmd page
do! write cmd
do! updatePagePermalinks page.Id oldPage.PriorPermalinks page.PriorPermalinks
do! updatePageRevisions page.Id oldPage.Revisions page.Revisions
return ()
| None -> return ()
}
/// Update a page's prior permalinks
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
match! findFullById pageId webLogId with
| Some page ->
do! updatePagePermalinks pageId page.PriorPermalinks permalinks
return true
| None -> return false
}
interface IPageData with
member _.Add page = add page
member _.All webLogId = all webLogId
member _.CountAll webLogId = countAll webLogId
member _.CountListed webLogId = countListed webLogId
member _.Delete pageId webLogId = delete pageId webLogId
member _.FindById pageId webLogId = findById pageId webLogId
member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId
member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
member _.FindFullById pageId webLogId = findFullById pageId webLogId
member _.FindFullByWebLog webLogId = findFullByWebLog webLogId
member _.FindListed webLogId = findListed webLogId
member _.FindPageOfPages webLogId pageNbr = findPageOfPages webLogId pageNbr
member _.Restore pages = restore pages
member _.Update page = update page
member _.UpdatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks

View File

@@ -0,0 +1,486 @@
namespace MyWebLog.Data.SQLite
open System.Threading.Tasks
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
open NodaTime
/// SQLite myWebLog post data implementation
type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS
/// Add parameters for post INSERT or UPDATE statements
let addPostParameters (cmd : SqliteCommand) (post : Post) =
[ cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId)
cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status)
cmd.Parameters.AddWithValue ("@title", post.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", maybeInstant post.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn)
cmd.Parameters.AddWithValue ("@template", maybe post.Template)
cmd.Parameters.AddWithValue ("@text", post.Text)
cmd.Parameters.AddWithValue ("@episode", maybe (if Option.isSome post.Episode then
Some (Utils.serialize ser post.Episode)
else None))
cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty post.Metadata then None
else Some (Utils.serialize ser post.Metadata)))
] |> ignore
/// Append category IDs and tags to a post
let appendPostCategoryAndTag (post : Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id) |> ignore
cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync ()
let post = { post with CategoryIds = toList Map.toCategoryId rdr }
do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync ()
return { post with Tags = toList (Map.getString "tag") rdr }
}
/// Append revisions and permalinks to a post
let appendPostRevisionsAndPermalinks (post : Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@postId", PostId.toString post.Id) |> ignore
cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId"
use! rdr = cmd.ExecuteReaderAsync ()
let post = { post with PriorPermalinks = toList Map.toPermalink rdr }
do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT as_of, revision_text FROM post_revision WHERE post_id = @postId ORDER BY as_of DESC"
use! rdr = cmd.ExecuteReaderAsync ()
return { post with Revisions = toList Map.toRevision rdr }
}
/// The SELECT statement for a post that will include episode data, if it exists
let selectPost = "SELECT p.* FROM post p"
/// Shorthand for mapping a data reader to a post
let toPost =
Map.toPost ser
/// Find just-the-post by its ID for the given web log (excludes category, tag, meta, revisions, and permalinks)
let findPostById postId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<Post> webLogId (fun p -> p.WebLogId) toPost rdr
}
/// Return a post with no revisions, prior permalinks, or text
let postWithoutText rdr =
{ toPost rdr with Text = "" }
/// Update a post's assigned categories
let updatePostCategories postId oldCats newCats = backgroundTask {
let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.Add ("@categoryId", SqliteType.Text)
] |> ignore
let runCmd catId = backgroundTask {
cmd.Parameters["@categoryId"].Value <- CategoryId.toString catId
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO post_category VALUES (@postId, @categoryId)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a post's assigned categories
let updatePostTags postId (oldTags : string list) newTags = backgroundTask {
let toDelete, toAdd = Utils.diffLists oldTags newTags id
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.Add ("@tag", SqliteType.Text)
] |> ignore
let runCmd (tag : string) = backgroundTask {
cmd.Parameters["@tag"].Value <- tag
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_tag WHERE post_id = @postId AND tag = @tag"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO post_tag VALUES (@postId, @tag)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a post's prior permalinks
let updatePostPermalinks postId oldLinks newLinks = backgroundTask {
let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore
let runCmd link = backgroundTask {
cmd.Parameters["@link"].Value <- Permalink.toString link
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_permalink WHERE post_id = @postId AND permalink = @link"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO post_permalink VALUES (@postId, @link)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a post's revisions
let updatePostRevisions postId oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf"
toDelete
|> List.map (runCmd false)
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO post_revision VALUES (@postId, @asOf, @text)"
toAdd
|> List.map (runCmd true)
|> Task.WhenAll
|> ignore
}
// IMPLEMENTATION FUNCTIONS
/// Add a post
let add post = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"INSERT INTO post (
id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text,
episode, meta_items
) VALUES (
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text,
@episode, @metaItems
)"
addPostParameters cmd post
do! write cmd
do! updatePostCategories post.Id [] post.CategoryIds
do! updatePostTags post.Id [] post.Tags
do! updatePostPermalinks post.Id [] post.PriorPermalinks
do! updatePostRevisions post.Id [] post.Revisions
}
/// Count posts in a status for the given web log
let countByStatus status webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE web_log_id = @webLogId AND status = @status"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString status) |> ignore
return! count cmd
}
/// Find a post by its ID for the given web log (excluding revisions and prior permalinks
let findById postId webLogId = backgroundTask {
match! findPostById postId webLogId with
| Some post ->
let! post = appendPostCategoryAndTag post
return Some post
| None -> return None
}
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink permalink webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId AND p.permalink = @link"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
let! post = appendPostCategoryAndTag (toPost rdr)
return Some post
else
return None
}
/// Find a complete post by its ID for the given web log
let findFullById postId webLogId = backgroundTask {
match! findById postId webLogId with
| Some post ->
let! post = appendPostRevisionsAndPermalinks post
return Some post
| None -> return None
}
/// Delete a post by its ID for the given web log
let delete postId webLogId = backgroundTask {
match! findFullById postId webLogId with
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
cmd.CommandText <-
"DELETE FROM post_revision WHERE post_id = @id;
DELETE FROM post_permalink WHERE post_id = @id;
DELETE FROM post_tag WHERE post_id = @id;
DELETE FROM post_category WHERE post_id = @id;
DELETE FROM post_comment WHERE post_id = @id;
DELETE FROM post WHERE id = @id"
do! write cmd
return true
| None -> return false
}
/// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
let linkSql, linkParams = inClause "AND pp.permalink" "link" Permalink.toString permalinks
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
{linkSql}"
addWebLogId cmd webLogId
cmd.Parameters.AddRange linkParams
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toPermalink rdr) else None
}
/// Get all complete posts for the given web log
let findFullByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList toPost rdr
|> List.map (fun post -> backgroundTask {
let! post = appendPostCategoryAndTag post
return! appendPostRevisionsAndPermalinks post
})
|> Task.WhenAll
return List.ofArray posts
}
/// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
let catSql, catParams = inClause "AND pc.category_id" "catId" CategoryId.toString categoryIds
cmd.CommandText <- $"
{selectPost}
INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = @status
{catSql}
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
cmd.Parameters.AddRange catParams
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll
return List.ofArray posts
}
/// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks)
let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"
{selectPost}
WHERE p.web_log_id = @webLogId
ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList postWithoutText rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll
return List.ofArray posts
}
/// Get a page of published posts for the given web log (excludes revisions and prior permalinks)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"
{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll
return List.ofArray posts
}
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"
{selectPost}
INNER JOIN post_tag pt ON pt.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND pt.tag = @tag
ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
cmd.Parameters.AddWithValue ("@tag", tag)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll
return List.ofArray posts
}
/// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"
{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND p.published_on < @publishedOn
ORDER BY p.published_on DESC
LIMIT 1"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! older = backgroundTask {
if rdr.Read () then
let! post = appendPostCategoryAndTag (postWithoutText rdr)
return Some post
else
return None
}
do! rdr.CloseAsync ()
cmd.CommandText <- $"
{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND p.published_on > @publishedOn
ORDER BY p.published_on
LIMIT 1"
use! rdr = cmd.ExecuteReaderAsync ()
let! newer = backgroundTask {
if rdr.Read () then
let! post = appendPostCategoryAndTag (postWithoutText rdr)
return Some post
else
return None
}
return older, newer
}
/// Restore posts from a backup
let restore posts = backgroundTask {
for post in posts do
do! add post
}
/// Update a post
let update (post : Post) = backgroundTask {
match! findFullById post.Id post.WebLogId with
| Some oldPost ->
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"UPDATE post
SET author_id = @authorId,
status = @status,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
template = @template,
post_text = @text,
episode = @episode,
meta_items = @metaItems
WHERE id = @id
AND web_log_id = @webLogId"
addPostParameters cmd post
do! write cmd
do! updatePostCategories post.Id oldPost.CategoryIds post.CategoryIds
do! updatePostTags post.Id oldPost.Tags post.Tags
do! updatePostPermalinks post.Id oldPost.PriorPermalinks post.PriorPermalinks
do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
| None -> return ()
}
/// Update prior permalinks for a post
let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
match! findFullById postId webLogId with
| Some post ->
do! updatePostPermalinks postId post.PriorPermalinks permalinks
return true
| None -> return false
}
interface IPostData with
member _.Add post = add post
member _.CountByStatus status webLogId = countByStatus status webLogId
member _.Delete postId webLogId = delete postId webLogId
member _.FindById postId webLogId = findById postId webLogId
member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId
member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
member _.FindFullById postId webLogId = findFullById postId webLogId
member _.FindFullByWebLog webLogId = findFullByWebLog webLogId
member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage
member _.FindPageOfPosts webLogId pageNbr postsPerPage = findPageOfPosts webLogId pageNbr postsPerPage
member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage =
findPageOfPublishedPosts webLogId pageNbr postsPerPage
member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage =
findPageOfTaggedPosts webLogId tag pageNbr postsPerPage
member _.FindSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn
member _.Restore posts = restore posts
member _.Update post = update post
member _.UpdatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks

View File

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

View File

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

View File

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

View File

@@ -0,0 +1,257 @@
namespace MyWebLog.Data.SQLite
open System.Threading.Tasks
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
// The web log podcast insert loop is not statically compilable; this is OK
#nowarn "3511"
/// SQLite myWebLog web log data implementation
type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS
/// Add parameters for web log INSERT or web log/RSS options UPDATE statements
let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled)
cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName)
cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed)
cmd.Parameters.AddWithValue ("@isCategoryEnabled", webLog.Rss.IsCategoryEnabled)
cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled)
cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright)
] |> ignore
/// Add parameters for web log INSERT or UPDATE statements
let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id)
cmd.Parameters.AddWithValue ("@name", webLog.Name)
cmd.Parameters.AddWithValue ("@slug", webLog.Slug)
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle)
cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage)
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage)
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId)
cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase)
cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone)
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx)
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads)
] |> ignore
addWebLogRssParameters cmd webLog
/// Add parameters for custom feed INSERT or UPDATE statements
let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) =
[ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId)
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source)
cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path)
cmd.Parameters.AddWithValue ("@podcast", maybe (if Option.isSome feed.Podcast then
Some (Utils.serialize ser feed.Podcast)
else None))
] |> ignore
/// Shorthand to map a data reader to a custom feed
let toCustomFeed =
Map.toCustomFeed ser
/// Get the current custom feeds for a web log
let getCustomFeeds (webLog : WebLog) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_feed WHERE web_log_id = @webLogId"
addWebLogId cmd webLog.Id
use! rdr = cmd.ExecuteReaderAsync ()
return toList toCustomFeed rdr
}
/// Append custom feeds to a web log
let appendCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog
return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
}
/// Update the custom feeds for a web log
let updateCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog
let toDelete, toAdd = Utils.diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
let toId (feed : CustomFeed) = feed.Id
let toUpdate =
webLog.Rss.CustomFeeds
|> List.filter (fun f ->
not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.Id))
use cmd = conn.CreateCommand ()
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
toDelete
|> List.map (fun it -> backgroundTask {
cmd.CommandText <- "DELETE FROM web_log_feed WHERE id = @id"
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id
do! write cmd
})
|> Task.WhenAll
|> ignore
cmd.Parameters.Clear ()
toAdd
|> List.map (fun it -> backgroundTask {
cmd.CommandText <-
"INSERT INTO web_log_feed (
id, web_log_id, source, path, podcast
) VALUES (
@id, @webLogId, @source, @path, @podcast
)"
cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.Id it
do! write cmd
})
|> Task.WhenAll
|> ignore
toUpdate
|> List.map (fun it -> backgroundTask {
cmd.CommandText <-
"UPDATE web_log_feed
SET source = @source,
path = @path,
podcast = @podcast
WHERE id = @id
AND web_log_id = @webLogId"
cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.Id it
do! write cmd
})
|> Task.WhenAll
|> ignore
}
// IMPLEMENTATION FUNCTIONS
/// Add a web log
let add webLog = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"INSERT INTO web_log (
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright
) VALUES (
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
@uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
)"
addWebLogParameters cmd webLog
do! write cmd
do! updateCustomFeeds webLog
}
/// Retrieve all web logs
let all () = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log"
use! rdr = cmd.ExecuteReaderAsync ()
let! webLogs =
toList Map.toWebLog rdr
|> List.map (fun webLog -> backgroundTask { return! appendCustomFeeds webLog })
|> Task.WhenAll
return List.ofArray webLogs
}
/// Delete a web log by its ID
let delete webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
addWebLogId cmd webLogId
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
let postSubQuery = subQuery "post"
let pageSubQuery = subQuery "page"
cmd.CommandText <- $"
DELETE FROM post_comment WHERE post_id IN {postSubQuery};
DELETE FROM post_revision WHERE post_id IN {postSubQuery};
DELETE FROM post_permalink WHERE post_id IN {postSubQuery};
DELETE FROM post_tag WHERE post_id IN {postSubQuery};
DELETE FROM post_category 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 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 WHERE web_log_id = @webLogId;
DELETE FROM web_log WHERE id = @webLogId"
do! write cmd
}
/// Find a web log by its host (URL base)
let findByHost (url : string) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log WHERE url_base = @urlBase"
cmd.Parameters.AddWithValue ("@urlBase", url) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
let! webLog = appendCustomFeeds (Map.toWebLog rdr)
return Some webLog
else
return None
}
/// Find a web log by its ID
let findById webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log WHERE id = @webLogId"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
let! webLog = appendCustomFeeds (Map.toWebLog rdr)
return Some webLog
else
return None
}
/// Update settings for a web log
let updateSettings webLog = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"UPDATE web_log
SET name = @name,
slug = @slug,
subtitle = @subtitle,
default_page = @defaultPage,
posts_per_page = @postsPerPage,
theme_id = @themeId,
url_base = @urlBase,
time_zone = @timeZone,
auto_htmx = @autoHtmx,
uploads = @uploads,
is_feed_enabled = @isFeedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright
WHERE id = @id"
addWebLogParameters cmd webLog
do! write cmd
}
/// Update RSS options for a web log
let updateRssOptions webLog = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"UPDATE web_log
SET is_feed_enabled = @isFeedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright
WHERE id = @id"
addWebLogRssParameters cmd webLog
cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) |> ignore
do! write cmd
do! updateCustomFeeds webLog
}
interface IWebLogData with
member _.Add webLog = add webLog
member _.All () = all ()
member _.Delete webLogId = delete webLogId
member _.FindByHost url = findByHost url
member _.FindById webLogId = findById webLogId
member _.UpdateSettings webLog = updateSettings webLog
member _.UpdateRssOptions webLog = updateRssOptions webLog

View File

@@ -0,0 +1,155 @@
namespace MyWebLog.Data.SQLite
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
/// SQLite myWebLog user data implementation
type SQLiteWebLogUserData (conn : SqliteConnection) =
// SUPPORT FUNCTIONS
/// Add parameters for web log user INSERT or UPDATE statements
let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) =
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.WebLogId)
cmd.Parameters.AddWithValue ("@email", user.Email)
cmd.Parameters.AddWithValue ("@firstName", user.FirstName)
cmd.Parameters.AddWithValue ("@lastName", user.LastName)
cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName)
cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash)
cmd.Parameters.AddWithValue ("@url", maybe user.Url)
cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel)
cmd.Parameters.AddWithValue ("@createdOn", instantParam user.CreatedOn)
cmd.Parameters.AddWithValue ("@lastSeenOn", maybeInstant user.LastSeenOn)
] |> ignore
// IMPLEMENTATION FUNCTIONS
/// Add a user
let add user = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"INSERT INTO web_log_user (
id, web_log_id, email, first_name, last_name, preferred_name, password_hash, url, access_level,
created_on, last_seen_on
) VALUES (
@id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @url, @accessLevel,
@createdOn, @lastSeenOn
)"
addWebLogUserParameters cmd user
do! write cmd
}
/// Find a user by their ID for the given web log
let findById userId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<WebLogUser> webLogId (fun u -> u.WebLogId) Map.toWebLogUser rdr
}
/// Delete a user if they have no posts or pages
let delete userId webLogId = backgroundTask {
match! findById userId webLogId with
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE author_id = @userId"
cmd.Parameters.AddWithValue ("@userId", WebLogUserId.toString userId) |> ignore
let! pageCount = count cmd
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE author_id = @userId"
let! postCount = count cmd
if pageCount + postCount > 0 then
return Error "User has pages or posts; cannot delete"
else
cmd.CommandText <- "DELETE FROM web_log_user WHERE id = @userId"
let! _ = cmd.ExecuteNonQueryAsync ()
return Ok true
| None -> return Error "User does not exist"
}
/// 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 email = @email"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@email", email) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toWebLogUser rdr) else None
}
/// Get all users for the given web log
let findByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId ORDER BY LOWER(preferred_name)"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toWebLogUser rdr
}
/// Find the names of users by their IDs for the given web log
let findNames webLogId userIds = backgroundTask {
use cmd = conn.CreateCommand ()
let nameSql, nameParams = inClause "AND id" "id" WebLogUserId.toString userIds
cmd.CommandText <- $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {nameSql}"
addWebLogId cmd webLogId
cmd.Parameters.AddRange nameParams
use! rdr = cmd.ExecuteReaderAsync ()
return
toList Map.toWebLogUser rdr
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
}
/// Restore users from a backup
let restore users = backgroundTask {
for user in users do
do! add user
}
/// Set a user's last seen date/time to now
let setLastSeen userId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"UPDATE web_log_user
SET last_seen_on = @lastSeenOn
WHERE id = @id
AND web_log_id = @webLogId"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId)
cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Noda.now ()))
] |> ignore
let! _ = cmd.ExecuteNonQueryAsync ()
()
}
/// Update a user
let update user = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"UPDATE web_log_user
SET email = @email,
first_name = @firstName,
last_name = @lastName,
preferred_name = @preferredName,
password_hash = @passwordHash,
url = @url,
access_level = @accessLevel,
created_on = @createdOn,
last_seen_on = @lastSeenOn
WHERE id = @id
AND web_log_id = @webLogId"
addWebLogUserParameters cmd user
do! write cmd
}
interface IWebLogUserData with
member _.Add user = add user
member _.Delete userId webLogId = delete userId webLogId
member _.FindByEmail email webLogId = findByEmail email webLogId
member _.FindById userId webLogId = findById userId webLogId
member _.FindByWebLog webLogId = findByWebLog webLogId
member _.FindNames webLogId userIds = findNames webLogId userIds
member _.Restore users = restore users
member _.SetLastSeen userId webLogId = setLastSeen userId webLogId
member _.Update user = update user

File diff suppressed because it is too large Load Diff

View File

@@ -5,18 +5,54 @@ module internal MyWebLog.Data.Utils
open MyWebLog
open MyWebLog.ViewModels
/// The current database version
let currentDbVersion = "v2"
/// Create a category hierarchy from the given list of categories
let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq {
for cat in cats |> List.filter (fun c -> c.parentId = parentId) do
let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.slug
{ id = CategoryId.toString cat.id
slug = fullSlug
name = cat.name
description = cat.description
parentNames = Array.ofList parentNames
for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do
let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug
{ Id = CategoryId.toString cat.Id
Slug = fullSlug
Name = cat.Name
Description = cat.Description
ParentNames = Array.ofList parentNames
// Post counts are filled on a second pass
postCount = 0
PostCount = 0
}
yield! orderByHierarchy cats (Some cat.id) (Some fullSlug) ([ cat.name ] |> List.append parentNames)
yield! orderByHierarchy cats (Some cat.Id) (Some fullSlug) ([ cat.Name ] |> List.append parentNames)
}
/// Get lists of items removed from and added to the given lists
let diffLists<'T, 'U when 'U : equality> oldItems newItems (f : 'T -> 'U) =
let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other))
List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems
/// Find meta items added and removed
let diffMetaItems (oldItems : MetaItem list) newItems =
diffLists oldItems newItems (fun item -> $"{item.Name}|{item.Value}")
/// Find the permalinks added and removed
let diffPermalinks oldLinks newLinks =
diffLists oldLinks newLinks Permalink.toString
/// Find the revisions added and removed
let diffRevisions oldRevs newRevs =
diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.ToUnixTimeTicks ()}|{MarkupText.toString rev.Text}")
open MyWebLog.Converters
open Newtonsoft.Json
/// Serialize an object to JSON
let serialize<'T> ser (item : 'T) =
JsonConvert.SerializeObject (item, Json.settings ser)
/// Deserialize a JSON string
let deserialize<'T> (ser : JsonSerializer) value =
JsonConvert.DeserializeObject<'T> (value, Json.settings ser)
open Microsoft.Extensions.Logging
/// Log a migration step
let logMigrationStep<'T> (log : ILogger<'T>) migration message =
log.LogInformation $"Migrating %s{migration}: %s{message}"

View File

@@ -2,27 +2,28 @@
open System
open MyWebLog
open NodaTime
/// A category under which a post may be identified
[<CLIMutable; NoComparison; NoEquality>]
type Category =
{ /// The ID of the category
id : CategoryId
Id : CategoryId
/// The ID of the web log to which the category belongs
webLogId : WebLogId
WebLogId : WebLogId
/// The displayed name
name : string
Name : string
/// The slug (used in category URLs)
slug : string
Slug : string
/// A longer description of the category
description : string option
Description : string option
/// The parent ID of this category (if a subcategory)
parentId : CategoryId option
ParentId : CategoryId option
}
/// Functions to support categories
@@ -30,12 +31,12 @@ module Category =
/// An empty category
let empty =
{ id = CategoryId.empty
webLogId = WebLogId.empty
name = ""
slug = ""
description = None
parentId = None
{ Id = CategoryId.empty
WebLogId = WebLogId.empty
Name = ""
Slug = ""
Description = None
ParentId = None
}
@@ -43,31 +44,31 @@ module Category =
[<CLIMutable; NoComparison; NoEquality>]
type Comment =
{ /// The ID of the comment
id : CommentId
Id : CommentId
/// The ID of the post to which this comment applies
postId : PostId
PostId : PostId
/// The ID of the comment to which this comment is a reply
inReplyToId : CommentId option
InReplyToId : CommentId option
/// The name of the commentor
name : string
Name : string
/// The e-mail address of the commentor
email : string
Email : string
/// The URL of the commentor's personal website
url : string option
Url : string option
/// The status of the comment
status : CommentStatus
Status : CommentStatus
/// When the comment was posted
postedOn : DateTime
PostedOn : Instant
/// The text of the comment
text : string
Text : string
}
/// Functions to support comments
@@ -75,15 +76,15 @@ module Comment =
/// An empty comment
let empty =
{ id = CommentId.empty
postId = PostId.empty
inReplyToId = None
name = ""
email = ""
url = None
status = Pending
postedOn = DateTime.UtcNow
text = ""
{ Id = CommentId.empty
PostId = PostId.empty
InReplyToId = None
Name = ""
Email = ""
Url = None
Status = Pending
PostedOn = Noda.epoch
Text = ""
}
@@ -91,43 +92,43 @@ module Comment =
[<CLIMutable; NoComparison; NoEquality>]
type Page =
{ /// The ID of this page
id : PageId
Id : PageId
/// The ID of the web log to which this page belongs
webLogId : WebLogId
WebLogId : WebLogId
/// The ID of the author of this page
authorId : WebLogUserId
AuthorId : WebLogUserId
/// The title of the page
title : string
Title : string
/// The link at which this page is displayed
permalink : Permalink
Permalink : Permalink
/// When this page was published
publishedOn : DateTime
PublishedOn : Instant
/// When this page was last updated
updatedOn : DateTime
UpdatedOn : Instant
/// Whether this page shows as part of the web log's navigation
showInPageList : bool
IsInPageList : bool
/// The template to use when rendering this page
template : string option
Template : string option
/// The current text of the page
text : string
Text : string
/// Metadata for this page
metadata : MetaItem list
Metadata : MetaItem list
/// Permalinks at which this page may have been previously served (useful for migrated content)
priorPermalinks : Permalink list
PriorPermalinks : Permalink list
/// Revisions of this page
revisions : Revision list
Revisions : Revision list
}
/// Functions to support pages
@@ -135,19 +136,19 @@ module Page =
/// An empty page
let empty =
{ id = PageId.empty
webLogId = WebLogId.empty
authorId = WebLogUserId.empty
title = ""
permalink = Permalink.empty
publishedOn = DateTime.MinValue
updatedOn = DateTime.MinValue
showInPageList = false
template = None
text = ""
metadata = []
priorPermalinks = []
revisions = []
{ Id = PageId.empty
WebLogId = WebLogId.empty
AuthorId = WebLogUserId.empty
Title = ""
Permalink = Permalink.empty
PublishedOn = Noda.epoch
UpdatedOn = Noda.epoch
IsInPageList = false
Template = None
Text = ""
Metadata = []
PriorPermalinks = []
Revisions = []
}
@@ -155,49 +156,52 @@ module Page =
[<CLIMutable; NoComparison; NoEquality>]
type Post =
{ /// The ID of this post
id : PostId
Id : PostId
/// The ID of the web log to which this post belongs
webLogId : WebLogId
WebLogId : WebLogId
/// The ID of the author of this post
authorId : WebLogUserId
AuthorId : WebLogUserId
/// The status
status : PostStatus
Status : PostStatus
/// The title
title : string
Title : string
/// The link at which the post resides
permalink : Permalink
Permalink : Permalink
/// The instant on which the post was originally published
publishedOn : DateTime option
PublishedOn : Instant option
/// The instant on which the post was last updated
updatedOn : DateTime
UpdatedOn : Instant
/// The template to use in displaying the post
template : string option
Template : string option
/// The text of the post in HTML (ready to display) format
text : string
Text : string
/// The Ids of the categories to which this is assigned
categoryIds : CategoryId list
CategoryIds : CategoryId list
/// The tags for the post
tags : string list
Tags : string list
/// Podcast episode information for this post
Episode : Episode option
/// Metadata for the post
metadata : MetaItem list
Metadata : MetaItem list
/// Permalinks at which this post may have been previously served (useful for migrated content)
priorPermalinks : Permalink list
PriorPermalinks : Permalink list
/// The revisions for this post
revisions : Revision list
Revisions : Revision list
}
/// Functions to support posts
@@ -205,37 +209,38 @@ module Post =
/// An empty post
let empty =
{ id = PostId.empty
webLogId = WebLogId.empty
authorId = WebLogUserId.empty
status = Draft
title = ""
permalink = Permalink.empty
publishedOn = None
updatedOn = DateTime.MinValue
text = ""
template = None
categoryIds = []
tags = []
metadata = []
priorPermalinks = []
revisions = []
{ Id = PostId.empty
WebLogId = WebLogId.empty
AuthorId = WebLogUserId.empty
Status = Draft
Title = ""
Permalink = Permalink.empty
PublishedOn = None
UpdatedOn = Noda.epoch
Text = ""
Template = None
CategoryIds = []
Tags = []
Episode = None
Metadata = []
PriorPermalinks = []
Revisions = []
}
/// A mapping between a tag and its URL value, used to translate restricted characters (ex. "#1" -> "number-1")
type TagMap =
{ /// The ID of this tag mapping
id : TagMapId
Id : TagMapId
/// The ID of the web log to which this tag mapping belongs
webLogId : WebLogId
WebLogId : WebLogId
/// The tag which should be mapped to a different value in links
tag : string
Tag : string
/// The value by which the tag should be linked
urlValue : string
UrlValue : string
}
/// Functions to support tag mappings
@@ -243,26 +248,26 @@ module TagMap =
/// An empty tag mapping
let empty =
{ id = TagMapId.empty
webLogId = WebLogId.empty
tag = ""
urlValue = ""
{ Id = TagMapId.empty
WebLogId = WebLogId.empty
Tag = ""
UrlValue = ""
}
/// A theme
type Theme =
{ /// The ID / path of the theme
id : ThemeId
Id : ThemeId
/// A long name of the theme
name : string
Name : string
/// The version of the theme
version : string
Version : string
/// The templates for this theme
templates: ThemeTemplate list
Templates: ThemeTemplate list
}
/// Functions to support themes
@@ -270,10 +275,10 @@ module Theme =
/// An empty theme
let empty =
{ id = ThemeId ""
name = ""
version = ""
templates = []
{ Id = ThemeId ""
Name = ""
Version = ""
Templates = []
}
@@ -281,48 +286,95 @@ module Theme =
type ThemeAsset =
{
/// The ID of the asset (consists of theme and path)
id : ThemeAssetId
Id : ThemeAssetId
/// The updated date (set from the file date from the ZIP archive)
updatedOn : DateTime
UpdatedOn : Instant
/// The data for the asset
data : byte[]
Data : byte[]
}
/// Functions to support theme assets
module ThemeAsset =
/// An empty theme asset
let empty =
{ Id = ThemeAssetId (ThemeId "", "")
UpdatedOn = Noda.epoch
Data = [||]
}
/// 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 : Instant
/// 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 = Noda.epoch
Data = [||]
}
/// A web log
[<CLIMutable; NoComparison; NoEquality>]
type WebLog =
{ /// The ID of the web log
id : WebLogId
Id : WebLogId
/// The name of the web log
name : string
Name : string
/// The slug of the web log
Slug : string
/// A subtitle for the web log
subtitle : string option
Subtitle : string option
/// The default page ("posts" or a page Id)
defaultPage : string
DefaultPage : string
/// The number of posts to display on pages of posts
postsPerPage : int
PostsPerPage : int
/// The path of the theme (within /themes)
themePath : string
/// The ID of the theme (also the path within /themes)
ThemeId : ThemeId
/// The URL base
urlBase : string
UrlBase : string
/// The time zone in which dates/times should be displayed
timeZone : string
TimeZone : string
/// The RSS options for this web log
rss : RssOptions
Rss : RssOptions
/// Whether to automatically load htmx
autoHtmx : bool
AutoHtmx : bool
/// Where uploads are placed
Uploads : UploadDestination
}
/// Functions to support web logs
@@ -330,76 +382,77 @@ module WebLog =
/// An empty web log
let empty =
{ id = WebLogId.empty
name = ""
subtitle = None
defaultPage = ""
postsPerPage = 10
themePath = "default"
urlBase = ""
timeZone = ""
rss = RssOptions.empty
autoHtmx = false
{ Id = WebLogId.empty
Name = ""
Slug = ""
Subtitle = None
DefaultPage = ""
PostsPerPage = 10
ThemeId = ThemeId "default"
UrlBase = ""
TimeZone = ""
Rss = RssOptions.empty
AutoHtmx = false
Uploads = Database
}
/// Get the host (including scheme) and extra path from the URL base
let hostAndPath webLog =
let scheme = webLog.urlBase.Split "://"
let scheme = webLog.UrlBase.Split "://"
let host = scheme[1].Split "/"
$"{scheme[0]}://{host[0]}", if host.Length > 1 then $"""/{String.Join ("/", host |> Array.skip 1)}""" else ""
/// Generate an absolute URL for the given link
let absoluteUrl webLog permalink =
$"{webLog.urlBase}/{Permalink.toString permalink}"
$"{webLog.UrlBase}/{Permalink.toString permalink}"
/// Generate a relative URL for the given link
let relativeUrl webLog permalink =
let _, leadPath = hostAndPath webLog
$"{leadPath}/{Permalink.toString permalink}"
/// Convert a UTC date/time to the web log's local date/time
let localTime webLog (date : DateTime) =
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)
/// Convert an Instant (UTC reference) to the web log's local date/time
let localTime webLog (date : Instant) =
match DateTimeZoneProviders.Tzdb[webLog.TimeZone] with
| null -> date.ToDateTimeUtc ()
| tz -> date.InZone(tz).ToDateTimeUnspecified ()
/// A user of the web log
[<CLIMutable; NoComparison; NoEquality>]
type WebLogUser =
{ /// The ID of the user
id : WebLogUserId
Id : WebLogUserId
/// The ID of the web log to which this user belongs
webLogId : WebLogId
WebLogId : WebLogId
/// The user name (e-mail address)
userName : string
Email : string
/// The user's first name
firstName : string
FirstName : string
/// The user's last name
lastName : string
LastName : string
/// The user's preferred name
preferredName : string
PreferredName : string
/// The hash of the user's password
passwordHash : string
/// Salt used to calculate the user's password hash
salt : Guid
PasswordHash : string
/// The URL of the user's personal site
url : string option
Url : string option
/// The user's authorization level
authorizationLevel : AuthorizationLevel
/// The user's access level
AccessLevel : AccessLevel
/// When the user was created
CreatedOn : Instant
/// When the user last logged on
LastSeenOn : Instant option
}
/// Functions to support web log users
@@ -407,21 +460,26 @@ module WebLogUser =
/// An empty web log user
let empty =
{ id = WebLogUserId.empty
webLogId = WebLogId.empty
userName = ""
firstName = ""
lastName = ""
preferredName = ""
passwordHash = ""
salt = Guid.Empty
url = None
authorizationLevel = User
{ Id = WebLogUserId.empty
WebLogId = WebLogId.empty
Email = ""
FirstName = ""
LastName = ""
PreferredName = ""
PasswordHash = ""
Url = None
AccessLevel = Author
CreatedOn = Noda.epoch
LastSeenOn = None
}
/// Get the user's displayed name
let displayName user =
let name =
seq { match user.preferredName with "" -> user.firstName | n -> n; " "; user.lastName }
seq { match user.PreferredName with "" -> user.FirstName | n -> n; " "; user.LastName }
|> Seq.reduce (+)
name.Trim ()
/// Does a user have the required access level?
let hasAccess level user =
AccessLevel.hasAccess level user.AccessLevel

View File

@@ -1,11 +1,5 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net6.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<DebugType>embedded</DebugType>
</PropertyGroup>
<ItemGroup>
<Compile Include="SupportTypes.fs" />
<Compile Include="DataTypes.fs" />
@@ -13,9 +7,9 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="Markdig" Version="0.30.2" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
<PackageReference Include="Markdown.ColorCode" Version="1.0.1" />
<PackageReference Include="Markdig" Version="0.30.4" />
<PackageReference Include="Markdown.ColorCode" Version="1.0.2" />
<PackageReference Include="NodaTime" Version="3.1.6" />
</ItemGroup>
</Project>

View File

@@ -1,6 +1,7 @@
namespace MyWebLog
open System
open NodaTime
/// Support functions for domain definition
[<AutoOpen>]
@@ -8,8 +9,76 @@ module private Helpers =
/// Create a new ID (short GUID)
// https://www.madskristensen.net/blog/A-shorter-and-URL-friendly-GUID
let newId() =
Convert.ToBase64String(Guid.NewGuid().ToByteArray()).Replace('/', '_').Replace('+', '-').Substring (0, 22)
let newId () =
Convert.ToBase64String(Guid.NewGuid().ToByteArray ()).Replace('/', '_').Replace('+', '-').Substring (0, 22)
/// Functions to support NodaTime manipulation
module Noda =
/// The clock to use when getting "now" (will make mutable for testing)
let clock : IClock = SystemClock.Instance
/// The Unix epoch
let epoch = Instant.FromUnixTimeSeconds 0L
/// Truncate an instant to remove fractional seconds
let toSecondsPrecision (value : Instant) =
Instant.FromUnixTimeSeconds (value.ToUnixTimeSeconds ())
/// The current Instant, with fractional seconds truncated
let now () =
toSecondsPrecision (clock.GetCurrentInstant ())
/// Convert a date/time to an Instant with whole seconds
let fromDateTime (dt : DateTime) =
toSecondsPrecision (Instant.FromDateTimeUtc (DateTime (dt.Ticks, DateTimeKind.Utc)))
/// A user's access level
type AccessLevel =
/// The user may create and publish posts and edit the ones they have created
| Author
/// The user may edit posts they did not create, but may not delete them
| Editor
/// The user may delete posts and configure web log settings
| WebLogAdmin
/// The user may manage themes (which affects all web logs for an installation)
| Administrator
/// Functions to support access levels
module AccessLevel =
/// Weightings for access levels
let private weights =
[ Author, 10
Editor, 20
WebLogAdmin, 30
Administrator, 40
]
|> Map.ofList
/// Convert an access level to its string representation
let toString =
function
| Author -> "Author"
| Editor -> "Editor"
| WebLogAdmin -> "WebLogAdmin"
| Administrator -> "Administrator"
/// Parse an access level from its string representation
let parse it =
match it with
| "Author" -> Author
| "Editor" -> Editor
| "WebLogAdmin" -> WebLogAdmin
| "Administrator" -> Administrator
| _ -> invalidOp $"{it} is not a valid access level"
/// Does a given access level allow an action that requires a certain access level?
let hasAccess needed held =
weights[needed] <= weights[held]
/// An identifier for a category
@@ -68,6 +137,115 @@ module CommentStatus =
| it -> invalidOp $"{it} is not a valid post status"
/// Valid values for the iTunes explicit rating
type ExplicitRating =
| Yes
| No
| Clean
/// Functions to support iTunes explicit ratings
module ExplicitRating =
/// Convert an explicit rating to a string
let toString : ExplicitRating -> string =
function
| Yes -> "yes"
| No -> "no"
| Clean -> "clean"
/// Parse a string into an explicit rating
let parse : string -> ExplicitRating =
function
| "yes" -> Yes
| "no" -> No
| "clean" -> Clean
| x -> raise (invalidArg "rating" $"{x} is not a valid explicit rating")
open NodaTime.Text
/// A podcast episode
type Episode =
{ /// The URL to the media file for the episode (may be permalink)
Media : string
/// The length of the media file, in bytes
Length : int64
/// The duration of the episode
Duration : Duration option
/// The media type of the file (overrides podcast default if present)
MediaType : string option
/// The URL to the image file for this episode (overrides podcast image if present, may be permalink)
ImageUrl : string option
/// A subtitle for this episode
Subtitle : string option
/// This episode's explicit rating (overrides podcast rating if present)
Explicit : ExplicitRating option
/// A link to a chapter file
ChapterFile : string option
/// The MIME type for the chapter file
ChapterType : string option
/// The URL for the transcript of the episode (may be permalink)
TranscriptUrl : string option
/// The MIME type of the transcript
TranscriptType : string option
/// The language in which the transcript is written
TranscriptLang : string option
/// If true, the transcript will be declared (in the feed) to be a captions file
TranscriptCaptions : bool option
/// The season number (for serialized podcasts)
SeasonNumber : int option
/// A description of the season
SeasonDescription : string option
/// The episode number
EpisodeNumber : double option
/// A description of the episode
EpisodeDescription : string option
}
/// Functions to support episodes
module Episode =
/// An empty episode
let empty =
{ Media = ""
Length = 0L
Duration = None
MediaType = None
ImageUrl = None
Subtitle = None
Explicit = None
ChapterFile = None
ChapterType = None
TranscriptUrl = None
TranscriptType = None
TranscriptLang = None
TranscriptCaptions = None
SeasonNumber = None
SeasonDescription = None
EpisodeNumber = None
EpisodeDescription = None
}
/// Format a duration for an episode
let formatDuration ep =
ep.Duration |> Option.map (DurationPattern.CreateWithInvariantCulture("H:mm:ss").Format)
open Markdig
open Markdown.ColorCode
@@ -108,10 +286,10 @@ module MarkupText =
[<CLIMutable; NoComparison; NoEquality>]
type MetaItem =
{ /// The name of the metadata value
name : string
Name : string
/// The metadata value
value : string
Value : string
}
/// Functions to support metadata items
@@ -119,17 +297,16 @@ module MetaItem =
/// An empty metadata item
let empty =
{ name = ""; value = "" }
{ Name = ""; Value = "" }
/// A revision of a page or post
[<CLIMutable; NoComparison; NoEquality>]
type Revision =
{ /// When this revision was saved
asOf : DateTime
AsOf : Instant
/// The text of the revision
text : MarkupText
Text : MarkupText
}
/// Functions to support revisions
@@ -137,8 +314,8 @@ module Revision =
/// An empty revision
let empty =
{ asOf = DateTime.UtcNow
text = Html ""
{ AsOf = Noda.epoch
Text = Html ""
}
@@ -171,6 +348,43 @@ module PageId =
let create () = PageId (newId ())
/// PodcastIndex.org podcast:medium allowed values
type PodcastMedium =
| Podcast
| Music
| Video
| Film
| Audiobook
| Newsletter
| Blog
/// Functions to support podcast medium
module PodcastMedium =
/// Convert a podcast medium to a string
let toString =
function
| Podcast -> "podcast"
| Music -> "music"
| Video -> "video"
| Film -> "film"
| Audiobook -> "audiobook"
| Newsletter -> "newsletter"
| Blog -> "blog"
/// Parse a string into a podcast medium
let parse value =
match value with
| "podcast" -> Podcast
| "music" -> Music
| "video" -> Video
| "film" -> Film
| "audiobook" -> Audiobook
| "newsletter" -> Newsletter
| "blog" -> Blog
| it -> invalidOp $"{it} is not a valid podcast medium"
/// Statuses for posts
type PostStatus =
/// The post should not be publicly available
@@ -248,83 +462,71 @@ module CustomFeedSource =
| source -> invalidArg "feedSource" $"{source} is not a valid feed source"
/// Valid values for the iTunes explicit rating
type ExplicitRating =
| Yes
| No
| Clean
/// Functions to support iTunes explicit ratings
module ExplicitRating =
/// Convert an explicit rating to a string
let toString : ExplicitRating -> string =
function
| Yes -> "yes"
| No -> "no"
| Clean -> "clean"
/// Parse a string into an explicit rating
let parse : string -> ExplicitRating =
function
| "yes" -> Yes
| "no" -> No
| "clean" -> Clean
| x -> raise (invalidArg "rating" $"{x} is not a valid explicit rating")
/// Options for a feed that describes a podcast
type PodcastOptions =
{ /// The title of the podcast
title : string
Title : string
/// A subtitle for the podcast
subtitle : string option
Subtitle : string option
/// The number of items in the podcast feed
itemsInFeed : int
ItemsInFeed : int
/// A summary of the podcast (iTunes field)
summary : string
Summary : string
/// The display name of the podcast author (iTunes field)
displayedAuthor : string
DisplayedAuthor : string
/// The e-mail address of the user who registered the podcast at iTunes
email : string
Email : string
/// The link to the image for the podcast
imageUrl : Permalink
ImageUrl : Permalink
/// The category from iTunes under which this podcast is categorized
iTunesCategory : string
/// The category from Apple Podcasts (iTunes) under which this podcast is categorized
AppleCategory : string
/// A further refinement of the categorization of this podcast (iTunes field / values)
iTunesSubcategory : string option
/// A further refinement of the categorization of this podcast (Apple Podcasts/iTunes field / values)
AppleSubcategory : string option
/// The explictness rating (iTunes field)
explicit : ExplicitRating
Explicit : ExplicitRating
/// The default media type for files in this podcast
defaultMediaType : string option
DefaultMediaType : string option
/// The base URL for relative URL media files for this podcast (optional; defaults to web log base)
mediaBaseUrl : string option
MediaBaseUrl : string option
/// A GUID for this podcast
PodcastGuid : Guid option
/// A URL at which information on supporting the podcast may be found (supports permalinks)
FundingUrl : string option
/// The text to be displayed in the funding item within the feed
FundingText : string option
/// The medium (what the podcast IS, not what it is ABOUT)
Medium : PodcastMedium option
}
/// A custom feed
type CustomFeed =
{ /// The ID of the custom feed
id : CustomFeedId
Id : CustomFeedId
/// The source for the custom feed
source : CustomFeedSource
Source : CustomFeedSource
/// The path for the custom feed
path : Permalink
Path : Permalink
/// Podcast options, if the feed defines a podcast
podcast : PodcastOptions option
Podcast : PodcastOptions option
}
/// Functions to support custom feeds
@@ -332,10 +534,10 @@ module CustomFeed =
/// An empty custom feed
let empty =
{ id = CustomFeedId ""
source = Category (CategoryId "")
path = Permalink ""
podcast = None
{ Id = CustomFeedId ""
Source = Category (CategoryId "")
Path = Permalink ""
Podcast = None
}
@@ -343,25 +545,25 @@ module CustomFeed =
[<CLIMutable; NoComparison; NoEquality>]
type RssOptions =
{ /// Whether the site feed of posts is enabled
feedEnabled : bool
IsFeedEnabled : bool
/// The name of the file generated for the site feed
feedName : string
FeedName : string
/// Override the "posts per page" setting for the site feed
itemsInFeed : int option
ItemsInFeed : int option
/// Whether feeds are enabled for all categories
categoryEnabled : bool
IsCategoryEnabled : bool
/// Whether feeds are enabled for all tags
tagEnabled : bool
IsTagEnabled : bool
/// A copyright string to be placed in all feeds
copyright : string option
Copyright : string option
/// Custom feeds for this web log
customFeeds: CustomFeed list
CustomFeeds: CustomFeed list
}
/// Functions to support RSS options
@@ -369,13 +571,13 @@ module RssOptions =
/// An empty set of RSS options
let empty =
{ feedEnabled = true
feedName = "feed.xml"
itemsInFeed = None
categoryEnabled = true
tagEnabled = true
copyright = None
customFeeds = []
{ IsFeedEnabled = true
FeedName = "feed.xml"
ItemsInFeed = None
IsCategoryEnabled = true
IsTagEnabled = true
Copyright = None
CustomFeeds = []
}
@@ -421,12 +623,56 @@ module ThemeAssetId =
/// A template for a theme
type ThemeTemplate =
{ /// The name of the template
name : string
Name : string
/// The text of the template
text : string
Text : string
}
/// Functions to support theme templates
module ThemeTemplate =
/// An empty theme template
let empty =
{ Name = ""
Text = ""
}
/// 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
@@ -444,26 +690,6 @@ module WebLogId =
let create () = WebLogId (newId ())
/// A level of authorization for a given web log
type AuthorizationLevel =
/// <summary>The user may administer all aspects of a web log</summary>
| Administrator
/// <summary>The user is a known user of a web log</summary>
| User
/// Functions to support authorization levels
module AuthorizationLevel =
/// Convert an authorization level to a string
let toString = function Administrator -> "Administrator" | User -> "User"
/// Parse a string into an authorization level
let parse value =
match value with
| "Administrator" -> Administrator
| "User" -> User
| it -> invalidOp $"{it} is not a valid authorization level"
/// An identifier for a web log user
type WebLogUserId = WebLogUserId of string

File diff suppressed because it is too large Load Diff

View File

@@ -7,16 +7,55 @@ 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 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 access level for the current user
member this.UserAccessLevel =
this.User.Claims
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.Role)
|> Option.map (fun claim -> AccessLevel.parse claim.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
/// The data implementation
member this.Data = this.RequestServices.GetRequiredService<IData> ()
/// Does the current user have the requested level of access?
member this.HasAccessLevel level =
defaultArg (this.UserAccessLevel |> Option.map (AccessLevel.hasAccess level)) false
open System.Collections.Concurrent
/// <summary>
@@ -32,19 +71,27 @@ module WebLogCache =
/// Try to get the web log for the current request (longest matching URL base wins)
let tryGet (path : string) =
_cache
|> List.filter (fun wl -> path.StartsWith wl.urlBase)
|> List.sortByDescending (fun wl -> wl.urlBase.Length)
|> List.filter (fun wl -> path.StartsWith wl.UrlBase)
|> List.sortByDescending (fun wl -> wl.UrlBase.Length)
|> List.tryHead
/// Cache the web log for a particular host
let set webLog =
_cache <- webLog :: (_cache |> List.filter (fun wl -> wl.id <> webLog.id))
_cache <- webLog :: (_cache |> List.filter (fun wl -> wl.Id <> webLog.Id))
/// Get all cached web logs
let all () =
_cache
/// Fill the web log cache from the database
let fill (data : IData) = backgroundTask {
let! webLogs = data.WebLog.all ()
let! webLogs = data.WebLog.All ()
_cache <- webLogs
}
/// Is the given theme in use by any web logs?
let isThemeInUse themeId =
_cache |> List.exists (fun wl -> wl.ThemeId = themeId)
/// A cache of page information needed to display the page list in templates
@@ -53,22 +100,30 @@ module PageListCache =
open MyWebLog.ViewModels
/// Cache of displayed pages
let private _cache = ConcurrentDictionary<string, DisplayPage[]> ()
let private _cache = ConcurrentDictionary<WebLogId, DisplayPage[]> ()
let private fillPages (webLog : WebLog) pages =
_cache[webLog.Id] <-
pages
|> List.map (fun pg -> DisplayPage.fromPage webLog { pg with Text = "" })
|> Array.ofList
/// Are there pages cached for this web log?
let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.urlBase
let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.Id
/// Get the pages for the web log for this request
let get (ctx : HttpContext) = _cache[ctx.WebLog.urlBase]
let get (ctx : HttpContext) = _cache[ctx.WebLog.Id]
/// Update the pages for the current web log
let update (ctx : HttpContext) = backgroundTask {
let webLog = ctx.WebLog
let! pages = ctx.Data.Page.findListed webLog.id
_cache[webLog.urlBase] <-
pages
|> List.map (fun pg -> DisplayPage.fromPage webLog { pg with text = "" })
|> Array.ofList
let! pages = ctx.Data.Page.FindListed ctx.WebLog.Id
fillPages ctx.WebLog pages
}
/// Refresh the pages for the given web log
let refresh (webLog : WebLog) (data : IData) = backgroundTask {
let! pages = data.Page.FindListed webLog.Id
fillPages webLog pages
}
@@ -78,18 +133,24 @@ module CategoryCache =
open MyWebLog.ViewModels
/// The cache itself
let private _cache = ConcurrentDictionary<string, DisplayCategory[]> ()
let private _cache = ConcurrentDictionary<WebLogId, DisplayCategory[]> ()
/// Are there categories cached for this web log?
let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.urlBase
let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.Id
/// Get the categories for the web log for this request
let get (ctx : HttpContext) = _cache[ctx.WebLog.urlBase]
let get (ctx : HttpContext) = _cache[ctx.WebLog.Id]
/// Update the cache with fresh data
let update (ctx : HttpContext) = backgroundTask {
let! cats = ctx.Data.Category.findAllForView ctx.WebLog.id
_cache[ctx.WebLog.urlBase] <- cats
let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.Id
_cache[ctx.WebLog.Id] <- cats
}
/// Refresh the category cache for the given web log
let refresh webLogId (data : IData) = backgroundTask {
let! cats = data.Category.FindAllForView webLogId
_cache[webLogId] <- cats
}
@@ -107,29 +168,54 @@ module TemplateCache =
let private hasInclude = Regex ("""{% include_template \"(.*)\" %}""", RegexOptions.None, TimeSpan.FromSeconds 2)
/// Get a template for the given theme and template name
let get (themeId : string) (templateName : string) (data : IData) = backgroundTask {
let templatePath = $"{themeId}/{templateName}"
let get (themeId : ThemeId) (templateName : string) (data : IData) = backgroundTask {
let templatePath = $"{ThemeId.toString themeId}/{templateName}"
match _cache.ContainsKey templatePath with
| true -> ()
| true -> return Ok _cache[templatePath]
| false ->
match! data.Theme.findById (ThemeId themeId) with
match! data.Theme.FindById themeId with
| Some theme ->
let mutable text = (theme.templates |> List.find (fun t -> t.name = templateName)).text
while hasInclude.IsMatch text do
let child = hasInclude.Match text
let childText = (theme.templates |> List.find (fun t -> t.name = child.Groups[1].Value)).text
text <- text.Replace (child.Value, childText)
_cache[templatePath] <- Template.Parse (text, SyntaxCompatibility.DotLiquid22)
| None -> ()
return _cache[templatePath]
match theme.Templates |> List.tryFind (fun t -> t.Name = templateName) with
| Some template ->
let mutable text = template.Text
let mutable childNotFound = ""
while hasInclude.IsMatch text do
let child = hasInclude.Match text
let childText =
match theme.Templates |> List.tryFind (fun t -> t.Name = child.Groups[1].Value) with
| Some childTemplate -> childTemplate.Text
| None ->
childNotFound <-
if childNotFound = "" then child.Groups[1].Value
else $"{childNotFound}; {child.Groups[1].Value}"
""
text <- text.Replace (child.Value, childText)
if childNotFound <> "" then
let s = if childNotFound.IndexOf ";" >= 0 then "s" else ""
return Error $"Could not find the child template{s} {childNotFound} required by {templateName}"
else
_cache[templatePath] <- Template.Parse (text, SyntaxCompatibility.DotLiquid22)
return Ok _cache[templatePath]
| None ->
return Error $"Theme ID {ThemeId.toString themeId} does not have a template named {templateName}"
| None -> return Result.Error $"Theme ID {ThemeId.toString themeId} does not exist"
}
/// Get all theme/template names currently cached
let allNames () =
_cache.Keys |> Seq.sort |> Seq.toList
/// Invalidate all template cache entries for the given theme ID
let invalidateTheme (themeId : string) =
let invalidateTheme (themeId : ThemeId) =
let keyPrefix = ThemeId.toString themeId
_cache.Keys
|> Seq.filter (fun key -> key.StartsWith themeId)
|> Seq.filter (fun key -> key.StartsWith keyPrefix)
|> List.ofSeq
|> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ())
/// Remove all entries from the template cache
let empty () =
_cache.Clear ()
/// A cache of asset names by themes
@@ -143,15 +229,15 @@ module ThemeAssetCache =
/// Refresh the list of assets for the given theme
let refreshTheme themeId (data : IData) = backgroundTask {
let! assets = data.ThemeAsset.findByTheme themeId
_cache[themeId] <- assets |> List.map (fun a -> match a.id with ThemeAssetId (_, path) -> path)
let! assets = data.ThemeAsset.FindByTheme themeId
_cache[themeId] <- assets |> List.map (fun a -> match a.Id with ThemeAssetId (_, path) -> path)
}
/// Fill the theme asset cache
let fill (data : IData) = backgroundTask {
let! assets = data.ThemeAsset.all ()
let! assets = data.ThemeAsset.All ()
for asset in assets do
let (ThemeAssetId (themeId, path)) = asset.id
let (ThemeAssetId (themeId, path)) = asset.Id
if not (_cache.ContainsKey themeId) then _cache[themeId] <- []
_cache[themeId] <- path :: _cache[themeId]
}

View File

@@ -8,24 +8,28 @@ open DotLiquid
open Giraffe.ViewEngine
open MyWebLog.ViewModels
/// Get the current web log from the DotLiquid context
let webLog (ctx : Context) =
ctx.Environments[0].["web_log"] :?> WebLog
/// Extensions on the DotLiquid Context object
type Context with
/// Get the current web log from the DotLiquid context
member this.WebLog =
this.Environments[0].["web_log"] :?> WebLog
/// Does an asset exist for the current theme?
let assetExists fileName (webLog : WebLog) =
ThemeAssetCache.get (ThemeId webLog.themePath) |> List.exists (fun it -> it = fileName)
ThemeAssetCache.get webLog.ThemeId |> List.exists (fun it -> it = fileName)
/// Obtain the link from known types
let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> string) =
match item with
| :? String as link -> Some link
| :? DisplayPage as page -> Some page.permalink
| :? PostListItem as post -> Some post.permalink
| :? DropProxy as proxy -> Option.ofObj proxy["permalink"] |> Option.map string
| :? DisplayPage as page -> Some page.Permalink
| :? PostListItem as post -> Some post.Permalink
| :? DropProxy as proxy -> Option.ofObj proxy["Permalink"] |> Option.map string
| _ -> None
|> function
| Some link -> linkFunc (webLog ctx) (Permalink link)
| Some link -> linkFunc ctx.WebLog (Permalink link)
| None -> $"alert('unknown item type {item.GetType().Name}')"
@@ -39,11 +43,11 @@ type AbsoluteLinkFilter () =
type CategoryLinkFilter () =
static member CategoryLink (ctx : Context, catObj : obj) =
match catObj with
| :? DisplayCategory as cat -> Some cat.slug
| :? DropProxy as proxy -> Option.ofObj proxy["slug"] |> Option.map string
| :? DisplayCategory as cat -> Some cat.Slug
| :? DropProxy as proxy -> Option.ofObj proxy["Slug"] |> Option.map string
| _ -> None
|> function
| Some slug -> WebLog.relativeUrl (webLog ctx) (Permalink $"category/{slug}/")
| Some slug -> WebLog.relativeUrl ctx.WebLog (Permalink $"category/{slug}/")
| None -> $"alert('unknown category object type {catObj.GetType().Name}')"
@@ -51,12 +55,12 @@ type CategoryLinkFilter () =
type EditPageLinkFilter () =
static member EditPageLink (ctx : Context, pageObj : obj) =
match pageObj with
| :? DisplayPage as page -> Some page.id
| :? DropProxy as proxy -> Option.ofObj proxy["id"] |> Option.map string
| :? DisplayPage as page -> Some page.Id
| :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId
| _ -> None
|> function
| Some pageId -> WebLog.relativeUrl (webLog ctx) (Permalink $"admin/page/{pageId}/edit")
| Some pageId -> WebLog.relativeUrl ctx.WebLog (Permalink $"admin/page/{pageId}/edit")
| None -> $"alert('unknown page object type {pageObj.GetType().Name}')"
@@ -64,38 +68,36 @@ type EditPageLinkFilter () =
type EditPostLinkFilter () =
static member EditPostLink (ctx : Context, postObj : obj) =
match postObj with
| :? PostListItem as post -> Some post.id
| :? DropProxy as proxy -> Option.ofObj proxy["id"] |> Option.map string
| :? PostListItem as post -> Some post.Id
| :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId
| _ -> None
|> function
| Some postId -> WebLog.relativeUrl (webLog ctx) (Permalink $"admin/post/{postId}/edit")
| Some postId -> WebLog.relativeUrl ctx.WebLog (Permalink $"admin/post/{postId}/edit")
| None -> $"alert('unknown post object type {postObj.GetType().Name}')"
/// A filter to generate nav links, highlighting the active link (exact match)
type NavLinkFilter () =
static member NavLink (ctx : Context, url : string, text : string) =
let webLog = webLog ctx
let _, path = WebLog.hostAndPath webLog
let _, path = WebLog.hostAndPath ctx.WebLog
let path = if path = "" then path else $"{path.Substring 1}/"
seq {
"<li class=\"nav-item\"><a class=\"nav-link"
if (string ctx.Environments[0].["current_page"]).StartsWith $"{path}{url}" then " active"
"\" href=\""
WebLog.relativeUrl webLog (Permalink url)
WebLog.relativeUrl ctx.WebLog (Permalink url)
"\">"
text
"</a></li>"
}
|> Seq.fold (+) ""
|> String.concat ""
/// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
type ThemeAssetFilter () =
static member ThemeAsset (ctx : Context, asset : string) =
let webLog = webLog ctx
WebLog.relativeUrl webLog (Permalink $"themes/{webLog.themePath}/{asset}")
WebLog.relativeUrl ctx.WebLog (Permalink $"themes/{ThemeId.toString ctx.WebLog.ThemeId}/{asset}")
/// Create various items in the page header based on the state of the page being generated
@@ -103,11 +105,11 @@ type PageHeadTag () =
inherit Tag ()
override this.Render (context : Context, result : TextWriter) =
let webLog = webLog context
let webLog = context.WebLog
// spacer
let s = " "
let getBool name =
context.Environments[0].[name] |> Option.ofObj |> Option.map Convert.ToBoolean |> Option.defaultValue false
defaultArg (context.Environments[0].[name] |> Option.ofObj |> Option.map Convert.ToBoolean) false
result.WriteLine $"""<meta name="generator" content="{context.Environments[0].["generator"]}">"""
@@ -123,26 +125,26 @@ type PageHeadTag () =
let relUrl = WebLog.relativeUrl webLog (Permalink url)
$"""{s}<link rel="alternate" type="application/rss+xml" title="{escTitle}" href="{relUrl}">"""
if webLog.rss.feedEnabled && getBool "is_home" then
result.WriteLine (feedLink webLog.name webLog.rss.feedName)
if webLog.Rss.IsFeedEnabled && getBool "is_home" then
result.WriteLine (feedLink webLog.Name webLog.Rss.FeedName)
result.WriteLine $"""{s}<link rel="canonical" href="{WebLog.absoluteUrl webLog Permalink.empty}">"""
if webLog.rss.categoryEnabled && getBool "is_category_home" then
if webLog.Rss.IsCategoryEnabled && getBool "is_category_home" then
let slug = context.Environments[0].["slug"] :?> string
result.WriteLine (feedLink webLog.name $"category/{slug}/{webLog.rss.feedName}")
result.WriteLine (feedLink webLog.Name $"category/{slug}/{webLog.Rss.FeedName}")
if webLog.rss.tagEnabled && getBool "is_tag_home" then
if webLog.Rss.IsTagEnabled && getBool "is_tag_home" then
let slug = context.Environments[0].["slug"] :?> string
result.WriteLine (feedLink webLog.name $"tag/{slug}/{webLog.rss.feedName}")
result.WriteLine (feedLink webLog.Name $"tag/{slug}/{webLog.Rss.FeedName}")
if getBool "is_post" then
let post = context.Environments[0].["model"] :?> PostDisplay
let url = WebLog.absoluteUrl webLog (Permalink post.posts[0].permalink)
let url = WebLog.absoluteUrl webLog (Permalink post.Posts[0].Permalink)
result.WriteLine $"""{s}<link rel="canonical" href="{url}">"""
if getBool "is_page" then
let page = context.Environments[0].["page"] :?> DisplayPage
let url = WebLog.absoluteUrl webLog (Permalink page.permalink)
let url = WebLog.absoluteUrl webLog (Permalink page.Permalink)
result.WriteLine $"""{s}<link rel="canonical" href="{url}">"""
@@ -151,11 +153,11 @@ type PageFootTag () =
inherit Tag ()
override this.Render (context : Context, result : TextWriter) =
let webLog = webLog context
let webLog = context.WebLog
// spacer
let s = " "
if webLog.autoHtmx then
if webLog.AutoHtmx then
result.WriteLine $"{s}{RenderView.AsString.htmlNode Htmx.Script.minified}"
if assetExists "script.js" webLog then
@@ -172,11 +174,11 @@ type RelativeLinkFilter () =
type TagLinkFilter () =
static member TagLink (ctx : Context, tag : string) =
ctx.Environments[0].["tag_mappings"] :?> TagMap list
|> List.tryFind (fun it -> it.tag = tag)
|> List.tryFind (fun it -> it.Tag = tag)
|> function
| Some tagMap -> tagMap.urlValue
| Some tagMap -> tagMap.UrlValue
| None -> tag.Replace (" ", "+")
|> function tagUrl -> WebLog.relativeUrl (webLog ctx) (Permalink $"tag/{tagUrl}/")
|> function tagUrl -> WebLog.relativeUrl ctx.WebLog (Permalink $"tag/{tagUrl}/")
/// Create links for a user to log on or off, and a dashboard link if they are logged off
@@ -184,11 +186,10 @@ type UserLinksTag () =
inherit Tag ()
override this.Render (context : Context, result : TextWriter) =
let webLog = webLog context
let link it = WebLog.relativeUrl webLog (Permalink it)
let link it = WebLog.relativeUrl context.WebLog (Permalink it)
seq {
"""<ul class="navbar-nav flex-grow-1 justify-content-end">"""
match Convert.ToBoolean context.Environments[0].["logged_on"] with
match Convert.ToBoolean context.Environments[0].["is_logged_on"] with
| true ->
$"""<li class="nav-item"><a class="nav-link" href="{link "admin/dashboard"}">Dashboard</a></li>"""
$"""<li class="nav-item"><a class="nav-link" href="{link "user/log-off"}">Log Off</a></li>"""
@@ -199,11 +200,11 @@ type UserLinksTag () =
|> Seq.iter result.WriteLine
/// A filter to retrieve the value of a meta item from a list
// (shorter than `{% assign item = list | where: "name", [name] | first %}{{ item.value }}`)
// (shorter than `{% assign item = list | where: "Name", [name] | first %}{{ item.value }}`)
type ValueFilter () =
static member Value (_ : Context, items : MetaItem list, name : string) =
match items |> List.tryFind (fun it -> it.name = name) with
| Some item -> item.value
match items |> List.tryFind (fun it -> it.Name = name) with
| Some item -> item.Value
| None -> $"-- {name} not found --"
@@ -222,16 +223,18 @@ let register () =
Template.RegisterTag<PageFootTag> "page_foot"
Template.RegisterTag<UserLinksTag> "user_links"
[ // Domain types
typeof<CustomFeed>; 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<DisplayTheme>; typeof<DisplayUpload>; typeof<DisplayUser>
typeof<EditCategoryModel>; typeof<EditCustomFeedModel>; typeof<EditMyInfoModel>; 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, [| "*" |]))

File diff suppressed because it is too large Load Diff

View File

@@ -1,22 +0,0 @@
/// Handlers for error conditions
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
}
/// 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"

View File

@@ -2,6 +2,7 @@
module MyWebLog.Handlers.Feed
open System
open System.Collections.Generic
open System.IO
open System.Net
open System.ServiceModel.Syndication
@@ -25,22 +26,22 @@ type FeedType =
let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
let webLog = ctx.WebLog
let debug = debug "Feed" ctx
let name = $"/{webLog.rss.feedName}"
let postCount = defaultArg webLog.rss.itemsInFeed webLog.postsPerPage
let name = $"/{webLog.Rss.FeedName}"
let postCount = defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage
debug (fun () -> $"Considering potential feed for {feedPath} (configured feed name {name})")
// Standard feed
match webLog.rss.feedEnabled && feedPath = name with
match webLog.Rss.IsFeedEnabled && feedPath = name with
| true ->
debug (fun () -> "Found standard feed")
Some (StandardFeed feedPath, postCount)
| false ->
// Category and tag feeds are handled by defined routes; check for custom feed
match webLog.rss.customFeeds
|> List.tryFind (fun it -> feedPath.EndsWith (Permalink.toString it.path)) with
match webLog.Rss.CustomFeeds
|> List.tryFind (fun it -> feedPath.EndsWith (Permalink.toString it.Path)) with
| Some feed ->
debug (fun () -> "Found custom feed")
Some (Custom (feed, feedPath),
feed.podcast |> Option.map (fun p -> p.itemsInFeed) |> Option.defaultValue postCount)
feed.Podcast |> Option.map (fun p -> p.ItemsInFeed) |> Option.defaultValue postCount)
| None ->
debug (fun () -> $"No matching feed found")
None
@@ -48,17 +49,17 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
/// Determine the function to retrieve posts for the given feed
let private getFeedPosts ctx feedType =
let childIds catId =
let cat = CategoryCache.get ctx |> Array.find (fun c -> c.id = CategoryId.toString catId)
getCategoryIds cat.slug ctx
let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = CategoryId.toString catId)
getCategoryIds cat.Slug ctx
let data = ctx.Data
match feedType with
| StandardFeed _ -> data.Post.findPageOfPublishedPosts ctx.WebLog.id 1
| CategoryFeed (catId, _) -> data.Post.findPageOfCategorizedPosts ctx.WebLog.id (childIds catId) 1
| TagFeed (tag, _) -> data.Post.findPageOfTaggedPosts ctx.WebLog.id tag 1
| StandardFeed _ -> data.Post.FindPageOfPublishedPosts ctx.WebLog.Id 1
| CategoryFeed (catId, _) -> data.Post.FindPageOfCategorizedPosts ctx.WebLog.Id (childIds catId) 1
| TagFeed (tag, _) -> data.Post.FindPageOfTaggedPosts ctx.WebLog.Id tag 1
| Custom (feed, _) ->
match feed.source with
| Category catId -> data.Post.findPageOfCategorizedPosts ctx.WebLog.id (childIds catId) 1
| Tag tag -> data.Post.findPageOfTaggedPosts ctx.WebLog.id tag 1
match feed.Source with
| Category catId -> data.Post.FindPageOfCategorizedPosts ctx.WebLog.Id (childIds catId) 1
| Tag tag -> data.Post.FindPageOfTaggedPosts ctx.WebLog.Id tag 1
/// Strip HTML from a string
let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace (text, "<(.|\n)*?>", "")
@@ -76,6 +77,9 @@ module private Namespace =
/// iTunes elements
let iTunes = "http://www.itunes.com/dtds/podcast-1.0.dtd"
/// Podcast Index (AKA "podcasting 2.0")
let podcast = "https://podcastindex.org/namespace/1.0"
/// Enables chapters
let psc = "http://podlove.org/simple-chapters/"
@@ -86,13 +90,13 @@ module private Namespace =
let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[]) (tagMaps : TagMap list)
(post : Post) =
let plainText =
let endingP = post.text.IndexOf "</p>"
stripHtml <| if endingP >= 0 then post.text[..(endingP - 1)] else post.text
let endingP = post.Text.IndexOf "</p>"
stripHtml <| if endingP >= 0 then post.Text[..(endingP - 1)] else post.Text
let item = SyndicationItem (
Id = WebLog.absoluteUrl webLog post.permalink,
Title = TextSyndicationContent.CreateHtmlContent post.title,
PublishDate = DateTimeOffset post.publishedOn.Value,
LastUpdatedTime = DateTimeOffset post.updatedOn,
Id = WebLog.absoluteUrl webLog post.Permalink,
Title = TextSyndicationContent.CreateHtmlContent post.Title,
PublishDate = post.PublishedOn.Value.ToDateTimeOffset (),
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset (),
Content = TextSyndicationContent.CreatePlaintextContent plainText)
item.AddPermalink (Uri item.Id)
@@ -100,25 +104,25 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[
let encoded =
let txt =
post.text
.Replace("src=\"/", $"src=\"{webLog.urlBase}/")
.Replace ("href=\"/", $"href=\"{webLog.urlBase}/")
post.Text
.Replace("src=\"/", $"src=\"{webLog.UrlBase}/")
.Replace ("href=\"/", $"href=\"{webLog.UrlBase}/")
let it = xmlDoc.CreateElement ("content", "encoded", Namespace.content)
let _ = it.AppendChild (xmlDoc.CreateCDataSection txt)
it
item.ElementExtensions.Add encoded
item.Authors.Add (SyndicationPerson (
Name = (authors |> List.find (fun a -> a.name = WebLogUserId.toString post.authorId)).value))
[ post.categoryIds
Name = (authors |> List.find (fun a -> a.Name = WebLogUserId.toString post.AuthorId)).Value))
[ post.CategoryIds
|> List.map (fun catId ->
let cat = cats |> Array.find (fun c -> c.id = CategoryId.toString catId)
SyndicationCategory (cat.name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.slug}/"), cat.name))
post.tags
let cat = cats |> Array.find (fun c -> c.Id = CategoryId.toString catId)
SyndicationCategory (cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name))
post.Tags
|> List.map (fun tag ->
let urlTag =
match tagMaps |> List.tryFind (fun tm -> tm.tag = tag) with
| Some tm -> tm.urlValue
match tagMaps |> List.tryFind (fun tm -> tm.Tag = tag) with
| Some tm -> tm.UrlValue
| None -> tag.Replace (" ", "+")
SyndicationCategory (tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)"))
]
@@ -126,37 +130,26 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[
|> List.iter item.Categories.Add
item
/// Convert non-absolute URLs to an absolute URL for this web log
let toAbsolute webLog (link : string) =
if link.StartsWith "http" then link else WebLog.absoluteUrl webLog (Permalink link)
/// Add episode information to a podcast feed item
let private addEpisode webLog (feed : CustomFeed) (post : Post) (item : SyndicationItem) =
let podcast = Option.get feed.podcast
let meta name = post.metadata |> List.tryFind (fun it -> it.name = name)
let value (item : MetaItem) = item.value
let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (post : Post) (item : SyndicationItem) =
let epMediaUrl =
match (meta >> Option.get >> value) "episode_media_file" with
match episode.Media with
| link when link.StartsWith "http" -> link
| link when Option.isSome podcast.mediaBaseUrl -> $"{podcast.mediaBaseUrl.Value}{link}"
| link when Option.isSome podcast.MediaBaseUrl -> $"{podcast.MediaBaseUrl.Value}{link}"
| link -> WebLog.absoluteUrl webLog (Permalink link)
let epMediaType =
match meta "episode_media_type", podcast.defaultMediaType with
| Some epType, _ -> Some epType.value
| None, Some defType -> Some defType
| _ -> None
let epImageUrl =
match defaultArg ((meta >> Option.map value) "episode_image") (Permalink.toString podcast.imageUrl) with
| link when link.StartsWith "http" -> link
| link -> WebLog.absoluteUrl webLog (Permalink link)
let epExplicit =
try
(meta >> Option.map (value >> ExplicitRating.parse)) "episode_explicit"
|> Option.defaultValue podcast.explicit
|> ExplicitRating.toString
with :? ArgumentException -> ExplicitRating.toString podcast.explicit
let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
let epImageUrl = defaultArg episode.ImageUrl (Permalink.toString podcast.ImageUrl) |> toAbsolute webLog
let epExplicit = defaultArg episode.Explicit podcast.Explicit |> ExplicitRating.toString
let xmlDoc = XmlDocument ()
let enclosure =
let it = xmlDoc.CreateElement "enclosure"
it.SetAttribute ("url", epMediaUrl)
meta "episode_media_length" |> Option.iter (fun len -> it.SetAttribute ("length", len.value))
it.SetAttribute ("length", string episode.Length)
epMediaType |> Option.iter (fun typ -> it.SetAttribute ("type", typ))
it
let image =
@@ -166,23 +159,70 @@ let private addEpisode webLog (feed : CustomFeed) (post : Post) (item : Syndicat
item.ElementExtensions.Add enclosure
item.ElementExtensions.Add image
item.ElementExtensions.Add ("creator", Namespace.dc, podcast.displayedAuthor)
item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.displayedAuthor)
item.ElementExtensions.Add ("creator", Namespace.dc, podcast.DisplayedAuthor)
item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor)
item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit)
meta "episode_subtitle"
|> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it.value))
meta "episode_duration"
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.value))
episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it))
Episode.formatDuration episode
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it))
if post.metadata |> List.exists (fun it -> it.name = "chapter") then
match episode.ChapterFile with
| Some chapters ->
let url = toAbsolute webLog chapters
let typ =
match episode.ChapterType with
| Some mime -> Some mime
| None when chapters.EndsWith ".json" -> Some "application/json+chapters"
| None -> None
let elt = xmlDoc.CreateElement ("podcast", "chapters", Namespace.podcast)
elt.SetAttribute ("url", url)
typ |> Option.iter (fun it -> elt.SetAttribute ("type", it))
item.ElementExtensions.Add elt
| None -> ()
match episode.TranscriptUrl with
| Some transcript ->
let url = toAbsolute webLog transcript
let elt = xmlDoc.CreateElement ("podcast", "transcript", Namespace.podcast)
elt.SetAttribute ("url", url)
elt.SetAttribute ("type", Option.get episode.TranscriptType)
episode.TranscriptLang |> Option.iter (fun it -> elt.SetAttribute ("language", it))
if defaultArg episode.TranscriptCaptions false then
elt.SetAttribute ("rel", "captions")
item.ElementExtensions.Add elt
| None -> ()
match episode.SeasonNumber with
| Some season ->
match episode.SeasonDescription with
| Some desc ->
let elt = xmlDoc.CreateElement ("podcast", "season", Namespace.podcast)
elt.SetAttribute ("name", desc)
elt.InnerText <- string season
item.ElementExtensions.Add elt
| None -> item.ElementExtensions.Add ("season", Namespace.podcast, string season)
| None -> ()
match episode.EpisodeNumber with
| Some epNumber ->
match episode.EpisodeDescription with
| Some desc ->
let elt = xmlDoc.CreateElement ("podcast", "episode", Namespace.podcast)
elt.SetAttribute ("name", desc)
elt.InnerText <- string epNumber
item.ElementExtensions.Add elt
| None -> item.ElementExtensions.Add ("episode", Namespace.podcast, string epNumber)
| None -> ()
if post.Metadata |> List.exists (fun it -> it.Name = "chapter") then
try
let chapters = xmlDoc.CreateElement ("psc", "chapters", Namespace.psc)
chapters.SetAttribute ("version", "1.2")
post.metadata
|> List.filter (fun it -> it.name = "chapter")
post.Metadata
|> List.filter (fun it -> it.Name = "chapter")
|> List.map (fun it ->
TimeSpan.Parse (it.value.Split(" ")[0]), it.value.Substring (it.value.IndexOf(" ") + 1))
TimeSpan.Parse (it.Value.Split(" ")[0]), it.Value.Substring (it.Value.IndexOf(" ") + 1))
|> List.sortBy fst
|> List.iter (fun chap ->
let chapter = xmlDoc.CreateElement ("psc", "chapter", Namespace.psc)
@@ -207,29 +247,34 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
child.InnerText <- value
elt
let podcast = Option.get feed.podcast
let feedUrl = WebLog.absoluteUrl webLog feed.path
let podcast = Option.get feed.Podcast
let feedUrl = WebLog.absoluteUrl webLog feed.Path
let imageUrl =
match podcast.imageUrl with
match podcast.ImageUrl with
| Permalink link when link.StartsWith "http" -> link
| Permalink _ -> WebLog.absoluteUrl webLog podcast.imageUrl
| Permalink _ -> WebLog.absoluteUrl webLog podcast.ImageUrl
let xmlDoc = XmlDocument ()
[ "dc", Namespace.dc; "itunes", Namespace.iTunes; "psc", Namespace.psc; "rawvoice", Namespace.rawVoice ]
[ "dc", Namespace.dc
"itunes", Namespace.iTunes
"podcast", Namespace.podcast
"psc", Namespace.psc
"rawvoice", Namespace.rawVoice
]
|> List.iter (fun (alias, nsUrl) -> addNamespace rssFeed alias nsUrl)
let categorization =
let it = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
it.SetAttribute ("text", podcast.iTunesCategory)
podcast.iTunesSubcategory
it.SetAttribute ("text", podcast.AppleCategory)
podcast.AppleSubcategory
|> Option.iter (fun subCat ->
let subCatElt = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
subCatElt.SetAttribute ("text", subCat)
it.AppendChild subCatElt |> ignore)
it
let image =
[ "title", podcast.title
[ "title", podcast.Title
"url", imageUrl
"link", feedUrl
]
@@ -239,8 +284,8 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
it.SetAttribute ("href", imageUrl)
it
let owner =
[ "name", podcast.displayedAuthor
"email", podcast.email
[ "name", podcast.DisplayedAuthor
"email", podcast.Email
]
|> List.fold (fun elt (name, value) -> addChild xmlDoc Namespace.iTunes "itunes" name value elt)
(xmlDoc.CreateElement ("itunes", "owner", Namespace.iTunes))
@@ -255,51 +300,62 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
rssFeed.ElementExtensions.Add categorization
rssFeed.ElementExtensions.Add iTunesImage
rssFeed.ElementExtensions.Add rawVoice
rssFeed.ElementExtensions.Add ("summary", Namespace.iTunes, podcast.summary)
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))
rssFeed.ElementExtensions.Add ("summary", Namespace.iTunes, podcast.Summary)
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.PodcastGuid
|> 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 =
let withoutFeed (it : string) = Permalink (it.Replace ($"/{webLog.rss.feedName}", ""))
let withoutFeed (it : string) = Permalink (it.Replace ($"/{webLog.Rss.FeedName}", ""))
match feedType with
| StandardFeed path
| CategoryFeed (_, path)
| TagFeed (_, path) -> Permalink path[1..], withoutFeed path
| Custom (feed, _) ->
match feed.source with
match feed.Source with
| Category (CategoryId catId) ->
feed.path, Permalink $"category/{(CategoryCache.get ctx |> Array.find (fun c -> c.id = catId)).slug}"
| Tag tag -> feed.path, Permalink $"""tag/{tag.Replace(" ", "+")}/"""
feed.Path, Permalink $"category/{(CategoryCache.get ctx |> Array.find (fun c -> c.Id = catId)).Slug}"
| Tag tag -> feed.Path, Permalink $"""tag/{tag.Replace(" ", "+")}/"""
/// Set the title and description of the feed based on its source
let private setTitleAndDescription feedType (webLog : WebLog) (cats : DisplayCategory[]) (feed : SyndicationFeed) =
let cleanText opt def = TextSyndicationContent (stripHtml (defaultArg opt def))
match feedType with
| StandardFeed _ ->
feed.Title <- cleanText None webLog.name
feed.Description <- cleanText webLog.subtitle webLog.name
feed.Title <- cleanText None webLog.Name
feed.Description <- cleanText webLog.Subtitle webLog.Name
| CategoryFeed (CategoryId catId, _) ->
let cat = cats |> Array.find (fun it -> it.id = catId)
feed.Title <- cleanText None $"""{webLog.name} - "{stripHtml cat.name}" Category"""
feed.Description <- cleanText cat.description $"""Posts categorized under "{cat.name}" """
let cat = cats |> Array.find (fun it -> it.Id = catId)
feed.Title <- cleanText None $"""{webLog.Name} - "{stripHtml cat.Name}" Category"""
feed.Description <- cleanText cat.Description $"""Posts categorized under "{cat.Name}" """
| TagFeed (tag, _) ->
feed.Title <- cleanText None $"""{webLog.name} - "{tag}" Tag"""
feed.Title <- cleanText None $"""{webLog.Name} - "{tag}" Tag"""
feed.Description <- cleanText None $"""Posts with the "{tag}" tag"""
| Custom (custom, _) ->
match custom.podcast with
match custom.Podcast with
| Some podcast ->
feed.Title <- cleanText None podcast.title
feed.Description <- cleanText podcast.subtitle podcast.title
feed.Title <- cleanText None podcast.Title
feed.Description <- cleanText podcast.Subtitle podcast.Title
| None ->
match custom.source with
match custom.Source with
| Category (CategoryId catId) ->
let cat = cats |> Array.find (fun it -> it.id = catId)
feed.Title <- cleanText None $"""{webLog.name} - "{stripHtml cat.name}" Category"""
feed.Description <- cleanText cat.description $"""Posts categorized under "{cat.name}" """
let cat = cats |> Array.find (fun it -> it.Id = catId)
feed.Title <- cleanText None $"""{webLog.Name} - "{stripHtml cat.Name}" Category"""
feed.Description <- cleanText cat.Description $"""Posts categorized under "{cat.Name}" """
| Tag tag ->
feed.Title <- cleanText None $"""{webLog.name} - "{tag}" Tag"""
feed.Title <- cleanText None $"""{webLog.Name} - "{tag}" Tag"""
feed.Description <- cleanText None $"""Posts with the "{tag}" tag"""
/// Create a feed with a known non-zero-length list of posts
@@ -309,16 +365,15 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
let! authors = getAuthors webLog posts data
let! tagMaps = getTagMappings webLog posts data
let cats = CategoryCache.get ctx
let podcast = match feedType with Custom (feed, _) when Option.isSome feed.podcast -> Some feed | _ -> None
let podcast = match feedType with Custom (feed, _) when Option.isSome feed.Podcast -> Some feed | _ -> None
let self, link = selfAndLink webLog feedType ctx
let toItem post =
let item = toFeedItem webLog authors cats tagMaps post
match podcast with
| Some feed when post.metadata |> List.exists (fun it -> it.name = "episode_media_file") ->
addEpisode webLog feed post item
| Some _ ->
warn "Feed" ctx $"[{webLog.name} {Permalink.toString self}] \"{stripHtml post.title}\" has no media"
match podcast, post.Episode with
| Some feed, Some episode -> addEpisode webLog (Option.get feed.Podcast) episode post item
| Some _, _ ->
warn "Feed" ctx $"[{webLog.Name} {Permalink.toString self}] \"{stripHtml post.Title}\" has no media"
item
| _ -> item
@@ -326,12 +381,12 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
addNamespace feed "content" Namespace.content
setTitleAndDescription feedType webLog cats feed
feed.LastUpdatedTime <- (List.head posts).updatedOn |> DateTimeOffset
feed.Generator <- generator ctx
feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset ()
feed.Generator <- ctx.Generator
feed.Items <- posts |> Seq.ofList |> Seq.map toItem
feed.Language <- "en"
feed.Id <- WebLog.absoluteUrl webLog link
webLog.rss.copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy)
webLog.Rss.Copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy)
feed.Links.Add (SyndicationLink (Uri (WebLog.absoluteUrl webLog self), "self", "", "application/rss+xml", 0L))
feed.ElementExtensions.Add ("link", "", WebLog.absoluteUrl webLog link)
@@ -359,101 +414,88 @@ let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> bac
// ~~ FEED ADMINISTRATION ~~
open DotLiquid
// GET: /admin/rss/settings
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
page_title = "RSS Settings"
model = EditRssModel.fromRssOptions webLog.rss
custom_feeds = feeds
|}
|> viewForTheme "admin" "rss-settings" next ctx
}
// POST: /admin/rss/settings
let saveSettings : HttpHandler = fun next ctx -> task {
// POST /admin/settings/rss
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditRssModel> ()
match! data.WebLog.findById ctx.WebLog.id with
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
let webLog = { webLog with rss = model.updateOptions webLog.rss }
do! data.WebLog.updateRssOptions webLog
let webLog = { webLog with Rss = model.UpdateOptions webLog.Rss }
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
do! addMessage ctx { UserMessage.success with Message = "RSS settings updated successfully" }
return! redirectToGet "admin/settings#rss-settings" next ctx
| None -> return! Error.notFound next ctx
}
// GET: /admin/rss/{id}/edit
let editCustomFeed feedId : HttpHandler = fun next ctx -> task {
// GET /admin/settings/rss/{id}/edit
let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let customFeed =
match feedId with
| "new" -> Some { CustomFeed.empty with id = CustomFeedId "new" }
| _ -> ctx.WebLog.rss.customFeeds |> List.tryFind (fun f -> f.id = CustomFeedId feedId)
| "new" -> Some { CustomFeed.empty with Id = CustomFeedId "new" }
| _ -> 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
|}
|> viewForTheme "admin" "custom-feed-edit" next ctx
| None -> return! Error.notFound next ctx
}
hashForPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditCustomFeedModel.fromFeed f)
|> addToHash "medium_values" [|
KeyValuePair.Create ("", "&ndash; Unspecified &ndash;")
KeyValuePair.Create (PodcastMedium.toString Podcast, "Podcast")
KeyValuePair.Create (PodcastMedium.toString Music, "Music")
KeyValuePair.Create (PodcastMedium.toString Video, "Video")
KeyValuePair.Create (PodcastMedium.toString Film, "Film")
KeyValuePair.Create (PodcastMedium.toString Audiobook, "Audiobook")
KeyValuePair.Create (PodcastMedium.toString Newsletter, "Newsletter")
KeyValuePair.Create (PodcastMedium.toString Blog, "Blog")
|]
|> adminView "custom-feed-edit" next ctx
| None -> Error.notFound next ctx
// POST: /admin/rss/save
let saveCustomFeed : HttpHandler = fun next ctx -> task {
// POST /admin/settings/rss/save
let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLog.findById ctx.WebLog.id with
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
let! model = ctx.BindFormAsync<EditCustomFeedModel> ()
let theFeed =
match model.id with
| "new" -> Some { CustomFeed.empty with id = CustomFeedId.create () }
| _ -> webLog.rss.customFeeds |> List.tryFind (fun it -> CustomFeedId.toString it.id = model.id)
match model.Id with
| "new" -> Some { CustomFeed.empty with Id = CustomFeedId.create () }
| _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> CustomFeedId.toString it.Id = model.Id)
match theFeed with
| Some feed ->
let feeds = model.updateFeed feed :: (webLog.rss.customFeeds |> List.filter (fun it -> it.id <> feed.id))
let webLog = { webLog with rss = { webLog.rss with customFeeds = feeds } }
do! data.WebLog.updateRssOptions webLog
let feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun it -> it.Id <> feed.Id))
let webLog = { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog
do! addMessage ctx {
UserMessage.success with
message = $"""Successfully {if model.id = "new" then "add" else "sav"}ed custom feed"""
Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed"""
}
let nextUrl = $"admin/settings/rss/{CustomFeedId.toString feed.id}/edit"
return! redirectToGet (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
let deleteCustomFeed feedId : HttpHandler = fun next ctx -> task {
// POST /admin/settings/rss/{id}/delete
let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLog.findById ctx.WebLog.id with
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
let customId = CustomFeedId feedId
if webLog.rss.customFeeds |> List.exists (fun f -> f.id = customId) then
if webLog.Rss.CustomFeeds |> List.exists (fun f -> f.Id = customId) then
let webLog = {
webLog with
rss = {
webLog.rss with
customFeeds = webLog.rss.customFeeds |> List.filter (fun f -> f.id <> customId)
Rss = {
webLog.Rss with
CustomFeeds = webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> customId)
}
}
do! data.WebLog.updateRssOptions webLog
do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog
do! addMessage ctx { UserMessage.success with message = "Custom feed deleted successfully" }
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
do! addMessage ctx { UserMessage.warning with Message = "Custom feed not found; no action taken" }
return! redirectToGet "admin/settings#rss-settings" next ctx
| None -> return! Error.notFound next ctx
}

View File

@@ -12,12 +12,116 @@ type ISession with
this.SetString (key, JsonSerializer.Serialize item)
/// Get an item from the session
member this.Get<'T> key =
member this.TryGet<'T> key =
match this.GetString key with
| null -> None
| item -> Some (JsonSerializer.Deserialize<'T> item)
/// Keys used in the myWebLog-standard DotLiquid hash
module ViewContext =
/// The anti cross-site request forgery (CSRF) token set to use for form submissions
[<Literal>]
let AntiCsrfTokens = "csrf"
/// The categories for this web log
[<Literal>]
let Categories = "categories"
/// The main content of the view
[<Literal>]
let Content = "content"
/// The current page URL
[<Literal>]
let CurrentPage = "current_page"
/// The generator string for the current version of myWebLog
[<Literal>]
let Generator = "generator"
/// The HTML to load htmx from the unpkg CDN
[<Literal>]
let HtmxScript = "htmx_script"
/// Whether the current user has Administrator privileges
[<Literal>]
let IsAdministrator = "is_administrator"
/// Whether the current user has Author (or above) privileges
[<Literal>]
let IsAuthor = "is_author"
/// Whether the current view is displaying a category archive page
[<Literal>]
let IsCategory = "is_category"
/// Whether the current view is displaying the first page of a category archive
[<Literal>]
let IsCategoryHome = "is_category_home"
/// Whether the current user has Editor (or above) privileges
[<Literal>]
let IsEditor = "is_editor"
/// Whether the current view is the home page for the web log
[<Literal>]
let IsHome = "is_home"
/// Whether there is a user logged on
[<Literal>]
let IsLoggedOn = "is_logged_on"
/// Whether the current view is displaying a page
[<Literal>]
let IsPage = "is_page"
/// Whether the current view is displaying a post
[<Literal>]
let IsPost = "is_post"
/// Whether the current view is a tag archive page
[<Literal>]
let IsTag = "is_tag"
/// Whether the current view is the first page of a tag archive
[<Literal>]
let IsTagHome = "is_tag_home"
/// Whether the current user has Web Log Admin (or above) privileges
[<Literal>]
let IsWebLogAdmin = "is_web_log_admin"
/// Messages to be displayed to the user
[<Literal>]
let Messages = "messages"
/// The view model / form for the page
[<Literal>]
let Model = "model"
/// The listed pages for the web log
[<Literal>]
let PageList = "page_list"
/// The title of the page being displayed
[<Literal>]
let PageTitle = "page_title"
/// The slug for category or tag archive pages
[<Literal>]
let Slug = "slug"
/// The ID of the current user
[<Literal>]
let UserId = "user_id"
/// The current web log
[<Literal>]
let WebLog = "web_log"
/// The HTTP item key for loading the session
let private sessionLoadedKey = "session-loaded"
@@ -38,46 +142,42 @@ open MyWebLog.ViewModels
/// Add a message to the user's session
let addMessage (ctx : HttpContext) message = task {
do! loadSession ctx
let msg = match ctx.Session.Get<UserMessage list> "messages" with Some it -> it | None -> []
ctx.Session.Set ("messages", message :: msg)
let msg = match ctx.Session.TryGet<UserMessage list> ViewContext.Messages with Some it -> it | None -> []
ctx.Session.Set (ViewContext.Messages, message :: msg)
}
/// Get any messages from the user's session, removing them in the process
let messages (ctx : HttpContext) = task {
do! loadSession ctx
match ctx.Session.Get<UserMessage list> "messages" with
match ctx.Session.TryGet<UserMessage list> ViewContext.Messages with
| Some msg ->
ctx.Session.Remove "messages"
ctx.Session.Remove ViewContext.Messages
return msg |> (List.rev >> Array.ofList)
| 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
/// Either get the web log from the hash, or get it from the cache and add it to the hash
let private deriveWebLogFromHash (hash : Hash) (ctx : HttpContext) =
if hash.ContainsKey "web_log" then () else hash.Add ("web_log", ctx.WebLog)
hash["web_log"] :?> WebLog
/// Shorthand for creating a DotLiquid hash from an anonymous object
let makeHash (values : obj) =
Hash.FromAnonymousObject values
/// Create a hash with the page title filled
let hashForPage (title : string) =
makeHash {| page_title = title |}
/// Add a key to the hash, returning the modified hash
// (note that the hash itself is mutated; this is only used to make it pipeable)
let addToHash key (value : obj) (hash : Hash) =
if hash.ContainsKey key then hash[key] <- value else hash.Add (key, value)
hash
/// Add anti-CSRF tokens to the given hash
let withAntiCsrf (ctx : HttpContext) =
addToHash ViewContext.AntiCsrfTokens ctx.CsrfTokenSet
open System.Security.Claims
open Giraffe
open Giraffe.Htmx
open Giraffe.ViewEngine
@@ -86,115 +186,205 @@ open Giraffe.ViewEngine
let private htmxScript = RenderView.AsString.htmlNode Htmx.Script.minified
/// Populate the DotLiquid hash with standard information
let private populateHash hash ctx = task {
// Don't need the web log, but this adds it to the hash if the function is called directly
let _ = deriveWebLogFromHash hash ctx
let addViewContext ctx (hash : Hash) = task {
let! messages = messages ctx
hash.Add ("logged_on", ctx.User.Identity.IsAuthenticated)
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 ("htmx_script", htmxScript)
do! commitSession ctx
return
if hash.ContainsKey ViewContext.HtmxScript && hash.ContainsKey ViewContext.Messages then
// We have already populated everything; just update messages
hash[ViewContext.Messages] <- Array.concat [ hash[ViewContext.Messages] :?> UserMessage[]; messages ]
hash
else
ctx.User.Claims
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.NameIdentifier)
|> Option.map (fun claim -> addToHash ViewContext.UserId claim.Value hash)
|> Option.defaultValue hash
|> addToHash ViewContext.WebLog ctx.WebLog
|> addToHash ViewContext.PageList (PageListCache.get ctx)
|> addToHash ViewContext.Categories (CategoryCache.get ctx)
|> addToHash ViewContext.CurrentPage ctx.Request.Path.Value[1..]
|> addToHash ViewContext.Messages messages
|> addToHash ViewContext.Generator ctx.Generator
|> addToHash ViewContext.HtmxScript htmxScript
|> addToHash ViewContext.IsLoggedOn ctx.User.Identity.IsAuthenticated
|> addToHash ViewContext.IsAuthor (ctx.HasAccessLevel Author)
|> addToHash ViewContext.IsEditor (ctx.HasAccessLevel Editor)
|> addToHash ViewContext.IsWebLogAdmin (ctx.HasAccessLevel WebLogAdmin)
|> addToHash ViewContext.IsAdministrator (ctx.HasAccessLevel Administrator)
}
/// Is the request from htmx?
let isHtmx (ctx : HttpContext) =
ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
/// Convert messages to headers (used for htmx responses)
let messagesToHeaders (messages : UserMessage array) : HttpHandler =
seq {
yield!
messages
|> Array.map (fun m ->
match m.Detail with
| Some detail -> $"{m.Level}|||{m.Message}|||{detail}"
| None -> $"{m.Level}|||{m.Message}"
|> setHttpHeader "X-Message")
withHxNoPushUrl
}
|> Seq.reduce (>=>)
/// Redirect after doing some action; commits session and issues a temporary redirect
let redirectToGet url : HttpHandler = fun _ ctx -> task {
do! commitSession ctx
return! redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink url)) earlyReturn ctx
}
/// Handlers for error conditions
module Error =
open System.Net
/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
let notAuthorized : HttpHandler = fun next ctx ->
if ctx.Request.Method = "GET" then
let redirectUrl = $"user/log-on?returnUrl={WebUtility.UrlEncode ctx.Request.Path}"
if isHtmx ctx then (withHxRedirect redirectUrl >=> redirectToGet redirectUrl) next ctx
else redirectToGet redirectUrl next ctx
else
if isHtmx ctx then
let messages = [|
{ UserMessage.error with
Message = $"You are not authorized to access the URL {ctx.Request.Path.Value}"
}
|]
(messagesToHeaders messages >=> setStatusCode 401) 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 =
handleContext (fun ctx ->
if isHtmx ctx then
let messages = [|
{ UserMessage.error with Message = $"The URL {ctx.Request.Path.Value} was not found" }
|]
RequestErrors.notFound (messagesToHeaders messages) earlyReturn ctx
else RequestErrors.NOT_FOUND "Not found" earlyReturn ctx)
let server message : HttpHandler =
handleContext (fun ctx ->
if isHtmx ctx then
let messages = [| { UserMessage.error with Message = message } |]
ServerErrors.internalError (messagesToHeaders messages) earlyReturn ctx
else ServerErrors.INTERNAL_ERROR message earlyReturn 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 {
do! populateHash hash ctx
let viewForTheme themeId template next ctx (hash : Hash) = task {
let! hash = addViewContext ctx hash
// NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render;
// the net effect is a "layout" capability similar to Razor or Pug
// Render view content...
let! contentTemplate = TemplateCache.get theme template ctx.Data
hash.Add ("content", contentTemplate.Render hash)
// ...then render that content with its layout
let isHtmx = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
let! layoutTemplate = TemplateCache.get theme (if isHtmx then "layout-partial" else "layout") ctx.Data
return! htmlString (layoutTemplate.Render hash) next ctx
match! TemplateCache.get themeId template ctx.Data with
| Ok contentTemplate ->
let _ = addToHash ViewContext.Content (contentTemplate.Render hash) hash
// ...then render that content with its layout
match! TemplateCache.get themeId (if isHtmx ctx then "layout-partial" else "layout") ctx.Data with
| Ok layoutTemplate -> return! htmlString (layoutTemplate.Render hash) next ctx
| Error message -> return! Error.server message next ctx
| Error message -> return! Error.server message next ctx
}
/// Render a bare view for the specified theme, using the specified template and hash
let bareForTheme theme template next ctx = fun (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)
let! layoutTemplate = TemplateCache.get theme "layout-bare" ctx.Data
// add messages as HTTP headers
let messages = hash["messages"] :?> UserMessage[]
let actions = seq {
yield!
messages
|> Array.map (fun m ->
match m.detail with
| Some detail -> $"{m.level}|||{m.message}|||{detail}"
| None -> $"{m.level}|||{m.message}"
|> setHttpHeader "X-Message")
withHxNoPush
htmlString (layoutTemplate.Render hash)
}
return! (actions |> Seq.reduce (>=>)) next ctx
let bareForTheme themeId template next ctx (hash : Hash) = task {
let! hash = addViewContext ctx hash
let withContent = task {
if hash.ContainsKey ViewContext.Content then return Ok hash
else
match! TemplateCache.get themeId template ctx.Data with
| Ok contentTemplate -> return Ok (addToHash ViewContext.Content (contentTemplate.Render hash) hash)
| Error message -> return Error message
}
match! withContent with
| Ok completeHash ->
// Bare templates are rendered with layout-bare
match! TemplateCache.get themeId "layout-bare" ctx.Data with
| Ok layoutTemplate ->
return!
(messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage[])
>=> htmlString (layoutTemplate.Render completeHash))
next ctx
| Error message -> return! Error.server message next ctx
| Error message -> return! Error.server message next ctx
}
/// 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 = task {
let! hash = addViewContext ctx hash
return! viewForTheme (hash[ViewContext.WebLog] :?> WebLog).ThemeId template next ctx hash
}
/// Redirect after doing some action; commits session and issues a temporary redirect
let redirectToGet url : HttpHandler = fun next ctx -> task {
do! commitSession ctx
return! redirectTo false url next ctx
}
/// The ID for the admin theme
let adminTheme = ThemeId "admin"
open System.Security.Claims
/// Display a view for the admin theme
let adminView template =
viewForTheme adminTheme template
/// 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
/// Display a bare view for the admin theme
let adminBareView template =
bareForTheme adminTheme template
open Microsoft.AspNetCore.Antiforgery
/// Get the Anti-CSRF service
let private antiForgery (ctx : HttpContext) = ctx.RequestServices.GetRequiredService<IAntiforgery> ()
/// Get the cross-site request forgery token set
let csrfToken (ctx : HttpContext) =
(antiForgery ctx).GetAndStoreTokens ctx
/// Validate the cross-site request forgery token in the current request
/// Validate the anti 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
let requireUser : HttpHandler = requiresAuthentication Error.notAuthorized
/// Require a specific level of access for a route
let requireAccess level : HttpHandler = fun next ctx -> task {
match ctx.UserAccessLevel with
| Some userLevel when AccessLevel.hasAccess level userLevel -> return! next ctx
| Some userLevel ->
do! addMessage ctx
{ UserMessage.warning with
Message = $"The page you tried to access requires {AccessLevel.toString level} privileges"
Detail = Some $"Your account only has {AccessLevel.toString userLevel} privileges"
}
return! Error.notAuthorized next ctx
| None ->
do! addMessage ctx
{ UserMessage.warning with Message = "The page you tried to access required you to be logged on" }
return! Error.notAuthorized next ctx
}
/// Determine if a user is authorized to edit a page or post, given the author
let canEdit authorId (ctx : HttpContext) =
ctx.UserId = authorId || ctx.HasAccessLevel Editor
open System.Threading.Tasks
/// Create a Task with a Some result for the given object
let someTask<'T> (it : 'T) = Task.FromResult (Some it)
open System.Collections.Generic
open MyWebLog.Data
/// Get the templates available for the current web log's theme (in a key/value pair list)
let templatesForTheme (ctx : HttpContext) (typ : string) = backgroundTask {
match! ctx.Data.Theme.findByIdWithoutText (ThemeId ctx.WebLog.themePath) with
match! ctx.Data.Theme.FindByIdWithoutText ctx.WebLog.ThemeId with
| Some theme ->
return seq {
KeyValuePair.Create ("", $"- Default (single-{typ}) -")
yield!
theme.templates
theme.Templates
|> Seq.ofList
|> Seq.filter (fun it -> it.name.EndsWith $"-{typ}" && it.name <> $"single-{typ}")
|> Seq.map (fun it -> KeyValuePair.Create (it.name, it.name))
|> Seq.filter (fun it -> it.Name.EndsWith $"-{typ}" && it.Name <> $"single-{typ}")
|> Seq.map (fun it -> KeyValuePair.Create (it.Name, it.Name))
}
|> Array.ofSeq
| None -> return [| KeyValuePair.Create ("", $"- Default (single-{typ}) -") |]
@@ -203,29 +393,38 @@ let templatesForTheme (ctx : HttpContext) (typ : string) = backgroundTask {
/// Get all authors for a list of posts as metadata items
let getAuthors (webLog : WebLog) (posts : Post list) (data : IData) =
posts
|> List.map (fun p -> p.authorId)
|> List.map (fun p -> p.AuthorId)
|> List.distinct
|> data.WebLogUser.findNames webLog.id
|> data.WebLogUser.FindNames webLog.Id
/// Get all tag mappings for a list of posts as metadata items
let getTagMappings (webLog : WebLog) (posts : Post list) (data : IData) =
posts
|> List.map (fun p -> p.tags)
|> List.map (fun p -> p.Tags)
|> List.concat
|> List.distinct
|> fun tags -> data.TagMap.findMappingForTags tags webLog.id
|> fun tags -> data.TagMap.FindMappingForTags tags webLog.Id
/// Get all category IDs for the given slug (includes owned subcategories)
let getCategoryIds slug ctx =
let allCats = CategoryCache.get ctx
let cat = allCats |> Array.find (fun cat -> cat.slug = slug)
let cat = allCats |> Array.find (fun cat -> cat.Slug = slug)
// Category pages include posts in subcategories
allCats
|> Seq.ofArray
|> Seq.filter (fun c -> c.id = cat.id || Array.contains cat.name c.parentNames)
|> Seq.map (fun c -> CategoryId c.id)
|> Seq.filter (fun c -> c.Id = cat.Id || Array.contains cat.Name c.ParentNames)
|> Seq.map (fun c -> CategoryId c.Id)
|> List.ofSeq
open System
open System.Globalization
open NodaTime
/// Parse a date/time to UTC
let parseToUtc (date : string) =
Instant.FromDateTimeUtc (DateTime.Parse (date, null, DateTimeStyles.AdjustToUniversal))
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Logging
/// Log level for debugging

View File

@@ -0,0 +1,199 @@
/// Handlers to manipulate pages
module MyWebLog.Handlers.Page
open Giraffe
open MyWebLog
open MyWebLog.ViewModels
// GET /admin/pages
// GET /admin/pages/page/{pageNbr}
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! pages = ctx.Data.Page.FindPageOfPages ctx.WebLog.Id pageNbr
return!
hashForPage "Pages"
|> withAntiCsrf ctx
|> addToHash "pages" (pages
|> Seq.ofList
|> Seq.truncate 25
|> Seq.map (DisplayPage.fromPageMinimal ctx.WebLog)
|> List.ofSeq)
|> addToHash "page_nbr" pageNbr
|> addToHash "prev_page" (if pageNbr = 2 then "" else $"/page/{pageNbr - 1}")
|> addToHash "has_next" (List.length pages > 25)
|> addToHash "next_page" $"/page/{pageNbr + 1}"
|> adminView "page-list" next ctx
}
// GET /admin/page/{id}/edit
let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! result = task {
match pgId with
| "new" -> return Some ("Add a New Page", { Page.empty with Id = PageId "new"; AuthorId = ctx.UserId })
| _ ->
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) when canEdit page.AuthorId ctx ->
let model = EditPageModel.fromPage page
let! templates = templatesForTheme ctx "page"
return!
hashForPage title
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "metadata" (
Array.zip model.MetaNames model.MetaValues
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]))
|> addToHash "templates" templates
|> adminView "page-edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/page/{id}/delete
let delete pgId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Page.Delete (PageId pgId) ctx.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 = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
hashForPage "Manage Prior Permalinks"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManagePermalinksModel.fromPage pg)
|> adminView "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/page/permalinks
let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let pageId = PageId model.Id
match! ctx.Data.Page.FindById pageId ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
let links = model.Prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Page.UpdatePriorPermalinks pageId ctx.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
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/page/{id}/revisions
let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
hashForPage "Manage Page Revisions"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManageRevisionsModel.fromPage ctx.WebLog pg)
|> adminView "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/page/{id}/revisions/purge
let purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
match! data.Page.FindFullById (PageId pgId) ctx.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 = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
let _, extra = WebLog.hostAndPath ctx.WebLog
return! {|
content =
[ """<div class="mwl-revision-preview mb-3">"""
(MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text
"</div>"
]
|> String.concat ""
|}
|> makeHash |> adminBareView "" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/page/{id}/revision/{revision-date}/restore
let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update
{ pg with
Revisions = { rev with AsOf = Noda.now () }
:: (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
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/page/{id}/revision/{revision-date}/delete
let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
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! adminBareView "" next ctx (makeHash {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/page/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> ()
let data = ctx.Data
let now = Noda.now ()
let tryPage =
if model.IsNew then
{ Page.empty with
Id = PageId.create ()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
PublishedOn = now
} |> someTask
else data.Page.FindFullById (PageId model.PageId) ctx.WebLog.Id
match! tryPage with
| Some page when canEdit page.AuthorId ctx ->
let updateList = page.IsInPageList <> model.IsShownInPageList
let updatedPage = model.UpdatePage page now
do! (if model.IsNew then data.Page.Add else data.Page.Update) updatedPage
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
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}

View File

@@ -2,6 +2,7 @@
module MyWebLog.Handlers.Post
open System
open System.Collections.Generic
open MyWebLog
/// Parse a slug and page number from an "everything else" URL
@@ -9,14 +10,13 @@ let private parseSlugAndPage webLog (slugAndPage : string seq) =
let fullPath = slugAndPage |> Seq.head
let slugPath = slugAndPage |> Seq.skip 1 |> Seq.head
let slugs, isFeed =
let feedName = $"/{webLog.rss.feedName}"
let feedName = $"/{webLog.Rss.FeedName}"
let notBlank = Array.filter (fun it -> it <> "")
if ( (webLog.rss.categoryEnabled && fullPath.StartsWith "/category/")
|| (webLog.rss.tagEnabled && fullPath.StartsWith "/tag/" ))
if ( (webLog.Rss.IsCategoryEnabled && fullPath.StartsWith "/category/")
|| (webLog.Rss.IsTagEnabled && fullPath.StartsWith "/tag/" ))
&& slugPath.EndsWith feedName then
notBlank (slugPath.Replace(feedName, "").Split "/"), true
else
notBlank (slugPath.Split "/"), false
else notBlank (slugPath.Split "/"), false
let pageIdx = Array.IndexOf (slugs, "page")
let pageNbr =
match pageIdx with
@@ -35,12 +35,11 @@ type ListType =
| TagList
open System.Threading.Tasks
open DotLiquid
open MyWebLog.Data
open MyWebLog.ViewModels
/// Convert a list of posts into items ready to be displayed
let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (data : IData) = task {
let preparePostList webLog posts listType (url : string) pageNbr perPage (data : IData) = task {
let! authors = getAuthors webLog posts data
let! tagMappings = getTagMappings webLog posts data
let relUrl it = Some <| WebLog.relativeUrl webLog (Permalink it)
@@ -53,63 +52,65 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (da
let! olderPost, newerPost =
match listType with
| SinglePost ->
let post = List.head posts
let dateTime = defaultArg post.publishedOn post.updatedOn
data.Post.findSurroundingPosts webLog.id dateTime
let post = List.head posts
let target = defaultArg post.PublishedOn post.UpdatedOn
data.Post.FindSurroundingPosts webLog.Id target
| _ -> Task.FromResult (None, None)
let newerLink =
match listType, pageNbr with
| SinglePost, _ -> newerPost |> Option.map (fun p -> Permalink.toString p.permalink)
| SinglePost, _ -> newerPost |> Option.map (fun p -> Permalink.toString p.Permalink)
| _, 1 -> None
| PostList, 2 when webLog.defaultPage = "posts" -> Some ""
| PostList, 2 when webLog.DefaultPage = "posts" -> Some ""
| PostList, _ -> relUrl $"page/{pageNbr - 1}"
| CategoryList, 2 -> relUrl $"category/{url}/"
| CategoryList, _ -> relUrl $"category/{url}/page/{pageNbr - 1}"
| TagList, 2 -> relUrl $"tag/{url}/"
| TagList, _ -> relUrl $"tag/{url}/page/{pageNbr - 1}"
| AdminList, 2 -> relUrl "admin/posts"
| AdminList, 2 -> relUrl "admin/posts"
| AdminList, _ -> relUrl $"admin/posts/page/{pageNbr - 1}"
let olderLink =
match listType, List.length posts > perPage with
| SinglePost, _ -> olderPost |> Option.map (fun p -> Permalink.toString p.permalink)
| SinglePost, _ -> olderPost |> Option.map (fun p -> Permalink.toString p.Permalink)
| _, false -> None
| PostList, true -> relUrl $"page/{pageNbr + 1}"
| CategoryList, true -> relUrl $"category/{url}/page/{pageNbr + 1}"
| TagList, true -> relUrl $"tag/{url}/page/{pageNbr + 1}"
| AdminList, true -> relUrl $"admin/posts/page/{pageNbr + 1}"
let model =
{ posts = postItems
authors = authors
subtitle = None
newerLink = newerLink
newerName = newerPost |> Option.map (fun p -> p.title)
olderLink = olderLink
olderName = olderPost |> Option.map (fun p -> p.title)
{ Posts = postItems
Authors = authors
Subtitle = None
NewerLink = newerLink
NewerName = newerPost |> Option.map (fun p -> p.Title)
OlderLink = olderLink
OlderName = olderPost |> Option.map (fun p -> p.Title)
}
return Hash.FromAnonymousObject {|
model = model
categories = CategoryCache.get ctx
tag_mappings = tagMappings
is_post = match listType with SinglePost -> true | _ -> false
|}
return
makeHash {||}
|> addToHash ViewContext.Model model
|> addToHash "tag_mappings" tagMappings
|> addToHash ViewContext.IsPost (match listType with SinglePost -> true | _ -> false)
}
open Giraffe
// GET /page/{pageNbr}
let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let data = ctx.Data
let! posts = data.Post.findPageOfPublishedPosts webLog.id pageNbr webLog.postsPerPage
let! hash = preparePostList webLog posts PostList "" pageNbr webLog.postsPerPage ctx data
let title =
match pageNbr, webLog.defaultPage with
let count = ctx.WebLog.PostsPerPage
let data = ctx.Data
let! posts = data.Post.FindPageOfPublishedPosts ctx.WebLog.Id pageNbr count
let! hash = preparePostList ctx.WebLog posts PostList "" pageNbr count data
let title =
match pageNbr, ctx.WebLog.DefaultPage with
| 1, "posts" -> None
| _, "posts" -> Some $"Page {pageNbr}"
| _, _ -> Some $"Page {pageNbr} &laquo; Posts"
match title with Some ttl -> hash.Add ("page_title", ttl) | None -> ()
if pageNbr = 1 && webLog.defaultPage = "posts" then hash.Add ("is_home", true)
return! themedView "index" next ctx hash
return!
match title with Some ttl -> addToHash ViewContext.PageTitle ttl hash | None -> hash
|> function
| hash ->
if pageNbr = 1 && ctx.WebLog.DefaultPage = "posts" then addToHash ViewContext.IsHome true hash else hash
|> themedView "index" next ctx
}
// GET /page/{pageNbr}/
@@ -123,23 +124,24 @@ let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task {
let data = ctx.Data
match parseSlugAndPage webLog slugAndPage with
| Some pageNbr, slug, isFeed ->
match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.slug = slug) with
match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.Slug = slug) with
| Some cat when isFeed ->
return! Feed.generate (Feed.CategoryFeed ((CategoryId cat.id), $"category/{slug}/{webLog.rss.feedName}"))
(defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx
return! Feed.generate (Feed.CategoryFeed ((CategoryId cat.Id), $"category/{slug}/{webLog.Rss.FeedName}"))
(defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage) next ctx
| Some cat ->
// Category pages include posts in subcategories
match! data.Post.findPageOfCategorizedPosts webLog.id (getCategoryIds slug ctx) pageNbr webLog.postsPerPage
match! data.Post.FindPageOfCategorizedPosts webLog.Id (getCategoryIds slug ctx) pageNbr webLog.PostsPerPage
with
| posts when List.length posts > 0 ->
let! hash = preparePostList webLog posts CategoryList cat.slug pageNbr webLog.postsPerPage ctx data
let! hash = preparePostList webLog posts CategoryList cat.Slug pageNbr webLog.PostsPerPage data
let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
hash.Add ("page_title", $"{cat.name}: Category Archive{pgTitle}")
hash.Add ("subtitle", defaultArg cat.description "")
hash.Add ("is_category", true)
hash.Add ("is_category_home", (pageNbr = 1))
hash.Add ("slug", slug)
return! themedView "index" next ctx hash
return!
addToHash ViewContext.PageTitle $"{cat.Name}: Category Archive{pgTitle}" hash
|> addToHash "subtitle" (defaultArg cat.Description "")
|> addToHash ViewContext.IsCategory true
|> addToHash ViewContext.IsCategoryHome (pageNbr = 1)
|> addToHash ViewContext.Slug slug
|> themedView "index" next ctx
| _ -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx
| None, _, _ -> return! Error.notFound next ctx
@@ -156,27 +158,28 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
| Some pageNbr, rawTag, isFeed ->
let urlTag = HttpUtility.UrlDecode rawTag
let! tag = backgroundTask {
match! data.TagMap.findByUrlValue urlTag webLog.id with
| Some m -> return m.tag
match! data.TagMap.FindByUrlValue urlTag webLog.Id with
| Some m -> return m.Tag
| None -> return urlTag
}
if isFeed then
return! Feed.generate (Feed.TagFeed (tag, $"tag/{rawTag}/{webLog.rss.feedName}"))
(defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx
return! Feed.generate (Feed.TagFeed (tag, $"tag/{rawTag}/{webLog.Rss.FeedName}"))
(defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage) next ctx
else
match! data.Post.findPageOfTaggedPosts webLog.id tag pageNbr webLog.postsPerPage with
match! data.Post.FindPageOfTaggedPosts webLog.Id tag pageNbr webLog.PostsPerPage with
| posts when List.length posts > 0 ->
let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.postsPerPage ctx data
let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.PostsPerPage data
let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
hash.Add ("page_title", $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}")
hash.Add ("is_tag", true)
hash.Add ("is_tag_home", (pageNbr = 1))
hash.Add ("slug", rawTag)
return! themedView "index" next ctx hash
return!
addToHash ViewContext.PageTitle $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}" hash
|> addToHash ViewContext.IsTag true
|> addToHash ViewContext.IsTagHome (pageNbr = 1)
|> addToHash ViewContext.Slug rawTag
|> themedView "index" next ctx
// Other systems use hyphens for spaces; redirect if this is an old tag link
| _ ->
let spacedTag = tag.Replace ("-", " ")
match! data.Post.findPageOfTaggedPosts webLog.id spacedTag pageNbr 1 with
match! data.Post.FindPageOfTaggedPosts webLog.Id spacedTag pageNbr 1 with
| posts when List.length posts > 0 ->
let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}"
return!
@@ -190,176 +193,224 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
// GET /
let home : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
match webLog.defaultPage with
match webLog.DefaultPage with
| "posts" -> return! pageOfPosts 1 next ctx
| pageId ->
match! ctx.Data.Page.findById (PageId pageId) webLog.id with
match! ctx.Data.Page.FindById (PageId pageId) webLog.Id with
| Some page ->
return!
Hash.FromAnonymousObject {|
page = DisplayPage.fromPage webLog page
categories = CategoryCache.get ctx
page_title = page.title
is_home = true
|}
|> themedView (defaultArg page.template "single-page") next ctx
hashForPage page.Title
|> addToHash "page" (DisplayPage.fromPage webLog page)
|> addToHash ViewContext.IsHome true
|> themedView (defaultArg page.Template "single-page") next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/posts
// GET /admin/posts/page/{pageNbr}
let all pageNbr : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let data = ctx.Data
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)
return! viewForTheme "admin" "post-list" next ctx hash
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25
let! hash = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data
return!
addToHash ViewContext.PageTitle "Posts" hash
|> withAntiCsrf ctx
|> adminView "post-list" next ctx
}
// GET /admin/post/{id}/edit
let edit postId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
let! result = task {
match postId with
| "new" -> return Some ("Write a New Post", { Post.empty with id = PostId "new" })
| "new" -> return Some ("Write a New Post", { Post.empty with Id = PostId "new" })
| _ ->
match! data.Post.findFullById (PostId postId) webLog.id with
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post -> return Some ("Edit Post", post)
| None -> return None
}
match result with
| Some (title, post) ->
let! cats = data.Category.findAllForView webLog.id
| Some (title, post) when canEdit post.AuthorId ctx ->
let! templates = templatesForTheme ctx "post"
let model = EditPostModel.fromPost webLog post
let model = EditPostModel.fromPost ctx.WebLog post
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = model
metadata = Array.zip model.metaNames model.metaValues
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
page_title = title
templates = templates
categories = cats
|}
|> viewForTheme "admin" "post-edit" next ctx
hashForPage title
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "metadata" (
Array.zip model.MetaNames model.MetaValues
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]))
|> addToHash "templates" templates
|> addToHash "explicit_values" [|
KeyValuePair.Create ("", "&ndash; Default &ndash;")
KeyValuePair.Create (ExplicitRating.toString Yes, "Yes")
KeyValuePair.Create (ExplicitRating.toString No, "No")
KeyValuePair.Create (ExplicitRating.toString Clean, "Clean")
|]
|> adminView "post-edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/delete
let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Post.Delete (PostId postId) ctx.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 ->
let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
Hash.FromAnonymousObject {|
csrf = csrfToken ctx
model = ManagePermalinksModel.fromPost post
page_title = $"Manage Prior Permalinks"
|}
|> viewForTheme "admin" "permalinks" next ctx
hashForPage "Manage Prior Permalinks"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManagePermalinksModel.fromPost post)
|> adminView "permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/post/permalinks
let savePermalinks : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel> ()
let links = model.prior |> Array.map Permalink |> List.ofArray
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
| 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
}
#nowarn "3511"
// POST /admin/post/save
let save : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel> ()
let webLog = ctx.WebLog
let data = ctx.Data
let now = DateTime.UtcNow
let! pst = task {
match model.postId with
| "new" ->
return Some
{ Post.empty with
id = PostId.create ()
webLogId = webLog.id
authorId = userId ctx
}
| postId -> return! data.Post.findFullById (PostId postId) webLog.id
}
match pst with
| Some post ->
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 post =
match Permalink.toString post.permalink with
| "" -> post
| link when link = model.permalink -> post
| _ -> { post with priorPermalinks = post.permalink :: post.priorPermalinks }
let post =
{ post with
title = model.title
permalink = Permalink model.permalink
publishedOn = if model.doPublish then Some now else post.publishedOn
updatedOn = now
text = MarkupText.toHtml revision.text
tags = model.tags.Split ","
|> Seq.ofArray
|> Seq.map (fun it -> it.Trim().ToLower ())
|> Seq.filter (fun it -> it <> "")
|> Seq.sort
|> List.ofSeq
template = match model.template.Trim () with "" -> None | tmpl -> Some tmpl
categoryIds = model.categoryIds |> Array.map CategoryId |> List.ofArray
status = if model.doPublish then Published else post.status
metadata = Seq.zip model.metaNames model.metaValues
|> Seq.filter (fun it -> fst it > "")
|> Seq.map (fun it -> { name = fst it; value = snd it })
|> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}")
|> List.ofSeq
revisions = match post.revisions |> List.tryHead with
| Some r when r.text = revision.text -> post.revisions
| _ -> revision :: post.revisions
}
let post =
match model.setPublished with
| true ->
let dt = WebLog.utcTime webLog model.pubOverride.Value
match model.setUpdated with
| true ->
{ post with
publishedOn = Some dt
updatedOn = dt
revisions = [ { (List.head post.revisions) with asOf = dt } ]
}
| false -> { post with publishedOn = Some dt }
| false -> post
do! (if model.postId = "new" then data.Post.add else data.Post.update) post
// If the post was published or its categories changed, refresh the category cache
if model.doPublish
|| not (pst.Value.categoryIds
|> List.append post.categoryIds
|> List.distinct
|> 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
let postId = PostId model.Id
match! ctx.Data.Post.FindById postId ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
let links = model.Prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Post.UpdatePriorPermalinks postId ctx.WebLog.Id links with
| true ->
do! addMessage ctx { UserMessage.success with Message = "Post permalinks saved successfully" }
return! redirectToGet $"admin/post/{model.Id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/post/{id}/revisions
let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
hashForPage "Manage Post Revisions"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManageRevisionsModel.fromPost ctx.WebLog post)
|> adminView "revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/post/{id}/revisions/purge
let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
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
| Some _ -> return! Error.notAuthorized 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 = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
let _, extra = WebLog.hostAndPath ctx.WebLog
return! {|
content =
[ """<div class="mwl-revision-preview mb-3">"""
(MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text
"</div>"
]
|> String.concat ""
|}
|> makeHash |> adminBareView "" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/revision/{revision-date}/restore
let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update
{ post with
Revisions = { rev with AsOf = Noda.now () }
:: (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
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/revision/{revision-date}/delete
let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
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! adminBareView "" next ctx (makeHash {| content = "" |})
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// POST /admin/post/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel> ()
let data = ctx.Data
let tryPost =
if model.IsNew then
{ Post.empty with
Id = PostId.create ()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
} |> someTask
else data.Post.FindFullById (PostId model.PostId) ctx.WebLog.Id
match! tryPost with
| Some post when canEdit post.AuthorId ctx ->
let priorCats = post.CategoryIds
let updatedPost =
model.UpdatePost post (Noda.now ())
|> function
| post ->
if model.SetPublished then
let dt = parseToUtc (model.PubOverride.Value.ToString "o")
if model.SetUpdated then
{ post with
PublishedOn = Some dt
UpdatedOn = dt
Revisions = [ { (List.head post.Revisions) with AsOf = dt } ]
}
else { post with PublishedOn = Some dt }
else post
do! (if model.PostId = "new" then data.Post.Add else data.Post.Update) updatedPost
// If the post was published or its categories changed, refresh the category cache
if model.DoPublish
|| not (priorCats
|> List.append updatedPost.CategoryIds
|> List.distinct
|> List.length = List.length priorCats) then
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Post saved successfully" }
return! redirectToGet $"admin/post/{PostId.toString post.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}

View File

@@ -8,7 +8,6 @@ open MyWebLog
/// Module to resolve routes that do not match any other known route (web blog content)
module CatchAll =
open DotLiquid
open MyWebLog.ViewModels
/// Sequence where the first returned value is the proper handler for the link
@@ -27,190 +26,190 @@ module CatchAll =
if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.empty)
let permalink = Permalink (textLink.Substring 1)
// Current post
match data.Post.findByPermalink permalink webLog.id |> await with
match data.Post.FindByPermalink permalink webLog.Id |> await with
| Some post ->
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
debug (fun () -> "Found post by permalink")
let hash = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 data |> await
yield fun next ctx ->
addToHash ViewContext.PageTitle post.Title hash
|> themedView (defaultArg post.Template "single-post") next ctx
| None -> ()
// Current page
match data.Page.findByPermalink permalink webLog.id |> await with
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 = DisplayPage.fromPage webLog page
categories = CategoryCache.get ctx
page_title = page.title
is_page = true
|}
|> themedView (defaultArg page.template "single-page") next ctx
hashForPage page.Title
|> addToHash "page" (DisplayPage.fromPage webLog page)
|> addToHash ViewContext.IsPage true
|> themedView (defaultArg page.Template "single-page") next ctx
| None -> ()
// 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
let altLink =
Permalink (if textLink.EndsWith "/" then textLink[1..textLink.Length - 2] else $"{textLink[1..]}/")
match data.Post.findByPermalink altLink webLog.id |> await with
match data.Post.FindByPermalink altLink webLog.Id |> await with
| Some post ->
debug (fun () -> $"Found post by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog post.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
match data.Page.FindByPermalink altLink webLog.Id |> await with
| Some page ->
debug (fun () -> $"Found page by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog page.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
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
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}
let route : HttpHandler = fun next ctx -> task {
match deriveAction ctx |> Seq.tryHead with
| Some handler -> return! handler next ctx
| None -> return! Error.notFound next ctx
}
let route : HttpHandler = fun next ctx ->
match deriveAction ctx |> Seq.tryHead with Some handler -> handler next ctx | None -> Error.notFound next ctx
/// 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
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.ToDateTimeUtc ()) 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 [
route "/administration" >=> Admin.Dashboard.admin
subRoute "/categor" (choose [
route "ies" >=> Admin.listCategories
route "ies/bare" >=> Admin.listCategoriesBare
routef "y/%s/edit" Admin.editCategory
route "ies" >=> Admin.Category.all
route "ies/bare" >=> Admin.Category.bare
routef "y/%s/edit" Admin.Category.edit
])
route "/dashboard" >=> Admin.dashboard
route "/dashboard" >=> Admin.Dashboard.user
route "/my-info" >=> User.myInfo
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
subRoute "/rss" (choose [
route "" >=> Feed.editSettings
routef "/%s/edit" Feed.editCustomFeed
route "" >=> Admin.WebLog.settings
routef "/rss/%s/edit" Feed.editCustomFeed
subRoute "/user" (choose [
route "s" >=> User.all
routef "/%s/edit" User.edit
])
subRoute "/tag-mapping" (choose [
route "s" >=> Admin.tagMappings
route "s/bare" >=> Admin.tagMappingsBare
routef "/%s/edit" Admin.editMapping
route "s" >=> Admin.TagMapping.all
routef "/%s/edit" Admin.TagMapping.edit
])
])
route "/theme/update" >=> Admin.themeUpdatePage
route "/user/edit" >=> User.edit
subRoute "/theme" (choose [
route "/list" >=> Admin.Theme.all
route "/new" >=> Admin.Theme.add
])
subRoute "/upload" (choose [
route "s" >=> Upload.list
route "/new" >=> Upload.showNew
])
]
POST >=> validateCsrf >=> choose [
subRoute "/category" (choose [
route "/save" >=> Admin.saveCategory
routef "/%s/delete" Admin.deleteCategory
subRoute "/cache" (choose [
routef "/theme/%s/refresh" Admin.Cache.refreshTheme
routef "/web-log/%s/refresh" Admin.Cache.refreshWebLog
])
subRoute "/category" (choose [
route "/save" >=> Admin.Category.save
routef "/%s/delete" Admin.Category.delete
])
route "/my-info" >=> User.saveMyInfo
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
route "" >=> Admin.WebLog.saveSettings
subRoute "/rss" (choose [
route "" >=> Feed.saveSettings
route "/save" >=> Feed.saveCustomFeed
routef "/%s/delete" Feed.deleteCustomFeed
])
subRoute "/tag-mapping" (choose [
route "/save" >=> Admin.saveMapping
routef "/%s/delete" Admin.deleteMapping
route "/save" >=> Admin.TagMapping.save
routef "/%s/delete" Admin.TagMapping.delete
])
subRoute "/user" (choose [
route "/save" >=> User.save
routef "/%s/delete" User.delete
])
])
route "/theme/update" >=> Admin.updateTheme
route "/user/save" >=> User.save
subRoute "/theme" (choose [
route "/new" >=> Admin.Theme.save
routef "/%s/delete" Admin.Theme.delete
])
subRoute "/upload" (choose [
route "/save" >=> Upload.save
routexp "/delete/(.*)" Upload.deleteFromDisk
routef "/%s/delete" Upload.deleteFromDb
])
]
])
GET_HEAD >=> routexp "/category/(.*)" Post.pageOfCategorizedPosts
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
@@ -229,10 +228,10 @@ let routerWithPath extraPath : HttpHandler =
subRoute extraPath router
/// Handler to apply Giraffe routing with a possible sub-route
let handleRoute : HttpHandler = fun next ctx -> task {
let handleRoute : HttpHandler = fun next ctx ->
let _, extraPath = WebLog.hostAndPath ctx.WebLog
return! (if extraPath = "" then router else routerWithPath extraPath) next ctx
}
(if extraPath = "" then router else routerWithPath extraPath) next ctx
open Giraffe.EndpointRouting

View File

@@ -0,0 +1,208 @@
/// Handlers to manipulate uploaded files
module MyWebLog.Handlers.Upload
open System
open System.IO
open Microsoft.Net.Http.Headers
/// 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")
// ~~ SERVING UPLOADS ~~
open System.Globalization
open Giraffe
open Microsoft.AspNetCore.Http
open NodaTime
/// 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 > Instant.FromDateTimeUtc (DateTime.Parse (it[0], null, DateTimeStyles.AdjustToUniversal)) -> None
| _ -> Some (setStatusCode 304)
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 ->
let headers = ResponseHeaders ctx.Response.Headers
headers.ContentType <- (deriveMimeType >> MediaTypeHeaderValue) path
headers.CacheControl <- cacheForThirtyDays
let stream = new MemoryStream (data)
streamData true stream None (Some (DateTimeOffset updatedOn)) next ctx
open MyWebLog
// 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.ToDateTimeUtc ()) path upload.Data next ctx
| None -> return! Error.notFound next ctx
else
return! Error.notFound next ctx
}
// ~~ ADMINISTRATION ~~
open System.Text.RegularExpressions
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 = requireAccess Author >=> 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!
hashForPage "Uploaded Files"
|> withAntiCsrf ctx
|> addToHash "files" allFiles
|> adminView "upload-list" next ctx
}
// GET /admin/upload/new
let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
hashForPage "Upload a File"
|> withAntiCsrf ctx
|> addToHash "destination" (UploadDestination.toString ctx.WebLog.Uploads)
|> adminView "upload-new" next ctx
/// Redirect to the upload list
let showUploads : HttpHandler =
redirectToGet "admin/uploads"
// POST /admin/upload/save
let save : HttpHandler = requireAccess Author >=> 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 now = Noda.now ()
let localNow = WebLog.localTime ctx.WebLog 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 = ctx.WebLog.Id
Path = Permalink $"{year}/{month}/{fileName}"
UpdatedOn = now
Data = stream.ToArray ()
}
do! ctx.Data.Upload.Add file
| Disk ->
let fullPath = Path.Combine (uploadDir, ctx.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 = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Upload.Delete (UploadId upId) ctx.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 = requireAccess WebLogAdmin >=> fun next ctx -> task {
let filePath = urlParts |> Seq.skip 1 |> Seq.head
let path = Path.Combine (uploadDir, ctx.WebLog.Slug, filePath)
if File.Exists path then
File.Delete path
removeEmptyDirectories ctx.WebLog filePath
do! addMessage ctx { UserMessage.success with Message = $"{filePath} deleted successfully" }
return! showUploads next ctx
else return! Error.notFound next ctx
}

View File

@@ -2,117 +2,237 @@
module MyWebLog.Handlers.User
open System
open System.Security.Cryptography
open System.Text
open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Identity
open MyWebLog
open NodaTime
/// Hash a password for a given user
let hashedPassword (plainText : string) (email : string) (salt : Guid) =
let allSalt = Array.concat [ salt.ToByteArray (); Encoding.UTF8.GetBytes email ]
use alg = new Rfc2898DeriveBytes (plainText, allSalt, 2_048)
Convert.ToBase64String (alg.GetBytes 64)
// ~~ LOG ON / LOG OFF ~~
/// Create a password hash a password for a given user
let createPasswordHash user password =
PasswordHasher<WebLogUser>().HashPassword (user, password)
/// Verify whether a password is valid
let verifyPassword user password (ctx : HttpContext) = backgroundTask {
match user with
| Some usr ->
let hasher = PasswordHasher<WebLogUser> ()
match hasher.VerifyHashedPassword (usr, usr.PasswordHash, password) with
| PasswordVerificationResult.Success -> return Ok ()
| PasswordVerificationResult.SuccessRehashNeeded ->
do! ctx.Data.WebLogUser.Update { usr with PasswordHash = hasher.HashPassword (usr, password) }
return Ok ()
| _ -> return Error "Log on attempt unsuccessful"
| None -> return Error "Log on attempt unsuccessful"
}
open DotLiquid
open Giraffe
open MyWebLog.ViewModels
// GET /user/log-on
let logOn returnUrl : HttpHandler = fun next ctx -> task {
let logOn returnUrl : HttpHandler = fun next ctx ->
let returnTo =
match returnUrl with
| Some _ -> returnUrl
| None ->
match ctx.Request.Query.ContainsKey "returnUrl" with
| true -> Some ctx.Request.Query["returnUrl"].[0]
| false -> None
return!
Hash.FromAnonymousObject {|
model = { LogOnModel.empty with returnTo = returnTo }
page_title = "Log On"
csrf = csrfToken ctx
|}
|> viewForTheme "admin" "log-on" next ctx
}
| None -> if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None
hashForPage "Log On"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model { LogOnModel.empty with ReturnTo = returnTo }
|> adminView "log-on" next ctx
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
| Some user when user.passwordHash = hashedPassword model.password user.userName user.salt ->
let! model = ctx.BindFormAsync<LogOnModel> ()
let data = ctx.Data
let! tryUser = data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id
match! verifyPassword tryUser model.Password ctx with
| Ok _ ->
let user = tryUser.Value
let claims = seq {
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.id)
Claim (ClaimTypes.Name, $"{user.firstName} {user.lastName}")
Claim (ClaimTypes.GivenName, user.preferredName)
Claim (ClaimTypes.Role, user.authorizationLevel.ToString ())
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id)
Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
Claim (ClaimTypes.GivenName, user.PreferredName)
Claim (ClaimTypes.Role, AccessLevel.toString user.AccessLevel)
}
let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity,
AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow))
do! data.WebLogUser.SetLastSeen user.Id user.WebLogId
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
| _ ->
do! addMessage ctx { UserMessage.error with message = "Log on attempt unsuccessful" }
return! logOn model.returnTo next ctx
{ UserMessage.success with
Message = "Log on successful"
Detail = Some $"Welcome to {ctx.WebLog.Name}!"
}
return!
match model.ReturnTo with
| Some url -> redirectTo false url next ctx
| None -> redirectToGet "admin/dashboard" next ctx
| Error msg ->
do! addMessage ctx { UserMessage.error with Message = msg }
return! logOn model.ReturnTo next ctx
}
// GET /user/log-off
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
do! addMessage ctx { UserMessage.info with Message = "Log off successful" }
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)
return! viewForTheme "admin" "user-edit" next ctx hash
// ~~ ADMINISTRATION ~~
open System.Collections.Generic
open Giraffe.Htmx
/// Got no time for URL/form manipulators...
let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?"
// GET /admin/settings/users
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id
return!
hashForPage "User Administration"
|> withAntiCsrf ctx
|> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList)
|> adminBareView "user-list-body" next ctx
}
// GET /admin/user/edit
let edit : HttpHandler = fun next ctx -> task {
match! ctx.Data.WebLogUser.findById (userId ctx) ctx.WebLog.id with
| Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) next ctx
/// Show the edit user page
let private showEdit (model : EditUserModel) : HttpHandler = fun next ctx ->
hashForPage (if model.IsNew then "Add a New User" else "Edit User")
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "access_levels" [|
KeyValuePair.Create (AccessLevel.toString Author, "Author")
KeyValuePair.Create (AccessLevel.toString Editor, "Editor")
KeyValuePair.Create (AccessLevel.toString WebLogAdmin, "Web Log Admin")
if ctx.HasAccessLevel Administrator then
KeyValuePair.Create (AccessLevel.toString Administrator, "Administrator")
|]
|> adminBareView "user-edit" next ctx
// GET /admin/settings/user/{id}/edit
let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let isNew = usrId = "new"
let userId = WebLogUserId usrId
let tryUser =
if isNew then someTask { WebLogUser.empty with Id = userId }
else ctx.Data.WebLogUser.FindById userId ctx.WebLog.Id
match! tryUser with
| Some user -> return! showEdit (EditUserModel.fromUser user) next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/user/save
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
| Some user ->
let pw, salt =
if model.newPassword = "" then
user.passwordHash, user.salt
else
let newSalt = Guid.NewGuid ()
hashedPassword model.newPassword user.userName newSalt, newSalt
let user =
{ user with
firstName = model.firstName
lastName = model.lastName
preferredName = model.preferredName
passwordHash = pw
salt = salt
}
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
| None -> return! Error.notFound next ctx
else
do! addMessage ctx { UserMessage.error with message = "Passwords did not match; no updates made" }
return! showEdit (Hash.FromAnonymousObject {|
model = { model with newPassword = ""; newPasswordConfirm = "" }
|}) next ctx
// POST /admin/settings/user/{id}/delete
let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLogUser.FindById (WebLogUserId userId) ctx.WebLog.Id with
| Some user ->
if user.AccessLevel = Administrator && not (ctx.HasAccessLevel Administrator) then
return! goAway next ctx
else
match! data.WebLogUser.Delete user.Id user.WebLogId with
| Ok _ ->
do! addMessage ctx
{ UserMessage.success with
Message = $"User {WebLogUser.displayName user} deleted successfully"
}
return! all next ctx
| Error msg ->
do! addMessage ctx
{ UserMessage.error with
Message = $"User {WebLogUser.displayName user} was not deleted"
Detail = Some msg
}
return! all next ctx
| None -> return! Error.notFound next ctx
}
/// Display the user "my info" page, with information possibly filled in
let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandler = fun next ctx ->
hashForPage "Edit Your Information"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "access_level" (AccessLevel.toString user.AccessLevel)
|> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn)
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog
(defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
|> adminView "my-info" next ctx
// GET /admin/my-info
let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user -> return! showMyInfo (EditMyInfoModel.fromUser user) user next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/my-info
let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditMyInfoModel> ()
let data = ctx.Data
match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user when model.NewPassword = model.NewPasswordConfirm ->
let pw = if model.NewPassword = "" then user.PasswordHash else createPasswordHash user model.NewPassword
let user =
{ user with
FirstName = model.FirstName
LastName = model.LastName
PreferredName = model.PreferredName
PasswordHash = pw
}
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 "admin/my-info" next ctx
| Some user ->
do! addMessage ctx { UserMessage.error with Message = "Passwords did not match; no updates made" }
return! showMyInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user next ctx
| None -> return! Error.notFound next ctx
}
// User save is not statically compilable; not sure why, but we'll revisit it at some point
#nowarn "3511"
// POST /admin/settings/user/save
let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel> ()
let data = ctx.Data
let tryUser =
if model.IsNew then
{ WebLogUser.empty with
Id = WebLogUserId.create ()
WebLogId = ctx.WebLog.Id
CreatedOn = Noda.now ()
} |> someTask
else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
match! tryUser with
| Some user when model.Password = model.PasswordConfirm ->
let updatedUser = model.UpdateUser user
if updatedUser.AccessLevel = Administrator && not (ctx.HasAccessLevel Administrator) then
return! goAway next ctx
else
let toUpdate =
if model.Password = "" then updatedUser
else { updatedUser with PasswordHash = createPasswordHash updatedUser model.Password }
do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate
do! addMessage ctx
{ UserMessage.success with
Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully"""
}
return! all next ctx
| Some _ ->
do! addMessage ctx { UserMessage.error with Message = "The passwords did not match; nothing saved" }
return!
(withHxRetarget $"#user_{model.Id}" >=> showEdit { model with Password = ""; PasswordConfirm = "" })
next ctx
| None -> return! Error.notFound next ctx
}

View File

@@ -4,6 +4,7 @@ open System
open System.IO
open Microsoft.Extensions.DependencyInjection
open MyWebLog.Data
open NodaTime
/// Create the web log information
let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
@@ -23,65 +24,77 @@ 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
// If this is the first web log being created, the user will be an installation admin; otherwise, they will be an
// admin just over their web log
let! webLogs = data.WebLog.All ()
let accessLevel = if List.isEmpty webLogs then Administrator else WebLogAdmin
do! data.WebLog.Add
{ WebLog.empty with
id = webLogId
name = args[2]
urlBase = args[1]
defaultPage = PageId.toString homePageId
timeZone = timeZone
Id = webLogId
Name = args[2]
Slug = slug
UrlBase = args[1]
DefaultPage = PageId.toString homePageId
TimeZone = timeZone
}
// Create the admin user
let salt = Guid.NewGuid ()
do! data.WebLogUser.add
{ WebLogUser.empty with
id = userId
webLogId = webLogId
userName = args[3]
firstName = "Admin"
lastName = "User"
preferredName = "Admin"
passwordHash = Handlers.User.hashedPassword args[4] args[3] salt
salt = salt
authorizationLevel = Administrator
}
let now = Noda.now ()
let user =
{ WebLogUser.empty with
Id = userId
WebLogId = webLogId
Email = args[3]
FirstName = "Admin"
LastName = "User"
PreferredName = "Admin"
AccessLevel = accessLevel
CreatedOn = now
}
do! data.WebLogUser.Add { user with PasswordHash = Handlers.User.createPasswordHash user args[4] }
// Create the default home page
do! data.Page.add
do! data.Page.Add
{ Page.empty with
id = homePageId
webLogId = webLogId
authorId = userId
title = "Welcome to myWebLog!"
permalink = Permalink "welcome-to-myweblog.html"
publishedOn = DateTime.UtcNow
updatedOn = DateTime.UtcNow
text = "<p>This is your default home page.</p>"
revisions = [
{ asOf = DateTime.UtcNow
text = Html "<p>This is your default home page.</p>"
Id = homePageId
WebLogId = webLogId
AuthorId = userId
Title = "Welcome to myWebLog!"
Permalink = Permalink "welcome-to-myweblog.html"
PublishedOn = now
UpdatedOn = now
Text = "<p>This is your default home page.</p>"
Revisions = [
{ AsOf = now
Text = Html "<p>This is your default home page.</p>"
}
]
}
printfn $"Successfully initialized database for {args[2]} with URL base {args[1]}"
match accessLevel with
| Administrator -> printfn $" ({args[3]} is an installation administrator)"
| WebLogAdmin ->
printfn $" ({args[3]} is a web log administrator;"
printfn """ use "upgrade-user" to promote to installation administrator)"""
| _ -> ()
}
/// Create a new web log
let createWebLog args sp = task {
match args |> Array.length with
| 5 -> do! doCreateWebLog args sp
| _ -> printfn "Usage: MyWebLog init [url] [name] [admin-email] [admin-pw]"
| _ -> eprintfn "Usage: myWebLog init [url] [name] [admin-email] [admin-pw]"
}
/// Import prior permalinks from a text files with lines in the format "[old] [new]"
let importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
let private importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
let data = sp.GetRequiredService<IData> ()
match! data.WebLog.findByHost urlBase with
match! data.WebLog.FindByHost urlBase with
| Some webLog ->
let mapping =
@@ -92,13 +105,13 @@ let importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
Permalink parts[0], Permalink parts[1])
for old, current in mapping do
match! data.Post.findByPermalink current webLog.id with
match! data.Post.FindByPermalink current webLog.Id with
| Some post ->
let! withLinks = data.Post.findFullById post.id post.webLogId
let! _ = data.Post.updatePriorPermalinks post.id post.webLogId
(old :: withLinks.Value.priorPermalinks)
let! withLinks = data.Post.FindFullById post.Id post.WebLogId
let! _ = data.Post.UpdatePriorPermalinks post.Id post.WebLogId
(old :: withLinks.Value.PriorPermalinks)
printfn $"{Permalink.toString old} -> {Permalink.toString current}"
| None -> printfn $"Cannot find current post for {Permalink.toString current}"
| None -> eprintfn $"Cannot find current post for {Permalink.toString current}"
printfn "Done!"
| None -> eprintfn $"No web log found at {urlBase}"
}
@@ -107,158 +120,200 @@ let importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
let importLinks args sp = task {
match args |> Array.length with
| 3 -> do! importPriorPermalinks args[1] args[2] sp
| _ -> printfn "Usage: MyWebLog import-links [url] [file-name]"
| _ -> eprintfn "Usage: myWebLog import-links [url] [file-name]"
}
// Loading a theme and restoring a backup are not statically compilable; this is OK
#nowarn "3511"
open Microsoft.Extensions.Logging
/// Load a theme from the given ZIP file
let loadTheme (args : string[]) (sp : IServiceProvider) = task {
if args.Length > 1 then
if args.Length = 2 then
let fileName =
match args[1].LastIndexOf Path.DirectorySeparatorChar with
| -1 -> args[1]
| it -> args[1][(it + 1)..]
match Handlers.Admin.getThemeName fileName with
| Ok themeName ->
match Handlers.Admin.Theme.deriveIdFromFileName fileName with
| Ok themeId ->
let data = sp.GetRequiredService<IData> ()
let clean = if args.Length > 2 then bool.Parse args[2] else true
use stream = File.Open (args[1], FileMode.Open)
use copy = new MemoryStream ()
do! stream.CopyToAsync copy
do! Handlers.Admin.loadThemeFromZip themeName copy clean data
printfn $"Theme {themeName} loaded successfully"
let! theme = Handlers.Admin.Theme.loadFromZip themeId copy data
let fac = sp.GetRequiredService<ILoggerFactory> ()
let log = fac.CreateLogger "MyWebLog.Themes"
log.LogInformation $"{theme.Name} v{theme.Version} ({ThemeId.toString theme.Id}) loaded"
| Error message -> eprintfn $"{message}"
else
printfn "Usage: MyWebLog load-theme [theme-zip-file-name] [*clean-load]"
printfn " * optional, defaults to true"
eprintfn "Usage: myWebLog load-theme [theme-zip-file-name]"
}
/// Back up a web log's data
module Backup =
open System.Threading.Tasks
open MyWebLog.Converters
open Newtonsoft.Json
/// A theme asset, with the data base-64 encoded
type EncodedAsset =
{ /// The ID of the theme asset
id : ThemeAssetId
Id : ThemeAssetId
/// The updated date for this asset
updatedOn : DateTime
UpdatedOn : Instant
/// The data for this asset, base-64 encoded
data : string
Data : string
}
/// Create an encoded theme asset from the original theme asset
static member fromAsset (asset : ThemeAsset) =
{ id = asset.id
updatedOn = asset.updatedOn
data = Convert.ToBase64String asset.data
{ Id = asset.Id
UpdatedOn = asset.UpdatedOn
Data = Convert.ToBase64String asset.Data
}
/// 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 toAsset (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 : Instant
/// 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 toUpload (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
webLog : WebLog
WebLog : WebLog
/// The users for this web log
users : WebLogUser list
Users : WebLogUser list
/// The theme used by this web log at the time the archive was made
theme : Theme
Theme : Theme
/// Assets for the theme used by this web log at the time the archive was made
assets : EncodedAsset list
Assets : EncodedAsset list
/// The categories for this web log
categories : Category list
Categories : Category list
/// The tag mappings for this web log
tagMappings : TagMap list
TagMappings : TagMap list
/// The pages for this web log (containing only the most recent revision)
pages : Page list
Pages : Page list
/// The posts for this web log (containing only the most recent revision)
posts : Post list
Posts : Post list
/// The uploaded files for this web log
Uploads : EncodedUpload list
}
/// Create a JSON serializer (uses RethinkDB data implementation's JSON converters)
/// Create a JSON serializer
let private getSerializer prettyOutput =
let serializer = JsonSerializer.CreateDefault ()
Json.all () |> Seq.iter serializer.Converters.Add
let serializer = Json.configure (JsonSerializer.CreateDefault ())
if prettyOutput then serializer.Formatting <- Formatting.Indented
serializer
/// Display statistics for a backup archive
let private displayStats (msg : string) (webLog : WebLog) archive =
let userCount = List.length archive.users
let assetCount = List.length archive.assets
let categoryCount = List.length archive.categories
let tagMapCount = List.length archive.tagMappings
let pageCount = List.length archive.pages
let postCount = List.length archive.posts
let userCount = List.length archive.Users
let assetCount = List.length archive.Assets
let categoryCount = List.length archive.Categories
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 $""" - The theme "{archive.theme.name}" with {assetCount} asset{plural assetCount "" "s"}"""
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 {
// Create the data structure
let themeId = ThemeId webLog.themePath
printfn "- Exporting theme..."
let! theme = data.Theme.findById themeId
let! assets = data.ThemeAsset.findByThemeWithData themeId
let! theme = data.Theme.FindById webLog.ThemeId
let! assets = data.ThemeAsset.FindByThemeWithData webLog.ThemeId
printfn "- Exporting users..."
let! users = data.WebLogUser.findByWebLog webLog.id
let! users = data.WebLogUser.FindByWebLog webLog.Id
printfn "- Exporting categories and tag mappings..."
let! categories = data.Category.findByWebLog webLog.id
let! tagMaps = data.TagMap.findByWebLog webLog.id
let! categories = data.Category.FindByWebLog webLog.Id
let! tagMaps = data.TagMap.FindByWebLog webLog.Id
printfn "- Exporting pages..."
let! pages = data.Page.findFullByWebLog webLog.id
let! pages = data.Page.FindFullByWebLog webLog.Id
printfn "- Exporting posts..."
let! posts = data.Post.findFullByWebLog webLog.id
let! posts = data.Post.FindFullByWebLog webLog.Id
printfn "- Exporting uploads..."
let! uploads = data.Upload.FindByWebLogWithData webLog.Id
printfn "- Writing archive..."
let archive = {
webLog = webLog
users = users
theme = Option.get theme
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 })
}
let archive =
{ WebLog = webLog
Users = users
Theme = Option.get theme
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 })
Uploads = uploads |> List.map EncodedUpload.fromUpload
}
// Write the structure to the backup file
if File.Exists fileName then File.Delete fileName
@@ -267,82 +322,90 @@ 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 {
let! restore = task {
match! data.WebLog.findById archive.webLog.id with
| Some webLog when defaultArg newUrlBase webLog.urlBase = webLog.urlBase ->
do! data.WebLog.delete webLog.id
return archive
match! data.WebLog.FindById archive.WebLog.Id with
| Some webLog when defaultArg newUrlBase webLog.UrlBase = webLog.UrlBase ->
do! data.WebLog.Delete webLog.Id
return { archive with WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase webLog.UrlBase } }
| Some _ ->
// Err'body gets new IDs...
let newWebLogId = WebLogId.create ()
let newCatIds = archive.categories |> List.map (fun cat -> cat.id, CategoryId.create ()) |> dict
let newMapIds = archive.tagMappings |> List.map (fun tm -> tm.id, TagMapId.create ()) |> dict
let newPageIds = archive.pages |> List.map (fun page -> page.id, PageId.create ()) |> dict
let newPostIds = archive.posts |> List.map (fun post -> post.id, PostId.create ()) |> dict
let newUserIds = archive.users |> List.map (fun user -> user.id, WebLogUserId.create ()) |> dict
let newCatIds = archive.Categories |> List.map (fun cat -> cat.Id, CategoryId.create ()) |> dict
let newMapIds = archive.TagMappings |> List.map (fun tm -> tm.Id, TagMapId.create ()) |> dict
let newPageIds = archive.Pages |> List.map (fun page -> page.Id, PageId.create ()) |> dict
let newPostIds = archive.Posts |> List.map (fun post -> post.Id, PostId.create ()) |> dict
let 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 }
users = archive.users
|> List.map (fun u -> { u with id = newUserIds[u.id]; webLogId = newWebLogId })
categories = archive.categories
|> List.map (fun c -> { c with id = newCatIds[c.id]; webLogId = newWebLogId })
tagMappings = archive.tagMappings
|> List.map (fun tm -> { tm with id = newMapIds[tm.id]; webLogId = newWebLogId })
pages = archive.pages
WebLog = { archive.WebLog with Id = newWebLogId; UrlBase = Option.get newUrlBase }
Users = archive.Users
|> List.map (fun u -> { u with Id = newUserIds[u.Id]; WebLogId = newWebLogId })
Categories = archive.Categories
|> List.map (fun c -> { c with Id = newCatIds[c.Id]; WebLogId = newWebLogId })
TagMappings = archive.TagMappings
|> List.map (fun tm -> { tm with Id = newMapIds[tm.Id]; WebLogId = newWebLogId })
Pages = archive.Pages
|> List.map (fun page ->
{ page with
id = newPageIds[page.id]
webLogId = newWebLogId
authorId = newUserIds[page.authorId]
Id = newPageIds[page.Id]
WebLogId = newWebLogId
AuthorId = newUserIds[page.AuthorId]
})
posts = archive.posts
Posts = archive.Posts
|> List.map (fun post ->
{ post with
id = newPostIds[post.id]
webLogId = newWebLogId
authorId = newUserIds[post.authorId]
categoryIds = post.categoryIds |> List.map (fun c -> newCatIds[c])
Id = newPostIds[post.Id]
WebLogId = newWebLogId
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
{ archive with
webLog = { archive.webLog with urlBase = defaultArg newUrlBase archive.webLog.urlBase }
WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase archive.WebLog.UrlBase }
}
}
// Restore theme and assets (one at a time, as assets can be large)
printfn ""
printfn "- Importing theme..."
do! data.Theme.save restore.theme
let! _ = restore.assets |> List.map (EncodedAsset.fromAsset >> data.ThemeAsset.save) |> Task.WhenAll
do! data.Theme.Save restore.Theme
restore.Assets
|> List.iter (EncodedAsset.toAsset >> data.ThemeAsset.Save >> Async.AwaitTask >> Async.RunSynchronously)
// Restore web log data
printfn "- Restoring web log..."
do! data.WebLog.add restore.webLog
do! data.WebLog.Add restore.WebLog
printfn "- Restoring users..."
do! data.WebLogUser.restore restore.users
do! data.WebLogUser.Restore restore.Users
printfn "- Restoring categories and tag mappings..."
do! data.TagMap.restore restore.tagMappings
do! data.Category.restore restore.categories
if not (List.isEmpty restore.TagMappings) then do! data.TagMap.Restore restore.TagMappings
if not (List.isEmpty restore.Categories) then do! data.Category.Restore restore.Categories
printfn "- Restoring pages..."
do! data.Page.restore restore.pages
if not (List.isEmpty restore.Pages) then do! data.Page.Restore restore.Pages
printfn "- Restoring posts..."
do! data.Post.restore restore.posts
if not (List.isEmpty restore.Posts) then do! data.Post.Restore restore.Posts
// TODO: comments not yet implemented
displayStats "Restored for {{NAME}}:" restore.webLog restore
printfn "- Restoring uploads..."
if not (List.isEmpty restore.Uploads) then
do! data.Upload.Restore (restore.Uploads |> List.map EncodedUpload.toUpload)
displayStats "Restored for <>NAME<>:" restore.WebLog restore
}
/// Decide whether to restore a backup
@@ -366,22 +429,29 @@ module Backup =
if doOverwrite then
do! doRestore archive newUrlBase data
else
printfn $"{archive.webLog.name} backup restoration canceled"
printfn $"{archive.WebLog.Name} backup restoration canceled"
}
/// Generate a backup archive
let generateBackup (args : string[]) (sp : IServiceProvider) = task {
if args.Length = 3 || args.Length = 4 then
if args.Length > 1 && args.Length < 5 then
let data = sp.GetRequiredService<IData> ()
match! data.WebLog.findByHost args[1] with
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]}"
| None -> eprintfn $"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"""
eprintfn """Usage: myWebLog backup [url-base] [*backup-file-name] [**"pretty"]"""
eprintfn """ * optional - default is [web-log-slug].json"""
eprintfn """ ** optional - default is non-pretty JSON output"""
}
/// Restore a backup archive
@@ -391,8 +461,49 @@ module Backup =
let newUrlBase = if args.Length = 3 then Some args[2] else None
do! restoreBackup args[1] newUrlBase (args[0] <> "do-restore") data
else
printfn "Usage: MyWebLog restore [backup-file-name] [*url-base]"
printfn " * optional - will restore to original URL base if omitted"
printfn " (use do-restore to skip confirmation prompt)"
eprintfn "Usage: myWebLog restore [backup-file-name] [*url-base]"
eprintfn " * optional - will restore to original URL base if omitted"
eprintfn " (use do-restore to skip confirmation prompt)"
}
/// Upgrade a WebLogAdmin user to an Administrator user
let private doUserUpgrade urlBase email (data : IData) = task {
match! data.WebLog.FindByHost urlBase with
| Some webLog ->
match! data.WebLogUser.FindByEmail email webLog.Id with
| Some user ->
match user.AccessLevel with
| WebLogAdmin ->
do! data.WebLogUser.Update { user with AccessLevel = Administrator }
printfn $"{email} is now an Administrator user"
| other -> eprintfn $"ERROR: {email} is an {AccessLevel.toString other}, not a WebLogAdmin"
| None -> eprintfn $"ERROR: no user {email} found at {urlBase}"
| None -> eprintfn $"ERROR: no web log found for {urlBase}"
}
/// Upgrade a WebLogAdmin user to an Administrator user if the command-line arguments are good
let upgradeUser (args : string[]) (sp : IServiceProvider) = task {
match args.Length with
| 3 -> do! doUserUpgrade args[1] args[2] (sp.GetRequiredService<IData> ())
| _ -> eprintfn "Usage: myWebLog upgrade-user [web-log-url-base] [email-address]"
}
/// Set a user's password
let doSetPassword urlBase email password (data : IData) = task {
match! data.WebLog.FindByHost urlBase with
| Some webLog ->
match! data.WebLogUser.FindByEmail email webLog.Id with
| Some user ->
do! data.WebLogUser.Update { user with PasswordHash = Handlers.User.createPasswordHash user password }
printfn $"Password for user {email} at {webLog.Name} set successfully"
| None -> eprintfn $"ERROR: no user {email} found at {urlBase}"
| None -> eprintfn $"ERROR: no web log found for {urlBase}"
}
/// Set a user's password if the command-line arguments are good
let setPassword (args : string[]) (sp : IServiceProvider) = task {
match args.Length with
| 4 -> do! doSetPassword args[1] args[2] args[3] (sp.GetRequiredService<IData> ())
| _ -> eprintfn "Usage: myWebLog set-password [web-log-url-base] [email-address] [password]"
}

View File

@@ -2,22 +2,20 @@
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net6.0</TargetFramework>
<PublishSingleFile>true</PublishSingleFile>
<SelfContained>false</SelfContained>
<DebugType>embedded</DebugType>
<NoWarn>3391</NoWarn>
</PropertyGroup>
<ItemGroup>
<Content Include="appsettings.json" CopyToOutputDirectory="Always" />
<Content Include="appsettings*.json" CopyToOutputDirectory="Always" />
<Compile Include="Caches.fs" />
<Compile Include="Handlers\Error.fs" />
<Compile Include="Handlers\Helpers.fs" />
<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" />
@@ -25,14 +23,13 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="DotLiquid" Version="2.2.656" />
<PackageReference Include="DotLiquid" Version="2.2.682" />
<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.5" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.5" />
<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" />
<PackageReference Include="System.ServiceModel.Syndication" Version="6.0.0" />
<PackageReference Include="System.ServiceModel.Syndication" Version="7.0.0" />
</ItemGroup>
<ItemGroup>
@@ -41,7 +38,7 @@
</ItemGroup>
<ItemGroup>
<None Include=".\wwwroot\img\*.png" CopyToOutputDirectory="Always" />
<None Include=".\wwwroot\upload\*" CopyToOutputDirectory="Always" />
</ItemGroup>
</Project>

View File

@@ -10,12 +10,12 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>)
/// Is the debug level enabled on the logger?
let isDebug = log.IsEnabled LogLevel.Debug
member this.InvokeAsync (ctx : HttpContext) = task {
member _.InvokeAsync (ctx : HttpContext) = task {
/// Create the full path of the request
let path = $"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{ctx.Request.Path.Value}"
match WebLogCache.tryGet path with
| Some webLog ->
if isDebug then log.LogDebug $"Resolved web log {WebLogId.toString webLog.id} for {path}"
if isDebug then log.LogDebug $"Resolved web log {WebLogId.toString webLog.Id} for {path}"
ctx.Items["webLog"] <- webLog
if PageListCache.exists ctx then () else do! PageListCache.update ctx
if CategoryCache.exists ctx then () else do! CategoryCache.update ctx
@@ -29,6 +29,8 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>)
open System
open Microsoft.Extensions.DependencyInjection
open MyWebLog.Data
open Newtonsoft.Json
open Npgsql
/// Logic to obtain a data connection and implementation based on configured values
module DataImplementation =
@@ -37,31 +39,72 @@ module DataImplementation =
open RethinkDb.Driver.FSharp
open RethinkDb.Driver.Net
/// Create an NpgsqlDataSource from the connection string, configuring appropriately
let createNpgsqlDataSource (cfg : IConfiguration) =
let builder = NpgsqlDataSourceBuilder (cfg.GetConnectionString "PostgreSQL")
let _ = builder.UseNodaTime ()
// let _ = builder.UseLoggerFactory(LoggerFactory.Create(fun it -> it.AddConsole () |> ignore))
builder.Build ()
/// Get the configured data implementation
let get (sp : IServiceProvider) : IData =
let config = sp.GetRequiredService<IConfiguration> ()
if (config.GetConnectionString >> isNull >> not) "SQLite" then
let conn = new SqliteConnection (config.GetConnectionString "SQLite")
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
upcast SQLiteData (conn, sp.GetRequiredService<ILogger<SQLiteData>> ())
elif (config.GetSection "RethinkDB").Exists () then
Json.all () |> Seq.iter Converter.Serializer.Converters.Add
let rethinkCfg = DataConfig.FromConfiguration (config.GetSection "RethinkDB")
let conn = rethinkCfg.CreateConnectionAsync () |> Async.AwaitTask |> Async.RunSynchronously
upcast RethinkDbData (conn, rethinkCfg, sp.GetRequiredService<ILogger<RethinkDbData>> ())
else
let config = sp.GetRequiredService<IConfiguration> ()
let await it = (Async.AwaitTask >> Async.RunSynchronously) it
let connStr name = config.GetConnectionString name
let hasConnStr name = (connStr >> isNull >> not) name
let createSQLite connStr : IData =
let log = sp.GetRequiredService<ILogger<SQLiteData>> ()
log.LogInformation "Using default SQLite database myweblog.db"
let conn = new SqliteConnection ("Data Source=./myweblog.db;Cache=Shared")
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
upcast SQLiteData (conn, log)
let conn = new SqliteConnection (connStr)
log.LogInformation $"Using SQLite database {conn.DataSource}"
await (SQLiteData.setUpConnection conn)
SQLiteData (conn, log, Json.configure (JsonSerializer.CreateDefault ()))
if hasConnStr "SQLite" then
createSQLite (connStr "SQLite")
elif hasConnStr "RethinkDB" then
let log = sp.GetRequiredService<ILogger<RethinkDbData>> ()
let _ = Json.configure Converter.Serializer
let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB")
let conn = await (rethinkCfg.CreateConnectionAsync log)
RethinkDbData (conn, rethinkCfg, log)
elif hasConnStr "PostgreSQL" then
let source = createNpgsqlDataSource config
use conn = source.CreateConnection ()
let log = sp.GetRequiredService<ILogger<PostgresData>> ()
log.LogInformation $"Using PostgreSQL database {conn.Database}"
PostgresData (source, log, Json.configure (JsonSerializer.CreateDefault ()))
else
createSQLite "Data Source=./myweblog.db;Cache=Shared"
open System.Threading.Tasks
/// Show a list of valid command-line interface commands
let showHelp () =
printfn " "
printfn "COMMAND WHAT IT DOES"
printfn "----------- ------------------------------------------------------"
printfn "backup Create a JSON file backup of a web log"
printfn "do-restore Restore a JSON file backup (overwrite data silently)"
printfn "help Display this information"
printfn "import-links Import prior permalinks"
printfn "init Initializes a new web log"
printfn "load-theme Load a theme"
printfn "restore Restore a JSON file backup (prompt before overwriting)"
printfn "set-password Set a password for a specific user"
printfn "upgrade-user Upgrade a WebLogAdmin user to a full Administrator"
printfn " "
printfn "For more information on a particular command, run it with no options."
Task.FromResult ()
open System.IO
open Giraffe
open Giraffe.EndpointRouting
open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.HttpOverrides
open Microsoft.Extensions.Caching.Distributed
open NeoSmart.Caching.Sqlite
open RethinkDB.DistributedCache
@@ -82,11 +125,12 @@ let rec main args =
let _ = builder.Services.AddAuthorization ()
let _ = builder.Services.AddAntiforgery ()
let sp = builder.Services.BuildServiceProvider ()
let sp = builder.Services.BuildServiceProvider ()
let data = DataImplementation.get sp
let _ = builder.Services.AddSingleton<JsonSerializer> data.Serializer
task {
do! data.startUp ()
do! data.StartUp ()
do! WebLogCache.fill data
do! ThemeAssetCache.fill data
} |> Async.AwaitTask |> Async.RunSynchronously
@@ -95,23 +139,35 @@ let rec main args =
match data with
| :? RethinkDbData as rethink ->
// A RethinkDB connection is designed to work as a singleton
builder.Services.AddSingleton<IData> data |> ignore
builder.Services.AddDistributedRethinkDBCache (fun opts ->
opts.TableName <- "Session"
opts.Connection <- rethink.Conn)
|> ignore
let _ = builder.Services.AddSingleton<IData> data
let _ =
builder.Services.AddDistributedRethinkDBCache (fun opts ->
opts.TableName <- "Session"
opts.Connection <- rethink.Conn)
()
| :? SQLiteData as sql ->
// ADO.NET connections are designed to work as per-request instantiation
let cfg = sp.GetRequiredService<IConfiguration> ()
builder.Services.AddScoped<SqliteConnection> (fun sp ->
let conn = new SqliteConnection (sql.Conn.ConnectionString)
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
conn)
|> ignore
builder.Services.AddScoped<IData, SQLiteData> () |> ignore
let _ =
builder.Services.AddScoped<SqliteConnection> (fun sp ->
let conn = new SqliteConnection (sql.Conn.ConnectionString)
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
conn)
let _ = builder.Services.AddScoped<IData, SQLiteData> () |> ignore
// Use SQLite for caching as well
let cachePath = Option.ofObj (cfg.GetConnectionString "SQLiteCachePath") |> Option.defaultValue "./session.db"
builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath) |> ignore
let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./session.db"
let _ = builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath)
()
| :? PostgresData as postgres ->
// ADO.NET Data Sources are designed to work as singletons
let _ =
builder.Services.AddSingleton<NpgsqlDataSource> (fun sp ->
DataImplementation.createNpgsqlDataSource (sp.GetRequiredService<IConfiguration> ()))
let _ = builder.Services.AddSingleton<IData> postgres
let _ =
builder.Services.AddSingleton<IDistributedCache> (fun _ ->
Postgres.DistributedCache () :> IDistributedCache)
()
| _ -> ()
let _ = builder.Services.AddSession(fun opts ->
@@ -130,8 +186,19 @@ let rec main args =
| Some it when it = "import-links" -> Maintenance.importLinks args app.Services
| Some it when it = "load-theme" -> Maintenance.loadTheme args app.Services
| Some it when it = "backup" -> Maintenance.Backup.generateBackup args app.Services
| Some it when it = "restore" -> Maintenance.Backup.restoreFromBackup args app.Services
| _ ->
| Some it when it = "restore" -> Maintenance.Backup.restoreFromBackup args app.Services
| Some it when it = "do-restore" -> Maintenance.Backup.restoreFromBackup args app.Services
| Some it when it = "upgrade-user" -> Maintenance.upgradeUser args app.Services
| Some it when it = "set-password" -> Maintenance.setPassword args app.Services
| Some it when it = "help" -> showHelp ()
| Some it ->
printfn $"""Unrecognized command "{it}" - valid commands are:"""
showHelp ()
| None -> task {
// Load all themes in the application directory
for themeFile in Directory.EnumerateFiles (".", "*-theme.zip") do
do! Maintenance.loadTheme [| ""; themeFile |] app.Services
let _ = app.UseForwardedHeaders ()
let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
let _ = app.UseMiddleware<WebLogMiddleware> ()
@@ -141,7 +208,8 @@ let rec main args =
let _ = app.UseSession ()
let _ = app.UseGiraffe Handlers.Routes.endpoint
System.Threading.Tasks.Task.FromResult (app.Run ())
app.Run ()
}
|> Async.AwaitTask |> Async.RunSynchronously
0 // Exit code

View File

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

View File

View File

@@ -0,0 +1,32 @@
<div class="form-floating pb-3">
<input type="text" name="Title" id="title" class="form-control" placeholder="Title" autofocus required
value="{{ model.title }}">
<label for="title">Title</label>
</div>
<div class="form-floating pb-3">
<input type="text" name="Permalink" id="permalink" class="form-control" placeholder="Permalink" required
value="{{ model.permalink }}">
<label for="permalink">Permalink</label>
{%- unless model.is_new %}
{%- assign entity_url_base = "admin/" | append: entity | append: "/" | append: entity_id -%}
<span class="form-text">
<a href="{{ entity_url_base | append: "/permalinks" | relative_link }}">Manage Permalinks</a>
<span class="text-muted"> &bull; </span>
<a href="{{ entity_url_base | append: "/revisions" | relative_link }}">Manage Revisions</a>
</span>
{%- endunless -%}
</div>
<div class="mb-2">
<label for="text">Text</label> &nbsp; &nbsp;
<div class="btn-group btn-group-sm" role="group" aria-label="Text format button group">
<input type="radio" name="Source" id="source_html" class="btn-check" value="HTML"
{%- if model.source == "HTML" %} checked="checked"{% endif %}>
<label class="btn btn-sm btn-outline-secondary" for="source_html">HTML</label>
<input type="radio" name="Source" id="source_md" class="btn-check" value="Markdown"
{%- if model.source == "Markdown" %} checked="checked"{% endif %}>
<label class="btn btn-sm btn-outline-secondary" for="source_md">Markdown</label>
</div>
</div>
<div class="pb-3">
<textarea name="Text" id="text" class="form-control" rows="20">{{ model.text }}</textarea>
</div>

View File

@@ -7,20 +7,42 @@
<span class="navbar-toggler-icon"></span>
</button>
<div class="collapse navbar-collapse" id="navbarText">
{% if logged_on -%}
{%- if is_logged_on %}
<ul class="navbar-nav">
{{ "admin/dashboard" | nav_link: "Dashboard" }}
{{ "admin/pages" | nav_link: "Pages" }}
{{ "admin/posts" | nav_link: "Posts" }}
{{ "admin/categories" | nav_link: "Categories" }}
{{ "admin/settings" | nav_link: "Settings" }}
{%- if is_author %}
{{ "admin/pages" | nav_link: "Pages" }}
{{ "admin/posts" | nav_link: "Posts" }}
{{ "admin/uploads" | nav_link: "Uploads" }}
{%- endif %}
{%- if is_web_log_admin %}
{{ "admin/categories" | nav_link: "Categories" }}
{{ "admin/settings" | nav_link: "Settings" }}
{%- endif %}
{%- if is_administrator %}
{{ "admin/administration" | nav_link: "Admin" }}
{%- endif %}
</ul>
{%- endif %}
<ul class="navbar-nav flex-grow-1 justify-content-end">
{% if logged_on -%}
{{ "admin/user/edit" | nav_link: "Edit User" }}
{{ "user/log-off" | nav_link: "Log Off" }}
{%- if is_logged_on %}
{{ "admin/my-info" | nav_link: "My Info" }}
<li class="nav-item">
<a class="nav-link" href="https://bitbadger.solutions/open-source/myweblog/#how-to-use-myweblog"
target="_blank">
Docs
</a>
</li>
<li class="nav-item">
<a class="nav-link" href="{{ "user/log-off" | relative_link }}" hx-boost="false">Log Off</a>
</li>
{%- else -%}
<li class="nav-item">
<a class="nav-link" href="https://bitbadger.solutions/open-source/myweblog/#how-to-use-myweblog"
target="_blank">
Docs
</a>
</li>
{{ "user/log-on" | nav_link: "Log On" }}
{%- endif %}
</ul>
@@ -28,27 +50,36 @@
</div>
</nav>
</header>
<main class="mx-3 mt-3">
<div class="messages mt-2" id="msgContainer">
<div id="toastHost" class="position-fixed top-0 w-100" aria-live="polite" aria-atomic="true">
<div id="toasts" class="toast-container position-absolute p-3 mt-5 top-0 end-0">
{% for msg in messages %}
<div role="alert" class="alert alert-{{ msg.level }} alert-dismissible fade show">
{{ msg.message }}
<button type="button" class="btn-close" data-bs-dismiss="alert" aria-label="Close"></button>
{% if msg.detail %}
<hr>
{{ msg.detail.value }}
{% endif %}
<div class="toast" role="alert" aria-live="assertive" aria-atomic="true"
{%- unless msg.level == "success" %} data-bs-autohide="false"{% endunless %}>
<div class="toast-header bg-{{ msg.level }}{% unless msg.level == "warning" %} text-white{% endunless %}">
<strong class="me-auto text-uppercase">
{% if msg.level == "danger" %}error{% else %}{{ msg.level}}{% endif %}
</strong>
<button type="button" class="btn-close" data-bs-dismiss="toast" aria-label="Close"></button>
</div>
<div class="toast-body bg-{{ msg.level }} bg-opacity-25">
{{ msg.message }}
{%- if msg.detail %}
<hr>
{{ msg.detail.value }}
{%- endif %}
</div>
</div>
{% endfor %}
</div>
</div>
<main class="mx-3 mt-3">
<div class="load-overlay p-5" id="loadOverlay"><h1 class="p-3">Loading&hellip;</h1></div>
{{ content }}
</main>
<footer class="position-fixed bottom-0 w-100">
<div class="container-fluid">
<div class="row">
<div class="col-xs-12 text-end">
<img src="{{ "themes/admin/logo-light.png" | relative_link }}" alt="myWebLog" width="120" height="34">
</div>
</div>
<div class="text-end text-white me-2">
{%- 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>
</footer>

View File

@@ -0,0 +1,3 @@
{%- assign theme_col = "col-12 col-md-6" -%}
{%- assign slug_col = "d-none d-md-block col-md-3" -%}
{%- assign tmpl_col = "d-none d-md-block col-md-3" -%}

View File

@@ -0,0 +1,4 @@
{%- assign user_col = "col-12 col-md-4 col-xl-3" -%}
{%- assign email_col = "col-12 col-md-4 col-xl-4" -%}
{%- assign cre8_col = "d-none d-xl-block col-xl-2" -%}
{%- assign last_col = "col-12 col-md-4 col-xl-3" -%}

View File

@@ -0,0 +1,108 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<fieldset class="container mb-3 pb-0">
<legend>Themes</legend>
<a href="{{ "admin/theme/new" | relative_link }}" class="btn btn-primary btn-sm mb-3"
hx-target="#theme_new">
Upload a New Theme
</a>
<div class="container g-0">
{% include_template "_theme-list-columns" %}
<div class="row mwl-table-heading">
<div class="{{ theme_col }}">Theme</div>
<div class="{{ slug_col }} d-none d-md-inline-block">Slug</div>
<div class="{{ tmpl_col }} d-none d-md-inline-block">Templates</div>
</div>
</div>
<div class="row mwl-table-detail" id="theme_new"></div>
{{ theme_list }}
</fieldset>
<fieldset class="container mb-3 pb-0">
{%- assign cache_base_url = "admin/cache/" -%}
<legend>Caches</legend>
<div class="row pb-2">
<div class="col">
<p>
myWebLog uses a few caches to ensure that it serves pages as fast as possible.
(<a href="https://bitbadger.solutions/open-source/myweblog/advanced.html#cache-management"
target="_blank">more information</a>)
</p>
</div>
</div>
<div class="row">
<div class="col-12 col-lg-6 pb-3">
<div class="card">
<header class="card-header text-white bg-secondary">Web Logs</header>
<div class="card-body pb-0">
<h6 class="card-subtitle text-muted pb-3">
These caches include the page list and categories for each web log
</h6>
{%- assign web_log_base_url = cache_base_url | append: "web-log/" -%}
<form method="post" class="container g-0" hx-boost="false" hx-target="body"
hx-swap="innerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<button type="submit" class="btn btn-sm btn-primary mb-2"
hx-post="{{ web_log_base_url | append: "all/refresh" | relative_link }}">
Refresh All
</button>
<div class="row mwl-table-heading">
<div class="col">Web Log</div>
</div>
{%- for web_log in web_logs %}
<div class="row mwl-table-detail">
<div class="col">
{{ web_log[1] }}<br>
<small>
<span class="text-muted">{{ web_log[2] }}</span><br>
{%- assign refresh_url = web_log_base_url | append: web_log[0] | append: "/refresh" | relative_link -%}
<a href="{{ refresh_url }}" hx-post="{{ refresh_url }}">Refresh</a>
</small>
</div>
</div>
{%- endfor %}
</form>
</div>
</div>
</div>
<div class="col-12 col-lg-6 pb-3">
<div class="card">
<header class="card-header text-white bg-secondary">Themes</header>
<div class="card-body pb-0">
<h6 class="card-subtitle text-muted pb-3">
The theme template cache is filled on demand as pages are displayed; refreshing a theme with no cached
templates will still refresh its asset cache
</h6>
{%- assign theme_base_url = cache_base_url | append: "theme/" -%}
<form method="post" class="container g-0" hx-boost="false" hx-target="body"
hx-swap="innerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<button type="submit" class="btn btn-sm btn-primary mb-2"
hx-post="{{ theme_base_url | append: "all/refresh" | relative_link }}">
Refresh All
</button>
<div class="row mwl-table-heading">
<div class="col-8">Theme</div>
<div class="col-4">Cached</div>
</div>
{%- for theme in cached_themes %}
{% unless theme[0] == "admin" %}
<div class="row mwl-table-detail">
<div class="col-8">
{{ theme[1] }}<br>
<small>
<span class="text-muted">{{ theme[0] }} &bull; </span>
{%- assign refresh_url = theme_base_url | append: theme[0] | append: "/refresh" | relative_link -%}
<a href="{{ refresh_url }}" hx-post="{{ refresh_url }}">Refresh</a>
</small>
</div>
<div class="col-4">{{ theme[2] }}</div>
</div>
{% endunless %}
{%- endfor %}
</form>
</div>
</div>
</div>
</div>
</fieldset>
</article>

View File

@@ -3,25 +3,25 @@
<form hx-post="{{ "admin/category/save" | relative_link }}" method="post" class="container"
hx-target="#catList" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="categoryId" value="{{ model.category_id }}">
<input type="hidden" name="CategoryId" value="{{ model.category_id }}">
<div class="row">
<div class="col-12 col-sm-6 col-lg-4 col-xxl-3 offset-xxl-1 mb-3">
<div class="form-floating">
<input type="text" name="name" id="name" class="form-control form-control-sm" placeholder="Name" autofocus
required value="{{ model.name | escape }}">
<input type="text" name="Name" id="name" class="form-control" placeholder="Name" autofocus required
value="{{ model.name | escape }}">
<label for="name">Name</label>
</div>
</div>
<div class="col-12 col-sm-6 col-lg-4 col-xxl-3 mb-3">
<div class="form-floating">
<input type="text" name="slug" id="slug" class="form-control form-control-sm" placeholder="Slug" required
<input type="text" name="Slug" id="slug" class="form-control" placeholder="Slug" required
value="{{ model.slug | escape }}">
<label for="slug">Slug</label>
</div>
</div>
<div class="col-12 col-lg-4 col-xxl-3 offset-xxl-1 mb-3">
<div class="form-floating">
<select name="parentId" id="parentId" class="form-control form-control-sm">
<select name="ParentId" id="parentId" class="form-control">
<option value=""{% if model.parent_id == "" %} selected="selected"{% endif %}>
&ndash; None &ndash;
</option>
@@ -38,7 +38,7 @@
</div>
<div class="col-12 col-xl-10 offset-xl-1 mb-3">
<div class="form-floating">
<input name="description" id="description" class="form-control form-control-sm"
<input name="Description" id="description" class="form-control"
placeholder="A short description of this category" value="{{ model.description | escape }}">
<label for="description">Description</label>
</div>

View File

@@ -1,46 +1,57 @@
<form method="post" id="catList" class="container" hx-target="this" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row mwl-table-detail" id="cat_new"></div>
{%- assign cat_count = categories | size -%}
{% if cat_count > 0 %}
{%- assign cat_col = "col-12 col-md-6 col-xl-5 col-xxl-4" -%}
{%- assign desc_col = "col-12 col-md-6 col-xl-7 col-xxl-8" -%}
{% for cat in categories -%}
<div class="row mwl-table-detail" id="cat_{{ cat.id }}">
<div class="{{ cat_col }} no-wrap">
{%- if cat.parent_names %}
<small class="text-muted">{% for name in cat.parent_names %}{{ name }} &rang; {% endfor %}</small>
{%- endif %}
{{ cat.name }}<br>
<small>
{%- if cat.post_count > 0 %}
<a href="{{ cat | category_link }}" target="_blank">
View {{ cat.post_count }} Post{% unless cat.post_count == 1 %}s{% endunless -%}
</a>
<span class="text-muted"> &bull; </span>
{%- endif %}
{%- capture cat_edit %}admin/category/{{ cat.id }}/edit{% endcapture -%}
<a href="{{ cat_edit | relative_link }}" hx-target="#cat_{{ cat.id }}"
hx-swap="innerHTML show:#cat_{{ cat.id }}:top">
Edit
</a>
<span class="text-muted"> &bull; </span>
{%- capture cat_del %}admin/category/{{ cat.id }}/delete{% endcapture -%}
{%- capture cat_del_link %}{{ cat_del | relative_link }}{% endcapture -%}
<a href="{{ cat_del_link }}" hx-post="{{ cat_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the category &ldquo;{{ cat.name }}&rdquo;? This action cannot be undone.">
Delete
</a>
</small>
<div id="catList" class="container">
<div class="row">
<div class="col">
{%- assign cat_count = categories | size -%}
{% if cat_count > 0 %}
{%- assign cat_col = "col-12 col-md-6 col-xl-5 col-xxl-4" -%}
{%- assign desc_col = "col-12 col-md-6 col-xl-7 col-xxl-8" -%}
<div class="container">
<div class="row mwl-table-heading">
<div class="{{ cat_col }}">Category<span class="d-md-none">; Description</span></div>
<div class="{{ desc_col }} d-none d-md-inline-block">Description</div>
</div>
</div>
<div class="{{ desc_col }}">
{%- if cat.description %}{{ cat.description.value }}{% else %}<em class="text-muted">none</em>{% endif %}
<form method="post" class="container" hx-target="#catList" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row mwl-table-detail" id="cat_new"></div>
{% for cat in categories -%}
<div class="row mwl-table-detail" id="cat_{{ cat.id }}">
<div class="{{ cat_col }} no-wrap">
{%- if cat.parent_names %}
<small class="text-muted">{% for name in cat.parent_names %}{{ name }} &rang; {% endfor %}</small>
{%- endif %}
{{ cat.name }}<br>
<small>
{%- assign cat_url_base = "admin/category/" | append: cat.id -%}
{%- if cat.post_count > 0 %}
<a href="{{ cat | category_link }}" target="_blank">
View {{ cat.post_count }} Post{% unless cat.post_count == 1 %}s{% endunless -%}
</a>
<span class="text-muted"> &bull; </span>
{%- endif %}
<a href="{{ cat_url_base | append: "/edit" | relative_link }}" hx-target="#cat_{{ cat.id }}"
hx-swap="innerHTML show:#cat_{{ cat.id }}:top">
Edit
</a>
<span class="text-muted"> &bull; </span>
{%- assign cat_del_link = cat_url_base | append: "/delete" | relative_link -%}
<a href="{{ cat_del_link }}" hx-post="{{ cat_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the category &ldquo;{{ cat.name }}&rdquo;? This action cannot be undone.">
Delete
</a>
</small>
</div>
<div class="{{ desc_col }}">
{%- if cat.description %}{{ cat.description.value }}{% else %}<em class="text-muted">none</em>{% endif %}
</div>
</div>
{%- endfor %}
</form>
{%- else -%}
<div id="cat_new">
<p class="text-muted fst-italic text-center">This web log has no categores defined</p>
</div>
</div>
{%- endfor %}
{%- else -%}
<div class="row">
<div class="col-12 text-muted fst-italic text-center">This web log has no categores defined</div>
{%- endif %}
</div>
{%- endif %}
</form>
</div>
</div>

View File

@@ -4,13 +4,5 @@
hx-target="#cat_new">
Add a New Category
</a>
<div class="container">
{%- assign cat_col = "col-12 col-md-6 col-xl-5 col-xxl-4" -%}
{%- assign desc_col = "col-12 col-md-6 col-xl-7 col-xxl-8" -%}
<div class="row mwl-table-heading">
<div class="{{ cat_col }}">Category<span class="d-md-none">; Description</span></div>
<div class="{{ desc_col }} d-none d-md-inline-block">Description</div>
</div>
</div>
{{ category_list }}
</article>

View File

@@ -1,13 +1,19 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="{{ "admin/settings/rss/save" | relative_link }}" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="id" value="{{ model.id }}">
<input
type="hidden"
name="{{ csrf.form_field_name }}"
value="{{ csrf.request_token }}">
<input
type="hidden"
name="Id"
value="{{ model.id }}">
{%- assign typ = model.source_type -%}
<div class="container">
<div class="row pb-3">
<div class="col">
<a href="{{ "admin/settings/rss" | relative_link }}">&laquo; Back to RSS Settings</a>
<a href="{{ "admin/settings#rss-settings" | relative_link }}">&laquo; Back to Settings</a>
</div>
</div>
<div class="row pb-3">
@@ -17,8 +23,13 @@
<div class="row">
<div class="col">
<div class="form-floating">
<input type="text" name="path" id="path" class="form-control" placeholder="Relative Feed Path"
value="{{ model.path }}">
<input
type="text"
name="Path"
id="path"
class="form-control"
placeholder="Relative Feed Path"
value="{{ model.path }}">
<label for="path">Relative Feed Path</label>
<span class="form-text fst-italic">Appended to {{ web_log.url_base }}/</span>
</div>
@@ -27,8 +38,13 @@
<div class="row">
<div class="col py-3 d-flex align-self-center justify-content-center">
<div class="form-check form-switch">
<input type="checkbox" name="isPodcast" id="isPodcast" class="form-check-input" value="true"
{%- if model.is_podcast %} checked="checked"{% endif %} onclick="Admin.checkPodcast()">
<input
type="checkbox"
name="IsPodcast"
id="isPodcast"
class="form-check-input"
value="true"
{%- if model.is_podcast %}checked="checked"{% endif %}onclick="Admin.checkPodcast()">
<label for="isPodcast" class="form-check-label">This Is a Podcast Feed</label>
</div>
</div>
@@ -41,21 +57,31 @@
<div class="row d-flex align-items-center">
<div class="col-1 d-flex justify-content-end pb-3">
<div class="form-check form-check-inline me-0">
<input type="radio" name="sourceType" id="sourceTypeCat" class="form-check-input" value="category"
{%- unless typ == "tag" %} checked="checked" {% endunless -%}
onclick="Admin.customFeedBy('category')">
<input
type="radio"
name="SourceType"
id="sourceTypeCat"
class="form-check-input"
value="category"
{%- unless typ == "tag" %}checked="checked"{% endunless -%}onclick="Admin.customFeedBy('category')">
<label for="sourceTypeCat" class="form-check-label d-none">Category</label>
</div>
</div>
<div class="col-11 pb-3">
<div class="form-floating">
<select name="sourceValue" id="sourceValueCat" class="form-control" required
{%- if typ == "tag" %} disabled="disabled"{% endif %}>
<select
name="SourceValue"
id="sourceValueCat"
class="form-control"
required
{%- if typ == "tag" %}disabled="disabled"{% endif %}>
<option value="">&ndash; Select Category &ndash;</option>
{% for cat in categories -%}
<option value="{{ cat.id }}"
{%- if typ != "tag" and model.source_value == cat.id %} selected="selected"{% endif -%}>
{% for it in cat.parent_names %}{{ it }} &rang; {% endfor %}{{ cat.name }}
<option value="{{ cat.id }}"{%- if typ != "tag" and model.source_value == cat.id %}selected="selected"{% endif -%}>
{% for it in cat.parent_names %}
{{ it }} &rang;
{% endfor %}
{{ cat.name }}
</option>
{%- endfor %}
</select>
@@ -64,16 +90,25 @@
</div>
<div class="col-1 d-flex justify-content-end pb-3">
<div class="form-check form-check-inline me-0">
<input type="radio" name="sourceType" id="sourceTypeTag" class="form-check-input" value="tag"
{%- if typ == "tag" %} checked="checked"{% endif %} onclick="Admin.customFeedBy('tag')">
<input
type="radio"
name="SourceType"
id="sourceTypeTag"
class="form-check-input"
value="tag"
{%- if typ == "tag" %}checked="checked"{% endif %}onclick="Admin.customFeedBy('tag')">
<label for="sourceTypeTag" class="form-check-label d-none">Tag</label>
</div>
</div>
<div class="col-11 pb-3">
<div class="form-floating">
<input type="text" name="sourceValue" id="sourceValueTag" class="form-control" placeholder="Tag"
{%- unless typ == "tag" %} disabled="disabled"{% endunless %} required
{%- if typ == "tag" %} value="{{ model.source_value }}"{% endif %}>
<input
type="text"
name="SourceValue"
id="sourceValueTag"
class="form-control"
placeholder="Tag"
{%- unless typ == "tag" %}disabled="disabled"{% endunless %}required{%- if typ == "tag" %}value="{{ model.source_value }}"{% endif %}>
<label for="sourceValueTag">Tag</label>
</div>
</div>
@@ -83,27 +118,47 @@
</div>
<div class="row pb-3">
<div class="col">
<fieldset class="container" id="podcastFields"{% unless model.is_podcast %} disabled="disabled"{%endunless%}>
<fieldset
class="container"
id="podcastFields"
{% unless model.is_podcast %}disabled="disabled"{% endunless %}>
<legend>Podcast Settings</legend>
<div class="row">
<div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3">
<div class="form-floating">
<input type="text" name="title" id="title" class="form-control" placeholder="Title" required
value="{{ model.title }}">
<input
type="text"
name="Title"
id="title"
class="form-control"
placeholder="Title"
required
value="{{ model.title }}">
<label for="title">Title</label>
</div>
</div>
<div class="col-12 col-md-4 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="subtitle" id="subtitle" class="form-control" placeholder="Subtitle"
value="{{ model.subtitle }}">
<input
type="text"
name="Subtitle"
id="subtitle"
class="form-control"
placeholder="Subtitle"
value="{{ model.subtitle }}">
<label for="subtitle">Podcast Subtitle</label>
</div>
</div>
<div class="col-12 col-md-3 col-lg-2 pb-3">
<div class="form-floating">
<input type="number" name="itemsInFeed" id="itemsInFeed" class="form-control" placeholder="Items"
required value="{{ model.items_in_feed }}">
<input
type="number"
name="ItemsInFeed"
id="itemsInFeed"
class="form-control"
placeholder="Items"
required
value="{{ model.items_in_feed }}">
<label for="itemsInFeed"># Episodes</label>
</div>
</div>
@@ -111,12 +166,20 @@
<div class="row">
<div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3">
<div class="form-floating">
<input type="text" name="itunesCategory" id="itunesCategory" class="form-control"
placeholder="iTunes Category" required value="{{ model.itunes_category }}">
<label for="itunesCategory">iTunes Category</label>
<input
type="text"
name="AppleCategory"
id="appleCategory"
class="form-control"
placeholder="iTunes Category"
required
value="{{ model.apple_category }}">
<label for="appleCategory">iTunes Category</label>
<span class="form-text fst-italic">
<a href="https://www.thepodcasthost.com/planning/itunes-podcast-categories/" target="_blank"
rel="noopener">
<a
href="https://www.thepodcasthost.com/planning/itunes-podcast-categories/"
target="_blank"
rel="noopener">
iTunes Category / Subcategory List
</a>
</span>
@@ -124,17 +187,26 @@
</div>
<div class="col-12 col-md-4 pb-3">
<div class="form-floating">
<input type="text" name="itunesSubcategory" id="itunesSubcategory" class="form-control"
placeholder="iTunes Subcategory" value="{{ model.itunes_subcategory }}">
<label for="itunesSubcategory">iTunes Subcategory</label>
<input
type="text"
name="AppleSubcategory"
id="appleSubcategory"
class="form-control"
placeholder="iTunes Subcategory"
value="{{ model.apple_subcategory }}">
<label for="appleSubcategory">iTunes Subcategory</label>
</div>
</div>
<div class="col-12 col-md-3 col-lg-2 pb-3">
<div class="form-floating">
<select name="explicit" id="explicit" class="form-control" required>
<option value="yes"{% if model.explicit == "yes" %} selected="selected"{% endif %}>Yes</option>
<option value="no"{% if model.explicit == "no" %} selected="selected"{% endif %}>No</option>
<option value="clean"{% if model.explicit == "clean" %} selected="selected"{% endif %}>
<select
name="Explicit"
id="explicit"
class="form-control"
required>
<option value="yes" {% if model.explicit == "yes" %}selected="selected"{% endif %}>Yes</option>
<option value="no" {% if model.explicit == "no" %}selected="selected"{% endif %}>No</option>
<option value="clean" {% if model.explicit == "clean" %}selected="selected"{% endif %}>
Clean
</option>
</select>
@@ -145,31 +217,54 @@
<div class="row">
<div class="col-12 col-md-6 col-lg-4 offset-xxl-1 pb-3">
<div class="form-floating">
<input type="text" name="displayedAuthor" id="displayedAuthor" class="form-control"
placeholder="Author" required value="{{ model.displayed_author }}">
<input
type="text"
name="DisplayedAuthor"
id="displayedAuthor"
class="form-control"
placeholder="Author"
required
value="{{ model.displayed_author }}">
<label for="displayedAuthor">Displayed Author</label>
</div>
</div>
<div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="email" name="email" id="email" class="form-control" placeholder="Email" required
value="{{ model.email }}">
<input
type="email"
name="Email"
id="email"
class="form-control"
placeholder="Email"
required
value="{{ model.email }}">
<label for="email">Author E-mail</label>
<span class="form-text fst-italic">For iTunes, must match registered e-mail</span>
</div>
</div>
<div class="col-12 col-sm-5 col-md-4 col-lg-4 col-xl-3 offset-xl-1 col-xxl-2 offset-xxl-0">
<div class="form-floating">
<input type="text" name="defaultMediaType" id="defaultMediaType" class="form-control"
placeholder="Media Type" value="{{ model.default_media_type }}">
<input
type="text"
name="DefaultMediaType"
id="defaultMediaType"
class="form-control"
placeholder="Media Type"
value="{{ model.default_media_type }}">
<label for="defaultMediaType">Default Media Type</label>
<span class="form-text fst-italic">Optional; blank for no default</span>
</div>
</div>
<div class="col-12 col-sm-7 col-md-8 col-lg-10 offset-lg-1">
<div class="form-floating">
<input type="text" name="imageUrl" id="imageUrl" class="form-control" placeholder="Image URL" required
value="{{ model.image_url }}">
<input
type="text"
name="ImageUrl"
id="imageUrl"
class="form-control"
placeholder="Image URL"
required
value="{{ model.image_url }}">
<label for="imageUrl">Image URL</label>
<span class="form-text fst-italic">Relative URL will be appended to {{ web_log.url_base }}/</span>
</div>
@@ -178,23 +273,102 @@
<div class="row pb-3">
<div class="col-12 col-lg-10 offset-lg-1">
<div class="form-floating">
<input type="text" name="summary" id="summary" class="form-control" placeholder="Summary" required
value="{{ model.summary }}">
<input
type="text"
name="Summary"
id="summary"
class="form-control"
placeholder="Summary"
required
value="{{ model.summary }}">
<label for="summary">Summary</label>
<span class="form-text fst-italic">Displayed in podcast directories</span>
</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"
placeholder="Media Base URL" value="{{ model.media_base_url }}">
<input
type="text"
name="MediaBaseUrl"
id="mediaBaseUrl"
class="form-control"
placeholder="Media Base URL"
value="{{ model.media_base_url }}">
<label for="mediaBaseUrl">Media Base URL</label>
<span class="form-text fst-italic">Optional; prepended to episode media file if present</span>
</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="PodcastGuid"
id="guid"
class="form-control"
placeholder="GUID"
value="{{ model.podcast_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>
@@ -205,4 +379,4 @@
</div>
</div>
</form>
</article>
</article>

View File

@@ -9,8 +9,10 @@
Published <span class="badge rounded-pill bg-secondary">{{ model.posts }}</span>
&nbsp; Drafts <span class="badge rounded-pill bg-secondary">{{ model.drafts }}</span>
</h6>
<a href="{{ "admin/posts" | relative_link }}" class="btn btn-secondary me-2">View All</a>
<a href="{{ "admin/post/new/edit" | relative_link }}" class="btn btn-primary">Write a New Post</a>
{% if is_author %}
<a href="{{ "admin/posts" | relative_link }}" class="btn btn-secondary me-2">View All</a>
<a href="{{ "admin/post/new/edit" | relative_link }}" class="btn btn-primary">Write a New Post</a>
{% endif %}
</div>
</div>
</section>
@@ -22,8 +24,10 @@
All <span class="badge rounded-pill bg-secondary">{{ model.pages }}</span>
&nbsp; Shown in Page List <span class="badge rounded-pill bg-secondary">{{ model.listed_pages }}</span>
</h6>
<a href="{{ "admin/pages" | relative_link }}" class="btn btn-secondary me-2">View All</a>
<a href="{{ "admin/page/new/edit" | relative_link }}" class="btn btn-primary">Create a New Page</a>
{% if is_author %}
<a href="{{ "admin/pages" | relative_link }}" class="btn btn-secondary me-2">View All</a>
<a href="{{ "admin/page/new/edit" | relative_link }}" class="btn btn-primary">Create a New Page</a>
{% endif %}
</div>
</div>
</section>
@@ -37,15 +41,19 @@
All <span class="badge rounded-pill bg-secondary">{{ model.categories }}</span>
&nbsp; Top Level <span class="badge rounded-pill bg-secondary">{{ model.top_level_categories }}</span>
</h6>
<a href="{{ "admin/categories" | relative_link }}" class="btn btn-secondary me-2">View All</a>
<a href="{{ "admin/category/new/edit" | relative_link }}" class="btn btn-secondary">Add a New Category</a>
{% if is_web_log_admin %}
<a href="{{ "admin/categories" | relative_link }}" class="btn btn-secondary me-2">View All</a>
<a href="{{ "admin/category/new/edit" | relative_link }}" class="btn btn-secondary">Add a New Category</a>
{% endif %}
</div>
</div>
</section>
</div>
<div class="row pb-3">
<div class="col text-end">
<a href="{{ "admin/settings" | relative_link }}" class="btn btn-secondary">Modify Settings</a>
{% if is_web_log_admin %}
<div class="row pb-3">
<div class="col text-end">
<a href="{{ "admin/settings" | relative_link }}" class="btn btn-secondary">Modify Settings</a>
</div>
</div>
</div>
{% endif %}
</article>

View File

@@ -5,6 +5,5 @@
</head>
<body>
{% include_template "_layout" %}
<script>Admin.dismissSuccesses()</script>
</body>
</html>

View File

@@ -4,29 +4,16 @@
<meta name="viewport" content="width=device-width, initial-scale=1">
<meta name="generator" content="{{ generator }}">
<title>{{ page_title | strip_html }} &laquo; Admin &laquo; {{ web_log.name | strip_html }}</title>
<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css"
integrity="sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" crossorigin="anonymous">
<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@5.1.3/dist/css/bootstrap.min.css"
integrity="sha384-1BmE4kWBq78iYhFldvKuhfTAU6auU8tT94WrHftjDbrCEXSU1oBoqyl2QvZ6jIW3" crossorigin="anonymous">
<link rel="stylesheet" href="{{ "themes/admin/admin.css" | relative_link }}">
</head>
<body hx-boost="true">
<body hx-boost="true" hx-indicator="#loadOverlay">
{% include_template "_layout" %}
<script src="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js"
integrity="sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM"
<script src="https://cdn.jsdelivr.net/npm/bootstrap@5.1.3/dist/js/bootstrap.bundle.min.js"
integrity="sha384-ka7Sk0Gln4gmtz2MlQnikT1wXgYsOg+OMhuP+IlRH9sENBO0LRn5q+8nbTov4+1p"
crossorigin="anonymous"></script>
{{ htmx_script }}
<script>
const cssLoaded = [...document.styleSheets].filter(it => it.href.indexOf("bootstrap.min.css") > -1).length > 0
if (!cssLoaded) {
const local = document.createElement("link")
local.rel = "stylesheet"
local.href = "{{ "themes/admin/bootstrap.min.css" | relative_link }}"
document.getElementsByTagName("link")[0].prepend(local)
}
setTimeout(function () {
if (!bootstrap) document.write('<script src=\"{{ "script/bootstrap.bundle.min.js" | relative_link }}\"><\/script>')
}, 2000)
</script>
<script src="{{ "themes/admin/admin.js" | relative_link }}"></script>
<script>Admin.dismissSuccesses()</script>
</body>
</html>

View File

@@ -3,19 +3,19 @@
<form action="{{ "user/log-on" | relative_link }}" method="post" hx-push-url="true">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
{% if model.return_to %}
<input type="hidden" name="returnTo" value="{{ model.return_to.value }}">
<input type="hidden" name="ReturnTo" value="{{ model.return_to.value }}">
{% endif %}
<div class="container">
<div class="row">
<div class="col-12 col-md-6 col-lg-4 offset-lg-2 pb-3">
<div class="form-floating">
<input type="email" id="email" name="emailAddress" class="form-control" autofocus required>
<input type="email" id="email" name="EmailAddress" class="form-control" autofocus required>
<label for="email">E-mail Address</label>
</div>
</div>
<div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="password" id="password" name="password" class="form-control" required>
<input type="password" id="password" name="Password" class="form-control" required>
<label for="password">Password</label>
</div>
</div>

View File

@@ -0,0 +1,77 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="{{ "admin/my-info" | relative_link }}" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="d-flex flex-row flex-wrap justify-content-around">
<div class="text-center mb-3 lh-sm">
<strong class="text-decoration-underline">Access Level</strong><br>{{ access_level }}
</div>
<div class="text-center mb-3 lh-sm">
<strong class="text-decoration-underline">Created</strong><br>{{ created_on | date: "MMMM d, yyyy" }}
</div>
<div class="text-center mb-3 lh-sm">
<strong class="text-decoration-underline">Last Log On</strong><br>
{{ last_seen_on | date: "MMMM d, yyyy" }} at {{ last_seen_on | date: "h:mmtt" | downcase }}
</div>
</div>
<div class="container">
<div class="row"><div class="col"><hr class="mt-0"></div></div>
<div class="row mb-3">
<div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="FirstName" id="firstName" class="form-control" autofocus required
placeholder="First" value="{{ model.first_name }}">
<label for="firstName">First Name</label>
</div>
</div>
<div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="LastName" id="lastName" class="form-control" required
placeholder="Last" value="{{ model.last_name }}">
<label for="lastName">Last Name</label>
</div>
</div>
<div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="PreferredName" id="preferredName" class="form-control" required
placeholder="Preferred" value="{{ model.preferred_name }}">
<label for="preferredName">Preferred Name</label>
</div>
</div>
</div>
<div class="row mb-3">
<div class="col">
<fieldset class="p-2">
<legend class="ps-1">Change Password</legend>
<div class="row">
<div class="col">
<p class="form-text">Optional; leave blank to keep your current password</p>
</div>
</div>
<div class="row">
<div class="col-12 col-md-6 pb-3">
<div class="form-floating">
<input type="password" name="NewPassword" id="newPassword" class="form-control"
placeholder="Password">
<label for="newPassword">New Password</label>
</div>
</div>
<div class="col-12 col-md-6 pb-3">
<div class="form-floating">
<input type="password" name="NewPasswordConfirm" id="newPasswordConfirm" class="form-control"
placeholder="Confirm">
<label for="newPasswordConfirm">Confirm New Password</label>
</div>
</div>
</div>
</fieldset>
</div>
</div>
<div class="row">
<div class="col text-center mb-3">
<button type="submit" class="btn btn-primary">Save Changes</button>
</div>
</div>
</div>
</form>
</article>

View File

@@ -2,40 +2,17 @@
<article>
<form action="{{ "admin/page/save" | relative_link }}" method="post" hx-push-url="true">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="pageId" value="{{ model.page_id }}">
<input type="hidden" name="PageId" value="{{ model.page_id }}">
<div class="container">
<div class="row mb-3">
<div class="col-9">
<div class="form-floating pb-3">
<input type="text" name="title" id="title" class="form-control" autofocus required
value="{{ model.title }}">
<label for="title">Title</label>
</div>
<div class="form-floating pb-3">
<input type="text" name="permalink" id="permalink" class="form-control" required
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>
{% endif -%}
</div>
<div class="mb-2">
<label for="text">Text</label> &nbsp; &nbsp;
<input type="radio" name="source" id="source_html" class="btn-check" value="HTML"
{%- if model.source == "HTML" %} checked="checked"{% endif %}>
<label class="btn btn-sm btn-outline-secondary" for="source_html">HTML</label>
<input type="radio" name="source" id="source_md" class="btn-check" value="Markdown"
{%- if model.source == "Markdown" %} checked="checked"{% endif %}>
<label class="btn btn-sm btn-outline-secondary" for="source_md">Markdown</label>
</div>
<div class="mb-3">
<textarea name="text" id="text" class="form-control">{{ model.text }}</textarea>
</div>
{%- assign entity = "page" -%}
{%- assign entity_id = model.page_id -%}
{% include_template "_edit-common" %}
</div>
<div class="col-3">
<div class="form-floating pb-3">
<select name="template" id="template" class="form-control">
<select name="Template" id="template" class="form-control">
{% for tmpl in templates -%}
<option value="{{ tmpl[0] }}"{% if model.template == tmpl[0] %} selected="selected"{% endif %}>
{{ tmpl[1] }}
@@ -45,7 +22,7 @@
<label for="template">Page Template</label>
</div>
<div class="form-check form-switch">
<input type="checkbox" name="isShownInPageList" id="showList" class="form-check-input" value="true"
<input type="checkbox" name="IsShownInPageList" id="showList" class="form-check-input" value="true"
{%- if model.is_shown_in_page_list %} checked="checked"{% endif %}>
<label for="showList" class="form-check-label">Show in Page List</label>
</div>
@@ -77,14 +54,14 @@
</div>
<div class="col-3">
<div class="form-floating">
<input type="text" name="metaNames" id="metaNames_{{ meta[0] }}" class="form-control"
<input type="text" name="MetaNames" id="metaNames_{{ meta[0] }}" class="form-control"
placeholder="Name" value="{{ meta[1] }}">
<label for="metaNames_{{ meta[0] }}">Name</label>
</div>
</div>
<div class="col-8">
<div class="form-floating">
<input type="text" name="metaValues" id="metaValues_{{ meta[0] }}" class="form-control"
<input type="text" name="MetaValues" id="metaValues_{{ meta[0] }}" class="form-control"
placeholder="Value" value="{{ meta[2] }}">
<label for="metaValues_{{ meta[0] }}">Value</label>
</div>

View File

@@ -2,37 +2,40 @@
<article>
<a href="{{ "admin/page/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3">Create a New Page</a>
{%- assign page_count = pages | size -%}
{%- assign title_col = "col-12 col-md-5" -%}
{%- assign link_col = "col-12 col-md-5" -%}
{%- assign upd8_col = "col-12 col-md-2" -%}
<form method="post" class="container" hx-target="body">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row mwl-table-heading">
<div class="{{ title_col }}">
<span class="d-none d-md-inline">Title</span><span class="d-md-none">Page</span>
{% if page_count > 0 %}
{%- assign title_col = "col-12 col-md-5" -%}
{%- assign link_col = "col-12 col-md-5" -%}
{%- assign upd8_col = "col-12 col-md-2" -%}
<form method="post" class="container mb-3" hx-target="body">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row mwl-table-heading">
<div class="{{ title_col }}">
<span class="d-none d-md-inline">Title</span><span class="d-md-none">Page</span>
</div>
<div class="{{ link_col }} d-none d-md-inline-block">Permalink</div>
<div class="{{ upd8_col }} d-none d-md-inline-block">Updated</div>
</div>
<div class="{{ link_col }} d-none d-md-inline-block">Permalink</div>
<div class="{{ upd8_col }} d-none d-md-inline-block">Updated</div>
</div>
{% if page_count > 0 %}
{% for pg in pages -%}
<div class="row mwl-table-detail">
<div class="{{ title_col }}">
{{ pg.title }}
{%- if pg.is_default %} &nbsp; <span class="badge bg-success">HOME PAGE</span>{% endif -%}
{%- if pg.show_in_page_list %} &nbsp; <span class="badge bg-primary">IN PAGE LIST</span> {% endif -%}<br>
{%- if pg.is_in_page_list %} &nbsp; <span class="badge bg-primary">IN PAGE LIST</span> {% endif -%}<br>
<small>
{%- capture pg_link %}{% unless pg.is_default %}{{ pg.permalink }}{% endunless %}{% endcapture -%}
<a href="{{ pg_link | relative_link }}" target="_blank">View Page</a>
<span class="text-muted"> &bull; </span>
<a href="{{ pg | edit_page_link }}">Edit</a>
<span class="text-muted"> &bull; </span>
{%- capture pg_del %}admin/page/{{ pg.id }}/delete{% endcapture -%}
{%- capture pg_del_link %}{{ pg_del | relative_link }}{% endcapture -%}
<a href="{{ pg_del_link }}" hx-post="{{ pg_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the page &ldquo;{{ pg.title | strip_html | escape }}&rdquo;? This action cannot be undone.">
Delete
</a>
{% if is_editor or is_author and user_id == pg.author_id %}
<span class="text-muted"> &bull; </span>
<a href="{{ pg | edit_page_link }}">Edit</a>
{% endif %}
{% if is_web_log_admin %}
<span class="text-muted"> &bull; </span>
{%- assign pg_del_link = "admin/page/" | append: pg.id | append: "/delete" | relative_link -%}
<a href="{{ pg_del_link }}" hx-post="{{ pg_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the page &ldquo;{{ pg.title | strip_html | escape }}&rdquo;? This action cannot be undone.">
Delete
</a>
{% endif %}
</small>
</div>
<div class="{{ link_col }}">
@@ -45,26 +48,30 @@
</div>
</div>
{%- endfor %}
{% else %}
<div class="row">
<div class="col text-muted fst-italic text-center">This web log has no pages</div>
</form>
{% if page_nbr > 1 or has_next %}
<div class="d-flex justify-content-evenly mb-3">
<div>
{% if page_nbr > 1 %}
<p>
<a class="btn btn-secondary" href="{{ "admin/pages" | append: prev_page | relative_link }}">
&laquo; Previous
</a>
</p>
{% endif %}
</div>
<div class="text-right">
{% if has_next %}
<p>
<a class="btn btn-secondary" href="{{ "admin/pages" | append: next_page | relative_link }}">
Next &raquo;
</a>
</p>
{% endif %}
</div>
</div>
{% endif %}
</form>
{% if page_nbr > 1 or page_count == 25 %}
<div class="d-flex justify-content-evenly pb-3">
<div>
{% if page_nbr > 1 %}
{%- capture prev_link %}admin/pages{{ prev_page }}{% endcapture -%}
<p><a class="btn btn-default" href="{{ prev_link | relative_link }}">&laquo; Previous</a></p>
{% endif %}
</div>
<div class="text-right">
{% if page_count == 25 %}
{%- capture next_link %}admin/pages{{ next_page }}{% endcapture -%}
<p><a class="btn btn-default" href="{{ next_link | relative_link }}">Next &raquo;</a></p>
{% endif %}
</div>
</div>
{% else %}
<p class="text-muted fst-italic text-center">This web log has no pages</p>
{% endif %}
</article>

View File

@@ -1,9 +1,9 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
{%- capture form_action %}admin/{{ model.entity }}/permalinks{% endcapture -%}
<form action="{{ form_action | relative_link }}" method="post">
{%- assign base_url = "admin/" | append: model.entity | append: "/" -%}
<form action="{{ base_url | append: "permalinks" | relative_link }}" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="id" value="{{ model.id }}">
<input type="hidden" name="Id" value="{{ model.id }}">
<div class="container">
<div class="row">
<div class="col">
@@ -11,8 +11,9 @@
<strong>{{ model.current_title }}</strong><br>
<small class="text-muted">
<span class="fst-italic">{{ model.current_permalink }}</span><br>
{%- capture back_link %}admin/{{ model.entity }}/{{ model.id }}/edit{% endcapture -%}
<a href="{{ back_link | relative_link }}">&laquo; Back to Edit {{ model.entity | capitalize }}</a>
<a href="{{ base_url | append: model.id | append: "/edit" | relative_link }}">
&laquo; Back to Edit {{ model.entity | capitalize }}
</a>
</small>
</p>
</div>
@@ -35,7 +36,7 @@
</div>
<div class="col-11">
<div class="form-floating">
<input type="text" name="prior" id="prior_{{ link_count }}" class="form-control"
<input type="text" name="Prior" id="prior_{{ link_count }}" class="form-control"
placeholder="Link" value="{{ link }}">
<label for="prior_{{ link_count }}">Link</label>
</div>

View File

@@ -2,50 +2,212 @@
<article>
<form action="{{ "admin/post/save" | relative_link }}" method="post" hx-push-url="true">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="postId" value="{{ model.post_id }}">
<input type="hidden" name="PostId" value="{{ model.post_id }}">
<div class="container">
<div class="row mb-3">
<div class="col-12 col-lg-9">
{%- assign entity = "post" -%}
{%- assign entity_id = model.post_id -%}
{% include_template "_edit-common" %}
<div class="form-floating pb-3">
<input type="text" name="title" id="title" class="form-control" placeholder="Title" autofocus required
value="{{ model.title }}">
<label for="title">Title</label>
</div>
<div class="form-floating pb-3">
<input type="text" name="permalink" id="permalink" class="form-control" placeholder="Permalink" required
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>
{% endif -%}
</div>
<div class="mb-2">
<label for="text">Text</label> &nbsp; &nbsp;
<input type="radio" name="source" id="source_html" class="btn-check" value="HTML"
{%- if model.source == "HTML" %} checked="checked"{% endif %}>
<label class="btn btn-sm btn-outline-secondary" for="source_html">HTML</label>
<input type="radio" name="source" id="source_md" class="btn-check" value="Markdown"
{%- if model.source == "Markdown" %} checked="checked"{% endif %}>
<label class="btn btn-sm btn-outline-secondary" for="source_md">Markdown</label>
</div>
<div class="pb-3">
<textarea name="text" id="text" class="form-control" rows="20">{{ model.text }}</textarea>
</div>
<div class="form-floating pb-3">
<input type="text" name="tags" id="tags" class="form-control" placeholder="Tags"
<input type="text" name="Tags" id="tags" class="form-control" placeholder="Tags"
value="{{ model.tags }}">
<label for="tags">Tags</label>
<div class="form-text">comma-delimited</div>
</div>
{% if model.status == "Draft" %}
<div class="form-check pb-2">
<input type="checkbox" name="doPublish" id="doPublish" class="form-check-input" value="true">
<div class="form-check form-switch pb-2">
<input type="checkbox" name="DoPublish" id="doPublish" class="form-check-input" value="true">
<label for="doPublish" class="form-check-label">Publish This Post</label>
</div>
{% endif %}
<button type="submit" class="btn btn-primary pb-2">Save Changes</button>
<hr class="mb-3">
<fieldset class="mb-3">
<legend>
<span class="form-check form-switch">
<small>
<input type="checkbox" name="IsEpisode" id="isEpisode" class="form-check-input" value="true"
data-bs-toggle="collapse" data-bs-target="#episodeItems" onclick="Admin.toggleEpisodeFields()"
{%- if model.is_episode %} checked="checked"{% endif %}>
</small>
<label for="isEpisode">Podcast Episode</label>
</span>
</legend>
<div id="episodeItems" class="container p-0 collapse{% if model.is_episode %} show{% endif %}">
<div class="row">
<div class="col-12 col-md-8 pb-3">
<div class="form-floating">
<input type="text" name="Media" id="media" class="form-control" placeholder="Media" required
value="{{ model.media }}">
<label for="media">Media File</label>
<div class="form-text">
Relative URL will be appended to base media path (if set) or served from this web log
</div>
</div>
</div>
<div class="col-12 col-md-4 pb-3">
<div class="form-floating">
<input type="text" name="MediaType" id="mediaType" class="form-control" placeholder="Media Type"
value="{{ model.media_type }}">
<label for="mediaType">Media MIME Type</label>
<div class="form-text">Optional; overrides podcast default</div>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col">
<div class="form-floating">
<input type="number" name="Length" id="length" class="form-control" placeholder="Length" required
value="{{ model.length }}">
<label for="length">Media Length (bytes)</label>
<div class="form-text">TODO: derive from above file name</div>
</div>
</div>
<div class="col">
<div class="form-floating">
<input type="text" name="Duration" id="duration" class="form-control" placeholder="Duration"
value="{{ model.duration }}">
<label for="duration">Duration</label>
<div class="form-text">Recommended; enter in <code>HH:MM:SS</code> format</div>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col">
<div class="form-floating">
<input type="text" name="Subtitle" id="subtitle" class="form-control" placeholder="Subtitle"
value="{{ model.subtitle }}">
<label for="subtitle">Subtitle</label>
<div class="form-text">Optional; a subtitle for this episode</div>
</div>
</div>
</div>
<div class="row">
<div class="col-12 col-md-8 pb-3">
<div class="form-floating">
<input type="text" name="ImageUrl" id="imageUrl" class="form-control" placeholder="Image URL"
value="{{ model.image_url }}">
<label for="imageUrl">Image URL</label>
<div class="form-text">
Optional; overrides podcast default; relative URL served from this web log
</div>
</div>
</div>
<div class="col-12 col-md-4 pb-3">
<div class="form-floating">
<select name="Explicit" id="explicit" class="form-control">
{% for exp_value in explicit_values %}
<option value="{{ exp_value[0] }}"
{%- if model.explicit == exp_value[0] %} selected="selected"{% endif -%}>
{{ exp_value[1] }}
</option>
{% endfor %}
</select>
<label for="explicit">Explicit Rating</label>
<div class="form-text">Optional; overrides podcast default</div>
</div>
</div>
</div>
<div class="row">
<div class="col-12 col-md-8 pb-3">
<div class="form-floating">
<input type="text" name="ChapterFile" id="chapterFile" class="form-control"
placeholder="Chapter File" value="{{ model.chapter_file }}">
<label for="chapterFile">Chapter File</label>
<div class="form-text">Optional; relative URL served from this web log</div>
</div>
</div>
<div class="col-12 col-md-4 pb-3">
<div class="form-floating">
<input type="text" name="ChapterType" id="chapterType" class="form-control"
placeholder="Chapter Type" value="{{ model.chapter_type }}">
<label for="chapterType">Chapter MIME Type</label>
<div class="form-text">
Optional; <code>application/json+chapters</code> assumed if chapter file ends with
<code>.json</code>
</div>
</div>
</div>
</div>
<div class="row">
<div class="col-12 col-md-8 pb-3">
<div class="form-floating">
<input type="text" name="TranscriptUrl" id="transcriptUrl" class="form-control"
placeholder="Transcript URL" value="{{ model.transcript_url }}"
onkeyup="Admin.requireTranscriptType()">
<label for="transcriptUrl">Transcript URL</label>
<div class="form-text">Optional; relative URL served from this web log</div>
</div>
</div>
<div class="col-12 col-md-4 pb-3">
<div class="form-floating">
<input type="text" name="TranscriptType" id="transcriptType" class="form-control"
placeholder="Transcript Type" value="{{ model.transcript_type }}"
{%- if model.transcript_url != "" %} required{% endif %}>
<label for="transcriptType">Transcript MIME Type</label>
<div class="form-text">Required if transcript URL provided</div>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col">
<div class="form-floating">
<input type="text" name="TranscriptLang" id="transcriptLang" class="form-control"
placeholder="Transcript Language" value="{{ model.transcript_lang }}">
<label for="transcriptLang">Transcript Language</label>
<div class="form-text">Optional; overrides podcast default</div>
</div>
</div>
<div class="col d-flex justify-content-center">
<div class="form-check form-switch align-self-center pb-3">
<input type="checkbox" name="TranscriptCaptions" id="transcriptCaptions" class="form-check-input"
value="true" {% if model.transcript_captions %} checked="checked"{% endif %}>
<label for="transcriptCaptions">This is a captions file</label>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col col-md-4">
<div class="form-floating">
<input type="number" name="SeasonNumber" id="seasonNumber" class="form-control"
placeholder="Season Number" value="{{ model.season_number }}">
<label for="seasonNumber">Season Number</label>
<div class="form-text">Optional</div>
</div>
</div>
<div class="col col-md-8">
<div class="form-floating">
<input type="text" name="SeasonDescription" id="seasonDescription" class="form-control"
placeholder="Season Description" maxlength="128" value="{{ model.season_description }}">
<label for="seasonDescription">Season Description</label>
<div class="form-text">Optional</div>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col col-md-4">
<div class="form-floating">
<input type="number" name="EpisodeNumber" id="episodeNumber" class="form-control" step="0.01"
placeholder="Episode Number" value="{{ model.episode_number }}">
<label for="episodeNumber">Episode Number</label>
<div class="form-text">Optional; up to 2 decimal points</div>
</div>
</div>
<div class="col col-md-8">
<div class="form-floating">
<input type="text" name="EpisodeDescription" id="episodeDescription" class="form-control"
placeholder="Episode Description" maxlength="128" value="{{ model.episode_description }}">
<label for="episodeDescription">Episode Description</label>
<div class="form-text">Optional</div>
</div>
</div>
</div>
</div>
<script>
document.addEventListener("DOMContentLoaded", () => Admin.toggleEpisodeFields())
</script>
</fieldset>
<fieldset class="pb-3">
<legend>
Metadata
@@ -55,11 +217,6 @@
</button>
</legend>
<div id="metaItemContainer" class="collapse">
{%- unless model.meta_names contains "episode_media_file" %}
<button class="btn btn-sm btn-secondary" onclick="Admin.addPodcastFields()" id="addPodcastFieldButton">
Add Podcast Episode Fields
</button>
{%- endunless %}
<div id="metaItems" class="container">
{%- for meta in metadata %}
<div id="meta_{{ meta[0] }}" class="row mb-3">
@@ -70,14 +227,14 @@
</div>
<div class="col-3">
<div class="form-floating">
<input type="text" name="metaNames" id="metaNames_{{ meta[0] }}" class="form-control"
<input type="text" name="MetaNames" id="metaNames_{{ meta[0] }}" class="form-control"
placeholder="Name" value="{{ meta[1] }}">
<label for="metaNames_{{ meta[0] }}">Name</label>
</div>
</div>
<div class="col-8">
<div class="form-floating">
<input type="text" name="metaValues" id="metaValues_{{ meta[0] }}" class="form-control"
<input type="text" name="MetaValues" id="metaValues_{{ meta[0] }}" class="form-control"
placeholder="Value" value="{{ meta[2] }}">
<label for="metaValues_{{ meta[0] }}">Value</label>
</div>
@@ -98,14 +255,14 @@
<div class="row">
<div class="col align-self-center">
<div class="form-check form-switch pb-2">
<input type="checkbox" name="setPublished" id="setPublished" class="form-check-input"
<input type="checkbox" name="SetPublished" id="setPublished" class="form-check-input"
value="true">
<label for="setPublished" class="form-check-label">Set Published Date</label>
</div>
</div>
<div class="col-4">
<div class="form-floating">
<input type="datetime-local" name="pubOverride" id="pubOverride" class="form-control"
<input type="datetime-local" name="PubOverride" id="pubOverride" class="form-control"
placeholder="Override Date"
{%- if model.pub_override -%}
value="{{ model.pub_override | date: "yyyy-MM-dd\THH:mm" }}"
@@ -115,7 +272,7 @@
</div>
<div class="col-5 align-self-center">
<div class="form-check form-switch pb-2">
<input type="checkbox" name="setUpdated" id="setUpdated" class="form-check-input" value="true">
<input type="checkbox" name="SetUpdated" id="setUpdated" class="form-check-input" value="true">
<label for="setUpdated" class="form-check-label">
Purge revisions and<br>set as updated date as well
</label>
@@ -128,7 +285,7 @@
</div>
<div class="col-12 col-lg-3">
<div class="form-floating pb-3">
<select name="template" id="template" class="form-control">
<select name="Template" id="template" class="form-control">
{% for tmpl in templates -%}
<option value="{{ tmpl[0] }}"{% if model.template == tmpl[0] %} selected="selected"{% endif %}>
{{ tmpl[1] }}
@@ -141,7 +298,7 @@
<legend>Categories</legend>
{% for cat in categories %}
<div class="form-check">
<input type="checkbox" name="categoryIds" id="categoryId_{{ cat.id }}" class="form-check-input"
<input type="checkbox" name="CategoryIds" id="categoryId_{{ cat.id }}" class="form-check-input"
value="{{ cat.id }}" {% if model.category_ids contains cat.id %} checked="checked"{% endif %}>
<label for="categoryId_{{ cat.id }}" class="form-check-label"
{%- if cat.description %} title="{{ cat.description.value | strip_html | escape }}"{% endif %}>
@@ -155,3 +312,4 @@
</div>
</form>
</article>
<script>window.setTimeout(() => Admin.toggleEpisodeFields(), 500)</script>

View File

@@ -1,22 +1,22 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<a href="{{ "admin/post/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3">Write a New Post</a>
<form method="post" class="container" hx-target="body">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
{%- assign post_count = model.posts | size -%}
{%- assign date_col = "col-xs-12 col-md-3 col-lg-2" -%}
{%- assign title_col = "col-xs-12 col-md-7 col-lg-6 col-xl-5 col-xxl-4" -%}
{%- assign author_col = "col-xs-12 col-md-2 col-lg-1" -%}
{%- assign tag_col = "col-lg-3 col-xl-4 col-xxl-5 d-none d-lg-inline-block" -%}
<div class="row mwl-table-heading">
<div class="{{ date_col }}">
<span class="d-md-none">Post</span><span class="d-none d-md-inline">Date</span>
{%- assign post_count = model.posts | size -%}
{%- if post_count > 0 %}
<form method="post" class="container mb-3" hx-target="body">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
{%- assign date_col = "col-xs-12 col-md-3 col-lg-2" -%}
{%- assign title_col = "col-xs-12 col-md-7 col-lg-6 col-xl-5 col-xxl-4" -%}
{%- assign author_col = "col-xs-12 col-md-2 col-lg-1" -%}
{%- assign tag_col = "col-lg-3 col-xl-4 col-xxl-5 d-none d-lg-inline-block" -%}
<div class="row mwl-table-heading">
<div class="{{ date_col }}">
<span class="d-md-none">Post</span><span class="d-none d-md-inline">Date</span>
</div>
<div class="{{ title_col }} d-none d-md-inline-block">Title</div>
<div class="{{ author_col }} d-none d-md-inline-block">Author</div>
<div class="{{ tag_col }}">Tags</div>
</div>
<div class="{{ title_col }} d-none d-md-inline-block">Title</div>
<div class="{{ author_col }} d-none d-md-inline-block">Author</div>
<div class="{{ tag_col }}">Tags</div>
</div>
{%- if post_count > 0 %}
{% for post in model.posts -%}
<div class="row mwl-table-detail">
<div class="{{ date_col }} no-wrap">
@@ -42,22 +42,22 @@
</span>
</div>
<div class="{{ title_col }}">
{%- assign media = post.metadata | value: "episode_media_file" -%}
{%- unless media == "-- episode_media_file not found --" -%}
<span class="badge bg-success float-end text-uppercase">Episode</span>
{%- endunless -%}
{%- if post.episode %}<span class="badge bg-success float-end text-uppercase mt-1">Episode</span>{% endif -%}
{{ post.title }}<br>
<small>
<a href="{{ post | relative_link }}" target="_blank">View Post</a>
<span class="text-muted"> &bull; </span>
<a href="{{ post | edit_post_link }}">Edit</a>
<span class="text-muted"> &bull; </span>
{%- capture post_del %}admin/post/{{ post.id }}/delete{% endcapture -%}
{%- capture post_del_link %}{{ post_del | relative_link }}{% endcapture -%}
<a href="{{ post_del_link }}" hx-post="{{ post_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the page &ldquo;{{ post.title | strip_html | escape }}&rdquo;? This action cannot be undone.">
Delete
</a>
{% if is_editor or is_author and user_id == post.author_id %}
<span class="text-muted"> &bull; </span>
<a href="{{ post | edit_post_link }}">Edit</a>
{% endif %}
{% if is_web_log_admin %}
<span class="text-muted"> &bull; </span>
{%- assign post_del_link = "admin/post/" | append: post.id | append: "/delete" | relative_link -%}
<a href="{{ post_del_link }}" hx-post="{{ post_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the page &ldquo;{{ post.title | strip_html | escape }}&rdquo;? This action cannot be undone.">
Delete
</a>
{% endif %}
</small>
</div>
<div class="{{ author_col }}">
@@ -77,24 +77,22 @@
</div>
</div>
{%- endfor %}
{% else %}
<div class="row">
<div class="col text-muted fst-italic text-center">This web log has no posts</div>
</form>
{% if model.newer_link or model.older_link %}
<div class="d-flex justify-content-evenly mb-3">
<div>
{% if model.newer_link %}
<p><a class="btn btn-secondary" href="{{ model.newer_link.value }}">&laquo; Newer Posts</a></p>
{% endif %}
</div>
<div class="text-right">
{% if model.older_link %}
<p><a class="btn btn-secondary" href="{{ model.older_link.value }}">Older Posts &raquo;</a></p>
{% endif %}
</div>
</div>
{% endif %}
</form>
{% if model.newer_link or model.older_link %}
<div class="d-flex justify-content-evenly">
<div>
{% if model.newer_link %}
<p><a class="btn btn-default" href="{{ model.newer_link.value }}">&laquo; Newer Posts</a></p>
{% endif %}
</div>
<div class="text-right">
{% if model.older_link %}
<p><a class="btn btn-default" href="{{ model.older_link.value }}">Older Posts &raquo;</a></p>
{% endif %}
</div>
</div>
{% else %}
<p class="text-muted fst-italic text-center">This web log has no posts</p>
{% endif %}
</article>

View File

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

View File

@@ -1,113 +0,0 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="{{ "admin/settings/rss" | relative_link }}" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="container">
<div class="row pb-3">
<div class="col col-xl-8 offset-xl-2">
<fieldset class="d-flex justify-content-evenly flex-row">
<legend>Feeds Enabled</legend>
<div class="form-check form-switch pb-2">
<input type="checkbox" name="feedEnabled" id="feedEnabled" class="form-check-input" value="true"
{% if model.feed_enabled %}checked="checked"{% endif %}>
<label for="feedEnabled" class="form-check-label">All Posts</label>
</div>
<div class="form-check form-switch pb-2">
<input type="checkbox" name="categoryEnabled" id="categoryEnabled" class="form-check-input" value="true"
{% if model.category_enabled %}checked="checked"{% endif %}>
<label for="categoryEnabled" class="form-check-label">Posts by Category</label>
</div>
<div class="form-check form-switch pb-2">
<input type="checkbox" name="tagEnabled" id="tagEnabled" class="form-check-input" value="true"
{% if model.tag_enabled %}checked="checked"{% endif %}>
<label for="tagEnabled" class="form-check-label">Posts by Tag</label>
</div>
</fieldset>
</div>
</div>
<div class="row">
<div class="col-12 col-sm-6 col-md-3 col-xl-2 offset-xl-2 pb-3">
<div class="form-floating">
<input type="text" name="feedName" id="feedName" class="form-control" placeholder="Feed File Name"
value="{{ model.feed_name }}">
<label for="feedName">Feed File Name</label>
<span class="form-text">Default is <code>feed.xml</code></span>
</div>
</div>
<div class="col-12 col-sm-6 col-md-4 col-xl-2 pb-3">
<div class="form-floating">
<input type="number" name="itemsInFeed" id="itemsInFeed" class="form-control" min="0"
placeholder="Items in Feed" required value="{{ model.items_in_feed }}">
<label for="itemsInFeed">Items in Feed</label>
<span class="form-text">Set to &ldquo;0&rdquo; to use &ldquo;Posts per Page&rdquo; setting ({{ web_log.posts_per_page }})</span>
</div>
</div>
<div class="col-12 col-md-5 col-xl-4 pb-3">
<div class="form-floating">
<input type="text" name="copyright" id="copyright" class="form-control" placeholder="Copyright String"
value="{{ model.copyright }}">
<label for="copyright">Copyright String</label>
<span class="form-text">
Can be a
<a href="https://creativecommons.org/share-your-work/" target="_blank" rel="noopener">
Creative Commons license string
</a>
</span>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col text-center">
<button type="submit" class="btn btn-primary">Save Changes</button>
</div>
</div>
</div>
</form>
<h3>Custom Feeds</h3>
<a class="btn btn-sm btn-secondary" href="{{ 'admin/settings/rss/new/edit' | relative_link }}">
Add a New Custom Feed
</a>
<form method="post" class="container" hx-target="body">
{%- assign source_col = "col-12 col-md-6" -%}
{%- assign path_col = "col-12 col-md-6" -%}
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row mwl-table-heading">
<div class="{{ source_col }}">
<span class="d-md-none">Feed</span><span class="d-none d-md-inline">Source</span>
</div>
<div class="{{ path_col }} d-none d-md-inline-block">Relative Path</div>
</div>
{%- assign feed_count = custom_feeds | size -%}
{% if feed_count > 0 %}
{% for feed in custom_feeds %}
<div class="row mwl-table-detail">
<div class="{{ source_col }}">
{{ feed.source }}
{%- if feed.is_podcast %} &nbsp; <span class="badge bg-primary">PODCAST</span>{% endif %}<br>
<small>
<a href="{{ feed.path | relative_link }}" target="_blank">View Feed</a>
<span class="text-muted"> &bull; </span>
{%- capture feed_edit %}admin/settings/rss/{{ feed.id }}/edit{% endcapture -%}
<a href="{{ feed_edit | relative_link }}">Edit</a>
<span class="text-muted"> &bull; </span>
{%- capture feed_del %}admin/settings/rss/{{ feed.id }}/delete{% endcapture -%}
{%- capture feed_del_link %}{{ feed_del | relative_link }}{% endcapture -%}
<a href="{{ feed_del_link }}" hx-post="{{ feed_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the custom RSS feed based on {{ feed.source | strip_html | escape }}? This action cannot be undone.">
Delete
</a>
</small>
</div>
<div class="{{ path_col }}">
<small class="d-md-none">Served at {{ feed.path }}</small>
<span class="d-none d-md-inline">{{ feed.path }}</span>
</div>
</div>
{% endfor %}
{% else %}
<tr>
<td colspan="3" class="text-muted fst-italic text-center">No custom feeds defined</td>
</tr>
{% endif %}
</form>
</article>

View File

@@ -1,80 +1,246 @@
<h2 class="my-3">{{ web_log.name }} Settings</h2>
<p class="text-muted">
Other Settings: <a href="{{ "admin/settings/tag-mappings" | relative_link }}">Tag Mappings</a> &bull;
<a href="{{ "admin/settings/rss" | relative_link }}">RSS Settings</a>
</p>
<article>
<form action="{{ "admin/settings" | relative_link }}" method="post">
<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="form-floating">
<input type="text" name="name" id="name" class="form-control" value="{{ model.name }}" required autofocus>
<label for="name">Name</label>
<p class="text-muted">
Go to: <a href="#users">Users</a> &bull; <a href="#rss-settings">RSS Settings</a> &bull;
<a href="#tag-mappings">Tag Mappings</a>
</p>
<fieldset class="container mb-3">
<legend>Web Log Settings</legend>
<form action="{{ "admin/settings" | relative_link }}" method="post">
<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 pb-3">
<div class="form-floating">
<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="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-6 col-xl-4 offset-xl-1 pb-3">
<div class="form-floating">
<select name="ThemeId" id="themeId" class="form-control" required>
{% for theme in themes -%}
<option value="{{ theme[0] }}"{% if model.theme_id == theme[0] %} selected="selected"{% endif %}>
{{ theme[1] }}
</option>
{%- endfor %}
</select>
<label for="themeId">Theme</label>
</div>
</div>
<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 %}>
{{ pg[1] }}
</option>
{%- endfor %}
</select>
<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="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 }}">
<label for="subtitle">Subtitle</label>
<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"
{%- if model.auto_htmx %} checked="checked"{% endif %}>
<label for="autoHtmx" class="form-check-label">Auto-Load htmx</label>
</div>
<span class="form-text fst-italic">
<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="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 class="row pb-3">
<div class="col text-center">
<button type="submit" class="btn btn-primary">Save Changes</button>
</div>
</div>
<div class="col-12 col-md-4 col-xl-3 pb-3">
<div class="form-floating">
<select name="themePath" id="themePath" class="form-control" required>
{% for theme in themes -%}
<option value="{{ theme[0] }}"{% if model.theme_path == theme[0] %} selected="selected"{% endif %}>
{{ theme[1] }}
</option>
{%- endfor %}
</select>
<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="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 %}>
{{ pg[1] }}
</option>
{%- endfor %}
</select>
<label for="defaultPage">Default Page</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"
{%- if model.auto_htmx %} checked="checked"{% endif %}>
<label for="autoHtmx" class="form-check-label">Auto-Load htmx</label>
</div>
<span class="form-text fst-italic">
<a href="https://htmx.org" target="_blank" rel="noopener">What is this?</a>
</span>
</div>
</div>
<div class="row pb-3">
<div class="col text-center">
<button type="submit" class="btn btn-primary">Save Changes</button>
</div>
</form>
</fieldset>
<fieldset id="users" class="container mb-3 pb-0">
<legend>Users</legend>
{% include_template "_user-list-columns" %}
<a href="{{ "admin/settings/user/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3"
hx-target="#user_new">
Add a New User
</a>
<div class="container g-0">
<div class="row mwl-table-heading">
<div class="{{ user_col }}">User<span class="d-md-none">; Full Name / E-mail; Last Log On</span></div>
<div class="{{ email_col }} d-none d-md-inline-block">Full Name / E-mail</div>
<div class="{{ cre8_col }}">Created</div>
<div class="{{ last_col }} d-none d-md-block">Last Log On</div>
</div>
</div>
</form>
{{ user_list }}
</fieldset>
<fieldset id="rss-settings" class="container mb-3 pb-0">
<legend>RSS Settings</legend>
<form action="{{ "admin/settings/rss" | relative_link }}" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="container">
<div class="row pb-3">
<div class="col col-xl-8 offset-xl-2">
<fieldset class="d-flex justify-content-evenly flex-row">
<legend>Feeds Enabled</legend>
<div class="form-check form-switch pb-2">
<input type="checkbox" name="IsFeedEnabled" id="feedEnabled" class="form-check-input" value="true"
{%- if rss_model.is_feed_enabled %} checked="checked"{% endif %}>
<label for="feedEnabled" class="form-check-label">All Posts</label>
</div>
<div class="form-check form-switch pb-2">
<input type="checkbox" name="IsCategoryEnabled" id="categoryEnabled" class="form-check-input"
value="true" {%- if rss_model.is_category_enabled %} checked="checked"{% endif %}>
<label for="categoryEnabled" class="form-check-label">Posts by Category</label>
</div>
<div class="form-check form-switch pb-2">
<input type="checkbox" name="IsTagEnabled" id="tagEnabled" class="form-check-input" value="true"
{%- if rss_model.tag_enabled %} checked="checked"{% endif %}>
<label for="tagEnabled" class="form-check-label">Posts by Tag</label>
</div>
</fieldset>
</div>
</div>
<div class="row">
<div class="col-12 col-sm-6 col-md-3 col-xl-2 offset-xl-2 pb-3">
<div class="form-floating">
<input type="text" name="FeedName" id="feedName" class="form-control" placeholder="Feed File Name"
value="{{ rss_model.feed_name }}">
<label for="feedName">Feed File Name</label>
<span class="form-text">Default is <code>feed.xml</code></span>
</div>
</div>
<div class="col-12 col-sm-6 col-md-4 col-xl-2 pb-3">
<div class="form-floating">
<input type="number" name="ItemsInFeed" id="itemsInFeed" class="form-control" min="0"
placeholder="Items in Feed" required value="{{ rss_model.items_in_feed }}">
<label for="itemsInFeed">Items in Feed</label>
<span class="form-text">Set to &ldquo;0&rdquo; to use &ldquo;Posts per Page&rdquo; setting ({{ web_log.posts_per_page }})</span>
</div>
</div>
<div class="col-12 col-md-5 col-xl-4 pb-3">
<div class="form-floating">
<input type="text" name="Copyright" id="copyright" class="form-control" placeholder="Copyright String"
value="{{ rss_model.copyright }}">
<label for="copyright">Copyright String</label>
<span class="form-text">
Can be a
<a href="https://creativecommons.org/share-your-work/" target="_blank" rel="noopener">
Creative Commons license string
</a>
</span>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col text-center">
<button type="submit" class="btn btn-primary">Save Changes</button>
</div>
</div>
</div>
</form>
<fieldset class="container mb-3 pb-0">
<legend>Custom Feeds</legend>
<a class="btn btn-sm btn-secondary" href="{{ 'admin/settings/rss/new/edit' | relative_link }}">
Add a New Custom Feed
</a>
{%- assign feed_count = custom_feeds | size -%}
{%- if feed_count > 0 %}
<form method="post" class="container g-0" hx-target="body">
{%- assign source_col = "col-12 col-md-6" -%}
{%- assign path_col = "col-12 col-md-6" -%}
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row mwl-table-heading">
<div class="{{ source_col }}">
<span class="d-md-none">Feed</span><span class="d-none d-md-inline">Source</span>
</div>
<div class="{{ path_col }} d-none d-md-inline-block">Relative Path</div>
</div>
{% for feed in custom_feeds %}
<div class="row mwl-table-detail">
<div class="{{ source_col }}">
{{ feed.source }}
{%- if feed.is_podcast %} &nbsp; <span class="badge bg-primary">PODCAST</span>{% endif %}<br>
<small>
{%- assign feed_url = "admin/settings/rss/" | append: feed.id -%}
<a href="{{ feed.path | relative_link }}" target="_blank">View Feed</a>
<span class="text-muted"> &bull; </span>
<a href="{{ feed_url | append: "/edit" | relative_link }}">Edit</a>
<span class="text-muted"> &bull; </span>
{%- assign feed_del_link = feed_url | append: "/delete" | relative_link -%}
<a href="{{ feed_del_link }}" hx-post="{{ feed_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the custom RSS feed based on {{ feed.source | strip_html | escape }}? This action cannot be undone.">
Delete
</a>
</small>
</div>
<div class="{{ path_col }}">
<small class="d-md-none">Served at {{ feed.path }}</small>
<span class="d-none d-md-inline">{{ feed.path }}</span>
</div>
</div>
{%- endfor %}
</form>
{%- else %}
<p class="text-muted fst-italic text-center">No custom feeds defined</p>
{%- endif %}
</fieldset>
</fieldset>
<fieldset id="tag-mappings" class="container mb-3 pb-0">
<legend>Tag Mappings</legend>
<a href="{{ "admin/settings/tag-mapping/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3"
hx-target="#tag_new">
Add a New Tag Mapping
</a>
{{ tag_mapping_list }}
</fieldset>
</article>

View File

@@ -2,18 +2,18 @@
<form hx-post="{{ "admin/settings/tag-mapping/save" | relative_link }}" method="post" class="container"
hx-target="#tagList" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="id" value="{{ model.id }}">
<input type="hidden" name="Id" value="{{ model.id }}">
<div class="row mb-3">
<div class="col-6 col-lg-4 offset-lg-2">
<div class="form-floating">
<input type="text" name="tag" id="tag" class="form-control" placeholder="Tag" autofocus required
<input type="text" name="Tag" id="tag" class="form-control" placeholder="Tag" autofocus required
value="{{ model.tag }}">
<label for="tag">Tag</label>
</div>
</div>
<div class="col-6 col-lg-4">
<div class="form-floating">
<input type="text" name="urlValue" id="urlValue" class="form-control" placeholder="URL Value" required
<input type="text" name="UrlValue" id="urlValue" class="form-control" placeholder="URL Value" required
value="{{ model.url_value }}">
<label for="urlValue">URL Value</label>
</div>
@@ -22,7 +22,7 @@
<div class="row mb-3">
<div class="col text-center">
<button type="submit" class="btn btn-sm btn-primary">Save Changes</button>
<a href="{{ "admin/settings/tag-mappings/bare" | relative_link }}" class="btn btn-sm btn-secondary ms-3">
<a href="{{ "admin/settings/tag-mappings" | relative_link }}" class="btn btn-sm btn-secondary ms-3">
Cancel
</a>
</div>

View File

@@ -1,34 +1,45 @@
<form method="post" class="container" id="tagList" hx-target="this" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row mwl-table-detail" id="tag_new"></div>
{%- assign map_count = mappings | size -%}
{% if map_count > 0 -%}
{% for map in mappings -%}
{%- assign map_id = mapping_ids | value: map.tag -%}
<div class="row mwl-table-detail" id="tag_{{ map_id }}">
<div class="col no-wrap">
{{ map.tag }}<br>
<small>
{%- capture map_edit %}admin/settings/tag-mapping/{{ map_id }}/edit{% endcapture -%}
<a href="{{ map_edit | relative_link }}" hx-target="#tag_{{ map_id }}"
hx-swap="innerHTML show:#tag_{{ map_id }}:top">
Edit
</a>
<span class="text-muted"> &bull; </span>
{%- capture map_del %}admin/settings/tag-mapping/{{ map_id }}/delete{% endcapture -%}
{%- capture map_del_link %}{{ map_del | relative_link }}{% endcapture -%}
<a href="{{ map_del_link }}" hx-post="{{ map_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the mapping for &ldquo;{{ map.tag }}&rdquo;? This action cannot be undone.">
Delete
</a>
</small>
<div id="tagList" class="container">
<div class="row">
<div class="col">
{%- assign map_count = mappings | size -%}
{% if map_count > 0 -%}
<div class="container">
<div class="row mwl-table-heading">
<div class="col">Tag</div>
<div class="col">URL Value</div>
</div>
</div>
<div class="col">{{ map.url_value }}</div>
</div>
{%- endfor %}
{%- else -%}
<div class="row">
<div class="col text-muted text-center fst-italic">This web log has no tag mappings</div>
<form method="post" class="container" hx-target="#tagList" hx-swap="outerHTML">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row mwl-table-detail" id="tag_new"></div>
{% for map in mappings -%}
{%- assign map_id = mapping_ids | value: map.tag -%}
<div class="row mwl-table-detail" id="tag_{{ map_id }}">
<div class="col no-wrap">
{{ map.tag }}<br>
<small>
{%- assign map_url = "admin/settings/tag-mapping/" | append: map_id -%}
<a href="{{ map_url | append: "/edit" | relative_link }}" hx-target="#tag_{{ map_id }}"
hx-swap="innerHTML show:#tag_{{ map_id }}:top">
Edit
</a>
<span class="text-muted"> &bull; </span>
{%- assign map_del_link = map_url | append: "/delete" | relative_link -%}
<a href="{{ map_del_link }}" hx-post="{{ map_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the mapping for &ldquo;{{ map.tag }}&rdquo;? This action cannot be undone.">
Delete
</a>
</small>
</div>
<div class="col">{{ map.url_value }}</div>
</div>
{%- endfor %}
</form>
{%- else -%}
<div id="tag_new">
<p class="text-muted text-center fst-italic">This web log has no tag mappings</p>
</div>
{%- endif %}
</div>
{%- endif %}
</form>
</div>
</div>

View File

@@ -1,14 +0,0 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<a href="{{ "admin/settings/tag-mapping/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3"
hx-target="#tag_new">
Add a New Tag Mapping
</a>
<div class="container">
<div class="row mwl-table-heading">
<div class="col">Tag</div>
<div class="col">URL Value</div>
</div>
</div>
{{ tag_mapping_list }}
</article>

View File

@@ -0,0 +1,33 @@
<form method="post" id="themeList" class="container g-0" hx-target="this" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
{% include_template "_theme-list-columns" %}
{% for theme in themes -%}
<div class="row mwl-table-detail" id="theme_{{ theme.id }}">
<div class="{{ theme_col }} no-wrap">
{{ theme.name }}
{%- if theme.is_in_use %}
<span class="badge bg-primary ms-2">IN USE</span>
{%- endif %}
{%- unless theme.is_on_disk %}
<span class="badge bg-warning text-dark ms-2">NOT ON DISK</span>
{%- endunless %}<br>
<small>
<span class="text-muted">v{{ theme.version }}</span>
{% unless theme.is_in_use or theme.id == "default" %}
<span class="text-muted"> &bull; </span>
{%- assign theme_del_link = "admin/theme/" | append: theme.id | append: "/delete" | relative_link -%}
<a href="{{ theme_del_link }}" hx-post="{{ theme_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the theme &ldquo;{{ theme.name }}&rdquo;? This action cannot be undone.">
Delete
</a>
{% endunless %}
<span class="d-md-none text-muted">
<br>Slug: {{ theme.id }} &bull; {{ theme.template_count }} Templates
</span>
</small>
</div>
<div class="{{ slug_col }}">{{ theme.id }}</div>
<div class="{{ tmpl_col }}">{{ theme.template_count }}</div>
</div>
{%- endfor %}
</form>

View File

@@ -0,0 +1,30 @@
<div class="col">
<h5 class="mt-2">{{ page_title }}</h5>
<form action="{{ "admin/theme/new" | 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-sm-6 pb-3">
<div class="form-floating">
<input type="file" id="file" name="file" class="form-control" accept=".zip" placeholder="Theme File" required>
<label for="file">Theme File</label>
</div>
</div>
<div class="col-12 col-sm-6 pb-3 d-flex justify-content-center align-items-center">
<div class="form-check form-switch pb-2">
<input type="checkbox" name="DoOverwrite" id="doOverwrite" class="form-check-input" value="true">
<label for="doOverwrite" class="form-check-label">Overwrite</label>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col text-center">
<button type="submit" class="btn btn-sm btn-primary">Upload Theme</button>
<button type="button" class="btn btn-sm btn-secondary ms-3"
onclick="document.getElementById('theme_new').innerHTML = ''">
Cancel
</button>
</div>
</div>
</form>
</div>

View File

@@ -0,0 +1,76 @@
<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-center"><em class="text-muted">Uploaded files served from</em><br>{{ upload_base }}</div>
</div>
{%- assign file_count = files | size -%}
{%- if file_count > 0 %}
<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>
{% 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 -%}
{%- assign path_and_name = file.path | append: file.name -%}
{%- assign blog_rel = upload_path | append: path_and_name -%}
<span class="badge bg-{{ badge_class }} text-uppercase float-end mt-1">{{ file.source }}</span>
{{ file.name }}<br>
<small>
<a href="{{ upload_base | append: path_and_name }}" target="_blank">View File</a>
<span class="text-muted"> &bull; Copy </span>
<a href="{{ blog_rel | absolute_link }}" hx-boost="false"
onclick="return Admin.copyText('{{ blog_rel | absolute_link }}', this)">
Absolute
</a>
<span class="text-muted"> | </span>
<a href="{{ blog_rel | relative_link }}" hx-boost="false"
onclick="return Admin.copyText('{{ blog_rel | relative_link }}', this)">
Relative
</a>
{%- unless base_url == "/" %}
<span class="text-muted"> | </span>
<a href="{{ blog_rel }}" hx-boost="false"
onclick="return Admin.copyText('/{{ blog_rel }}', this)">
For Post
</a>
{%- endunless %}
<span class="text-muted"> Link</span>
{% if is_web_log_admin %}
<span class="text-muted"> &bull; </span>
{%- capture delete_url -%}
{%- if file.source == "Disk" -%}
admin/upload/delete/{{ path_and_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>
{% endif %}
</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"><br>This web log has uploaded files</div>
</div>
{%- endif %}
</form>
</article>

View File

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

View File

@@ -1,26 +0,0 @@
<h2>Upload a Theme</h2>
<article>
<form action="{{ "admin/theme/update" | 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-sm-6 offset-sm-3 pb-3">
<div class="form-floating">
<input type="file" id="file" name="file" class="form-control" accept=".zip" placeholder="Theme File" required>
<label for="file">Theme File</label>
</div>
</div>
<div class="col-12 col-sm-6 pb-3">
<div class="form-check form-switch pb-2">
<input type="checkbox" name="clean" id="clean" class="form-check-input" value="true">
<label for="clean" class="form-check-label">Delete Existing Theme Files</label>
</div>
</div>
</div>
<div class="row pb-3">
<div class="col text-center">
<button type="submit" class="btn btn-primary">Upload Theme</button>
</div>
</div>
</form>
</article>

View File

@@ -1,64 +1,102 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="{{ "admin/user/save" | relative_link }}" method="post">
<div class="col-12">
<h5 class="my-3">{{ page_title }}</h5>
<form hx-post="{{ "admin/settings/user/save" | relative_link }}" method="post" class="container"
hx-target="#userList" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="container">
<div class="row mb-3">
<div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="firstName" id="firstName" class="form-control" autofocus required
placeholder="First" value="{{ model.first_name }}">
<label for="firstName">First Name</label>
</div>
</div>
<div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="lastName" id="lastName" class="form-control" required
placeholder="Last" value="{{ model.last_name }}">
<label for="lastName">Last Name</label>
</div>
</div>
<div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="preferredName" id="preferredName" class="form-control" required
placeholder="Preferred" value="{{ model.preferred_name }}">
<label for="preferredName">Preferred Name</label>
</div>
<input type="hidden" name="Id" value="{{ model.id }}">
<div class="row">
<div class="col-12 col-md-5 col-lg-3 col-xxl-2 offset-xxl-1 mb-3">
<div class="form-floating">
<select name="AccessLevel" id="accessLevel" class="form-control" required autofocus>
{%- for level in access_levels %}
<option value="{{ level[0] }}"{% if model.access_level == level[0] %} selected{% endif %}>
{{ level[1] }}
</option>
{%- endfor %}
</select>
<label for="accessLevel">Access Level</label>
</div>
</div>
<div class="row mb-3">
<div class="col">
<fieldset class="container">
<legend>Change Password</legend>
<div class="row">
<div class="col">
<p class="form-text">Optional; leave blank to keep your current password</p>
</div>
</div>
<div class="row">
<div class="col-12 col-md-6 pb-3">
<div class="form-floating">
<input type="password" name="newPassword" id="newPassword" class="form-control"
placeholder="Password">
<label for="newPassword">New Password</label>
</div>
</div>
<div class="col-12 col-md-6 pb-3">
<div class="form-floating">
<input type="password" name="newPasswordConfirm" id="newPasswordConfirm" class="form-control"
placeholder="Confirm">
<label for="newPasswordConfirm">Confirm New Password</label>
</div>
</div>
</div>
</fieldset>
<div class="col-12 col-md-7 col-lg-4 col-xxl-3 mb-3">
<div class="form-floating">
<input type="email" name="Email" id="email" class="form-control" placeholder="E-mail" required
value="{{ model.email | escape }}">
<label for="email">E-mail Address</label>
</div>
</div>
<div class="row">
<div class="col text-center mb-3">
<button type="submit" class="btn btn-primary">Save Changes</button>
<div class="col-12 col-lg-5 mb-3">
<div class="form-floating">
<input type="text" name="Url" id="url" class="form-control" placeholder="URL"
value="{{ model.url | escape }}">
<label for="url">User&rsquo;s Personal URL</label>
</div>
</div>
</div>
<div class="row mb-3">
<div class="col-12 col-md-6 col-lg-4 col-xl-3 offset-xl-1 pb-3">
<div class="form-floating">
<input type="text" name="FirstName" id="firstName" class="form-control" placeholder="First" required
value="{{ model.first_name | escape }}">
<label for="firstName">First Name</label>
</div>
</div>
<div class="col-12 col-md-6 col-lg-4 col-xl-3 pb-3">
<div class="form-floating">
<input type="text" name="LastName" id="lastName" class="form-control" placeholder="Last" required
value="{{ model.last_name | escape }}">
<label for="lastName">Last Name</label>
</div>
</div>
<div class="col-12 col-md-6 offset-md-3 col-lg-4 offset-lg-0 col-xl-3 offset-xl-1 pb-3">
<div class="form-floating">
<input type="text" name="PreferredName" id="preferredName" class="form-control"
placeholder="Preferred" required value="{{ model.preferred_name | escape }}">
<label for="preferredName">Preferred Name</label>
</div>
</div>
</div>
<div class="row mb-3">
<div class="col-12 col-xl-10 offset-xl-1">
<fieldset class="p-2">
<legend class="ps-1">{% unless model.is_new %}Change {% endunless %}Password</legend>
{% unless model.is_new %}
<div class="row">
<div class="col">
<p class="form-text">Optional; leave blank not change the user&rsquo;s password</p>
</div>
</div>
{% endunless %}
<div class="row">
<div class="col-12 col-md-6 pb-3">
<div class="form-floating">
<input type="password" name="Password" id="password" class="form-control"
placeholder="Password"{% if model.is_new %} required{% endif %}>
<label for="password">{% unless model.is_new %}New {% endunless %}Password</label>
</div>
</div>
<div class="col-12 col-md-6 pb-3">
<div class="form-floating">
<input type="password" name="PasswordConfirm" id="passwordConfirm" class="form-control"
placeholder="Confirm"{% if model.is_new %} required{% endif %}>
<label for="passwordConfirm">Confirm{% unless model.is_new %} New{% endunless %} Password</label>
</div>
</div>
</div>
</fieldset>
</div>
</div>
<div class="row mb-3">
<div class="col text-center">
<button type="submit" class="btn btn-sm btn-primary">Save Changes</button>
{% if model.is_new %}
<button type="button" class="btn btn-sm btn-secondary ms-3"
onclick="document.getElementById('user_new').innerHTML = ''">
Cancel
</button>
{% else %}
<a href="{{ "admin/settings/users" | relative_link }}" class="btn btn-sm btn-secondary ms-3">Cancel</a>
{% endif %}
</div>
</div>
</form>
</article>
</div>

View File

@@ -0,0 +1,61 @@
<div id="userList">
<div class="container g-0">
<div class="row mwl-table-detail" id="user_new"></div>
</div>
<form method="post" id="userList" class="container g-0" hx-target="this" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
{% include_template "_user-list-columns" %}
{%- assign badge = "ms-2 badge bg" -%}
{% for user in users -%}
<div class="row mwl-table-detail" id="user_{{ user.id }}">
<div class="{{ user_col }} no-wrap">
{{ user.preferred_name }}
{%- if user.access_level == "Administrator" %}
<span class="{{ badge }}-success">ADMINISTRATOR</span>
{%- elsif user.access_level == "WebLogAdmin" %}
<span class="{{ badge }}-primary">WEB LOG ADMIN</span>
{%- elsif user.access_level == "Editor" %}
<span class="{{ badge }}-secondary">EDITOR</span>
{%- elsif user.access_level == "Author" %}
<span class="{{ badge }}-dark">AUTHOR</span>
{%- endif %}<br>
{%- unless is_administrator == false and user.access_level == "Administrator" %}
<small>
{%- assign user_url_base = "admin/settings/user/" | append: user.id -%}
<a href="{{ user_url_base | append: "/edit" | relative_link }}" hx-target="#user_{{ user.id }}"
hx-swap="innerHTML show:#user_{{ user.id }}:top">
Edit
</a>
{% unless user_id == user.id %}
<span class="text-muted"> &bull; </span>
{%- assign user_del_link = user_url_base | append: "/delete" | relative_link -%}
<a href="{{ user_del_link }}" hx-post="{{ user_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the user &ldquo;{{ user.preferred_name }}&rdquo;? This action cannot be undone. (This action will not succeed if the user has authored any posts or pages.)">
Delete
</a>
{% endunless %}
</small>
{%- endunless %}
</div>
<div class="{{ email_col }}">
{{ user.first_name }} {{ user.last_name }}<br>
<small class="text-muted">
{{ user.email }}
{%- unless user.url == "" %}<br>{{ user.url }}{% endunless %}
</small>
</div>
<div class="{{ cre8_col }}">
{{ user.created_on | date: "MMMM d, yyyy" }}
</div>
<div class="{{ last_col }}">
{% if user.last_seen_on %}
{{ user.last_seen_on | date: "MMMM d, yyyy" }} at
{{ user.last_seen_on | date: "h:mmtt" | downcase }}
{% else %}
--
{% endif %}
</div>
</div>
{%- endfor %}
</form>
</div>

View File

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

View File

@@ -29,7 +29,6 @@ header nav {
footer {
background-color: #808080;
border-top: solid 1px black;
color: white;
}
.messages {
max-width: 60rem;
@@ -85,3 +84,34 @@ 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;
}
.load-overlay {
display: none;
position: fixed;
top: 55px;
left: 0;
z-index: 100;
width: 100%;
height: 100%;
background-color: rgba(0, 0, 0, .1);
transition: ease-in-out .5s;
}
.load-overlay h1 {
background-color: rgba(204, 204, 0, .95);
height: fit-content;
border: solid 6px darkgreen;
border-radius: 2rem;
}
.load-overlay.htmx-request {
display: flex;
flex-flow: row;
}
#toastHost {
z-index: 5;
}

View File

@@ -1,13 +1,22 @@
const Admin = {
/** The next index for a metadata item */
/**
* Support functions for the administrative UI
*/
this.Admin = {
/**
* The next index for a metadata item
* @type {number}
*/
nextMetaIndex : 0,
/** The next index for a permalink */
/**
* The next index for a permalink
* @type {number}
*/
nextPermalink : 0,
/**
* Set the next meta item index
* @param idx The index to set
* @param {number} idx The index to set
*/
setNextMetaIndex(idx) {
this.nextMetaIndex = idx
@@ -15,7 +24,7 @@
/**
* Set the next permalink index
* @param idx The index to set
* @param {number} idx The index to set
*/
setPermalinkIndex(idx) {
this.nextPermalink = idx
@@ -47,7 +56,7 @@
const nameField = document.createElement("input")
nameField.type = "text"
nameField.name = "metaNames"
nameField.name = "MetaNames"
nameField.id = `metaNames_${this.nextMetaIndex}`
nameField.className = "form-control"
nameField.placeholder = "Name"
@@ -85,7 +94,7 @@
const valueField = document.createElement("input")
valueField.type = "text"
valueField.name = "metaValues"
valueField.name = "MetaValues"
valueField.id = `metaValues_${this.nextMetaIndex}`
valueField.className = "form-control"
valueField.placeholder = "Value"
@@ -173,7 +182,7 @@
// Link
const linkField = document.createElement("input")
linkField.type = "text"
linkField.name = "prior"
linkField.name = "Prior"
linkField.id = `prior_${this.nextPermalink}`
linkField.className = "form-control"
linkField.placeholder = "Link"
@@ -204,42 +213,38 @@
},
/**
* Add podcast episode metadata fields
* Enable or disable podcast fields
*/
addPodcastFields() {
[ [ "episode_media_file", true, "required; relative URL will be appended to configured base media path" ],
[ "episode_media_length", true, "required; file size in bytes" ],
[ "episode_duration", false, "suggested; format is HH:MM:SS" ],
[ "episode_media_type", false, "optional; blank uses podcast default" ],
[ "episode_image", false, "optional; relative URLs are served from this web log" ],
[ "episode_subtitle", false, "optional" ],
[ "episode_explicit", false, "optional; blank uses podcast default"]
].forEach(([fieldName, isRequired, hintText]) => {
const nameField = this.createMetaNameField()
nameField.value = fieldName
nameField.readOnly = true
const valueField = this.createMetaValueField()
valueField.required = isRequired
this.createMetaRow(
this.createMetaRemoveColumn(),
this.createMetaNameColumn(nameField),
this.createMetaValueColumn(valueField, hintText))
})
document.getElementById("addPodcastFieldButton").remove()
toggleEpisodeFields() {
const disabled = !document.getElementById("isEpisode").checked
;[ "media", "mediaType", "length", "duration", "subtitle", "imageUrl", "explicit", "chapterFile", "chapterType",
"transcriptUrl", "transcriptType", "transcriptLang", "transcriptCaptions", "seasonNumber", "seasonDescription",
"episodeNumber", "episodeDescription"
].forEach(it => document.getElementById(it).disabled = disabled)
},
/**
* Check to enable or disable podcast fields
*/
checkPodcast() {
document.getElementById("podcastFields").disabled = !document.getElementById("isPodcast").checked
},
/**
* Copy text to the clipboard
* @param {string} text The text to be copied
* @param {HTMLAnchorElement} elt The element on which the click was generated
* @return {boolean} False, to prevent navigation
*/
copyText(text, elt) {
navigator.clipboard.writeText(text)
elt.innerText = "Copied"
return false
},
/**
* Toggle the source of a custom RSS feed
* @param source The source that was selected
* @param {string} source The source that was selected
*/
customFeedBy(source) {
const categoryInput = document.getElementById("sourceValueCat")
@@ -257,7 +262,7 @@
/**
* Remove a metadata item
* @param idx The index of the metadata item to remove
* @param {number} idx The index of the metadata item to remove
*/
removeMetaItem(idx) {
document.getElementById(`meta_${idx}`).remove()
@@ -265,15 +270,22 @@
/**
* Remove a permalink
* @param idx The index of the permalink to remove
* @param {number} idx The index of the permalink to remove
*/
removePermalink(idx) {
document.getElementById(`link_${idx}`).remove()
},
/**
* Require transcript type if transcript URL is present
*/
requireTranscriptType() {
document.getElementById("transcriptType").required = document.getElementById("transcriptUrl").value.trim() !== ""
},
/**
* Show messages that may have come with an htmx response
* @param messages The messages from the response
* @param {string} messages The messages from the response
*/
showMessage(messages) {
const msgs = messages.split(", ")
@@ -281,42 +293,84 @@
const parts = msg.split("|||")
if (parts.length < 2) return
const msgDiv = document.createElement("div")
msgDiv.className = `alert alert-${parts[0]} alert-dismissible fade show`
msgDiv.setAttribute("role", "alert")
msgDiv.innerHTML = parts[1]
// Create the toast header
const toastType = document.createElement("strong")
toastType.className = "me-auto text-uppercase"
toastType.innerText = parts[0] === "danger" ? "error" : parts[0]
const closeBtn = document.createElement("button")
closeBtn.type = "button"
closeBtn.className = "btn-close"
closeBtn.setAttribute("data-bs-dismiss", "alert")
closeBtn.setAttribute("data-bs-dismiss", "toast")
closeBtn.setAttribute("aria-label", "Close")
msgDiv.appendChild(closeBtn)
const toastHead = document.createElement("div")
toastHead.className = `toast-header bg-${parts[0]}${parts[0] === "warning" ? "" : " text-white"}`
toastHead.appendChild(toastType)
toastHead.appendChild(closeBtn)
// Create the toast body
const toastBody = document.createElement("div")
toastBody.className = `toast-body bg-${parts[0]} bg-opacity-25`
toastBody.innerHTML = parts[1]
if (parts.length === 3) {
msgDiv.innerHTML += `<hr>${parts[2]}`
toastBody.innerHTML += `<hr>${parts[2]}`
}
document.getElementById("msgContainer").appendChild(msgDiv)
// Assemble the toast
const toast = document.createElement("div")
toast.className = "toast"
toast.setAttribute("role", "alert")
toast.setAttribute("aria-live", "assertive")
toast.setAttribute("aria-atomic", "true")
toast.appendChild(toastHead)
toast.appendChild(toastBody)
document.getElementById("toasts").appendChild(toast)
let options = { delay: 4000 }
if (parts[0] !== "success") options.autohide = false
const theToast = new bootstrap.Toast(toast, options)
theToast.show()
})
},
/**
* Set all "success" alerts to close after 4 seconds
* Initialize any toasts that were pre-rendered from the server
*/
dismissSuccesses() {
[...document.querySelectorAll(".alert-success")].forEach(alert => {
setTimeout(() => {
(bootstrap.Alert.getInstance(alert) ?? new bootstrap.Alert(alert)).close()
}, 4000)
showPreRenderedMessages() {
[...document.querySelectorAll(".toast")].forEach(el => {
if (el.getAttribute("data-mwl-shown") === "true" && el.className.indexOf("hide") >= 0) {
document.removeChild(el)
} else {
const toast = new bootstrap.Toast(el,
el.getAttribute("data-bs-autohide") === "false"
? { autohide: false } : { delay: 6000, autohide: true })
toast.show()
el.setAttribute("data-mwl-shown", "true")
}
})
}
}
htmx.on("htmx:afterOnLoad", function (evt) {
const hdrs = evt.detail.xhr.getAllResponseHeaders()
// Initialize any toasts that were pre-rendered from the server
Admin.showPreRenderedMessages()
// Show messages if there were any in the response
if (hdrs.indexOf("x-message") >= 0) {
Admin.showMessage(evt.detail.xhr.getResponseHeader("x-message"))
Admin.dismissSuccesses()
}
})
})
htmx.on("htmx:responseError", function (evt) {
const xhr = evt.detail.xhr
const hdrs = xhr.getAllResponseHeaders()
// Show an error message if there were none in the response
if (hdrs.indexOf("x-message") < 0) {
Admin.showMessage(`danger|||${xhr.status}: ${xhr.statusText}`)
}
})
document.addEventListener("DOMContentLoaded", Admin.showPreRenderedMessages, { once: true})

View File

@@ -1,56 +1,60 @@
{%- if is_category or is_tag %}
<h1 class="index-title">{{ page_title }}</h1>
{%- if is_category %}
{%- assign cat = categories | where: "slug", slug | first -%}
{%- if cat.description %}<h4 class="text-muted">{{ cat.description.value }}</h4>{% endif -%}
{%- endif %}
{%- endif %}
<section class="container mt-3" aria-label="The posts for the page">
{% for post in model.posts %}
<article>
<h1>
<a href="{{ post | relative_link }}" title="Permanent link to &quot;{{ post.title | escape }}&quot;">
{{ post.title }}
</a>
</h1>
<p>
Published on {{ post.published_on | date: "MMMM d, yyyy" }}
at {{ post.published_on | date: "h:mmtt" | downcase }}
by {{ model.authors | value: post.author_id }}
</p>
{{ post.text }}
{%- assign category_count = post.category_ids | size -%}
{%- assign tag_count = post.tags | size -%}
{% if category_count > 0 or tag_count > 0 %}
<footer>
<p>
{%- if category_count > 0 -%}
Categorized under:
{% for cat in post.category_ids -%}
{%- assign this_cat = categories | where: "id", cat | first -%}
{{ this_cat.name }}{% unless forloop.last %}, {% endunless %}
{%- assign cat_names = this_cat.name | concat: cat_names -%}
{%- endfor -%}
{%- assign cat_names = "" -%}
<br>
{% endif -%}
{%- if tag_count > 0 %}
Tagged: {{ post.tags | join: ", " }}
{% endif -%}
</p>
</footer>
{%- if subtitle %}<h4 class="text-muted">{{ subtitle }}</h4>{% endif -%}
{% endif %}
{%- assign post_count = model.posts | size -%}
{%- if post_count > 0 %}
<section class="container mt-3" aria-label="The posts for the page">
{%- for post in model.posts %}
<article>
<h1>
<a href="{{ post | relative_link }}" title="Permanent link to &quot;{{ post.title | escape }}&quot;">
{{ post.title }}
</a>
</h1>
<p>
Published on {{ post.published_on | date: "MMMM d, yyyy" }}
at {{ post.published_on | date: "h:mmtt" | downcase }}
by {{ model.authors | value: post.author_id }}
</p>
{{ post.text }}
{%- assign category_count = post.category_ids | size -%}
{%- assign tag_count = post.tags | size -%}
{% if category_count > 0 or tag_count > 0 %}
<footer>
<p>
{%- if category_count > 0 -%}
Categorized under:
{% for cat in post.category_ids -%}
{%- assign this_cat = categories | where: "Id", cat | first -%}
{{ this_cat.name }}{% unless forloop.last %}, {% endunless %}
{%- assign cat_names = this_cat.name | concat: cat_names -%}
{%- endfor -%}
{%- assign cat_names = "" -%}
<br>
{% endif -%}
{%- if tag_count > 0 %}
Tagged: {{ post.tags | join: ", " }}
{% endif -%}
</p>
</footer>
{% endif %}
<hr>
</article>
{% endfor %}
</section>
<nav aria-label="pagination">
<ul class="pagination justify-content-evenly mt-2">
{% if model.newer_link -%}
<li class="page-item"><a class="page-link" href="{{ model.newer_link.value }}">&laquo; Newer Posts</a></li>
{% endif %}
<hr>
</article>
{% endfor %}
</section>
<nav aria-label="pagination">
<ul class="pagination justify-content-evenly mt-2">
{% if model.newer_link -%}
<li class="page-item"><a class="page-link" href="{{ model.newer_link.value }}">&laquo; Newer Posts</a></li>
{% endif %}
{% if model.older_link -%}
<li class="page-item"><a class="page-link" href="{{ model.older_link.value }}">Older Posts &raquo;</a></li>
{%- endif -%}
</ul>
</nav>
{% if model.older_link -%}
<li class="page-item"><a class="page-link" href="{{ model.older_link.value }}">Older Posts &raquo;</a></li>
{%- endif -%}
</ul>
</nav>
{%- else %}
<article>
<p class="text-center mt-3">No posts found</p>
</article>
{%- endif %}

View File

@@ -3,8 +3,8 @@
<head>
<meta charset="utf-8">
<meta name="viewport" content="width=device-width">
<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css"
integrity="sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" crossorigin="anonymous">
<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@5.1.3/dist/css/bootstrap.min.css"
integrity="sha384-1BmE4kWBq78iYhFldvKuhfTAU6auU8tT94WrHftjDbrCEXSU1oBoqyl2QvZ6jIW3" crossorigin="anonymous">
<title>{{ page_title | strip_html }}{% if page_title %} &laquo; {% endif %}{{ web_log.name | strip_html }}</title>
{% page_head -%}
</head>
@@ -55,8 +55,8 @@
<img src="{{ "themes/admin/logo-dark.png" | relative_link }}" alt="myWebLog" width="120" height="34">
</div>
</footer>
<script src="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js"
integrity="sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM"
<script src="https://cdn.jsdelivr.net/npm/bootstrap@5.1.3/dist/js/bootstrap.bundle.min.js"
integrity="sha384-ka7Sk0Gln4gmtz2MlQnikT1wXgYsOg+OMhuP+IlRH9sENBO0LRn5q+8nbTov4+1p"
crossorigin="anonymous"></script>
</body>
</html>

View File

@@ -8,7 +8,9 @@
**DRAFT**
{% endif %}
by {{ model.authors | value: post.author_id }}
{% if logged_on %} &bull; <a hx-boost="false" href="{{ post | edit_post_link }}">Edit Post</a> {% endif %}
{%- if is_editor or is_author and user_id == post.author_id %}
&bull; <a hx-boost="false" href="{{ post | edit_post_link }}">Edit Post</a>
{%- endif %}
</h4>
<div>
<article class="container mt-3">
@@ -18,7 +20,7 @@
<h4 class="item-meta text-muted">
Categorized under
{% for cat_id in post.category_ids -%}
{% assign cat = categories | where: "id", cat_id | first %}
{% assign cat = categories | where: "Id", cat_id | first %}
<span class="text-nowrap">
<a href="{{ cat | category_link }}" title="Categorized under &ldquo;{{ cat.name | escape }}&rdquo;">
{{ cat.name }}

View File

@@ -1,2 +1,2 @@
myWebLog Default Theme
2.0.0-alpha36
2.0.0