bit-badger/myWebLog
1
0
Fork 0
Code Issues 3 Pull Requests Packages Projects Releases 11 Activity

V2 #36

Merged
danieljsummers merged 17 commits from v2-out-the-door into main 2023-02-26 18:01:21 +00:00
Conversation 0 Commits 17 Files Changed 36 +1174 -1963
36 changed files with 1174 additions and 1963 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
.config/dotnet-tools.json
View File

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

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>

147
build.fsx
View File

@ -1,147 +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"
!! $"{path}/**/*"
|> Zip.filesAsSpecs path
|> Seq.filter (fun (_, name) -> not (name.EndsWith ".zip"))
|> Zip.zipSpec $"{releasePath}/{name}-theme.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"
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}.{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"
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}.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
"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"

227
build.fsx.lock
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))

2
fake.cmd
View File

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

7
fake.sh
View File

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

3
src/Directory.Build.props
View File

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

1
src/MyWebLog.Data/Converters.fs
View File

@ -165,6 +165,7 @@ module Json =
Converters = ser.Converters, Converters = ser.Converters,
DefaultValueHandling = ser.DefaultValueHandling, DefaultValueHandling = ser.DefaultValueHandling,
DateFormatHandling = ser.DateFormatHandling, DateFormatHandling = ser.DateFormatHandling,
DateParseHandling = ser.DateParseHandling,
MetadataPropertyHandling = ser.MetadataPropertyHandling, MetadataPropertyHandling = ser.MetadataPropertyHandling,
MissingMemberHandling = ser.MissingMemberHandling, MissingMemberHandling = ser.MissingMemberHandling,
NullValueHandling = ser.NullValueHandling, NullValueHandling = ser.NullValueHandling,

19
src/MyWebLog.Data/MyWebLog.Data.fsproj
View File

@ -5,19 +5,16 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.8" /> <PackageReference Include="BitBadger.Npgsql.FSharp.Documents" Version="1.0.0-beta2" />
<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="6.0.0" /> <PackageReference Include="Microsoft.Data.Sqlite" Version="7.0.3" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" /> <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="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" Version="3.1.2" /> <PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.1" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" /> <PackageReference Include="Npgsql.NodaTime" Version="7.0.2" />
<PackageReference Include="Npgsql" Version="6.0.6" />
<PackageReference Include="Npgsql.FSharp" Version="5.3.0" />
<PackageReference Include="Npgsql.NodaTime" Version="6.0.6" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" /> <PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" /> <PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
@ -45,7 +42,7 @@
<Compile Include="Postgres\PostgresUploadData.fs" /> <Compile Include="Postgres\PostgresUploadData.fs" />
<Compile Include="Postgres\PostgresWebLogData.fs" /> <Compile Include="Postgres\PostgresWebLogData.fs" />
<Compile Include="Postgres\PostgresWebLogUserData.fs" /> <Compile Include="Postgres\PostgresWebLogUserData.fs" />
<Compile Include="PostgresData.fs" /> <Compile Include="PostgresData.fs" />
</ItemGroup> </ItemGroup>
</Project> </Project>

113
src/MyWebLog.Data/Postgres/PostgresCache.fs
View File

@ -2,6 +2,7 @@ namespace MyWebLog.Data.Postgres
open System.Threading open System.Threading
open System.Threading.Tasks open System.Threading.Tasks
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Caching.Distributed open Microsoft.Extensions.Caching.Distributed
open NodaTime open NodaTime
open Npgsql.FSharp open Npgsql.FSharp
@ -40,32 +41,26 @@ module private Helpers =
/// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog /// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog
type DistributedCache (connStr : string) = type DistributedCache () =
// ~~~ INITIALIZATION ~~~ // ~~~ INITIALIZATION ~~~
do do
task { task {
let! exists = let! exists =
Sql.connect connStr Custom.scalar
|> Sql.query $" $"SELECT EXISTS
SELECT EXISTS
(SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session') (SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session')
AS {existsName}" AS {existsName}" [] Map.toExists
|> Sql.executeRowAsync Map.toExists
if not exists then if not exists then
let! _ = do! Custom.nonQuery
Sql.connect connStr
|> Sql.query
"CREATE TABLE session ( "CREATE TABLE session (
id TEXT NOT NULL PRIMARY KEY, id TEXT NOT NULL PRIMARY KEY,
payload BYTEA NOT NULL, payload BYTEA NOT NULL,
expire_at TIMESTAMPTZ NOT NULL, expire_at TIMESTAMPTZ NOT NULL,
sliding_expiration INTERVAL, sliding_expiration INTERVAL,
absolute_expiration TIMESTAMPTZ); absolute_expiration TIMESTAMPTZ);
CREATE INDEX idx_session_expiration ON session (expire_at)" CREATE INDEX idx_session_expiration ON session (expire_at)" []
|> Sql.executeNonQueryAsync
()
} |> sync } |> sync
// ~~~ SUPPORT FUNCTIONS ~~~ // ~~~ SUPPORT FUNCTIONS ~~~
@ -74,16 +69,13 @@ type DistributedCache (connStr : string) =
let getEntry key = backgroundTask { let getEntry key = backgroundTask {
let idParam = "@id", Sql.string key let idParam = "@id", Sql.string key
let! tryEntry = let! tryEntry =
Sql.connect connStr Custom.single "SELECT * FROM session WHERE id = @id" [ idParam ]
|> Sql.query "SELECT * FROM session WHERE id = @id" (fun row ->
|> Sql.parameters [ idParam ] { Id = row.string "id"
|> Sql.executeAsync (fun row -> Payload = row.bytea "payload"
{ Id = row.string "id" ExpireAt = row.fieldValue<Instant> "expire_at"
Payload = row.bytea "payload" SlidingExpiration = row.fieldValueOrNone<Duration> "sliding_expiration"
ExpireAt = row.fieldValue<Instant> "expire_at" AbsoluteExpiration = row.fieldValueOrNone<Instant> "absolute_expiration" })
SlidingExpiration = row.fieldValueOrNone<Duration> "sliding_expiration"
AbsoluteExpiration = row.fieldValueOrNone<Instant> "absolute_expiration" })
|> tryHead
match tryEntry with match tryEntry with
| Some entry -> | Some entry ->
let now = getNow () let now = getNow ()
@ -96,11 +88,8 @@ type DistributedCache (connStr : string) =
true, { entry with ExpireAt = absExp } true, { entry with ExpireAt = absExp }
else true, { entry with ExpireAt = now.Plus slideExp } else true, { entry with ExpireAt = now.Plus slideExp }
if needsRefresh then if needsRefresh then
let! _ = do! Custom.nonQuery "UPDATE session SET expire_at = @expireAt WHERE id = @id"
Sql.connect connStr [ expireParam item.ExpireAt; idParam ]
|> Sql.query "UPDATE session SET expire_at = @expireAt WHERE id = @id"
|> Sql.parameters [ expireParam item.ExpireAt; idParam ]
|> Sql.executeNonQueryAsync
() ()
return if item.ExpireAt > now then Some entry else None return if item.ExpireAt > now then Some entry else None
| None -> return None | None -> return None
@ -113,26 +102,16 @@ type DistributedCache (connStr : string) =
let purge () = backgroundTask { let purge () = backgroundTask {
let now = getNow () let now = getNow ()
if lastPurge.Plus (Duration.FromMinutes 30L) < now then if lastPurge.Plus (Duration.FromMinutes 30L) < now then
let! _ = do! Custom.nonQuery "DELETE FROM session WHERE expire_at < @expireAt" [ expireParam now ]
Sql.connect connStr
|> Sql.query "DELETE FROM session WHERE expire_at < @expireAt"
|> Sql.parameters [ expireParam now ]
|> Sql.executeNonQueryAsync
lastPurge <- now lastPurge <- now
} }
/// Remove a cache entry /// Remove a cache entry
let removeEntry key = backgroundTask { let removeEntry key =
let! _ = Delete.byId "session" key
Sql.connect connStr
|> Sql.query "DELETE FROM session WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string key ]
|> Sql.executeNonQueryAsync
()
}
/// Save an entry /// Save an entry
let saveEntry (opts : DistributedCacheEntryOptions) key payload = backgroundTask { let saveEntry (opts : DistributedCacheEntryOptions) key payload =
let now = getNow () let now = getNow ()
let expireAt, slideExp, absExp = let expireAt, slideExp, absExp =
if opts.SlidingExpiration.HasValue then if opts.SlidingExpiration.HasValue then
@ -148,27 +127,21 @@ type DistributedCache (connStr : string) =
// Default to 1 hour sliding expiration // Default to 1 hour sliding expiration
let slide = Duration.FromHours 1 let slide = Duration.FromHours 1
now.Plus slide, Some slide, None now.Plus slide, Some slide, None
let! _ = Custom.nonQuery
Sql.connect connStr "INSERT INTO session (
|> Sql.query id, payload, expire_at, sliding_expiration, absolute_expiration
"INSERT INTO session ( ) VALUES (
id, payload, expire_at, sliding_expiration, absolute_expiration @id, @payload, @expireAt, @slideExp, @absExp
) VALUES ( ) ON CONFLICT (id) DO UPDATE
@id, @payload, @expireAt, @slideExp, @absExp SET payload = EXCLUDED.payload,
) ON CONFLICT (id) DO UPDATE expire_at = EXCLUDED.expire_at,
SET payload = EXCLUDED.payload, sliding_expiration = EXCLUDED.sliding_expiration,
expire_at = EXCLUDED.expire_at, absolute_expiration = EXCLUDED.absolute_expiration"
sliding_expiration = EXCLUDED.sliding_expiration, [ "@id", Sql.string key
absolute_expiration = EXCLUDED.absolute_expiration" "@payload", Sql.bytea payload
|> Sql.parameters expireParam expireAt
[ "@id", Sql.string key optParam "slideExp" slideExp
"@payload", Sql.bytea payload optParam "absExp" absExp ]
expireParam expireAt
optParam "slideExp" slideExp
optParam "absExp" absExp ]
|> Sql.executeNonQueryAsync
()
}
// ~~~ IMPLEMENTATION FUNCTIONS ~~~ // ~~~ IMPLEMENTATION FUNCTIONS ~~~
@ -200,11 +173,11 @@ type DistributedCache (connStr : string) =
} }
interface IDistributedCache with interface IDistributedCache with
member this.Get key = get key CancellationToken.None |> sync member _.Get key = get key CancellationToken.None |> sync
member this.GetAsync (key, token) = get key token member _.GetAsync (key, token) = get key token
member this.Refresh key = refresh key CancellationToken.None |> sync member _.Refresh key = refresh key CancellationToken.None |> sync
member this.RefreshAsync (key, token) = refresh key token member _.RefreshAsync (key, token) = refresh key token
member this.Remove key = remove key CancellationToken.None |> sync member _.Remove key = remove key CancellationToken.None |> sync
member this.RemoveAsync (key, token) = remove key token member _.RemoveAsync (key, token) = remove key token
member this.Set (key, value, options) = set key value options CancellationToken.None |> sync member _.Set (key, value, options) = set key value options CancellationToken.None |> sync
member this.SetAsync (key, value, options, token) = set key value options token member _.SetAsync (key, value, options, token) = set key value options token

153
src/MyWebLog.Data/Postgres/PostgresCategoryData.fs
View File

@ -1,34 +1,30 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// PostgreSQL myWebLog category data implementation /// PostgreSQL myWebLog category data implementation
type PostgresCategoryData (conn : NpgsqlConnection) = type PostgresCategoryData (log : ILogger) =
/// Count all categories for the given web log /// Count all categories for the given web log
let countAll webLogId = let countAll webLogId =
Sql.existingConnection conn log.LogTrace "Category.countAll"
|> Sql.query $"SELECT COUNT(id) AS {countName} FROM category WHERE web_log_id = @webLogId" Count.byContains Table.Category (webLogDoc webLogId)
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toCount
/// Count all top-level categories for the given web log /// Count all top-level categories for the given web log
let countTopLevel webLogId = let countTopLevel webLogId =
Sql.existingConnection conn log.LogTrace "Category.countTopLevel"
|> Sql.query $"SELECT COUNT(id) AS {countName} FROM category WHERE web_log_id = @webLogId AND parent_id IS NULL" Count.byContains Table.Category {| webLogDoc webLogId with ParentId = None |}
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toCount
/// Retrieve all categories for the given web log in a DotLiquid-friendly format /// Retrieve all categories for the given web log in a DotLiquid-friendly format
let findAllForView webLogId = backgroundTask { let findAllForView webLogId = backgroundTask {
log.LogTrace "Category.findAllForView"
let! cats = let! cats =
Sql.existingConnection conn Custom.list $"{selectWithCriteria Table.Category} ORDER BY LOWER(data ->> '{nameof Category.empty.Name}')"
|> Sql.query "SELECT * FROM category WHERE web_log_id = @webLogId ORDER BY LOWER(name)" [ webLogContains webLogId ] fromData<Category>
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toCategory
let ordered = Utils.orderByHierarchy cats None None [] let ordered = Utils.orderByHierarchy cats None None []
let counts = let counts =
ordered ordered
@ -40,18 +36,17 @@ type PostgresCategoryData (conn : NpgsqlConnection) =
|> Seq.map (fun cat -> cat.Id) |> Seq.map (fun cat -> cat.Id)
|> Seq.append (Seq.singleton it.Id) |> Seq.append (Seq.singleton it.Id)
|> List.ofSeq |> List.ofSeq
|> inClause "AND pc.category_id" "id" id |> arrayContains (nameof Post.empty.CategoryIds) id
let postCount = let postCount =
Sql.existingConnection conn Custom.scalar
|> Sql.query $" $"""SELECT COUNT(DISTINCT id) AS {countName}
SELECT COUNT(DISTINCT p.id) AS {countName} FROM {Table.Post}
FROM post p WHERE {Query.whereDataContains "@criteria"}
INNER JOIN post_category pc ON pc.post_id = p.id AND {catIdSql}"""
WHERE p.web_log_id = @webLogId [ "@criteria",
AND p.status = 'Published' Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
{catIdSql}" catIdParams
|> Sql.parameters (webLogIdParam webLogId :: catIdParams) ] Map.toCount
|> Sql.executeRowAsync Map.toCount
|> Async.AwaitTask |> Async.AwaitTask
|> Async.RunSynchronously |> Async.RunSynchronously
it.Id, postCount) it.Id, postCount)
@ -69,93 +64,75 @@ type PostgresCategoryData (conn : NpgsqlConnection) =
} }
/// Find a category by its ID for the given web log /// Find a category by its ID for the given web log
let findById catId webLogId = let findById catId webLogId =
Sql.existingConnection conn log.LogTrace "Category.findById"
|> Sql.query "SELECT * FROM category WHERE id = @id AND web_log_id = @webLogId" Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId CategoryId.toString webLogId
|> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ]
|> Sql.executeAsync Map.toCategory
|> tryHead
/// Find all categories for the given web log /// Find all categories for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
Sql.existingConnection conn log.LogTrace "Category.findByWebLog"
|> Sql.query "SELECT * FROM category WHERE web_log_id = @webLogId" Document.findByWebLog<Category> Table.Category webLogId
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toCategory
/// Create parameters for a category insert / update
let catParameters (cat : Category) =
Query.docParameters (CategoryId.toString cat.Id) cat
/// Delete a category /// Delete a category
let delete catId webLogId = backgroundTask { let delete catId webLogId = backgroundTask {
log.LogTrace "Category.delete"
match! findById catId webLogId with match! findById catId webLogId with
| Some cat -> | Some cat ->
// Reassign any children to the category's parent category // Reassign any children to the category's parent category
let parentParam = "@parentId", Sql.string (CategoryId.toString catId) let! children = Find.byContains<Category> Table.Category {| ParentId = CategoryId.toString catId |}
let! hasChildren = let hasChildren = not (List.isEmpty children)
Sql.existingConnection conn
|> Sql.query $"SELECT EXISTS (SELECT 1 FROM category WHERE parent_id = @parentId) AS {existsName}"
|> Sql.parameters [ parentParam ]
|> Sql.executeRowAsync Map.toExists
if hasChildren then if hasChildren then
let! _ = let! _ =
Sql.existingConnection conn Configuration.dataSource ()
|> Sql.query "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId" |> Sql.fromDataSource
|> Sql.parameters |> Sql.executeTransactionAsync [
[ parentParam Query.Update.partialById Table.Category,
"@newParentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) ] children |> List.map (fun child -> [
|> Sql.executeNonQueryAsync "@id", Sql.string (CategoryId.toString child.Id)
"@data", Query.jsonbDocParam {| ParentId = cat.ParentId |}
])
]
() ()
// Delete the category off all posts where it is assigned, and the category itself // Delete the category off all posts where it is assigned
let! _ = let! posts =
Sql.existingConnection conn Custom.list $"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.empty.CategoryIds}' @> @id"
|> Sql.query [ "@id", Query.jsonbDocParam [| CategoryId.toString catId |] ] fromData<Post>
"DELETE FROM post_category if not (List.isEmpty posts) then
WHERE category_id = @id let! _ =
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId); Configuration.dataSource ()
DELETE FROM category WHERE id = @id" |> Sql.fromDataSource
|> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ] |> Sql.executeTransactionAsync [
|> Sql.executeNonQueryAsync 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 return if hasChildren then ReassignedChildCategories else CategoryDeleted
| None -> return CategoryNotFound | None -> return CategoryNotFound
} }
/// The INSERT statement for a category
let catInsert =
"INSERT INTO category (
id, web_log_id, name, slug, description, parent_id
) VALUES (
@id, @webLogId, @name, @slug, @description, @parentId
)"
/// Create parameters for a category insert / update
let catParameters (cat : Category) = [
webLogIdParam cat.WebLogId
"@id", Sql.string (CategoryId.toString cat.Id)
"@name", Sql.string cat.Name
"@slug", Sql.string cat.Slug
"@description", Sql.stringOrNone cat.Description
"@parentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString)
]
/// Save a category /// Save a category
let save cat = backgroundTask { let save (cat : Category) = backgroundTask {
let! _ = log.LogTrace "Category.save"
Sql.existingConnection conn do! save Table.Category (CategoryId.toString cat.Id) cat
|> Sql.query $"
{catInsert} ON CONFLICT (id) DO UPDATE
SET name = EXCLUDED.name,
slug = EXCLUDED.slug,
description = EXCLUDED.description,
parent_id = EXCLUDED.parent_id"
|> Sql.parameters (catParameters cat)
|> Sql.executeNonQueryAsync
()
} }
/// Restore categories from a backup /// Restore categories from a backup
let restore cats = backgroundTask { let restore cats = backgroundTask {
log.LogTrace "Category.restore"
let! _ = let! _ =
Sql.existingConnection conn Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
catInsert, cats |> List.map catParameters Query.insert Table.Category, cats |> List.map catParameters
] ]
() ()
} }

294
src/MyWebLog.Data/Postgres/PostgresHelpers.fs
View File

@ -2,11 +2,68 @@
[<AutoOpen>] [<AutoOpen>]
module MyWebLog.Data.Postgres.PostgresHelpers 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
open System.Threading.Tasks open System.Threading.Tasks
open BitBadger.Npgsql.FSharp.Documents
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open NodaTime open NodaTime
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
@ -15,12 +72,24 @@ open Npgsql.FSharp
let webLogIdParam webLogId = let webLogIdParam webLogId =
"@webLogId", Sql.string (WebLogId.toString 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 /// The name of the field to select to be able to use Map.toCount
let countName = "the_count" let countName = "the_count"
/// The name of the field to select to be able to use Map.toExists /// The name of the field to select to be able to use Map.toExists
let existsName = "does_exist" 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 /// Create the SQL and parameters for an IN clause
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) = let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) =
if List.isEmpty items then "", [] if List.isEmpty items then "", []
@ -37,22 +106,11 @@ let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : '
|> Seq.head) |> Seq.head)
|> function sql, ps -> $"{sql})", ps |> function sql, ps -> $"{sql})", ps
/// Create the SQL and parameters for the array equivalent of an IN clause /// Create the SQL and parameters for match-any array query
let arrayInClause<'T> name (valueFunc : 'T -> string) (items : 'T list) = let arrayContains<'T> name (valueFunc : 'T -> string) (items : 'T list) =
if List.isEmpty items then "TRUE = FALSE", [] $"data['{name}'] ?| @{name}Values",
else ($"@{name}Values", Sql.stringArray (items |> List.map valueFunc |> Array.ofList))
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS} OR %s{name} && ARRAY[@{name}{idx}]",
($"@{name}{idx}", Sql.string (valueFunc it)) :: itemP)
(Seq.ofList items
|> Seq.map (fun it ->
$"{name} && ARRAY[@{name}0]", [ $"@{name}0", Sql.string (valueFunc it) ])
|> Seq.head)
/// Get the first result of the given query /// Get the first result of the given query
let tryHead<'T> (query : Task<'T list>) = backgroundTask { let tryHead<'T> (query : Task<'T list>) = backgroundTask {
let! results = query let! results = query
@ -71,113 +129,24 @@ let optParam<'T> name (it : 'T option) =
/// Mapping functions for SQL queries /// Mapping functions for SQL queries
module Map = module Map =
/// Map an id field to a category ID
let toCategoryId (row : RowReader) =
CategoryId (row.string "id")
/// Create a category from the current row
let toCategory (row : RowReader) : Category =
{ Id = toCategoryId row
WebLogId = row.string "web_log_id" |> WebLogId
Name = row.string "name"
Slug = row.string "slug"
Description = row.stringOrNone "description"
ParentId = row.stringOrNone "parent_id" |> Option.map CategoryId
}
/// Get a count from a row /// Get a count from a row
let toCount (row : RowReader) = let toCount (row : RowReader) =
row.int countName row.int countName
/// Create a custom feed from the current row
let toCustomFeed (ser : JsonSerializer) (row : RowReader) : CustomFeed =
{ Id = row.string "id" |> CustomFeedId
Source = row.string "source" |> CustomFeedSource.parse
Path = row.string "path" |> Permalink
Podcast = row.stringOrNone "podcast" |> Option.map (Utils.deserialize ser)
}
/// Get a true/false value as to whether an item exists /// Get a true/false value as to whether an item exists
let toExists (row : RowReader) = let toExists (row : RowReader) =
row.bool existsName row.bool existsName
/// Create a meta item from the current row
let toMetaItem (row : RowReader) : MetaItem =
{ Name = row.string "name"
Value = row.string "value"
}
/// Create a permalink from the current row /// Create a permalink from the current row
let toPermalink (row : RowReader) = let toPermalink (row : RowReader) =
Permalink (row.string "permalink") Permalink (row.string "permalink")
/// Create a page from the current row
let toPage (ser : JsonSerializer) (row : RowReader) : Page =
{ Page.empty with
Id = row.string "id" |> PageId
WebLogId = row.string "web_log_id" |> WebLogId
AuthorId = row.string "author_id" |> WebLogUserId
Title = row.string "title"
Permalink = toPermalink row
PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray
PublishedOn = row.fieldValue<Instant> "published_on"
UpdatedOn = row.fieldValue<Instant> "updated_on"
IsInPageList = row.bool "is_in_page_list"
Template = row.stringOrNone "template"
Text = row.string "page_text"
Metadata = row.stringOrNone "meta_items"
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
}
/// Create a post from the current row
let toPost (ser : JsonSerializer) (row : RowReader) : Post =
{ Post.empty with
Id = row.string "id" |> PostId
WebLogId = row.string "web_log_id" |> WebLogId
AuthorId = row.string "author_id" |> WebLogUserId
Status = row.string "status" |> PostStatus.parse
Title = row.string "title"
Permalink = toPermalink row
PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray
PublishedOn = row.fieldValueOrNone<Instant> "published_on"
UpdatedOn = row.fieldValue<Instant> "updated_on"
Template = row.stringOrNone "template"
Text = row.string "post_text"
Episode = row.stringOrNone "episode" |> Option.map (Utils.deserialize ser)
CategoryIds = row.stringArrayOrNone "category_ids"
|> Option.map (Array.map CategoryId >> List.ofArray)
|> Option.defaultValue []
Tags = row.stringArrayOrNone "tags"
|> Option.map List.ofArray
|> Option.defaultValue []
Metadata = row.stringOrNone "meta_items"
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
}
/// Create a revision from the current row /// Create a revision from the current row
let toRevision (row : RowReader) : Revision = let toRevision (row : RowReader) : Revision =
{ AsOf = row.fieldValue<Instant> "as_of" { AsOf = row.fieldValue<Instant> "as_of"
Text = row.string "revision_text" |> MarkupText.parse Text = row.string "revision_text" |> MarkupText.parse
} }
/// Create a tag mapping from the current row
let toTagMap (row : RowReader) : TagMap =
{ Id = row.string "id" |> TagMapId
WebLogId = row.string "web_log_id" |> WebLogId
Tag = row.string "tag"
UrlValue = row.string "url_value"
}
/// Create a theme from the current row (excludes templates)
let toTheme (row : RowReader) : Theme =
{ Theme.empty with
Id = row.string "id" |> ThemeId
Name = row.string "name"
Version = row.string "version"
}
/// Create a theme asset from the current row /// Create a theme asset from the current row
let toThemeAsset includeData (row : RowReader) : ThemeAsset = let toThemeAsset includeData (row : RowReader) : ThemeAsset =
{ Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path") { Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
@ -185,12 +154,6 @@ module Map =
Data = if includeData then row.bytea "data" else [||] Data = if includeData then row.bytea "data" else [||]
} }
/// Create a theme template from the current row
let toThemeTemplate includeText (row : RowReader) : ThemeTemplate =
{ Name = row.string "name"
Text = if includeText then row.string "template" else ""
}
/// Create an uploaded file from the current row /// Create an uploaded file from the current row
let toUpload includeData (row : RowReader) : Upload = let toUpload includeData (row : RowReader) : Upload =
{ Id = row.string "id" |> UploadId { Id = row.string "id" |> UploadId
@ -199,42 +162,75 @@ module Map =
UpdatedOn = row.fieldValue<Instant> "updated_on" UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||] Data = if includeData then row.bytea "data" else [||]
} }
/// Document manipulation functions
module Document =
/// Create a web log from the current row /// Determine whether a document exists with the given key for the given web log
let toWebLog (row : RowReader) : WebLog = let existsByWebLog<'TKey> table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId =
{ Id = row.string "id" |> WebLogId Custom.scalar
Name = row.string "name" $""" SELECT EXISTS (
Slug = row.string "slug" SELECT 1 FROM %s{table} WHERE id = @id AND {Query.whereDataContains "@criteria"}
Subtitle = row.stringOrNone "subtitle" ) AS {existsName}"""
DefaultPage = row.string "default_page" [ "@id", Sql.string (keyFunc key); webLogContains webLogId ] Map.toExists
PostsPerPage = row.int "posts_per_page"
ThemeId = row.string "theme_id" |> ThemeId
UrlBase = row.string "url_base"
TimeZone = row.string "time_zone"
AutoHtmx = row.bool "auto_htmx"
Uploads = row.string "uploads" |> UploadDestination.parse
Rss = {
IsFeedEnabled = row.bool "is_feed_enabled"
FeedName = row.string "feed_name"
ItemsInFeed = row.intOrNone "items_in_feed"
IsCategoryEnabled = row.bool "is_category_enabled"
IsTagEnabled = row.bool "is_tag_enabled"
Copyright = row.stringOrNone "copyright"
CustomFeeds = []
}
}
/// Create a web log user from the current row /// Find a document by its ID for the given web log
let toWebLogUser (row : RowReader) : WebLogUser = let findByIdAndWebLog<'TKey, 'TDoc> table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId =
{ Id = row.string "id" |> WebLogUserId Custom.single $"""{Query.selectFromTable table} WHERE id = @id AND {Query.whereDataContains "@criteria"}"""
WebLogId = row.string "web_log_id" |> WebLogId [ "@id", Sql.string (keyFunc key); webLogContains webLogId ] fromData<'TDoc>
Email = row.string "email"
FirstName = row.string "first_name" /// Find a document by its ID for the given web log
LastName = row.string "last_name" let findByWebLog<'TDoc> table webLogId : Task<'TDoc list> =
PreferredName = row.string "preferred_name" Find.byContains table (webLogDoc webLogId)
PasswordHash = row.string "password_hash"
Url = row.stringOrNone "url"
AccessLevel = row.string "access_level" |> AccessLevel.parse /// Functions to support revisions
CreatedOn = row.fieldValue<Instant> "created_on" module Revisions =
LastSeenOn = row.fieldValueOrNone<Instant> "last_seen_on"
} /// 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)
]
()
}

227
src/MyWebLog.Data/Postgres/PostgresPageData.fs
View File

@ -1,107 +1,63 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// PostgreSQL myWebLog page data implementation /// PostgreSQL myWebLog page data implementation
type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) = type PostgresPageData (log : ILogger) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// Append revisions and permalinks to a page /// Append revisions to a page
let appendPageRevisions (page : Page) = backgroundTask { let appendPageRevisions (page : Page) = backgroundTask {
let! revisions = log.LogTrace "Page.appendPageRevisions"
Sql.existingConnection conn let! revisions = Revisions.findByEntityId Table.PageRevision Table.Page page.Id PageId.toString
|> Sql.query "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC"
|> Sql.parameters [ "@pageId", Sql.string (PageId.toString page.Id) ]
|> Sql.executeAsync Map.toRevision
return { page with Revisions = revisions } return { page with Revisions = revisions }
} }
/// Shorthand to map to a page
let toPage = Map.toPage ser
/// Return a page with no text or revisions /// Return a page with no text or revisions
let pageWithoutText row = let pageWithoutText (row : RowReader) =
{ toPage row with Text = "" } { fromData<Page> row with Text = "" }
/// The INSERT statement for a page revision
let revInsert = "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)"
/// Parameters for a revision INSERT statement
let revParams pageId rev = [
typedParam "asOf" rev.AsOf
"@pageId", Sql.string (PageId.toString pageId)
"@text", Sql.string (MarkupText.toString rev.Text)
]
/// Update a page's revisions /// Update a page's revisions
let updatePageRevisions pageId oldRevs newRevs = backgroundTask { let updatePageRevisions pageId oldRevs newRevs =
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs log.LogTrace "Page.updatePageRevisions"
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then Revisions.update Table.PageRevision Table.Page pageId PageId.toString oldRevs newRevs
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
"DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf",
toDelete
|> List.map (fun it -> [
"@pageId", Sql.string (PageId.toString pageId)
typedParam "asOf" it.AsOf
])
if not (List.isEmpty toAdd) then
revInsert, toAdd |> List.map (revParams pageId)
]
()
}
/// Does the given page exist? /// Does the given page exist?
let pageExists pageId webLogId = let pageExists pageId webLogId =
Sql.existingConnection conn log.LogTrace "Page.pageExists"
|> Sql.query $"SELECT EXISTS (SELECT 1 FROM page WHERE id = @id AND web_log_id = @webLogId) AS {existsName}" Document.existsByWebLog Table.Page pageId PageId.toString webLogId
|> Sql.parameters [ "@id", Sql.string (PageId.toString pageId); webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toExists
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Get all pages for a web log (without text, revisions, prior permalinks, or metadata) /// Get all pages for a web log (without text or revisions)
let all webLogId = let all webLogId =
Sql.existingConnection conn log.LogTrace "Page.all"
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)" Custom.list $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')"
|> Sql.parameters [ webLogIdParam webLogId ] [ webLogContains webLogId ] fromData<Page>
|> Sql.executeAsync pageWithoutText
/// Count all pages for the given web log /// Count all pages for the given web log
let countAll webLogId = let countAll webLogId =
Sql.existingConnection conn log.LogTrace "Page.countAll"
|> Sql.query $"SELECT COUNT(id) AS {countName} FROM page WHERE web_log_id = @webLogId" Count.byContains Table.Page (webLogDoc webLogId)
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toCount
/// Count all pages shown in the page list for the given web log /// Count all pages shown in the page list for the given web log
let countListed webLogId = let countListed webLogId =
Sql.existingConnection conn log.LogTrace "Page.countListed"
|> Sql.query $" Count.byContains Table.Page {| webLogDoc webLogId with IsInPageList = true |}
SELECT COUNT(id) AS {countName}
FROM page
WHERE web_log_id = @webLogId
AND is_in_page_list = TRUE"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toCount
/// Find a page by its ID (without revisions) /// Find a page by its ID (without revisions)
let findById pageId webLogId = let findById pageId webLogId =
Sql.existingConnection conn log.LogTrace "Page.findById"
|> Sql.query "SELECT * FROM page WHERE id = @id AND web_log_id = @webLogId" Document.findByIdAndWebLog<PageId, Page> Table.Page pageId PageId.toString webLogId
|> Sql.parameters [ "@id", Sql.string (PageId.toString pageId); webLogIdParam webLogId ]
|> Sql.executeAsync toPage
|> tryHead
/// Find a complete page by its ID /// Find a complete page by its ID
let findFullById pageId webLogId = backgroundTask { let findFullById pageId webLogId = backgroundTask {
log.LogTrace "Page.findFullById"
match! findById pageId webLogId with match! findById pageId webLogId with
| Some page -> | Some page ->
let! withMore = appendPageRevisions page let! withMore = appendPageRevisions page
@ -111,57 +67,40 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// Delete a page by its ID /// Delete a page by its ID
let delete pageId webLogId = backgroundTask { let delete pageId webLogId = backgroundTask {
log.LogTrace "Page.delete"
match! pageExists pageId webLogId with match! pageExists pageId webLogId with
| true -> | true ->
let! _ = do! Delete.byId Table.Page (PageId.toString pageId)
Sql.existingConnection conn
|> Sql.query
"DELETE FROM page_revision WHERE page_id = @id;
DELETE FROM page WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string (PageId.toString pageId) ]
|> Sql.executeNonQueryAsync
return true return true
| false -> return false | false -> return false
} }
/// Find a page by its permalink for the given web log /// Find a page by its permalink for the given web log
let findByPermalink permalink webLogId = let findByPermalink permalink webLogId =
Sql.existingConnection conn log.LogTrace "Page.findByPermalink"
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link" Find.byContains<Page> Table.Page {| webLogDoc webLogId with Permalink = Permalink.toString permalink |}
|> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ]
|> Sql.executeAsync toPage
|> tryHead |> tryHead
/// Find the current permalink within a set of potential prior permalinks for the given web log /// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask { let findCurrentPermalink permalinks webLogId = backgroundTask {
log.LogTrace "Page.findCurrentPermalink"
if List.isEmpty permalinks then return None if List.isEmpty permalinks then return None
else else
let linkSql, linkParams = arrayInClause "prior_permalinks" Permalink.toString permalinks let linkSql, linkParam =
arrayContains (nameof Page.empty.PriorPermalinks) Permalink.toString permalinks
return! return!
Sql.existingConnection conn Custom.single
|> Sql.query $"SELECT permalink FROM page WHERE web_log_id = @webLogId AND ({linkSql})" $"""SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink
|> Sql.parameters (webLogIdParam webLogId :: linkParams) FROM page
|> Sql.executeAsync Map.toPermalink WHERE {Query.whereDataContains "@criteria"}
|> tryHead AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink
} }
/// Get all complete pages for the given web log /// Get all complete pages for the given web log
let findFullByWebLog webLogId = backgroundTask { let findFullByWebLog webLogId = backgroundTask {
let! pages = log.LogTrace "Page.findFullByWebLog"
Sql.existingConnection conn let! pages = Document.findByWebLog<Page> Table.Page webLogId
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId" let! revisions = Revisions.findByWebLog Table.PageRevision Table.Page PageId webLogId
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync toPage
let! revisions =
Sql.existingConnection conn
|> Sql.query
"SELECT *
FROM page_revision pr
INNER JOIN page p ON p.id = pr.page_id
WHERE p.web_log_id = @webLogId
ORDER BY pr.as_of DESC"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (fun row -> PageId (row.string "page_id"), Map.toRevision row)
return return
pages pages
|> List.map (fun it -> |> List.map (fun it ->
@ -170,95 +109,53 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// Get all listed pages for the given web log (without revisions or text) /// Get all listed pages for the given web log (without revisions or text)
let findListed webLogId = let findListed webLogId =
Sql.existingConnection conn log.LogTrace "Page.findListed"
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND is_in_page_list = TRUE ORDER BY LOWER(title)" Custom.list $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')"
|> Sql.parameters [ webLogIdParam webLogId ] [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with IsInPageList = true |} ]
|> Sql.executeAsync pageWithoutText pageWithoutText
/// Get a page of pages for the given web log (without revisions) /// Get a page of pages for the given web log (without revisions)
let findPageOfPages webLogId pageNbr = let findPageOfPages webLogId pageNbr =
Sql.existingConnection conn log.LogTrace "Page.findPageOfPages"
|> Sql.query Custom.list
"SELECT * $"{selectWithCriteria Table.Page}
FROM page ORDER BY LOWER(data->>'{nameof Page.empty.Title}')
WHERE web_log_id = @webLogId LIMIT @pageSize OFFSET @toSkip"
ORDER BY LOWER(title) [ webLogContains webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
LIMIT @pageSize OFFSET @toSkip" fromData<Page>
|> Sql.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
|> Sql.executeAsync toPage
/// The INSERT statement for a page
let pageInsert =
"INSERT INTO page (
id, web_log_id, author_id, title, permalink, prior_permalinks, published_on, updated_on, is_in_page_list,
template, page_text, meta_items
) VALUES (
@id, @webLogId, @authorId, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn, @isInPageList,
@template, @text, @metaItems
)"
/// The parameters for saving a page
let pageParams (page : Page) = [
webLogIdParam page.WebLogId
"@id", Sql.string (PageId.toString page.Id)
"@authorId", Sql.string (WebLogUserId.toString page.AuthorId)
"@title", Sql.string page.Title
"@permalink", Sql.string (Permalink.toString page.Permalink)
"@isInPageList", Sql.bool page.IsInPageList
"@template", Sql.stringOrNone page.Template
"@text", Sql.string page.Text
"@metaItems", Sql.jsonb (Utils.serialize ser page.Metadata)
"@priorPermalinks", Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
typedParam "publishedOn" page.PublishedOn
typedParam "updatedOn" page.UpdatedOn
]
/// Restore pages from a backup /// Restore pages from a backup
let restore (pages : Page list) = backgroundTask { 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 revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
let! _ = let! _ =
Sql.existingConnection conn Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
pageInsert, pages |> List.map pageParams Query.insert Table.Page,
revInsert, revisions |> List.map (fun (pageId, rev) -> revParams pageId rev) 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 /// Save a page
let save (page : Page) = backgroundTask { let save (page : Page) = backgroundTask {
log.LogTrace "Page.save"
let! oldPage = findFullById page.Id page.WebLogId let! oldPage = findFullById page.Id page.WebLogId
let! _ = do! save Table.Page (PageId.toString page.Id) { page with Revisions = [] }
Sql.existingConnection conn
|> Sql.query $"
{pageInsert} ON CONFLICT (id) DO UPDATE
SET author_id = EXCLUDED.author_id,
title = EXCLUDED.title,
permalink = EXCLUDED.permalink,
prior_permalinks = EXCLUDED.prior_permalinks,
published_on = EXCLUDED.published_on,
updated_on = EXCLUDED.updated_on,
is_in_page_list = EXCLUDED.is_in_page_list,
template = EXCLUDED.template,
page_text = EXCLUDED.page_text,
meta_items = EXCLUDED.meta_items"
|> Sql.parameters (pageParams page)
|> Sql.executeNonQueryAsync
do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions
() ()
} }
/// Update a page's prior permalinks /// Update a page's prior permalinks
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask { let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
log.LogTrace "Page.updatePriorPermalinks"
match! pageExists pageId webLogId with match! pageExists pageId webLogId with
| true -> | true ->
let! _ = do! Update.partialById Table.Page (PageId.toString pageId) {| PriorPermalinks = permalinks |}
Sql.existingConnection conn
|> Sql.query "UPDATE page SET prior_permalinks = @prior WHERE id = @id"
|> Sql.parameters
[ "@id", Sql.string (PageId.toString pageId)
"@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ]
|> Sql.executeNonQueryAsync
return true return true
| false -> return false | false -> return false
} }

356
src/MyWebLog.Data/Postgres/PostgresPostData.fs
View File

@ -1,128 +1,61 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json open NodaTime.Text
open NodaTime
open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// PostgreSQL myWebLog post data implementation /// PostgreSQL myWebLog post data implementation
type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) = type PostgresPostData (log : ILogger) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// Append revisions to a post /// Append revisions to a post
let appendPostRevisions (post : Post) = backgroundTask { let appendPostRevisions (post : Post) = backgroundTask {
let! revisions = log.LogTrace "Post.appendPostRevisions"
Sql.existingConnection conn let! revisions = Revisions.findByEntityId Table.PostRevision Table.Post post.Id PostId.toString
|> Sql.query "SELECT as_of, revision_text FROM post_revision WHERE post_id = @id ORDER BY as_of DESC"
|> Sql.parameters [ "@id", Sql.string (PostId.toString post.Id) ]
|> Sql.executeAsync Map.toRevision
return { post with Revisions = revisions } return { post with Revisions = revisions }
} }
/// The SELECT statement for a post that will include category IDs
let selectPost =
"SELECT *, ARRAY(SELECT cat.category_id FROM post_category cat WHERE cat.post_id = p.id) AS category_ids
FROM post p"
/// Shorthand for mapping to a post
let toPost = Map.toPost ser
/// Return a post with no revisions, prior permalinks, or text /// Return a post with no revisions, prior permalinks, or text
let postWithoutText row = let postWithoutText row =
{ toPost row with Text = "" } { fromData<Post> row with Text = "" }
/// The INSERT statement for a post/category cross-reference
let catInsert = "INSERT INTO post_category VALUES (@postId, @categoryId)"
/// Parameters for adding or updating a post/category cross-reference
let catParams postId cat = [
"@postId", Sql.string (PostId.toString postId)
"categoryId", Sql.string (CategoryId.toString cat)
]
/// Update a post's assigned categories
let updatePostCategories postId oldCats newCats = backgroundTask {
let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
"DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId",
toDelete |> List.map (catParams postId)
if not (List.isEmpty toAdd) then
catInsert, toAdd |> List.map (catParams postId)
]
()
}
/// The INSERT statement for a post revision
let revInsert = "INSERT INTO post_revision VALUES (@postId, @asOf, @text)"
/// The parameters for adding a post revision
let revParams postId rev = [
typedParam "asOf" rev.AsOf
"@postId", Sql.string (PostId.toString postId)
"@text", Sql.string (MarkupText.toString rev.Text)
]
/// Update a post's revisions /// Update a post's revisions
let updatePostRevisions postId oldRevs newRevs = backgroundTask { let updatePostRevisions postId oldRevs newRevs =
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs log.LogTrace "Post.updatePostRevisions"
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then Revisions.update Table.PostRevision Table.Post postId PostId.toString oldRevs newRevs
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
"DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf",
toDelete
|> List.map (fun it -> [
"@postId", Sql.string (PostId.toString postId)
typedParam "asOf" it.AsOf
])
if not (List.isEmpty toAdd) then
revInsert, toAdd |> List.map (revParams postId)
]
()
}
/// Does the given post exist? /// Does the given post exist?
let postExists postId webLogId = let postExists postId webLogId =
Sql.existingConnection conn log.LogTrace "Post.postExists"
|> Sql.query $"SELECT EXISTS (SELECT 1 FROM post WHERE id = @id AND web_log_id = @webLogId) AS {existsName}" Document.existsByWebLog Table.Post postId PostId.toString webLogId
|> Sql.parameters [ "@id", Sql.string (PostId.toString postId); webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toExists
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Count posts in a status for the given web log /// Count posts in a status for the given web log
let countByStatus status webLogId = let countByStatus status webLogId =
Sql.existingConnection conn log.LogTrace "Post.countByStatus"
|> Sql.query $"SELECT COUNT(id) AS {countName} FROM post WHERE web_log_id = @webLogId AND status = @status" Count.byContains Table.Post {| webLogDoc webLogId with Status = PostStatus.toString status |}
|> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString status) ]
|> Sql.executeRowAsync Map.toCount
/// Find a post by its ID for the given web log (excluding revisions) /// Find a post by its ID for the given web log (excluding revisions)
let findById postId webLogId = let findById postId webLogId =
Sql.existingConnection conn log.LogTrace "Post.findById"
|> Sql.query $"{selectPost} WHERE id = @id AND web_log_id = @webLogId" Document.findByIdAndWebLog<PostId, Post> Table.Post postId PostId.toString webLogId
|> Sql.parameters [ "@id", Sql.string (PostId.toString postId); webLogIdParam webLogId ]
|> Sql.executeAsync toPost
|> tryHead
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks) /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink permalink webLogId = let findByPermalink permalink webLogId =
Sql.existingConnection conn log.LogTrace "Post.findByPermalink"
|> Sql.query $"{selectPost} WHERE web_log_id = @webLogId AND permalink = @link" Custom.single (selectWithCriteria Table.Post)
|> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ] [ "@criteria",
|> Sql.executeAsync toPost Query.jsonbDocParam {| webLogDoc webLogId with Permalink = Permalink.toString permalink |}
|> tryHead ] fromData<Post>
/// Find a complete post by its ID for the given web log /// Find a complete post by its ID for the given web log
let findFullById postId webLogId = backgroundTask { let findFullById postId webLogId = backgroundTask {
log.LogTrace "Post.findFullById"
match! findById postId webLogId with match! findById postId webLogId with
| Some post -> | Some post ->
let! withRevisions = appendPostRevisions post let! withRevisions = appendPostRevisions post
@ -132,50 +65,38 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// Delete a post by its ID for the given web log /// Delete a post by its ID for the given web log
let delete postId webLogId = backgroundTask { let delete postId webLogId = backgroundTask {
log.LogTrace "Post.delete"
match! postExists postId webLogId with match! postExists postId webLogId with
| true -> | true ->
let! _ = let theId = PostId.toString postId
Sql.existingConnection conn do! Custom.nonQuery
|> Sql.query $"""DELETE FROM {Table.PostComment} WHERE {Query.whereDataContains "@criteria"};
"DELETE FROM post_revision WHERE post_id = @id; DELETE FROM {Table.Post} WHERE id = @id"""
DELETE FROM post_category WHERE post_id = @id; [ "@id", Sql.string theId; "@criteria", Query.jsonbDocParam {| PostId = theId |} ]
DELETE FROM post WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string (PostId.toString postId) ]
|> Sql.executeNonQueryAsync
return true return true
| false -> return false | false -> return false
} }
/// Find the current permalink from a list of potential prior permalinks for the given web log /// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask { let findCurrentPermalink permalinks webLogId = backgroundTask {
log.LogTrace "Post.findCurrentPermalink"
if List.isEmpty permalinks then return None if List.isEmpty permalinks then return None
else else
let linkSql, linkParams = arrayInClause "prior_permalinks" Permalink.toString permalinks let linkSql, linkParam =
arrayContains (nameof Post.empty.PriorPermalinks) Permalink.toString permalinks
return! return!
Sql.existingConnection conn Custom.single
|> Sql.query $"SELECT permalink FROM post WHERE web_log_id = @webLogId AND ({linkSql})" $"""SELECT data ->> '{nameof Post.empty.Permalink}' AS permalink
|> Sql.parameters (webLogIdParam webLogId :: linkParams) FROM {Table.Post}
|> Sql.executeAsync Map.toPermalink WHERE {Query.whereDataContains "@criteria"}
|> tryHead AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink
} }
/// Get all complete posts for the given web log /// Get all complete posts for the given web log
let findFullByWebLog webLogId = backgroundTask { let findFullByWebLog webLogId = backgroundTask {
let! posts = log.LogTrace "Post.findFullByWebLog"
Sql.existingConnection conn let! posts = Document.findByWebLog<Post> Table.Post webLogId
|> Sql.query $"{selectPost} WHERE web_log_id = @webLogId" let! revisions = Revisions.findByWebLog Table.PostRevision Table.Post PostId webLogId
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync toPost
let! revisions =
Sql.existingConnection conn
|> Sql.query
"SELECT *
FROM post_revision pr
INNER JOIN post p ON p.id = pr.post_id
WHERE p.web_log_id = @webLogId
ORDER BY as_of DESC"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (fun row -> PostId (row.string "post_id"), Map.toRevision row)
return return
posts posts
|> List.map (fun it -> |> List.map (fun it ->
@ -184,174 +105,103 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// Get a page of categorized posts for the given web log (excludes revisions) /// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
let catSql, catParams = inClause "AND pc.category_id" "catId" CategoryId.toString categoryIds log.LogTrace "Post.findPageOfCategorizedPosts"
Sql.existingConnection conn let catSql, catParam = arrayContains (nameof Post.empty.CategoryIds) CategoryId.toString categoryIds
|> Sql.query $" Custom.list
{selectPost} $"{selectWithCriteria Table.Post}
INNER JOIN post_category pc ON pc.post_id = p.id AND {catSql}
WHERE p.web_log_id = @webLogId ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
AND p.status = @status LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
{catSql} [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
ORDER BY published_on DESC catParam
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" ] fromData<Post>
|> Sql.parameters
[ webLogIdParam webLogId
"@status", Sql.string (PostStatus.toString Published)
yield! catParams ]
|> Sql.executeAsync toPost
/// Get a page of posts for the given web log (excludes text and revisions) /// Get a page of posts for the given web log (excludes text and revisions)
let findPageOfPosts webLogId pageNbr postsPerPage = let findPageOfPosts webLogId pageNbr postsPerPage =
Sql.existingConnection conn log.LogTrace "Post.findPageOfPosts"
|> Sql.query $" Custom.list
{selectPost} $"{selectWithCriteria Table.Post}
WHERE web_log_id = @webLogId ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC NULLS FIRST,
ORDER BY published_on DESC NULLS FIRST, updated_on data ->> '{nameof Post.empty.UpdatedOn}'
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters [ webLogIdParam webLogId ] [ webLogContains webLogId ] postWithoutText
|> Sql.executeAsync postWithoutText
/// Get a page of published posts for the given web log (excludes revisions) /// Get a page of published posts for the given web log (excludes revisions)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
Sql.existingConnection conn log.LogTrace "Post.findPageOfPublishedPosts"
|> Sql.query $" Custom.list
{selectPost} $"{selectWithCriteria Table.Post}
WHERE web_log_id = @webLogId ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
AND status = @status LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
ORDER BY published_on DESC [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |} ]
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" fromData<Post>
|> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString Published) ]
|> Sql.executeAsync toPost
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks) /// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage =
Sql.existingConnection conn log.LogTrace "Post.findPageOfTaggedPosts"
|> Sql.query $" Custom.list
{selectPost} $"{selectWithCriteria Table.Post}
WHERE web_log_id = @webLogId AND data['{nameof Post.empty.Tags}'] @> @tag
AND status = @status ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
AND tags && ARRAY[@tag] LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
ORDER BY published_on DESC [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" "@tag", Query.jsonbDocParam [| tag |]
|> Sql.parameters ] fromData<Post>
[ webLogIdParam webLogId
"@status", Sql.string (PostStatus.toString Published)
"@tag", Sql.string tag
]
|> Sql.executeAsync toPost
/// Find the next newest and oldest post from a publish date for the given web log /// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask { let findSurroundingPosts webLogId publishedOn = backgroundTask {
let queryParams () = Sql.parameters [ log.LogTrace "Post.findSurroundingPosts"
webLogIdParam webLogId let queryParams () = [
typedParam "publishedOn" publishedOn "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
"@status", Sql.string (PostStatus.toString Published) "@publishedOn", Sql.string ((InstantPattern.General.Format publishedOn).Substring (0, 19))
] ]
let pubField = nameof Post.empty.PublishedOn
let! older = let! older =
Sql.existingConnection conn Custom.list
|> Sql.query $" $"{selectWithCriteria Table.Post}
{selectPost} AND SUBSTR(data ->> '{pubField}', 1, 19) < @publishedOn
WHERE web_log_id = @webLogId ORDER BY data ->> '{pubField}' DESC
AND status = @status LIMIT 1" (queryParams ()) fromData<Post>
AND published_on < @publishedOn
ORDER BY published_on DESC
LIMIT 1"
|> queryParams ()
|> Sql.executeAsync toPost
let! newer = let! newer =
Sql.existingConnection conn Custom.list
|> Sql.query $" $"{selectWithCriteria Table.Post}
{selectPost} AND SUBSTR(data ->> '{pubField}', 1, 19) > @publishedOn
WHERE web_log_id = @webLogId ORDER BY data ->> '{pubField}'
AND status = @status LIMIT 1" (queryParams ()) fromData<Post>
AND published_on > @publishedOn
ORDER BY published_on
LIMIT 1"
|> queryParams ()
|> Sql.executeAsync toPost
return List.tryHead older, List.tryHead newer return List.tryHead older, List.tryHead newer
} }
/// The INSERT statement for a post
let postInsert =
"INSERT INTO post (
id, web_log_id, author_id, status, title, permalink, prior_permalinks, published_on, updated_on,
template, post_text, tags, meta_items, episode
) VALUES (
@id, @webLogId, @authorId, @status, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn,
@template, @text, @tags, @metaItems, @episode
)"
/// The parameters for saving a post
let postParams (post : Post) = [
webLogIdParam post.WebLogId
"@id", Sql.string (PostId.toString post.Id)
"@authorId", Sql.string (WebLogUserId.toString post.AuthorId)
"@status", Sql.string (PostStatus.toString post.Status)
"@title", Sql.string post.Title
"@permalink", Sql.string (Permalink.toString post.Permalink)
"@template", Sql.stringOrNone post.Template
"@text", Sql.string post.Text
"@priorPermalinks", Sql.stringArray (post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
"@episode", Sql.jsonbOrNone (post.Episode |> Option.map (Utils.serialize ser))
"@tags", Sql.stringArrayOrNone (if List.isEmpty post.Tags then None else Some (Array.ofList post.Tags))
"@metaItems",
if List.isEmpty post.Metadata then None else Some (Utils.serialize ser post.Metadata)
|> Sql.jsonbOrNone
optParam "publishedOn" post.PublishedOn
typedParam "updatedOn" post.UpdatedOn
]
/// Save a post /// Save a post
let save (post : Post) = backgroundTask { let save (post : Post) = backgroundTask {
log.LogTrace "Post.save"
let! oldPost = findFullById post.Id post.WebLogId let! oldPost = findFullById post.Id post.WebLogId
let! _ = do! save Table.Post (PostId.toString post.Id) { post with Revisions = [] }
Sql.existingConnection conn do! updatePostRevisions post.Id (match oldPost with Some p -> p.Revisions | None -> []) post.Revisions
|> Sql.query $"
{postInsert} ON CONFLICT (id) DO UPDATE
SET author_id = EXCLUDED.author_id,
status = EXCLUDED.status,
title = EXCLUDED.title,
permalink = EXCLUDED.permalink,
prior_permalinks = EXCLUDED.prior_permalinks,
published_on = EXCLUDED.published_on,
updated_on = EXCLUDED.updated_on,
template = EXCLUDED.template,
post_text = EXCLUDED.post_text,
tags = EXCLUDED.tags,
meta_items = EXCLUDED.meta_items,
episode = EXCLUDED.episode"
|> Sql.parameters (postParams post)
|> Sql.executeNonQueryAsync
do! updatePostCategories post.Id (match oldPost with Some p -> p.CategoryIds | None -> []) post.CategoryIds
do! updatePostRevisions post.Id (match oldPost with Some p -> p.Revisions | None -> []) post.Revisions
} }
/// Restore posts from a backup /// Restore posts from a backup
let restore posts = backgroundTask { let restore posts = backgroundTask {
let cats = posts |> List.collect (fun p -> p.CategoryIds |> List.map (fun c -> p.Id, c)) log.LogTrace "Post.restore"
let revisions = posts |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r)) let revisions = posts |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
let! _ = let! _ =
Sql.existingConnection conn Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
postInsert, posts |> List.map postParams Query.insert Table.Post,
catInsert, cats |> List.map (fun (postId, catId) -> catParams postId catId) posts
revInsert, revisions |> List.map (fun (postId, rev) -> revParams postId rev) |> 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 /// Update prior permalinks for a post
let updatePriorPermalinks postId webLogId permalinks = backgroundTask { let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
log.LogTrace "Post.updatePriorPermalinks"
match! postExists postId webLogId with match! postExists postId webLogId with
| true -> | true ->
let! _ = do! Update.partialById Table.Post (PostId.toString postId) {| PriorPermalinks = permalinks |}
Sql.existingConnection conn
|> Sql.query "UPDATE post SET prior_permalinks = @prior WHERE id = @id"
|> Sql.parameters
[ "@id", Sql.string (PostId.toString postId)
"@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ]
|> Sql.executeNonQueryAsync
return true return true
| false -> return false | false -> return false
} }

97
src/MyWebLog.Data/Postgres/PostgresTagMapData.fs
View File

@ -1,100 +1,61 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// PostgreSQL myWebLog tag mapping data implementation /// PostgreSQL myWebLog tag mapping data implementation
type PostgresTagMapData (conn : NpgsqlConnection) = type PostgresTagMapData (log : ILogger) =
/// Find a tag mapping by its ID for the given web log /// Find a tag mapping by its ID for the given web log
let findById tagMapId webLogId = let findById tagMapId webLogId =
Sql.existingConnection conn log.LogTrace "TagMap.findById"
|> Sql.query "SELECT * FROM tag_map WHERE id = @id AND web_log_id = @webLogId" Document.findByIdAndWebLog<TagMapId, TagMap> Table.TagMap tagMapId TagMapId.toString webLogId
|> Sql.parameters [ "@id", Sql.string (TagMapId.toString tagMapId); webLogIdParam webLogId ]
|> Sql.executeAsync Map.toTagMap
|> tryHead
/// Delete a tag mapping for the given web log /// Delete a tag mapping for the given web log
let delete tagMapId webLogId = backgroundTask { let delete tagMapId webLogId = backgroundTask {
let idParams = [ "@id", Sql.string (TagMapId.toString tagMapId) ] log.LogTrace "TagMap.delete"
let! exists = let! exists = Document.existsByWebLog Table.TagMap tagMapId TagMapId.toString webLogId
Sql.existingConnection conn
|> Sql.query $"
SELECT EXISTS
(SELECT 1 FROM tag_map WHERE id = @id AND web_log_id = @webLogId)
AS {existsName}"
|> Sql.parameters (webLogIdParam webLogId :: idParams)
|> Sql.executeRowAsync Map.toExists
if exists then if exists then
let! _ = do! Delete.byId Table.TagMap (TagMapId.toString tagMapId)
Sql.existingConnection conn
|> Sql.query "DELETE FROM tag_map WHERE id = @id"
|> Sql.parameters idParams
|> Sql.executeNonQueryAsync
return true return true
else return false else return false
} }
/// Find a tag mapping by its URL value for the given web log /// Find a tag mapping by its URL value for the given web log
let findByUrlValue urlValue webLogId = let findByUrlValue (urlValue : string) webLogId =
Sql.existingConnection conn log.LogTrace "TagMap.findByUrlValue"
|> Sql.query "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue" Custom.single (selectWithCriteria Table.TagMap)
|> Sql.parameters [ webLogIdParam webLogId; "@urlValue", Sql.string urlValue ] [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with UrlValue = urlValue |} ]
|> Sql.executeAsync Map.toTagMap fromData<TagMap>
|> tryHead
/// Get all tag mappings for the given web log /// Get all tag mappings for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
Sql.existingConnection conn log.LogTrace "TagMap.findByWebLog"
|> Sql.query "SELECT * FROM tag_map WHERE web_log_id = @webLogId ORDER BY tag" Custom.list $"{selectWithCriteria Table.TagMap} ORDER BY data ->> 'tag'" [ webLogContains webLogId ]
|> Sql.parameters [ webLogIdParam webLogId ] fromData<TagMap>
|> Sql.executeAsync Map.toTagMap
/// Find any tag mappings in a list of tags for the given web log /// Find any tag mappings in a list of tags for the given web log
let findMappingForTags tags webLogId = let findMappingForTags tags webLogId =
let tagSql, tagParams = inClause "AND tag" "tag" id tags log.LogTrace "TagMap.findMappingForTags"
Sql.existingConnection conn let tagSql, tagParam = arrayContains (nameof TagMap.empty.Tag) id tags
|> Sql.query $"SELECT * FROM tag_map WHERE web_log_id = @webLogId {tagSql}" Custom.list $"{selectWithCriteria Table.TagMap} AND {tagSql}" [ webLogContains webLogId; tagParam ]
|> Sql.parameters (webLogIdParam webLogId :: tagParams) fromData<TagMap>
|> Sql.executeAsync Map.toTagMap
/// The INSERT statement for a tag mapping
let tagMapInsert =
"INSERT INTO tag_map (
id, web_log_id, tag, url_value
) VALUES (
@id, @webLogId, @tag, @urlValue
)"
/// The parameters for saving a tag mapping
let tagMapParams (tagMap : TagMap) = [
webLogIdParam tagMap.WebLogId
"@id", Sql.string (TagMapId.toString tagMap.Id)
"@tag", Sql.string tagMap.Tag
"@urlValue", Sql.string tagMap.UrlValue
]
/// Save a tag mapping /// Save a tag mapping
let save tagMap = backgroundTask { let save (tagMap : TagMap) =
let! _ = save Table.TagMap (TagMapId.toString tagMap.Id) tagMap
Sql.existingConnection conn
|> Sql.query $"
{tagMapInsert} ON CONFLICT (id) DO UPDATE
SET tag = EXCLUDED.tag,
url_value = EXCLUDED.url_value"
|> Sql.parameters (tagMapParams tagMap)
|> Sql.executeNonQueryAsync
()
}
/// Restore tag mappings from a backup /// Restore tag mappings from a backup
let restore tagMaps = backgroundTask { let restore (tagMaps : TagMap list) = backgroundTask {
let! _ = let! _ =
Sql.existingConnection conn Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
tagMapInsert, tagMaps |> List.map tagMapParams Query.insert Table.TagMap,
tagMaps |> List.map (fun tagMap -> Query.docParameters (TagMapId.toString tagMap.Id) tagMap)
] ]
() ()
} }

204
src/MyWebLog.Data/Postgres/PostgresThemeData.fs
View File

@ -1,129 +1,53 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// PostreSQL myWebLog theme data implementation /// PostreSQL myWebLog theme data implementation
type PostgresThemeData (conn : NpgsqlConnection) = 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) /// Retrieve all themes (except 'admin'; excludes template text)
let all () = backgroundTask { let all () =
let! themes = log.LogTrace "Theme.all"
Sql.existingConnection conn Custom.list $"{Query.selectFromTable Table.Theme} WHERE id <> 'admin' ORDER BY id" [] withoutTemplateText
|> Sql.query "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id"
|> Sql.executeAsync Map.toTheme
let! templates =
Sql.existingConnection conn
|> Sql.query "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name"
|> Sql.executeAsync (fun row -> ThemeId (row.string "theme_id"), Map.toThemeTemplate false row)
return
themes
|> List.map (fun t ->
{ t with Templates = templates |> List.filter (fun tt -> fst tt = t.Id) |> List.map snd })
}
/// Does a given theme exist? /// Does a given theme exist?
let exists themeId = let exists themeId =
Sql.existingConnection conn log.LogTrace "Theme.exists"
|> Sql.query "SELECT EXISTS (SELECT 1 FROM theme WHERE id = @id) AS does_exist" Exists.byId Table.Theme (ThemeId.toString themeId)
|> Sql.parameters [ "@id", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeRowAsync Map.toExists
/// Find a theme by its ID /// Find a theme by its ID
let findById themeId = backgroundTask { let findById themeId =
let themeIdParam = [ "@id", Sql.string (ThemeId.toString themeId) ] log.LogTrace "Theme.findById"
let! theme = Find.byId<Theme> Table.Theme (ThemeId.toString themeId)
Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme WHERE id = @id"
|> Sql.parameters themeIdParam
|> Sql.executeAsync Map.toTheme
|> tryHead
if Option.isSome theme then
let! templates =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme_template WHERE theme_id = @id"
|> Sql.parameters themeIdParam
|> Sql.executeAsync (Map.toThemeTemplate true)
return Some { theme.Value with Templates = templates }
else return None
}
/// Find a theme by its ID (excludes the text of templates) /// Find a theme by its ID (excludes the text of templates)
let findByIdWithoutText themeId = backgroundTask { let findByIdWithoutText themeId =
match! findById themeId with log.LogTrace "Theme.findByIdWithoutText"
| Some theme -> Custom.single (Query.Find.byId Table.Theme) [ "@id", Sql.string (ThemeId.toString themeId) ] withoutTemplateText
return Some {
theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" })
}
| None -> return None
}
/// Delete a theme by its ID /// Delete a theme by its ID
let delete themeId = backgroundTask { let delete themeId = backgroundTask {
let idParams = [ "@id", Sql.string (ThemeId.toString themeId) ] log.LogTrace "Theme.delete"
let! exists = match! exists themeId with
Sql.existingConnection conn | true ->
|> Sql.query $"SELECT EXISTS (SELECT 1 FROM theme WHERE id = @id) AS {existsName}" do! Delete.byId Table.Theme (ThemeId.toString themeId)
|> Sql.parameters idParams
|> Sql.executeRowAsync Map.toExists
if exists then
let! _ =
Sql.existingConnection conn
|> Sql.query
"DELETE FROM theme_asset WHERE theme_id = @id;
DELETE FROM theme_template WHERE theme_id = @id;
DELETE FROM theme WHERE id = @id"
|> Sql.parameters idParams
|> Sql.executeNonQueryAsync
return true return true
else return false | false -> return false
} }
/// Save a theme /// Save a theme
let save (theme : Theme) = backgroundTask { let save (theme : Theme) =
let! oldTheme = findById theme.Id log.LogTrace "Theme.save"
let themeIdParam = Sql.string (ThemeId.toString theme.Id) save Table.Theme (ThemeId.toString theme.Id) theme
let! _ =
Sql.existingConnection conn
|> Sql.query
"INSERT INTO theme VALUES (@id, @name, @version)
ON CONFLICT (id) DO UPDATE
SET name = EXCLUDED.name,
version = EXCLUDED.version"
|> Sql.parameters
[ "@id", themeIdParam
"@name", Sql.string theme.Name
"@version", Sql.string theme.Version ]
|> Sql.executeNonQueryAsync
let toDelete, _ =
Utils.diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue [])
theme.Templates (fun t -> t.Name)
let toAddOrUpdate =
theme.Templates
|> List.filter (fun t -> not (toDelete |> List.exists (fun d -> d.Name = t.Name)))
if not (List.isEmpty toDelete) || not (List.isEmpty toAddOrUpdate) then
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
"DELETE FROM theme_template WHERE theme_id = @themeId AND name = @name",
toDelete |> List.map (fun tmpl -> [ "@themeId", themeIdParam; "@name", Sql.string tmpl.Name ])
if not (List.isEmpty toAddOrUpdate) then
"INSERT INTO theme_template VALUES (@themeId, @name, @template)
ON CONFLICT (theme_id, name) DO UPDATE
SET template = EXCLUDED.template",
toAddOrUpdate |> List.map (fun tmpl -> [
"@themeId", themeIdParam
"@name", Sql.string tmpl.Name
"@template", Sql.string tmpl.Text
])
]
()
}
interface IThemeData with interface IThemeData with
member _.All () = all () member _.All () = all ()
@ -135,68 +59,54 @@ type PostgresThemeData (conn : NpgsqlConnection) =
/// PostreSQL myWebLog theme data implementation /// PostreSQL myWebLog theme data implementation
type PostgresThemeAssetData (conn : NpgsqlConnection) = type PostgresThemeAssetData (log : ILogger) =
/// Get all theme assets (excludes data) /// Get all theme assets (excludes data)
let all () = let all () =
Sql.existingConnection conn log.LogTrace "ThemeAsset.all"
|> Sql.query "SELECT theme_id, path, updated_on FROM theme_asset" Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}" [] (Map.toThemeAsset false)
|> Sql.executeAsync (Map.toThemeAsset false)
/// Delete all assets for the given theme /// Delete all assets for the given theme
let deleteByTheme themeId = backgroundTask { let deleteByTheme themeId =
let! _ = log.LogTrace "ThemeAsset.deleteByTheme"
Sql.existingConnection conn Custom.nonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
|> Sql.query "DELETE FROM theme_asset WHERE theme_id = @themeId" [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeNonQueryAsync
()
}
/// Find a theme asset by its ID /// Find a theme asset by its ID
let findById assetId = let findById assetId =
log.LogTrace "ThemeAsset.findById"
let (ThemeAssetId (ThemeId themeId, path)) = assetId let (ThemeAssetId (ThemeId themeId, path)) = assetId
Sql.existingConnection conn Custom.single $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path"
|> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId AND path = @path" [ "@themeId", Sql.string themeId; "@path", Sql.string path ] (Map.toThemeAsset true)
|> Sql.parameters [ "@themeId", Sql.string themeId; "@path", Sql.string path ]
|> Sql.executeAsync (Map.toThemeAsset true)
|> tryHead
/// Get theme assets for the given theme (excludes data) /// Get theme assets for the given theme (excludes data)
let findByTheme themeId = let findByTheme themeId =
Sql.existingConnection conn log.LogTrace "ThemeAsset.findByTheme"
|> Sql.query "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId" Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ] [ "@themeId", Sql.string (ThemeId.toString themeId) ] (Map.toThemeAsset false)
|> Sql.executeAsync (Map.toThemeAsset false)
/// Get theme assets for the given theme /// Get theme assets for the given theme
let findByThemeWithData themeId = let findByThemeWithData themeId =
Sql.existingConnection conn log.LogTrace "ThemeAsset.findByThemeWithData"
|> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId" Custom.list $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ] [ "@themeId", Sql.string (ThemeId.toString themeId) ] (Map.toThemeAsset true)
|> Sql.executeAsync (Map.toThemeAsset true)
/// Save a theme asset /// Save a theme asset
let save (asset : ThemeAsset) = backgroundTask { let save (asset : ThemeAsset) =
log.LogTrace "ThemeAsset.save"
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
let! _ = Custom.nonQuery
Sql.existingConnection conn $"INSERT INTO {Table.ThemeAsset} (
|> Sql.query theme_id, path, updated_on, data
"INSERT INTO theme_asset ( ) VALUES (
theme_id, path, updated_on, data @themeId, @path, @updatedOn, @data
) VALUES ( ) ON CONFLICT (theme_id, path) DO UPDATE
@themeId, @path, @updatedOn, @data SET updated_on = EXCLUDED.updated_on,
) ON CONFLICT (theme_id, path) DO UPDATE data = EXCLUDED.data"
SET updated_on = EXCLUDED.updated_on, [ "@themeId", Sql.string themeId
data = EXCLUDED.data" "@path", Sql.string path
|> Sql.parameters "@data", Sql.bytea asset.Data
[ "@themeId", Sql.string themeId typedParam "updatedOn" asset.UpdatedOn ]
"@path", Sql.string path
"@data", Sql.bytea asset.Data
typedParam "updatedOn" asset.UpdatedOn ]
|> Sql.executeNonQueryAsync
()
}
interface IThemeAssetData with interface IThemeAssetData with
member _.All () = all () member _.All () = all ()

66
src/MyWebLog.Data/Postgres/PostgresUploadData.fs
View File

@ -1,16 +1,17 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// PostgreSQL myWebLog uploaded file data implementation /// PostgreSQL myWebLog uploaded file data implementation
type PostgresUploadData (conn : NpgsqlConnection) = type PostgresUploadData (log : ILogger) =
/// The INSERT statement for an uploaded file /// The INSERT statement for an uploaded file
let upInsert = let upInsert = $"
"INSERT INTO upload ( INSERT INTO {Table.Upload} (
id, web_log_id, path, updated_on, data id, web_log_id, path, updated_on, data
) VALUES ( ) VALUES (
@id, @webLogId, @path, @updatedOn, @data @id, @webLogId, @path, @updatedOn, @data
@ -26,64 +27,49 @@ type PostgresUploadData (conn : NpgsqlConnection) =
] ]
/// Save an uploaded file /// Save an uploaded file
let add upload = backgroundTask { let add upload =
let! _ = log.LogTrace "Upload.add"
Sql.existingConnection conn Custom.nonQuery upInsert (upParams upload)
|> Sql.query upInsert
|> Sql.parameters (upParams upload)
|> Sql.executeNonQueryAsync
()
}
/// Delete an uploaded file by its ID /// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask { let delete uploadId webLogId = backgroundTask {
let theParams = [ "@id", Sql.string (UploadId.toString uploadId); webLogIdParam webLogId ] log.LogTrace "Upload.delete"
let idParam = [ "@id", Sql.string (UploadId.toString uploadId) ]
let! path = let! path =
Sql.existingConnection conn Custom.single $"SELECT path FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
|> Sql.query "SELECT path FROM upload WHERE id = @id AND web_log_id = @webLogId" (webLogIdParam webLogId :: idParam) (fun row -> row.string "path")
|> Sql.parameters theParams
|> Sql.executeAsync (fun row -> row.string "path")
|> tryHead
if Option.isSome path then if Option.isSome path then
let! _ = do! Custom.nonQuery (Query.Delete.byId Table.Upload) idParam
Sql.existingConnection conn
|> Sql.query "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters theParams
|> Sql.executeNonQueryAsync
return Ok path.Value return Ok path.Value
else return Error $"""Upload ID {UploadId.toString uploadId} not found""" else return Error $"""Upload ID {UploadId.toString uploadId} not found"""
} }
/// Find an uploaded file by its path for the given web log /// Find an uploaded file by its path for the given web log
let findByPath path webLogId = let findByPath path webLogId =
Sql.existingConnection conn log.LogTrace "Upload.findByPath"
|> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId AND path = @path" Custom.single $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path"
|> Sql.parameters [ webLogIdParam webLogId; "@path", Sql.string path ] [ webLogIdParam webLogId; "@path", Sql.string path ] (Map.toUpload true)
|> Sql.executeAsync (Map.toUpload true)
|> tryHead
/// Find all uploaded files for the given web log (excludes data) /// Find all uploaded files for the given web log (excludes data)
let findByWebLog webLogId = let findByWebLog webLogId =
Sql.existingConnection conn log.LogTrace "Upload.findByWebLog"
|> Sql.query "SELECT id, web_log_id, path, updated_on FROM upload WHERE web_log_id = @webLogId" Custom.list $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ] [ webLogIdParam webLogId ] (Map.toUpload false)
|> Sql.executeAsync (Map.toUpload false)
/// Find all uploaded files for the given web log /// Find all uploaded files for the given web log
let findByWebLogWithData webLogId = let findByWebLogWithData webLogId =
Sql.existingConnection conn log.LogTrace "Upload.findByWebLogWithData"
|> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId" Custom.list $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId" [ webLogIdParam webLogId ]
|> Sql.parameters [ webLogIdParam webLogId ] (Map.toUpload true)
|> Sql.executeAsync (Map.toUpload true)
/// Restore uploads from a backup /// Restore uploads from a backup
let restore uploads = backgroundTask { let restore uploads = backgroundTask {
log.LogTrace "Upload.restore"
for batch in uploads |> List.chunkBySize 5 do for batch in uploads |> List.chunkBySize 5 do
let! _ = let! _ =
Sql.existingConnection conn Configuration.dataSource ()
|> Sql.executeTransactionAsync [ |> Sql.fromDataSource
upInsert, batch |> List.map upParams |> Sql.executeTransactionAsync [ upInsert, batch |> List.map upParams ]
]
() ()
} }

244
src/MyWebLog.Data/Postgres/PostgresWebLogData.fs
View File

@ -1,231 +1,61 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open Npgsql
open Npgsql.FSharp
/// PostgreSQL myWebLog web log data implementation /// PostgreSQL myWebLog web log data implementation
type PostgresWebLogData (conn : NpgsqlConnection, ser : JsonSerializer) = type PostgresWebLogData (log : ILogger) =
// SUPPORT FUNCTIONS
/// The parameters for web log INSERT or web log/RSS options UPDATE statements
let rssParams (webLog : WebLog) = [
"@isFeedEnabled", Sql.bool webLog.Rss.IsFeedEnabled
"@feedName", Sql.string webLog.Rss.FeedName
"@itemsInFeed", Sql.intOrNone webLog.Rss.ItemsInFeed
"@isCategoryEnabled", Sql.bool webLog.Rss.IsCategoryEnabled
"@isTagEnabled", Sql.bool webLog.Rss.IsTagEnabled
"@copyright", Sql.stringOrNone webLog.Rss.Copyright
]
/// The parameters for web log INSERT or UPDATE statements
let webLogParams (webLog : WebLog) = [
"@id", Sql.string (WebLogId.toString webLog.Id)
"@name", Sql.string webLog.Name
"@slug", Sql.string webLog.Slug
"@subtitle", Sql.stringOrNone webLog.Subtitle
"@defaultPage", Sql.string webLog.DefaultPage
"@postsPerPage", Sql.int webLog.PostsPerPage
"@themeId", Sql.string (ThemeId.toString webLog.ThemeId)
"@urlBase", Sql.string webLog.UrlBase
"@timeZone", Sql.string webLog.TimeZone
"@autoHtmx", Sql.bool webLog.AutoHtmx
"@uploads", Sql.string (UploadDestination.toString webLog.Uploads)
yield! rssParams webLog
]
/// Shorthand to map a result to a custom feed
let toCustomFeed =
Map.toCustomFeed ser
/// Get the current custom feeds for a web log
let getCustomFeeds (webLog : WebLog) =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log_feed WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLog.Id ]
|> Sql.executeAsync toCustomFeed
/// 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 } }
}
/// The parameters to save a custom feed
let feedParams webLogId (feed : CustomFeed) = [
webLogIdParam webLogId
"@id", Sql.string (CustomFeedId.toString feed.Id)
"@source", Sql.string (CustomFeedSource.toString feed.Source)
"@path", Sql.string (Permalink.toString feed.Path)
"@podcast", Sql.jsonbOrNone (feed.Podcast |> Option.map (Utils.serialize ser))
]
/// Update the custom feeds for a web log
let updateCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog
let toDelete, _ = Utils.diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
let toId (feed : CustomFeed) = feed.Id
let toAddOrUpdate =
webLog.Rss.CustomFeeds |> List.filter (fun f -> not (toDelete |> List.map toId |> List.contains f.Id))
if not (List.isEmpty toDelete) || not (List.isEmpty toAddOrUpdate) then
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
"DELETE FROM web_log_feed WHERE id = @id",
toDelete |> List.map (fun it -> [ "@id", Sql.string (CustomFeedId.toString it.Id) ])
if not (List.isEmpty toAddOrUpdate) then
"INSERT INTO web_log_feed (
id, web_log_id, source, path, podcast
) VALUES (
@id, @webLogId, @source, @path, @podcast
) ON CONFLICT (id) DO UPDATE
SET source = EXCLUDED.source,
path = EXCLUDED.path,
podcast = EXCLUDED.podcast",
toAddOrUpdate |> List.map (feedParams webLog.Id)
]
()
}
// IMPLEMENTATION FUNCTIONS
/// Add a web log /// Add a web log
let add webLog = backgroundTask { let add (webLog : WebLog) =
let! _ = log.LogTrace "WebLog.add"
Sql.existingConnection conn insert Table.WebLog (WebLogId.toString webLog.Id) webLog
|> Sql.query
"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
)"
|> Sql.parameters (webLogParams webLog)
|> Sql.executeNonQueryAsync
do! updateCustomFeeds webLog
}
/// Retrieve all web logs /// Retrieve all web logs
let all () = backgroundTask { let all () =
let! webLogs = log.LogTrace "WebLog.all"
Sql.existingConnection conn Find.all<WebLog> Table.WebLog
|> Sql.query "SELECT * FROM web_log"
|> Sql.executeAsync Map.toWebLog
let! feeds =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log_feed"
|> Sql.executeAsync (fun row -> WebLogId (row.string "web_log_id"), toCustomFeed row)
return
webLogs
|> List.map (fun it ->
{ it with
Rss =
{ it.Rss with
CustomFeeds = feeds |> List.filter (fun (wlId, _) -> wlId = it.Id) |> List.map snd } })
}
/// Delete a web log by its ID /// Delete a web log by its ID
let delete webLogId = backgroundTask { let delete webLogId =
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)" log.LogTrace "WebLog.delete"
let postSubQuery = subQuery "post" Custom.nonQuery
let pageSubQuery = subQuery "page" $"""DELETE FROM {Table.PostComment}
let! _ = WHERE data ->> '{nameof Comment.empty.PostId}' IN
Sql.existingConnection conn (SELECT id FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"});
|> Sql.query $" {Query.Delete.byContains Table.Post};
DELETE FROM post_comment WHERE post_id IN {postSubQuery}; {Query.Delete.byContains Table.Page};
DELETE FROM post_revision WHERE post_id IN {postSubQuery}; {Query.Delete.byContains Table.Category};
DELETE FROM post_category WHERE post_id IN {postSubQuery}; {Query.Delete.byContains Table.TagMap};
DELETE FROM post WHERE web_log_id = @webLogId; {Query.Delete.byContains Table.WebLogUser};
DELETE FROM page_revision WHERE page_id IN {pageSubQuery}; DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId;
DELETE FROM page WHERE web_log_id = @webLogId; DELETE FROM {Table.WebLog} WHERE id = @webLogId"""
DELETE FROM category WHERE web_log_id = @webLogId; [ webLogIdParam webLogId; webLogContains 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"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeNonQueryAsync
()
}
/// Find a web log by its host (URL base) /// Find a web log by its host (URL base)
let findByHost url = backgroundTask { let findByHost (url : string) =
let! webLog = log.LogTrace "WebLog.findByHost"
Sql.existingConnection conn Custom.single (selectWithCriteria Table.WebLog) [ "@criteria", Query.jsonbDocParam {| UrlBase = url |} ]
|> Sql.query "SELECT * FROM web_log WHERE url_base = @urlBase" fromData<WebLog>
|> Sql.parameters [ "@urlBase", Sql.string url ]
|> Sql.executeAsync Map.toWebLog
|> tryHead
if Option.isSome webLog then
let! withFeeds = appendCustomFeeds webLog.Value
return Some withFeeds
else return None
}
/// Find a web log by its ID /// Find a web log by its ID
let findById webLogId = backgroundTask { let findById webLogId =
let! webLog = log.LogTrace "WebLog.findById"
Sql.existingConnection conn Find.byId<WebLog> Table.WebLog (WebLogId.toString webLogId)
|> Sql.query "SELECT * FROM web_log WHERE id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toWebLog
|> tryHead
if Option.isSome webLog then
let! withFeeds = appendCustomFeeds webLog.Value
return Some withFeeds
else return None
}
/// Update settings for a web log /// Update settings for a web log
let updateSettings webLog = backgroundTask { let updateSettings (webLog : WebLog) =
let! _ = log.LogTrace "WebLog.updateSettings"
Sql.existingConnection conn Update.full Table.WebLog (WebLogId.toString webLog.Id) webLog
|> Sql.query
"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"
|> Sql.parameters (webLogParams webLog)
|> Sql.executeNonQueryAsync
()
}
/// Update RSS options for a web log /// Update RSS options for a web log
let updateRssOptions (webLog : WebLog) = backgroundTask { let updateRssOptions (webLog : WebLog) = backgroundTask {
let! _ = log.LogTrace "WebLog.updateRssOptions"
Sql.existingConnection conn match! findById webLog.Id with
|> Sql.query | Some _ -> do! Update.partialById Table.WebLog (WebLogId.toString webLog.Id) {| Rss = webLog.Rss |}
"UPDATE web_log | None -> ()
SET is_feed_enabled = @isFeedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright
WHERE id = @webLogId"
|> Sql.parameters (webLogIdParam webLog.Id :: rssParams webLog)
|> Sql.executeNonQueryAsync
do! updateCustomFeeds webLog
} }
interface IWebLogData with interface IWebLogData with

127
src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs
View File

@ -1,140 +1,91 @@
namespace MyWebLog.Data.Postgres namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// PostgreSQL myWebLog user data implementation /// PostgreSQL myWebLog user data implementation
type PostgresWebLogUserData (conn : NpgsqlConnection) = type PostgresWebLogUserData (log : ILogger) =
/// The INSERT statement for a user
let userInsert =
"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
)"
/// Parameters for saving web log users
let userParams (user : WebLogUser) = [
"@id", Sql.string (WebLogUserId.toString user.Id)
"@webLogId", Sql.string (WebLogId.toString user.WebLogId)
"@email", Sql.string user.Email
"@firstName", Sql.string user.FirstName
"@lastName", Sql.string user.LastName
"@preferredName", Sql.string user.PreferredName
"@passwordHash", Sql.string user.PasswordHash
"@url", Sql.stringOrNone user.Url
"@accessLevel", Sql.string (AccessLevel.toString user.AccessLevel)
typedParam "createdOn" user.CreatedOn
optParam "lastSeenOn" user.LastSeenOn
]
/// Find a user by their ID for the given web log /// Find a user by their ID for the given web log
let findById userId webLogId = let findById userId webLogId =
Sql.existingConnection conn log.LogTrace "WebLogUser.findById"
|> Sql.query "SELECT * FROM web_log_user WHERE id = @id AND web_log_id = @webLogId" Document.findByIdAndWebLog<WebLogUserId, WebLogUser> Table.WebLogUser userId WebLogUserId.toString webLogId
|> Sql.parameters [ "@id", Sql.string (WebLogUserId.toString userId); webLogIdParam webLogId ]
|> Sql.executeAsync Map.toWebLogUser
|> tryHead
/// Delete a user if they have no posts or pages /// Delete a user if they have no posts or pages
let delete userId webLogId = backgroundTask { let delete userId webLogId = backgroundTask {
log.LogTrace "WebLogUser.delete"
match! findById userId webLogId with match! findById userId webLogId with
| Some _ -> | Some _ ->
let userParam = [ "@userId", Sql.string (WebLogUserId.toString userId) ] let criteria = Query.whereDataContains "@criteria"
let! isAuthor = let! isAuthor =
Sql.existingConnection conn Custom.scalar
|> Sql.query $" SELECT ( EXISTS (SELECT 1 FROM {Table.Page} WHERE {criteria}
"SELECT ( EXISTS (SELECT 1 FROM page WHERE author_id = @userId OR EXISTS (SELECT 1 FROM {Table.Post} WHERE {criteria})
OR EXISTS (SELECT 1 FROM post WHERE author_id = @userId)) AS does_exist" ) AS {existsName}"
|> Sql.parameters userParam [ "@criteria", Query.jsonbDocParam {| AuthorId = userId |} ] Map.toExists
|> Sql.executeRowAsync Map.toExists
if isAuthor then if isAuthor then
return Error "User has pages or posts; cannot delete" return Error "User has pages or posts; cannot delete"
else else
let! _ = do! Delete.byId Table.WebLogUser (WebLogUserId.toString userId)
Sql.existingConnection conn
|> Sql.query "DELETE FROM web_log_user WHERE id = @userId"
|> Sql.parameters userParam
|> Sql.executeNonQueryAsync
return Ok true return Ok true
| None -> return Error "User does not exist" | None -> return Error "User does not exist"
} }
/// Find a user by their e-mail address for the given web log /// Find a user by their e-mail address for the given web log
let findByEmail email webLogId = let findByEmail (email : string) webLogId =
Sql.existingConnection conn log.LogTrace "WebLogUser.findByEmail"
|> Sql.query "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND email = @email" Custom.single (selectWithCriteria Table.WebLogUser)
|> Sql.parameters [ webLogIdParam webLogId; "@email", Sql.string email ] [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Email = email |} ]
|> Sql.executeAsync Map.toWebLogUser fromData<WebLogUser>
|> tryHead
/// Get all users for the given web log /// Get all users for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
Sql.existingConnection conn log.LogTrace "WebLogUser.findByWebLog"
|> Sql.query "SELECT * FROM web_log_user WHERE web_log_id = @webLogId ORDER BY LOWER(preferred_name)" Custom.list
|> Sql.parameters [ webLogIdParam webLogId ] $"{selectWithCriteria Table.WebLogUser} ORDER BY LOWER(data->>'{nameof WebLogUser.empty.PreferredName}')"
|> Sql.executeAsync Map.toWebLogUser [ webLogContains webLogId ] fromData<WebLogUser>
/// Find the names of users by their IDs for the given web log /// Find the names of users by their IDs for the given web log
let findNames webLogId userIds = backgroundTask { let findNames webLogId userIds = backgroundTask {
log.LogTrace "WebLogUser.findNames"
let idSql, idParams = inClause "AND id" "id" WebLogUserId.toString userIds let idSql, idParams = inClause "AND id" "id" WebLogUserId.toString userIds
let! users = let! users =
Sql.existingConnection conn Custom.list $"{selectWithCriteria Table.WebLogUser} {idSql}" (webLogContains webLogId :: idParams)
|> Sql.query $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {idSql}" fromData<WebLogUser>
|> Sql.parameters (webLogIdParam webLogId :: idParams)
|> Sql.executeAsync Map.toWebLogUser
return return
users users
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u }) |> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
} }
/// Restore users from a backup /// Restore users from a backup
let restore users = backgroundTask { let restore (users : WebLogUser list) = backgroundTask {
log.LogTrace "WebLogUser.restore"
let! _ = let! _ =
Sql.existingConnection conn Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
userInsert, users |> List.map userParams 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 /// Set a user's last seen date/time to now
let setLastSeen userId webLogId = backgroundTask { let setLastSeen userId webLogId = backgroundTask {
let! _ = log.LogTrace "WebLogUser.setLastSeen"
Sql.existingConnection conn match! Document.existsByWebLog Table.WebLogUser userId WebLogUserId.toString webLogId with
|> Sql.query "UPDATE web_log_user SET last_seen_on = @lastSeenOn WHERE id = @id AND web_log_id = @webLogId" | true ->
|> Sql.parameters do! Update.partialById Table.WebLogUser (WebLogUserId.toString userId) {| LastSeenOn = Some (Noda.now ()) |}
[ webLogIdParam webLogId | false -> ()
typedParam "lastSeenOn" (Noda.now ())
"@id", Sql.string (WebLogUserId.toString userId) ]
|> Sql.executeNonQueryAsync
()
} }
/// Save a user /// Save a user
let save user = backgroundTask { let save (user : WebLogUser) =
let! _ = log.LogTrace "WebLogUser.save"
Sql.existingConnection conn save Table.WebLogUser (WebLogUserId.toString user.Id) user
|> Sql.query $"
{userInsert} ON CONFLICT (id) DO UPDATE
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"
|> Sql.parameters (userParams user)
|> Sql.executeNonQueryAsync
()
}
interface IWebLogUserData with interface IWebLogUserData with
member _.Add user = save user member _.Add user = save user

279
src/MyWebLog.Data/PostgresData.fs
View File

@ -1,207 +1,127 @@
namespace MyWebLog.Data namespace MyWebLog.Data
open BitBadger.Npgsql.Documents
open BitBadger.Npgsql.FSharp.Documents
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data.Postgres open MyWebLog.Data.Postgres
open Newtonsoft.Json open Newtonsoft.Json
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// Data implementation for PostgreSQL /// Data implementation for PostgreSQL
type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, ser : JsonSerializer) = type PostgresData (source : NpgsqlDataSource, log : ILogger<PostgresData>, ser : JsonSerializer) =
/// Create any needed tables /// Create any needed tables
let ensureTables () = backgroundTask { let ensureTables () = backgroundTask {
let _ = NpgsqlConnection.GlobalTypeMapper.UseNodaTime () // 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 = let! tables =
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'" |> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'"
|> Sql.executeAsync (fun row -> row.string "tablename") |> Sql.executeAsync (fun row -> row.string "tablename")
let needsTable table = not (List.contains table tables) let needsTable table = not (List.contains table tables)
// Create a document table
let mutable isNew = false let mutable isNew = false
let sql = seq { let sql = seq {
// Theme tables // Theme tables
if needsTable "theme" then if needsTable Table.Theme then
isNew <- true isNew <- true
"CREATE TABLE theme ( Definition.createTable Table.Theme
id TEXT NOT NULL PRIMARY KEY, if needsTable Table.ThemeAsset then
name TEXT NOT NULL, $"CREATE TABLE {Table.ThemeAsset} (
version TEXT NOT NULL)" theme_id TEXT NOT NULL REFERENCES {Table.Theme} (id) ON DELETE CASCADE,
if needsTable "theme_template" then
"CREATE TABLE theme_template (
theme_id TEXT NOT NULL REFERENCES theme (id),
name TEXT NOT NULL,
template TEXT NOT NULL,
PRIMARY KEY (theme_id, name))"
if needsTable "theme_asset" then
"CREATE TABLE theme_asset (
theme_id TEXT NOT NULL REFERENCES theme (id),
path TEXT NOT NULL, path TEXT NOT NULL,
updated_on TIMESTAMPTZ NOT NULL, updated_on TIMESTAMPTZ NOT NULL,
data BYTEA NOT NULL, data BYTEA NOT NULL,
PRIMARY KEY (theme_id, path))" PRIMARY KEY (theme_id, path))"
// Web log tables // Web log table
if needsTable "web_log" then if needsTable Table.WebLog then
"CREATE TABLE web_log ( Definition.createTable Table.WebLog
id TEXT NOT NULL PRIMARY KEY, Definition.createIndex Table.WebLog Optimized
name TEXT NOT NULL,
slug TEXT NOT NULL,
subtitle TEXT,
default_page TEXT NOT NULL,
posts_per_page INTEGER NOT NULL,
theme_id TEXT NOT NULL REFERENCES theme (id),
url_base TEXT NOT NULL,
time_zone TEXT NOT NULL,
auto_htmx BOOLEAN NOT NULL DEFAULT FALSE,
uploads TEXT NOT NULL,
is_feed_enabled BOOLEAN NOT NULL DEFAULT FALSE,
feed_name TEXT NOT NULL,
items_in_feed INTEGER,
is_category_enabled BOOLEAN NOT NULL DEFAULT FALSE,
is_tag_enabled BOOLEAN NOT NULL DEFAULT FALSE,
copyright TEXT)"
"CREATE INDEX web_log_theme_idx ON web_log (theme_id)"
if needsTable "web_log_feed" then
"CREATE TABLE web_log_feed (
id TEXT NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
source TEXT NOT NULL,
path TEXT NOT NULL,
podcast JSONB)"
"CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"
// Category table // Category table
if needsTable "category" then if needsTable Table.Category then
"CREATE TABLE category ( Definition.createTable Table.Category
id TEXT NOT NULL PRIMARY KEY, Definition.createIndex Table.Category Optimized
web_log_id TEXT NOT NULL REFERENCES web_log (id),
name TEXT NOT NULL,
slug TEXT NOT NULL,
description TEXT,
parent_id TEXT)"
"CREATE INDEX category_web_log_idx ON category (web_log_id)"
// Web log user table // Web log user table
if needsTable "web_log_user" then if needsTable Table.WebLogUser then
"CREATE TABLE web_log_user ( Definition.createTable Table.WebLogUser
id TEXT NOT NULL PRIMARY KEY, Definition.createIndex Table.WebLogUser Optimized
web_log_id TEXT NOT NULL REFERENCES web_log (id),
email TEXT NOT NULL,
first_name TEXT NOT NULL,
last_name TEXT NOT NULL,
preferred_name TEXT NOT NULL,
password_hash TEXT NOT NULL,
url TEXT,
access_level TEXT NOT NULL,
created_on TIMESTAMPTZ NOT NULL,
last_seen_on TIMESTAMPTZ)"
"CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id)"
"CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)"
// Page tables // Page tables
if needsTable "page" then if needsTable Table.Page then
"CREATE TABLE page ( Definition.createTable Table.Page
id TEXT NOT NULL PRIMARY KEY, $"CREATE INDEX page_web_log_idx ON {Table.Page} ((data ->> '{nameof Page.empty.WebLogId}'))"
web_log_id TEXT NOT NULL REFERENCES web_log (id), $"CREATE INDEX page_author_idx ON {Table.Page} ((data ->> '{nameof Page.empty.AuthorId}'))"
author_id TEXT NOT NULL REFERENCES web_log_user (id), $"CREATE INDEX page_permalink_idx ON {Table.Page}
title TEXT NOT NULL, ((data ->> '{nameof Page.empty.WebLogId}'), (data ->> '{nameof Page.empty.Permalink}'))"
permalink TEXT NOT NULL, if needsTable Table.PageRevision then
prior_permalinks TEXT[] NOT NULL DEFAULT '{}', $"CREATE TABLE {Table.PageRevision} (
published_on TIMESTAMPTZ NOT NULL, page_id TEXT NOT NULL REFERENCES {Table.Page} (id) ON DELETE CASCADE,
updated_on TIMESTAMPTZ NOT NULL,
is_in_page_list BOOLEAN NOT NULL DEFAULT FALSE,
template TEXT,
page_text TEXT NOT NULL,
meta_items JSONB)"
"CREATE INDEX page_web_log_idx ON page (web_log_id)"
"CREATE INDEX page_author_idx ON page (author_id)"
"CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)"
if needsTable "page_revision" then
"CREATE TABLE page_revision (
page_id TEXT NOT NULL REFERENCES page (id),
as_of TIMESTAMPTZ NOT NULL, as_of TIMESTAMPTZ NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (page_id, as_of))" PRIMARY KEY (page_id, as_of))"
// Post tables // Post tables
if needsTable "post" then if needsTable Table.Post then
"CREATE TABLE post ( Definition.createTable Table.Post
id TEXT NOT NULL PRIMARY KEY, $"CREATE INDEX post_web_log_idx ON {Table.Post} ((data ->> '{nameof Post.empty.WebLogId}'))"
web_log_id TEXT NOT NULL REFERENCES web_log (id), $"CREATE INDEX post_author_idx ON {Table.Post} ((data ->> '{nameof Post.empty.AuthorId}'))"
author_id TEXT NOT NULL REFERENCES web_log_user (id), $"CREATE INDEX post_status_idx ON {Table.Post}
status TEXT NOT NULL, ((data ->> '{nameof Post.empty.WebLogId}'), (data ->> '{nameof Post.empty.Status}'),
title TEXT NOT NULL, (data ->> '{nameof Post.empty.UpdatedOn}'))"
permalink TEXT NOT NULL, $"CREATE INDEX post_permalink_idx ON {Table.Post}
prior_permalinks TEXT[] NOT NULL DEFAULT '{}', ((data ->> '{nameof Post.empty.WebLogId}'), (data ->> '{nameof Post.empty.Permalink}'))"
published_on TIMESTAMPTZ, $"CREATE INDEX post_category_idx ON {Table.Post} USING GIN ((data['{nameof Post.empty.CategoryIds}']))"
updated_on TIMESTAMPTZ NOT NULL, $"CREATE INDEX post_tag_idx ON {Table.Post} USING GIN ((data['{nameof Post.empty.Tags}']))"
template TEXT, if needsTable Table.PostRevision then
post_text TEXT NOT NULL, $"CREATE TABLE {Table.PostRevision} (
tags TEXT[], post_id TEXT NOT NULL REFERENCES {Table.Post} (id) ON DELETE CASCADE,
meta_items JSONB,
episode JSONB)"
"CREATE INDEX post_web_log_idx ON post (web_log_id)"
"CREATE INDEX post_author_idx ON post (author_id)"
"CREATE INDEX post_status_idx ON post (web_log_id, status, updated_on)"
"CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)"
if needsTable "post_category" then
"CREATE TABLE post_category (
post_id TEXT NOT NULL REFERENCES post (id),
category_id TEXT NOT NULL REFERENCES category (id),
PRIMARY KEY (post_id, category_id))"
"CREATE INDEX post_category_category_idx ON post_category (category_id)"
if needsTable "post_revision" then
"CREATE TABLE post_revision (
post_id TEXT NOT NULL REFERENCES post (id),
as_of TIMESTAMPTZ NOT NULL, as_of TIMESTAMPTZ NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (post_id, as_of))" PRIMARY KEY (post_id, as_of))"
if needsTable "post_comment" then if needsTable Table.PostComment then
"CREATE TABLE post_comment ( Definition.createTable Table.PostComment
id TEXT NOT NULL PRIMARY KEY, $"CREATE INDEX post_comment_post_idx ON {Table.PostComment}
post_id TEXT NOT NULL REFERENCES post(id), ((data ->> '{nameof Comment.empty.PostId}'))"
in_reply_to_id TEXT,
name TEXT NOT NULL,
email TEXT NOT NULL,
url TEXT,
status TEXT NOT NULL,
posted_on TIMESTAMPTZ NOT NULL,
comment_text TEXT NOT NULL)"
"CREATE INDEX post_comment_post_idx ON post_comment (post_id)"
// Tag map table // Tag map table
if needsTable "tag_map" then if needsTable Table.TagMap then
"CREATE TABLE tag_map ( Definition.createTable Table.TagMap
id TEXT NOT NULL PRIMARY KEY, Definition.createIndex Table.TagMap Optimized
web_log_id TEXT NOT NULL REFERENCES web_log (id),
tag TEXT NOT NULL,
url_value TEXT NOT NULL)"
"CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)"
// Uploaded file table // Uploaded file table
if needsTable "upload" then if needsTable Table.Upload then
"CREATE TABLE upload ( $"CREATE TABLE {Table.Upload} (
id TEXT NOT NULL PRIMARY KEY, id TEXT NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES {Table.WebLog} (id),
path TEXT NOT NULL, path TEXT NOT NULL,
updated_on TIMESTAMPTZ NOT NULL, updated_on TIMESTAMPTZ NOT NULL,
data BYTEA NOT NULL)" data BYTEA NOT NULL)"
"CREATE INDEX upload_web_log_idx ON upload (web_log_id)" $"CREATE INDEX upload_web_log_idx ON {Table.Upload} (web_log_id)"
"CREATE INDEX upload_path_idx ON upload (web_log_id, path)" $"CREATE INDEX upload_path_idx ON {Table.Upload} (web_log_id, path)"
// Database version table // Database version table
if needsTable "db_version" then if needsTable Table.DbVersion then
"CREATE TABLE db_version (id TEXT NOT NULL PRIMARY KEY)" $"CREATE TABLE {Table.DbVersion} (id TEXT NOT NULL PRIMARY KEY)"
$"INSERT INTO db_version VALUES ('{Utils.currentDbVersion}')" $"INSERT INTO {Table.DbVersion} VALUES ('{Utils.currentDbVersion}')"
} }
Sql.existingConnection conn Sql.fromDataSource source
|> Sql.executeTransactionAsync |> Sql.executeTransactionAsync
(sql (sql
|> Seq.map (fun s -> |> Seq.map (fun s ->
let parts = s.Split ' ' let parts = s.Replace(" IF NOT EXISTS", "", System.StringComparison.OrdinalIgnoreCase).Split ' '
if parts[1].ToLowerInvariant () = "table" then if parts[1].ToLowerInvariant () = "table" then
log.LogInformation $"Creating {parts[2]} table..." log.LogInformation $"Creating {parts[2]} table..."
s, [ [] ]) s, [ [] ])
@ -212,18 +132,40 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, ser : J
} }
/// Set a specific database version /// Set a specific database version
let setDbVersion version = backgroundTask { let setDbVersion version =
let! _ = Custom.nonQuery $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')" []
Sql.existingConnection conn
|> Sql.query $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')"
|> Sql.executeNonQueryAsync
()
}
/// 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 /// Do required data migration between versions
let migrate version = backgroundTask { let migrate version = backgroundTask {
match version with match version with
| Some "v2-rc2" -> () | Some "v2" -> ()
| Some "v2-rc2" -> do! migrateV2Rc2ToV2 ()
// Future versions will be inserted here // Future versions will be inserted here
| Some _ | Some _
| None -> | None ->
@ -233,26 +175,23 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, ser : J
interface IData with interface IData with
member _.Category = PostgresCategoryData conn member _.Category = PostgresCategoryData log
member _.Page = PostgresPageData (conn, ser) member _.Page = PostgresPageData log
member _.Post = PostgresPostData (conn, ser) member _.Post = PostgresPostData log
member _.TagMap = PostgresTagMapData conn member _.TagMap = PostgresTagMapData log
member _.Theme = PostgresThemeData conn member _.Theme = PostgresThemeData log
member _.ThemeAsset = PostgresThemeAssetData conn member _.ThemeAsset = PostgresThemeAssetData log
member _.Upload = PostgresUploadData conn member _.Upload = PostgresUploadData log
member _.WebLog = PostgresWebLogData (conn, ser) member _.WebLog = PostgresWebLogData log
member _.WebLogUser = PostgresWebLogUserData conn member _.WebLogUser = PostgresWebLogUserData log
member _.Serializer = ser member _.Serializer = ser
member _.StartUp () = backgroundTask { member _.StartUp () = backgroundTask {
log.LogTrace "PostgresData.StartUp"
do! ensureTables () do! ensureTables ()
let! version = let! version = Custom.single "SELECT id FROM db_version" [] (fun row -> row.string "id")
Sql.existingConnection conn
|> Sql.query "SELECT id FROM db_version"
|> Sql.executeAsync (fun row -> row.string "id")
|> tryHead
match version with match version with
| Some v when v = Utils.currentDbVersion -> () | Some v when v = Utils.currentDbVersion -> ()
| Some _ | Some _

11
src/MyWebLog.Data/RethinkDbData.fs
View File

@ -5,7 +5,6 @@ open MyWebLog
open RethinkDb.Driver open RethinkDb.Driver
/// Functions to assist with retrieving data /// Functions to assist with retrieving data
[<AutoOpen>]
module private RethinkHelpers = module private RethinkHelpers =
/// Table names /// Table names
@ -90,6 +89,7 @@ open System
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog.ViewModels open MyWebLog.ViewModels
open RethinkDb.Driver.FSharp open RethinkDb.Driver.FSharp
open RethinkHelpers
/// RethinkDB implementation of data functions for myWebLog /// RethinkDB implementation of data functions for myWebLog
type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<RethinkDbData>) = type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<RethinkDbData>) =
@ -214,11 +214,18 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
logStep "Setting database version to v2-rc2" logStep "Setting database version to v2-rc2"
do! setDbVersion "v2-rc2" do! setDbVersion "v2-rc2"
} }
/// Migrate from v2-rc2 to v2
let migrateV2Rc2ToV2 () = backgroundTask {
Utils.logMigrationStep log "v2-rc2 to v2" "Setting database version; no migration required"
do! setDbVersion "v2"
}
/// Migrate data between versions /// Migrate data between versions
let migrate version = backgroundTask { let migrate version = backgroundTask {
match version with match version with
| Some v when v = "v2-rc2" -> () | Some v when v = "v2" -> ()
| Some v when v = "v2-rc2" -> do! migrateV2Rc2ToV2 ()
| Some v when v = "v2-rc1" -> do! migrateV2Rc1ToV2Rc2 () | Some v when v = "v2-rc1" -> do! migrateV2Rc1ToV2Rc2 ()
| Some _ | Some _
| None -> | None ->

9
src/MyWebLog.Data/SQLiteData.fs
View File

@ -529,11 +529,18 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
do! setDbVersion "v2-rc2" do! setDbVersion "v2-rc2"
} }
/// Migrate from v2-rc2 to v2
let migrateV2Rc2ToV2 () = backgroundTask {
Utils.logMigrationStep log "v2-rc2 to v2" "Setting database version; no migration required"
do! setDbVersion "v2"
}
/// Migrate data among versions (up only) /// Migrate data among versions (up only)
let migrate version = backgroundTask { let migrate version = backgroundTask {
match version with match version with
| Some v when v = "v2-rc2" -> () | Some v when v = "v2" -> ()
| Some v when v = "v2-rc2" -> do! migrateV2Rc2ToV2 ()
| Some v when v = "v2-rc1" -> do! migrateV2Rc1ToV2Rc2 () | Some v when v = "v2-rc1" -> do! migrateV2Rc1ToV2Rc2 ()
| Some _ | Some _
| None -> | None ->

2
src/MyWebLog.Data/Utils.fs
View File

@ -6,7 +6,7 @@ open MyWebLog
open MyWebLog.ViewModels open MyWebLog.ViewModels
/// The current database version /// The current database version
let currentDbVersion = "v2-rc2" let currentDbVersion = "v2"
/// Create a category hierarchy from the given list of categories /// Create a category hierarchy from the given list of categories
let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq { let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq {

7
src/MyWebLog.Domain/MyWebLog.Domain.fsproj
View File

@ -7,10 +7,9 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Markdig" Version="0.30.3" /> <PackageReference Include="Markdig" Version="0.30.4" />
<PackageReference Update="FSharp.Core" Version="6.0.5" /> <PackageReference Include="Markdown.ColorCode" Version="1.0.2" />
<PackageReference Include="Markdown.ColorCode" Version="1.0.1" /> <PackageReference Include="NodaTime" Version="3.1.6" />
<PackageReference Include="NodaTime" Version="3.1.2" />
</ItemGroup> </ItemGroup>
</Project> </Project>

1
src/MyWebLog/Handlers/Helpers.fs
View File

@ -120,7 +120,6 @@ module ViewContext =
/// The current web log /// The current web log
[<Literal>] [<Literal>]
let WebLog = "web_log" let WebLog = "web_log"
/// The HTTP item key for loading the session /// The HTTP item key for loading the session

7
src/MyWebLog/Handlers/Page.fs
View File

@ -12,9 +12,14 @@ let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
return! return!
hashForPage "Pages" hashForPage "Pages"
|> withAntiCsrf ctx |> withAntiCsrf ctx
|> addToHash "pages" (pages |> List.map (DisplayPage.fromPageMinimal ctx.WebLog)) |> addToHash "pages" (pages
|> Seq.ofList
|> Seq.truncate 25
|> Seq.map (DisplayPage.fromPageMinimal ctx.WebLog)
|> List.ofSeq)
|> addToHash "page_nbr" pageNbr |> addToHash "page_nbr" pageNbr
|> addToHash "prev_page" (if pageNbr = 2 then "" else $"/page/{pageNbr - 1}") |> addToHash "prev_page" (if pageNbr = 2 then "" else $"/page/{pageNbr - 1}")
|> addToHash "has_next" (List.length pages > 25)
|> addToHash "next_page" $"/page/{pageNbr + 1}" |> addToHash "next_page" $"/page/{pageNbr + 1}"
|> adminView "page-list" next ctx |> adminView "page-list" next ctx
} }

9
src/MyWebLog/MyWebLog.fsproj
View File

@ -23,14 +23,13 @@
</ItemGroup> </ItemGroup>
<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" Version="6.0.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.8.0" /> <PackageReference Include="Giraffe.Htmx" Version="1.8.5" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.0" /> <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.5" />
<PackageReference Include="NeoSmart.Caching.Sqlite" Version="6.0.1" /> <PackageReference Include="NeoSmart.Caching.Sqlite" Version="6.0.1" />
<PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" /> <PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" />
<PackageReference Update="FSharp.Core" Version="6.0.5" /> <PackageReference Include="System.ServiceModel.Syndication" Version="7.0.0" />
<PackageReference Include="System.ServiceModel.Syndication" Version="6.0.0" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

33
src/MyWebLog/Program.fs
View File

@ -10,7 +10,7 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>)
/// Is the debug level enabled on the logger? /// Is the debug level enabled on the logger?
let isDebug = log.IsEnabled LogLevel.Debug let isDebug = log.IsEnabled LogLevel.Debug
member this.InvokeAsync (ctx : HttpContext) = task { member _.InvokeAsync (ctx : HttpContext) = task {
/// Create the full path of the request /// Create the full path of the request
let path = $"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{ctx.Request.Path.Value}" let path = $"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{ctx.Request.Path.Value}"
match WebLogCache.tryGet path with match WebLogCache.tryGet path with
@ -36,10 +36,16 @@ open Npgsql
module DataImplementation = module DataImplementation =
open MyWebLog.Converters open MyWebLog.Converters
// open Npgsql.Logging
open RethinkDb.Driver.FSharp open RethinkDb.Driver.FSharp
open RethinkDb.Driver.Net 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 /// Get the configured data implementation
let get (sp : IServiceProvider) : IData = let get (sp : IServiceProvider) : IData =
let config = sp.GetRequiredService<IConfiguration> () let config = sp.GetRequiredService<IConfiguration> ()
@ -62,11 +68,11 @@ module DataImplementation =
let conn = await (rethinkCfg.CreateConnectionAsync log) let conn = await (rethinkCfg.CreateConnectionAsync log)
RethinkDbData (conn, rethinkCfg, log) RethinkDbData (conn, rethinkCfg, log)
elif hasConnStr "PostgreSQL" then elif hasConnStr "PostgreSQL" then
let source = createNpgsqlDataSource config
use conn = source.CreateConnection ()
let log = sp.GetRequiredService<ILogger<PostgresData>> () let log = sp.GetRequiredService<ILogger<PostgresData>> ()
// NpgsqlLogManager.Provider <- ConsoleLoggingProvider NpgsqlLogLevel.Debug log.LogInformation $"Using PostgreSQL database {conn.Database}"
let conn = new NpgsqlConnection (connStr "PostgreSQL") PostgresData (source, log, Json.configure (JsonSerializer.CreateDefault ()))
log.LogInformation $"Using PostgreSQL database {conn.Host}:{conn.Port}/{conn.Database}"
PostgresData (conn, log, Json.configure (JsonSerializer.CreateDefault ()))
else else
createSQLite "Data Source=./myweblog.db;Cache=Shared" createSQLite "Data Source=./myweblog.db;Cache=Shared"
@ -152,16 +158,15 @@ let rec main args =
let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./session.db" let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./session.db"
let _ = builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath) let _ = builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath)
() ()
| :? PostgresData -> | :? PostgresData as postgres ->
// ADO.NET connections are designed to work as per-request instantiation // ADO.NET Data Sources are designed to work as singletons
let cfg = sp.GetRequiredService<IConfiguration> ()
let _ = let _ =
builder.Services.AddScoped<NpgsqlConnection> (fun sp -> builder.Services.AddSingleton<NpgsqlDataSource> (fun sp ->
new NpgsqlConnection (cfg.GetConnectionString "PostgreSQL")) DataImplementation.createNpgsqlDataSource (sp.GetRequiredService<IConfiguration> ()))
let _ = builder.Services.AddScoped<IData, PostgresData> () let _ = builder.Services.AddSingleton<IData> postgres
let _ = let _ =
builder.Services.AddSingleton<IDistributedCache> (fun sp -> builder.Services.AddSingleton<IDistributedCache> (fun _ ->
Postgres.DistributedCache (cfg.GetConnectionString "PostgreSQL") :> IDistributedCache) Postgres.DistributedCache () :> IDistributedCache)
() ()
| _ -> () | _ -> ()

2
src/MyWebLog/appsettings.json
View File

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

247
src/admin-theme/custom-feed-edit.liquid
View File

@ -1,13 +1,19 @@
<h2 class="my-3">{{ page_title }}</h2> <h2 class="my-3">{{ page_title }}</h2>
<article> <article>
<form action="{{ "admin/settings/rss/save" | relative_link }}" method="post"> <form action="{{ "admin/settings/rss/save" | relative_link }}" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <input
<input type="hidden" name="Id" value="{{ model.id }}"> type="hidden"
name="{{ csrf.form_field_name }}"
value="{{ csrf.request_token }}">
<input
type="hidden"
name="Id"
value="{{ model.id }}">
{%- assign typ = model.source_type -%} {%- assign typ = model.source_type -%}
<div class="container"> <div class="container">
<div class="row pb-3"> <div class="row pb-3">
<div class="col"> <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> </div>
<div class="row pb-3"> <div class="row pb-3">
@ -17,8 +23,13 @@
<div class="row"> <div class="row">
<div class="col"> <div class="col">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="Path" id="path" class="form-control" placeholder="Relative Feed Path" <input
value="{{ model.path }}"> type="text"
name="Path"
id="path"
class="form-control"
placeholder="Relative Feed Path"
value="{{ model.path }}">
<label for="path">Relative Feed Path</label> <label for="path">Relative Feed Path</label>
<span class="form-text fst-italic">Appended to {{ web_log.url_base }}/</span> <span class="form-text fst-italic">Appended to {{ web_log.url_base }}/</span>
</div> </div>
@ -27,8 +38,13 @@
<div class="row"> <div class="row">
<div class="col py-3 d-flex align-self-center justify-content-center"> <div class="col py-3 d-flex align-self-center justify-content-center">
<div class="form-check form-switch"> <div class="form-check form-switch">
<input type="checkbox" name="IsPodcast" id="isPodcast" class="form-check-input" value="true" <input
{%- if model.is_podcast %} checked="checked"{% endif %} onclick="Admin.checkPodcast()"> 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> <label for="isPodcast" class="form-check-label">This Is a Podcast Feed</label>
</div> </div>
</div> </div>
@ -41,21 +57,31 @@
<div class="row d-flex align-items-center"> <div class="row d-flex align-items-center">
<div class="col-1 d-flex justify-content-end pb-3"> <div class="col-1 d-flex justify-content-end pb-3">
<div class="form-check form-check-inline me-0"> <div class="form-check form-check-inline me-0">
<input type="radio" name="SourceType" id="sourceTypeCat" class="form-check-input" value="category" <input
{%- unless typ == "tag" %} checked="checked" {% endunless -%} type="radio"
onclick="Admin.customFeedBy('category')"> 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> <label for="sourceTypeCat" class="form-check-label d-none">Category</label>
</div> </div>
</div> </div>
<div class="col-11 pb-3"> <div class="col-11 pb-3">
<div class="form-floating"> <div class="form-floating">
<select name="SourceValue" id="sourceValueCat" class="form-control" required <select
{%- if typ == "tag" %} disabled="disabled"{% endif %}> name="SourceValue"
id="sourceValueCat"
class="form-control"
required
{%- if typ == "tag" %}disabled="disabled"{% endif %}>
<option value="">&ndash; Select Category &ndash;</option> <option value="">&ndash; Select Category &ndash;</option>
{% for cat in categories -%} {% for cat in categories -%}
<option value="{{ cat.id }}" <option value="{{ cat.id }}"{%- if typ != "tag" and model.source_value == cat.id %}selected="selected"{% endif -%}>
{%- if typ != "tag" and model.source_value == cat.id %} selected="selected"{% endif -%}> {% for it in cat.parent_names %}
{% for it in cat.parent_names %}{{ it }} &rang; {% endfor %}{{ cat.name }} {{ it }} &rang;
{% endfor %}
{{ cat.name }}
</option> </option>
{%- endfor %} {%- endfor %}
</select> </select>
@ -64,16 +90,25 @@
</div> </div>
<div class="col-1 d-flex justify-content-end pb-3"> <div class="col-1 d-flex justify-content-end pb-3">
<div class="form-check form-check-inline me-0"> <div class="form-check form-check-inline me-0">
<input type="radio" name="SourceType" id="sourceTypeTag" class="form-check-input" value="tag" <input
{%- if typ == "tag" %} checked="checked"{% endif %} onclick="Admin.customFeedBy('tag')"> 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> <label for="sourceTypeTag" class="form-check-label d-none">Tag</label>
</div> </div>
</div> </div>
<div class="col-11 pb-3"> <div class="col-11 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="SourceValue" id="sourceValueTag" class="form-control" placeholder="Tag" <input
{%- unless typ == "tag" %} disabled="disabled"{% endunless %} required type="text"
{%- if typ == "tag" %} value="{{ model.source_value }}"{% endif %}> 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> <label for="sourceValueTag">Tag</label>
</div> </div>
</div> </div>
@ -83,27 +118,47 @@
</div> </div>
<div class="row pb-3"> <div class="row pb-3">
<div class="col"> <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> <legend>Podcast Settings</legend>
<div class="row"> <div class="row">
<div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3"> <div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="Title" id="title" class="form-control" placeholder="Title" required <input
value="{{ model.title }}"> type="text"
name="Title"
id="title"
class="form-control"
placeholder="Title"
required
value="{{ model.title }}">
<label for="title">Title</label> <label for="title">Title</label>
</div> </div>
</div> </div>
<div class="col-12 col-md-4 col-lg-4 pb-3"> <div class="col-12 col-md-4 col-lg-4 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="Subtitle" id="subtitle" class="form-control" placeholder="Subtitle" <input
value="{{ model.subtitle }}"> type="text"
name="Subtitle"
id="subtitle"
class="form-control"
placeholder="Subtitle"
value="{{ model.subtitle }}">
<label for="subtitle">Podcast Subtitle</label> <label for="subtitle">Podcast Subtitle</label>
</div> </div>
</div> </div>
<div class="col-12 col-md-3 col-lg-2 pb-3"> <div class="col-12 col-md-3 col-lg-2 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="number" name="ItemsInFeed" id="itemsInFeed" class="form-control" placeholder="Items" <input
required value="{{ model.items_in_feed }}"> type="number"
name="ItemsInFeed"
id="itemsInFeed"
class="form-control"
placeholder="Items"
required
value="{{ model.items_in_feed }}">
<label for="itemsInFeed"># Episodes</label> <label for="itemsInFeed"># Episodes</label>
</div> </div>
</div> </div>
@ -111,12 +166,20 @@
<div class="row"> <div class="row">
<div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3"> <div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="AppleCategory" id="appleCategory" class="form-control" <input
placeholder="iTunes Category" required value="{{ model.apple_category }}"> type="text"
name="AppleCategory"
id="appleCategory"
class="form-control"
placeholder="iTunes Category"
required
value="{{ model.apple_category }}">
<label for="appleCategory">iTunes Category</label> <label for="appleCategory">iTunes Category</label>
<span class="form-text fst-italic"> <span class="form-text fst-italic">
<a href="https://www.thepodcasthost.com/planning/itunes-podcast-categories/" target="_blank" <a
rel="noopener"> href="https://www.thepodcasthost.com/planning/itunes-podcast-categories/"
target="_blank"
rel="noopener">
iTunes Category / Subcategory List iTunes Category / Subcategory List
</a> </a>
</span> </span>
@ -124,17 +187,26 @@
</div> </div>
<div class="col-12 col-md-4 pb-3"> <div class="col-12 col-md-4 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="AppleSubcategory" id="appleSubcategory" class="form-control" <input
placeholder="iTunes Subcategory" value="{{ model.apple_subcategory }}"> type="text"
name="AppleSubcategory"
id="appleSubcategory"
class="form-control"
placeholder="iTunes Subcategory"
value="{{ model.apple_subcategory }}">
<label for="appleSubcategory">iTunes Subcategory</label> <label for="appleSubcategory">iTunes Subcategory</label>
</div> </div>
</div> </div>
<div class="col-12 col-md-3 col-lg-2 pb-3"> <div class="col-12 col-md-3 col-lg-2 pb-3">
<div class="form-floating"> <div class="form-floating">
<select name="Explicit" id="explicit" class="form-control" required> <select
<option value="yes"{% if model.explicit == "yes" %} selected="selected"{% endif %}>Yes</option> name="Explicit"
<option value="no"{% if model.explicit == "no" %} selected="selected"{% endif %}>No</option> id="explicit"
<option value="clean"{% if model.explicit == "clean" %} selected="selected"{% endif %}> 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 Clean
</option> </option>
</select> </select>
@ -145,31 +217,54 @@
<div class="row"> <div class="row">
<div class="col-12 col-md-6 col-lg-4 offset-xxl-1 pb-3"> <div class="col-12 col-md-6 col-lg-4 offset-xxl-1 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="DisplayedAuthor" id="displayedAuthor" class="form-control" <input
placeholder="Author" required value="{{ model.displayed_author }}"> type="text"
name="DisplayedAuthor"
id="displayedAuthor"
class="form-control"
placeholder="Author"
required
value="{{ model.displayed_author }}">
<label for="displayedAuthor">Displayed Author</label> <label for="displayedAuthor">Displayed Author</label>
</div> </div>
</div> </div>
<div class="col-12 col-md-6 col-lg-4 pb-3"> <div class="col-12 col-md-6 col-lg-4 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="email" name="Email" id="email" class="form-control" placeholder="Email" required <input
value="{{ model.email }}"> type="email"
name="Email"
id="email"
class="form-control"
placeholder="Email"
required
value="{{ model.email }}">
<label for="email">Author E-mail</label> <label for="email">Author E-mail</label>
<span class="form-text fst-italic">For iTunes, must match registered e-mail</span> <span class="form-text fst-italic">For iTunes, must match registered e-mail</span>
</div> </div>
</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="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"> <div class="form-floating">
<input type="text" name="DefaultMediaType" id="defaultMediaType" class="form-control" <input
placeholder="Media Type" value="{{ model.default_media_type }}"> type="text"
name="DefaultMediaType"
id="defaultMediaType"
class="form-control"
placeholder="Media Type"
value="{{ model.default_media_type }}">
<label for="defaultMediaType">Default Media Type</label> <label for="defaultMediaType">Default Media Type</label>
<span class="form-text fst-italic">Optional; blank for no default</span> <span class="form-text fst-italic">Optional; blank for no default</span>
</div> </div>
</div> </div>
<div class="col-12 col-sm-7 col-md-8 col-lg-10 offset-lg-1"> <div class="col-12 col-sm-7 col-md-8 col-lg-10 offset-lg-1">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="ImageUrl" id="imageUrl" class="form-control" placeholder="Image URL" required <input
value="{{ model.image_url }}"> type="text"
name="ImageUrl"
id="imageUrl"
class="form-control"
placeholder="Image URL"
required
value="{{ model.image_url }}">
<label for="imageUrl">Image URL</label> <label for="imageUrl">Image URL</label>
<span class="form-text fst-italic">Relative URL will be appended to {{ web_log.url_base }}/</span> <span class="form-text fst-italic">Relative URL will be appended to {{ web_log.url_base }}/</span>
</div> </div>
@ -178,8 +273,14 @@
<div class="row pb-3"> <div class="row pb-3">
<div class="col-12 col-lg-10 offset-lg-1"> <div class="col-12 col-lg-10 offset-lg-1">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="Summary" id="summary" class="form-control" placeholder="Summary" required <input
value="{{ model.summary }}"> type="text"
name="Summary"
id="summary"
class="form-control"
placeholder="Summary"
required
value="{{ model.summary }}">
<label for="summary">Summary</label> <label for="summary">Summary</label>
<span class="form-text fst-italic">Displayed in podcast directories</span> <span class="form-text fst-italic">Displayed in podcast directories</span>
</div> </div>
@ -188,8 +289,13 @@
<div class="row pb-3"> <div class="row pb-3">
<div class="col-12 col-lg-10 offset-lg-1"> <div class="col-12 col-lg-10 offset-lg-1">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="MediaBaseUrl" id="mediaBaseUrl" class="form-control" <input
placeholder="Media Base URL" value="{{ model.media_base_url }}"> 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> <label for="mediaBaseUrl">Media Base URL</label>
<span class="form-text fst-italic">Optional; prepended to episode media file if present</span> <span class="form-text fst-italic">Optional; prepended to episode media file if present</span>
</div> </div>
@ -198,8 +304,13 @@
<div class="row"> <div class="row">
<div class="col-12 col-lg-5 offset-lg-1 pb-3"> <div class="col-12 col-lg-5 offset-lg-1 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="FundingUrl" id="fundingUrl" class="form-control" placeholder="Funding URL" <input
value="{{ model.funding_url }}"> type="text"
name="FundingUrl"
id="fundingUrl"
class="form-control"
placeholder="Funding URL"
value="{{ model.funding_url }}">
<label for="fundingUrl">Funding URL</label> <label for="fundingUrl">Funding URL</label>
<span class="form-text fst-italic"> <span class="form-text fst-italic">
Optional; URL describing donation options for this podcast, relative URL supported Optional; URL describing donation options for this podcast, relative URL supported
@ -208,8 +319,14 @@
</div> </div>
<div class="col-12 col-lg-5 pb-3"> <div class="col-12 col-lg-5 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="FundingText" id="fundingText" class="form-control" maxlength="128" <input
placeholder="Funding Text" value="{{ model.funding_text }}"> type="text"
name="FundingText"
id="fundingText"
class="form-control"
maxlength="128"
placeholder="Funding Text"
value="{{ model.funding_text }}">
<label for="fundingText">Funding Text</label> <label for="fundingText">Funding Text</label>
<span class="form-text fst-italic">Optional; text for the funding link</span> <span class="form-text fst-italic">Optional; text for the funding link</span>
</div> </div>
@ -218,21 +335,28 @@
<div class="row pb-3"> <div class="row pb-3">
<div class="col-8 col-lg-5 offset-lg-1 pb-3"> <div class="col-8 col-lg-5 offset-lg-1 pb-3">
<div class="form-floating"> <div class="form-floating">
<input type="text" name="PodcastGuid" id="guid" class="form-control" placeholder="GUID" <input
value="{{ model.podcast_guid }}"> type="text"
name="PodcastGuid"
id="guid"
class="form-control"
placeholder="GUID"
value="{{ model.podcast_guid }}">
<label for="guid">Podcast GUID</label> <label for="guid">Podcast GUID</label>
<span class="form-text fst-italic"> <span class="form-text fst-italic">
Optional; v5 UUID uniquely identifying this podcast; once entered, do not change this value 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" (<a href="https://github.com/Podcastindex-org/podcast-namespace/blob/main/docs/1.0.md#guid" target="_blank">documentation</a>)
target="_blank">documentation</a>)
</span> </span>
</div> </div>
</div> </div>
<div class="col-4 col-lg-3 offset-lg-2 pb-3"> <div class="col-4 col-lg-3 offset-lg-2 pb-3">
<div class="form-floating"> <div class="form-floating">
<select name="Medium" id="medium" class="form-control"> <select
name="Medium"
id="medium"
class="form-control">
{% for med in medium_values -%} {% for med in medium_values -%}
<option value="{{ med[0] }}"{% if model.medium == med[0] %} selected{% endif %}> <option value="{{ med[0] }}"{% if model.medium == med[0] %}selected{% endif %}>
{{ med[1] }} {{ med[1] }}
</option> </option>
{%- endfor %} {%- endfor %}
@ -240,8 +364,7 @@
<label for="medium">Medium</label> <label for="medium">Medium</label>
<span class="form-text fst-italic"> <span class="form-text fst-italic">
Optional; medium of the podcast content Optional; medium of the podcast content
(<a href="https://github.com/Podcastindex-org/podcast-namespace/blob/main/docs/1.0.md#medium" (<a href="https://github.com/Podcastindex-org/podcast-namespace/blob/main/docs/1.0.md#medium" target="_blank">documentation</a>)
target="_blank">documentation</a>)
</span> </span>
</div> </div>
</div> </div>
@ -256,4 +379,4 @@
</div> </div>
</div> </div>
</form> </form>
</article> </article>

6
src/admin-theme/page-list.liquid
View File

@ -6,7 +6,7 @@
{%- assign title_col = "col-12 col-md-5" -%} {%- assign title_col = "col-12 col-md-5" -%}
{%- assign link_col = "col-12 col-md-5" -%} {%- assign link_col = "col-12 col-md-5" -%}
{%- assign upd8_col = "col-12 col-md-2" -%} {%- assign upd8_col = "col-12 col-md-2" -%}
<form method="post" class="container" hx-target="body"> <form method="post" class="container mb-3" hx-target="body">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row mwl-table-heading"> <div class="row mwl-table-heading">
<div class="{{ title_col }}"> <div class="{{ title_col }}">
@ -49,7 +49,7 @@
</div> </div>
{%- endfor %} {%- endfor %}
</form> </form>
{% if page_nbr > 1 or page_count == 25 %} {% if page_nbr > 1 or has_next %}
<div class="d-flex justify-content-evenly mb-3"> <div class="d-flex justify-content-evenly mb-3">
<div> <div>
{% if page_nbr > 1 %} {% if page_nbr > 1 %}
@ -61,7 +61,7 @@
{% endif %} {% endif %}
</div> </div>
<div class="text-right"> <div class="text-right">
{% if page_count == 25 %} {% if has_next %}
<p> <p>
<a class="btn btn-secondary" href="{{ "admin/pages" | append: next_page | relative_link }}"> <a class="btn btn-secondary" href="{{ "admin/pages" | append: next_page | relative_link }}">
Next &raquo; Next &raquo;

2
src/admin-theme/post-list.liquid
View File

@ -3,7 +3,7 @@
<a href="{{ "admin/post/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3">Write a New Post</a> <a href="{{ "admin/post/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3">Write a New Post</a>
{%- assign post_count = model.posts | size -%} {%- assign post_count = model.posts | size -%}
{%- if post_count > 0 %} {%- if post_count > 0 %}
<form method="post" class="container" hx-target="body"> <form method="post" class="container mb-3" hx-target="body">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}"> <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 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 title_col = "col-xs-12 col-md-7 col-lg-6 col-xl-5 col-xxl-4" -%}

2
src/admin-theme/version.txt
View File

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

33
src/admin-theme/wwwroot/admin.js
View File

@ -334,27 +334,34 @@ this.Admin = {
const theToast = new bootstrap.Toast(toast, options) const theToast = new bootstrap.Toast(toast, options)
theToast.show() theToast.show()
}) })
},
/**
* Initialize any toasts that were pre-rendered from the server
*/
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) { htmx.on("htmx:afterOnLoad", function (evt) {
const hdrs = evt.detail.xhr.getAllResponseHeaders() 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 // Show messages if there were any in the response
if (hdrs.indexOf("x-message") >= 0) { if (hdrs.indexOf("x-message") >= 0) {
Admin.showMessage(evt.detail.xhr.getResponseHeader("x-message")) Admin.showMessage(evt.detail.xhr.getResponseHeader("x-message"))
} }
// Initialize any toasts that were pre-rendered from the server
[...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:responseError", function (evt) { htmx.on("htmx:responseError", function (evt) {
@ -365,3 +372,5 @@ htmx.on("htmx:responseError", function (evt) {
Admin.showMessage(`danger|||${xhr.status}: ${xhr.statusText}`) Admin.showMessage(`danger|||${xhr.status}: ${xhr.statusText}`)
} }
}) })
document.addEventListener("DOMContentLoaded", Admin.showPreRenderedMessages, { once: true})

2
src/default-theme/version.txt
View File

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